当前位置:编程学习 > Delphi >>

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

自创改编小控件,不是一个哟!!

仔细看一下,你一定会喜欢的!

unit tcpip;


(*@/// inte易做图ce *)
inte易做图ce
  (*$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;
(*@\000000301*)
(*@///   EProtocolError=class(ETcpIpError) *)
EProtocolError=class(ETcpIpError)
  errornumber: word;
  protocoll: string;
  constructor Create(const proto,Msg:String; number:word);
  end;
(*@\000000401*)
(*@///   EProtocolBusy=class(ETcpIpError) *)
EProtocolBusy=class(ETcpIpError)
  constructor Create;
  end;
(*@\000000201*)

  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;
(*@\000002901*)

  { 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;
(*@\000000118*)
(*@///   T_Fingerd = class(T_TcpIp) *)
type
(*@///   TFingerInfo=record *)
TFingerInfo=record
  hostname: string;
  address: longint;
  request: string;
  end;
(*@\000000203*)
  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;
(*@\000000503*)

  { 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;                                    

补充:软件开发 , Delphi ,
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,