TCP/IP 使网络连接驱向简单化

自创改编小控件，不是一个哟！！

仔细看一下，你一定会喜欢的！

unit tcpip;

(*@/// interface *)
interface
  (*$x+ *)

(*@/// uses *)
uses
  sysutils,
  classes,
  controls,
  forms,
  winsock,
(*$ifdef ver80 *)
  winprocs,
  wintypes,
(*$else *)
  windows,
(*$endif *)
  messages,
  ip_misc;
(*@\\\*)

type
  t_socket_state = (invalid,valid,connected,state_unknown);
  t_timemode     = (tzUTC,tzLocal);
  t_ftp_mode     = (tftp_download,tftp_upload,tftp_getdir);
  t_filetype     = (ft_none, ft_dir, ft_file, ft_link);
  t_lpr_types    = (lp_plain, lp_ascii, lp_dvi, lp_plot, lp_ditroff, lp_ps,
                    lp_pr, lp_fortran, lp_troff, lp_raster, lp_cif);
  t_encoding     = (ec_base64, ec_quotedprintable, ec_none);
  TTraceLevel    = (tt_proto_sent, tt_proto_get, tt_socket);
(*@///   t_filedata=record ... end; *)
t_filedata=packed record
  filetype: t_filetype;
  size: integer;
  name: string;
  datetime: TDateTime;
  end;
(*@\\\*)
  ETcpIpError=class(Exception);
(*@///   ESocketError=class(ETcpIpError) *)
ESocketError=class(ETcpIpError)
  errornumber: word;
  constructor Create(number:word);
  end;
(*@\\\0000000301*)
(*@///   EProtocolError=class(ETcpIpError) *)
EProtocolError=class(ETcpIpError)
  errornumber: word;
  protocoll: string;
  constructor Create(const proto,Msg:String; number:word);
  end;
(*@\\\0000000401*)
(*@///   EProtocolBusy=class(ETcpIpError) *)
EProtocolBusy=class(ETcpIpError)
  constructor Create;
  end;
(*@\\\0000000201*)

  TTraceProc = procedure (const s:string; level:TTraceLevel) of object;
  TDataTransferProc = procedure (Sender:TObject; mode: t_ftp_mode; bytes: integer) of object;
  TFTPActionCompleteProc = procedure (Sender:TObject; mode: t_ftp_mode) of object;

  { The base component }
(*@///   T_TcpIp = class(TComponent) *)
T_TcpIp = class(TComponent)
protected
  f_handle: THandle;
  f_Socket: tsocket;
  f_hostname: string;
  f_tracer: TTraceProc;
  f_socket_number: smallint;
  ip_address: longint;  (* Network order! *)
  f_eof: boolean;
  f_newdata: boolean;
  f_stream: TStream;
  f_buffer: pointer;
  f_async: boolean;
  f_logged_in: boolean;
  procedure WndProc(var Msg : TMessage); virtual;
  function Create_Socket:TSocket;
  procedure connect_socket(var socket:TSocket; Socket_number:smallint;ip_address:longint);
  procedure bind_socket(var socket:TSocket; out_port_min,out_port_max: word);
  procedure open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); virtual;
  procedure open_socket_in(var socket:TSocket; Socket_number:smallint;ip_address:longint);
  procedure close_socket(var socket:TSocket);
  procedure close_socket_linger(var socket:TSocket);
  function accept_socket_in(socket:TSocket; var SockInfo:TSockAddr):TSocket;
  function socket_state(socket:TSocket):T_Socket_State;
  function Socket_by_name(const service:string):smallint;
  function read_line(f_socket:TSocket):string;
  procedure read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer);
  procedure write_buf(f_socket:TSocket; const buf; size:integer);
  procedure write_s(f_socket:TSocket; const s:string);
  procedure SetStream(value:TStream); (* for the property write of f_stream *)
  procedure action; VIRTUAL;
{   property Async:boolean read f_async write f_async default false; }
  procedure SendCommand(const s:string); VIRTUAL;
public
  procedure Login; virtual;
  procedure Logout; virtual;
  property OnTrace:TTraceProc read f_tracer write f_tracer;
  constructor Create(Aowner:TComponent); override;
  destructor Destroy; override;
  function eof(f_socket:TSocket):boolean; VIRTUAL;
  end;
(*@\\\0000002901*)

  { Finger client and demon      // RFC 1288 }
(*@///   T_Finger = class(T_TcpIp) *)
T_Finger = class(T_TcpIp)
protected
  f_user: string;
public
  constructor Create(Aowner:TComponent); override;
  property stream: TStream read f_stream;
  procedure action; override;
published
  property Hostname: string read f_hostname write f_hostname;
  property User: string read f_user write f_user;
  end;
(*@\\\0000000118*)
(*@///   T_Fingerd = class(T_TcpIp) *)
type
(*@///   TFingerInfo=record *)
TFingerInfo=record
  hostname: string;
  address: longint;
  request: string;
  end;
(*@\\\0000000203*)
  TFingerRequest=procedure (Sender:TObject; FingerInfo:TFingerInfo) of object;

T_Fingerd = class(T_TcpIp)
protected
  f_fingerrequest: TFingerRequest;
  f_answer: TStringList;
  procedure WndProc(var Msg : TMessage); override;
  procedure SetAnswer(Value: TStringList);
  procedure do_action; virtual;                    (* The real action *)
public
  constructor Create(Aowner:TComponent); override;
  destructor Destroy; override;
  procedure action; override;                      (* Only to set up *)
published
  property OnFingerRequest:TFingerRequest read f_fingerrequest write f_fingerrequest;
  property Answer: TStringList read f_answer write SetAnswer;
  end;
(*@\\\0000000503*)

  { HTTP and FTP - the file transfer protocols }
(*@///   T_HTTP = class(T_TcpIp)          // RFC 1945 (V1.0), RFC 2068 (V1.1) *)
T_HTTP = class(T_TcpIp)
protected
  f_url: string;
  f_path: string;   (* The real request string, calculated internally *)
  f_proxy: string;
  f_sender: string;
  f_reference: string;
  f_agent: string;
  f_nocache: boolean;
  f_status_nr: integer;
  f_status_txt: string;
  f_size: integer;
  f_type: string;
  f_author: string;
  f_do_author: TStringList;
  f_content_post: string;
  procedure GetHead;
  procedure GetBody;
  procedure sendrequest(const method,version: string);
  procedure getanswer;
public
  property stream: TStream read f_stream write SetStream;
  property content_size: integer read f_size;
  property content_type: string read f_type;
  property status_number: integer read f_status_nr;
  property status_text: string read f_status_txt;
  procedure action; override;                          (* the GET method *)
  procedure Post;                                      (* the POST method, untested!  *)
  constructor Create(Aowner:TComponent); override;
  destructor Destroy; override;
  procedure DoBasicAuthorization(const username,password:string);
  property AuthorizationRequest: TStringList read f_do_author;
  property Authorization: string read f_author write f_author;
published
  property URL: string read f_url write f_url;
  property Proxy: string read f_proxy write f_proxy;
  property Sender: string read f_sender write f_sender;
  property Agent: string read f_agent write f_agent;
  property Reference: string read f_reference write f_reference;
  property NoCache: boolean read f_nocache write f_nocache;
  property ContentTypePost: string read f_content_post write f_content_post;
  property OnTrace;
  end;
(*@\\\0000000C01*)
(*@///   T_FTP = class(T_TcpIp)           // RFC 959 *)
T_FTP = class(T_TcpIp)
protected
  f_url: string;
  f_status_nr: integer;
  f_status_txt: string;
  f_user: string;
  f_password: string;
  f_comm_socket: tsocket;
  f_passive: boolean;
  f_port: word;
  f_mode: t_ftp_mode;
  f_mode_intern: t_ftp_mode;
  f_cur_dir: TStringList;
  f_cur_dir_index: integer;
  f_size: integer;
  f_busy: boolean;
  f_onaction: TFTPActionCompleteProc;
  f_ondata_got: TDataTransferProc;
  f_dir_stream: TMemoryStream;
  f_async_data: boolean;
  procedure response;
  function read_line_comm:string;
  procedure SendCommand(const s:string); override;
  procedure get_datasocket;
  procedure WndProc(var Msg : TMessage); override;
  function do_write:boolean;
  function do_read:boolean;
  procedure finish_upload;
  procedure finish_download

[1] [2] [3]  下一页

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18