自創改編小控件，不是一個喲！！
仔細看一下，你一定會喜歡的！
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;
(*@\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;
