分享
 
 
 

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

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

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

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

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有