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;

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有