Self-created adaptation small controls, not one! !
Take a closer look, you will love it!
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; = (* @ //// *) etcpiper = class (exception); (* @ @ /// *) etcpiperror = class (* @ @ @ @ @ @ @ @ @ @ @ /// 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; (* @ @ @ @ @ / 00 00000401 *) (* @ /// EPROTOCOLBUSY = Class (etcmit) *) 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 sock et_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; F_Socket: Tsocket: Boolean; Virtual; End; (* @ @ @ @ @ @ @ @ @ /// 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; (* @ @ @ @ @ @ @ /// t_fingerd = class (t_tcpip) *) TYPE (* @ /// TfingerInfo = Record *) TFingerInfo = Record Hostname: string; address : long; (* @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ sdfffo) 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; (* @ / @ 00000503 *)
{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 ContentTyPost: String Read F_Content_Post Write F_Content_post; Property Ontrace; End;
(* @ @ @ @ @ @ /// 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 (co nst 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; design; 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; ooverride; 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_PRINTTTYPE WRITE F_PRINTTYPE DEFAULT LP_ASCII; Property CopyCount: Integer Read F_Count Write F_Coun T Default 1; Property Printbanner: Boolean Read F_Banner Write F_Banner Default False; Property PRINTTITLE: STRING READ F_TILE WRITE F_TITLE; END; (* @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @)
{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: Tcomp onent); 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: s TRING READ F_HOSTNAME WRITE F_HOSTNAME; Property ONTRACE; END; (* @ @ @ @ @ @ @ @ @ @)
{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; (* @ @ @ @ @ t _ = 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; (* @ @ @ @ @@@@
/// 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; (* @ @ @ @ @ @ // ilmentation *) Implementation
