自创改编小控件，不是一个哟！！
仔细看一下，你一定会喜欢的！
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; procedure finish_getdir;public (* will become public once tested *) procedure changedir(const f_dir:string); procedure removefile(const filename:string); procedure removedir(const dirname:string); procedure makedir(const dirname:string); procedure renamefile(const prior,after:string); procedure getdir(const dirname:string); function getdirentry:t_filedata;public property stream: TStream read f_stream write SetStream; property status_number: integer read f_status_nr; property status_text: string read f_status_txt; property busy: boolean read f_busy; procedure login; override; procedure logout; override; procedure download; procedure upload; procedure abort; procedure noop; constructor Create(Aowner:TComponent); override; destructor Destroy; override; procedure action; override; property Size:integer read f_size;published property Hostname: string read f_hostname write f_hostname; property URI: string read f_url write f_url; property Password:string read f_password write f_password; property Username:string read f_user write f_user; property Passive:boolean read f_passive write f_passive default true; property Port:word read f_port write f_port default 21; property Mode:t_ftp_mode read f_mode write f_mode default tftp_download; property OnDataReceived:TDataTransferProc read f_ondata_got write f_ondata_got; property OnActionComplete:TFTPActionCompleteProc read f_onaction write f_onaction; property Async:boolean read f_async_data write f_async_data; property OnTrace;end;(*@///0000003501*)
{ Time, RExec, LPR - the most useful UNIX services }(*@/// T_Time = class(T_TcpIp) // RFC 868 *)T_Time = class(T_TcpIp)protected f_time: TDateTime; f_timemode: T_TimeMode;public constructor Create(Aowner:TComponent); override; procedure action; override; property time: TDateTime read f_time;published property Hostname: string read f_hostname write f_hostname; property TimeMode: T_TimeMode read f_timemode write f_timemode default tzUTC; end;(*@///0000000103*)(*@/// T_RCommon = class(T_TcpIp) *)T_RCommon = class(T_TcpIp)protected procedure open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); override;public procedure action; override; property stream: TStream read f_stream;published property Hostname: string read f_hostname write f_hostname; end;(*@///0000000103*)(*@/// T_RExec = class(T_RCommon) *)T_RExec = class(T_RCommon)protected f_user: string; f_pass: string; f_command: string; procedure login; override;public constructor Create(Aowner:TComponent); override;published property UserName: string read f_user write f_user; property Password: string read f_pass write f_pass; property Command: string read f_command write f_command; end;(*@///0000000113*)(*@/// T_Rsh = class(T_RCommon) *)T_Rsh = class(T_RCommon)protected f_user_r: string; f_user_l: string; f_command: string; procedure login; override;public constructor Create(Aowner:TComponent); override;published property LocalUser: string read f_user_l write f_user_l; property RemoteUser: string read f_user_r write f_user_r; property Command: string read f_command write f_command; end;(*@///0000000111*)(*@/// T_lpr = class(T_TcpIp) // RFC 1179 *)T_lpr = class(T_TcpIp)protected f_printtype: t_lpr_types; f_banner: boolean; f_count: integer; f_user: string; f_queue: string; f_user_mail: string; f_jobname: string; f_title: string; procedure response; procedure open_socket_out(var socket:TSocket; Socket_number:smallint;ip_address:longint); override;public constructor Create(Aowner:TComponent); override; property stream: TStream read f_stream write SetStream; procedure action; override; procedure SendPrintData; procedure GetQueueStatus(detailed:boolean);published property Hostname: string read f_hostname write f_hostname; property User: string read f_user write f_user; property PrintQueue: string read f_queue write f_queue; property MailTo: string read f_user_mail write f_user_mail; property JobName: string read f_jobname write f_jobname; property PrintType:t_lpr_types read f_printtype write f_printtype default lp_ascii; property CopyCount:integer read f_count write f_count default 1; property PrintBanner:boolean read f_banner write f_banner default false; property PrintTitle:string read f_title write f_title; end;(*@///0000000103*)
{ The Mail and News protocols }(*@/// T_SMTP = class(T_TcpIp) // RFC 821 *)T_SMTP = class(T_TcpIp)protected f_user, f_host: string; f_status_nr: integer; f_status_txt: string; f_receipts, f_body: tstringlist; procedure SetBody(Value: TStringList); procedure SetRecipients(Value: TStringList); procedure response;public constructor Create(Aowner:TComponent); override; destructor Destroy; override; procedure action; override; property Recipients: TStringlist read f_receipts write SetRecipients; property Message: TStringList read f_body write SetBody; property Sender: string read f_user write f_user;published property Hostname: string read f_hostname write f_hostname; property OnTrace; end;(*@///0000001001*)(*@/// T_Pop3 = class(T_TcpIp) // RFC 1725 *)T_Pop3 = class(T_TcpIp)protected f_user: string; f_pass: string; f_list: TList; f_mail: TStringList; procedure response;public property Mail: TStringlist read f_mail; constructor Create(Aowner:TComponent); override; destructor Destroy; override; procedure action; override; (* retrieval of first message *) procedure Login; override; procedure GetHeaders; procedure Logout; override; procedure GetMail(index: integer); procedure DeleteMail(index:integer);published property Hostname: string read f_hostname write f_hostname; property UserName: string read f_user write f_user; property Password: string read f_pass write f_pass; property OnTrace;end;(*@///0000001701*)(*@/// T_NNTP = class(T_TcpIp) // RFC 977 *)T_NNTP = class(T_TcpIp)protected f_news: TStringList; f_newsgroups: TStringList; f_status_nr: integer; f_status_txt: string; procedure response; procedure action; override; (* ??? *) procedure SetNews(value:TStringlist); procedure GetArticleInternally;public property News: TStringlist read f_news write SetNews; property NewsGroups: TStringlist read f_newsgroups; constructor Create(Aowner:TComponent); override; destructor Destroy; override; procedure Login; override; procedure Logout; override; (* To get an article from a URL like nntp://hostname/number *) procedure GetArticle(const group:string; index:integer); (* To get an article from a URL like news:msgid *) procedure GetArticleID(const msgid:string); procedure PostArticle; (* Methods more for a Newsreader *) procedure GetAllNewsgroups; procedure GetNewNewsgroups(since:TDateTime); procedure SetGroup(const group:string; var low,high,count: integer); procedure GetArticleNr(index:integer); procedure SetCurrentArticle(index:integer); procedure GetCurrentArticle; procedure GetNextArticle; procedure GetPreviousArticle;published property Hostname: string read f_hostname write f_hostname; property OnTrace;end;(*@///0000002301*)
{ Mail and News text components }(*@/// T_MailNews = class(TComponent) *)T_MailNews = class(TComponent)protected f_from, f_sender, f_subject: string; f_body: TStringlist; f_add_header: TStringlist; f_message: TStringlist; f_references: string; f_replyto: string; procedure SetBody(Value: TStringList); procedure SetHeader(Value: TStringList);public constructor Create(Aowner:TComponent); override; destructor Destroy; override; procedure action; VIRTUAL;published property Sender: string read f_sender write f_sender; property From: string read f_from write f_from; property Body: TStringList read f_body write SetBody; property Header: TStringList read f_add_header write SetHeader; property Subject:string read f_subject write f_subject; property References:string read f_references write f_references; property ReplyTo:string read f_replyto write f_replyto;end;(*@///0000001001*)(*@/// T_Mail = class(T_MailNews) // RFC 822 *)T_Mail = class(T_MailNews)protected f_smtp: T_SMTP; f_receipts: TStringlist; f_cc: TStringlist; f_bcc: TStringlist; f_disclose_receipts: boolean; procedure SetRecipients(Value: TStringList); procedure SetCC(Value: TStringList); procedure SetBCC(Value: TStringList);public constructor Create(Aowner:TComponent); override; destructor Destroy; override; procedure action; override;published property SMTP: T_SMTP read f_smtp write f_smtp; property Disclose_Receipts: boolean read f_disclose_receipts write f_disclose_receipts default false; property Recipients: TStringlist read f_receipts write SetRecipients; property CC: TStringlist read f_cc write SetCC; property BCC: TStringlist read f_bcc write SetBCC;end;(*@///0000000601*)(*@/// T_News = class(T_MailNews) // RFC 850 *)T_News = class(T_MailNews)protected f_nntp: T_NNTP; f_newsgroups: TStringlist; f_organization: string; procedure SetNewsgroups(Value: TStringList);public constructor Create(Aowner:TComponent); override; destructor Destroy; override; procedure action; override;published property NNTP: T_NNTP read f_nntp write f_nntp; property Newsgroups: TStringlist read f_newsgroups write SetNewsgroups; property Organization: string read f_organization write f_organization;end;(*@///0000000C14*)(*@/// T_Attachment = class(TObject) *)T_Attachment = class(TObject)protected f_kind: string; f_disposition: string; f_data: TStream; f_text: TStringList; f_encoding: T_Encoding; procedure SetText(value:TStringList); procedure SetData(value:TStream);public constructor Create; destructor Destroy; override; property Kind: string read f_kind write f_kind; property Disposition: string read f_disposition write f_disposition; property Encoding: T_Encoding read f_encoding write f_encoding; property Text:TStringlist read f_text write SetText; property Data:TStream read f_data write SetData;end;(*@///0000000D01*)(*@/// T_Mime = class(TComponent) // RFC 1521 *)T_Mime = class(TComponent)protected f_mail: T_MailNews; boundary: string; f_attachment: TList; function GetNumberOfAttachments: integer;public constructor Create(Aowner:TComponent); override; destructor Destroy; override; function AttachFile(const filename:string):integer; function AttachText(text: TStringList):integer; procedure RemoveAllAttachments; procedure action; procedure SetMail(mail: TStringlist); function GetAttachment(index: integer):T_Attachment; procedure RemoveAttachment(index: integer); property Attachment[index:integer]:T_Attachment read GetAttachment; property NumberOfAttachments: integer read GetNumberOfAttachments;published property Mail: T_MailNews read f_mail write f_mail;end;(*@///0000000A01*)
const uwm_socketevent = wm_user+$100; (* my magic message number *)
var lpr_count: integer; (* the current job number *)
procedure Register;(*@///0000003B03*)(*@/// implementation *)implementation
