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

原创 2001年07月30日 16:40:00

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

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

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

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

(*@/// Parse a FTP directory line into a filedata record (UNIX and DOS style only) *)const month_str...
  • mysine
  • mysine
  • 2001年07月30日 16:41
  • 882

TCP/IP和Internet

下载第2章TCP/IP和Internet作者:Neal S.Jamison本章内容包括:• 一段历史• RFC和标准化过程• Internet服务简介• Intranet和E x t r a n e ...
  • menuconfig
  • menuconfig
  • 2007年07月26日 13:28
  • 791

《TCP/IP入门经典》——网络访问层

一、协议和硬件   1、网络访问层管理为物理网络准备数据所必须的服务与功能:    1)、与计算机网络适配器的连接。    2)、根据合适的网络方式调整数据传输。    3)、将数据转化为电子...
  • Explorer_day
  • Explorer_day
  • 2015年06月28日 21:40
  • 1364

配置PostgreSQL实现TCP/IP访问连接

自己的机器上装了PostgreSQL,也想让其他机器来共享我的数据库,那就需要做一下配置先~ 这里针对Windows下安装的PostgreSQL 8.2来说的,较低版本可能配置文件不尽相同~ 1- 找...
  • shuaiwang
  • shuaiwang
  • 2007年09月20日 16:21
  • 6877

网络各个协议:UDP、TCP/IP、SOCKET、HTTP

一、网络各个协议:TCP/IP、SOCKET、HTTP等网络七层由下往上分别为物理层、数据链路层、网络层、传输层、会话层、表示层和应用层。 其中物理层、数据链路层和网络层通常被称作媒体层,是网络工程...
  • DevanChen
  • DevanChen
  • 2016年12月21日 16:50
  • 475

显示协议统计信息和当前 TCP/IP 网络连接。

显示协议统计信息和当前 TCP/IP 网络连接。 NETSTAT [-a] [-b] [-e] [-n] [-o] [-p proto] [-r] [-s] [-v] [interval]   -...
  • winterduoduo
  • winterduoduo
  • 2011年06月02日 12:17
  • 859

51单片机 ENC28J60 TCP/IP通信

51单片机 ENC28J60 TCP/IP通信 单片机:STC90C516RD+ ENC28J60模块:mini(3.3V供电) 设备:PC、开发板、两个网线、路由器 首先先介绍一下本文的移植针对于单...
  • A_A666
  • A_A666
  • 2017年10月18日 20:50
  • 192

TCP/IP连接的建立

1.TCP连接的建立            设主机B运行一个服务器进程,它先发出一个被动打开命令,告诉它的TCP要准备接收客户进程的连续请求,然后服务进程就处于听的状态。不断检测是否有客户进程发起连续...
  • wangxiaotongfan
  • wangxiaotongfan
  • 2016年05月04日 17:01
  • 3996

socket通信,TCP协议,有多个客户端,服务器怎么向指定IP及端口的客户端发送数据!

1.服务器是在等待中,当得到socket连接时,就得到了对端的端点地址。每个客户端是不同的端点地址。 2.如果不用bind直接connect,系统分给客户端的端口是随机的...
  • YEYUANGEN
  • YEYUANGEN
  • 2011年09月19日 17:20
  • 4044

TCP-IP学习笔记五:Netty使用--简单通信编程1

TCP/IP学习笔记五:Netty使用–简单通信编程1标签(空格分隔):Netty 网络编程Netty的简单使用示例。编程思路按照注释进行就可以了。一、导入Netty的jar最先版本:netty-al...
  • MOTUI
  • MOTUI
  • 2016年10月11日 21:53
  • 944
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:TCP/IP 使网络连接驱向简单化
举报原因:
原因补充:

(最多只允许输入30个字)