开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
Psock.pas
资源名称：FastNet.rar　[点击查看]
上传用户：szzdds
上传日期：2013-09-18
资源大小：293k
文件大小：72k
源码类别：

Delphi控件源码

开发平台：

Delphi

Psock.pas：源码内容
  1. unit Psock;
  3. {$IFDEF VER100}
  4. {$DEFINE NMF3}
  5. {$ENDIF}
  6. {$IFDEF VER110}
  7. {$DEFINE NMF3}
  8. {$ENDIF}
  9. {$IFDEF VER120}
  10. {$DEFINE NMF3}
  11. {$ENDIF}
  12. {$IFDEF VER125}
  13. {$DEFINE NMF3}
  14. {$ENDIF}
  15. {$IFDEF VER130}
  16. {$DEFINE NMF3}
  17. {$ENDIF}
  18. {$IFDEF VER150}
  19. {$DEFINE NMF3}
  20. {$ENDIF}
  22. {$X+}
  23. {$H+}
  24. {$R-}
  25. {$DEFINE _WINSOCKAPI_}
  27. interface
  29. uses
  30.   Winsock, Classes, SysUtils, Extctrls, Forms, Messages, StdCtrls,
  31.   WinProcs, NMConst, NMFIFOBuffer, SyncObjs;
  33. {$IFDEF VER110}
  34. {$OBJEXPORTALL On}
  35. {$ENDIF}
  36. {$IFDEF VER120}
  37. {$OBJEXPORTALL On}
  38. {$ENDIF}
  39. {$IFDEF VER125}
  40. {$OBJEXPORTALL On}
  41. {$ENDIF}
  43. type
  44.   TSocket = Word;
  46. const
  48.   FD_ALL = 63;
  50.   {Size of receive and send buffer}
  51.   MAX_RECV_BUF = 65536;
  53.   { Levels for reporting Status Messages}
  54.   Status_None = 0;
  55.   Status_Informational = 1;
  56.   Status_Basic = 2;
  57.   Status_Routines = 4;
  58.   Status_Debug = 8;
  59.   Status_Trace = 16;
  61.   {Carriage Return and Line Feed constants}
  62.   CR = #13;
  63.   LF = #10;
  64.   CRLF = #13#10;
  66.   WM_ASYNCHRONOUSPROCESS = WM_USER + 101; {Message number for asynchronous socket messages}
  67.   WM_WAITFORRESPONSE = WM_USER + 102; {Message number for synchronous responses}
  69. type
  70.   TErrorMessage = record
  71.     ErrorCode: Integer;
  72.     Text: string[50];
  73.   end;
  75. const
  76.   WinsockMessage: array[0..50] of TErrorMessage =
  77.   (
  78.     (ErrorCode: 10004; Text: 'Interrupted system call'),
  79.     (ErrorCode: 10009; Text: 'Bad file number'),
  80.     (ErrorCode: 10013; Text: 'Permission denied'),
  81.     (ErrorCode: 10014; Text: 'Bad address'),
  82.     (ErrorCode: 10022; Text: 'Invalid argument'),
  83.     (ErrorCode: 10024; Text: 'Too many open files'),
  84.     (ErrorCode: 10035; Text: 'Operation would block'),
  85.     (ErrorCode: 10036; Text: 'Operation now in progress'),
  86.     (ErrorCode: 10037; Text: 'Operation already in progress'),
  87.     (ErrorCode: 10038; Text: 'Socket operation on non-socket'),
  88.     (ErrorCode: 10039; Text: 'Destination address required'),
  89.     (ErrorCode: 10040; Text: 'Message too long'),
  90.     (ErrorCode: 10041; Text: 'Wrong protocol type for socket'),
  91.     (ErrorCode: 10042; Text: 'Bad protocol option'),
  92.     (ErrorCode: 10043; Text: 'Protocol not supported'),
  93.     (ErrorCode: 10044; Text: 'Socket type not supported'),
  94.     (ErrorCode: 10045; Text: 'Operation not supported on socket'),
  95.     (ErrorCode: 10046; Text: 'Protocol family not supported'),
  96.     (ErrorCode: 10047; Text: 'Address family not supported by protocol family'),
  97.     (ErrorCode: 10048; Text: 'Address already in use'),
  98.     (ErrorCode: 10049; Text: 'Can''t assign requested address'),
  99.     (ErrorCode: 10050; Text: 'Network is down'),
  100.     (ErrorCode: 10051; Text: 'Network is unreachable'),
  101.     (ErrorCode: 10052; Text: 'Network dropped connection or reset'),
  102.     (ErrorCode: 10053; Text: 'Software caused connection abort'),
  103.     (ErrorCode: 10054; Text: 'Connection reset by peer'),
  104.     (ErrorCode: 10055; Text: 'No buffer space available'),
  105.     (ErrorCode: 10056; Text: 'Socket is already connected'),
  106.     (ErrorCode: 10057; Text: 'Socket is not connected'),
  107.     (ErrorCode: 10058; Text: 'Can''t send after socket shutdown'),
  108.     (ErrorCode: 10059; Text: 'Too many references, can''t splice'),
  109.     (ErrorCode: 10060; Text: 'Connection timed out'),
  110.     (ErrorCode: 10061; Text: 'Connection refused'),
  111.     (ErrorCode: 10062; Text: 'Too many levels of symbolic links'),
  112.     (ErrorCode: 10063; Text: 'File name too long'),
  113.     (ErrorCode: 10064; Text: 'Host is down'),
  114.     (ErrorCode: 10065; Text: 'No route to Host'),
  115.     (ErrorCode: 10066; Text: 'Directory not empty'),
  116.     (ErrorCode: 10067; Text: 'Too many processes'),
  117.     (ErrorCode: 10068; Text: 'Too many users'),
  118.     (ErrorCode: 10069; Text: 'Disc quota exceeded'),
  119.     (ErrorCode: 10070; Text: 'Stale NFS file handle'),
  120.     (ErrorCode: 10071; Text: 'Too many levels of remote in path'),
  121.     (ErrorCode: 10091; Text: 'Network subsystem is unavailable'),
  122.     (ErrorCode: 10092; Text: 'Incompatible version of WINSOCK.DLL'),
  123.     (ErrorCode: 10093; Text: 'Successful WSAStartup not yet performed'),
  124.     (ErrorCode: 11001; Text: 'Host not found'),
  125.     (ErrorCode: 11002; Text: 'Non-Authoritative Host not found'),
  126.     (ErrorCode: 11003; Text: 'Non-Recoverable error: FORMERR, REFUSED, NOTIMP'),
  127.     (ErrorCode: 11004; Text: 'Valid name, no data record of requested type'),
  128.     (ErrorCode: 0; Text: 'Unrecognized error code')
  129.     );
  130. type
  131.     {Event Handlers}
  132.   TOnErrorEvent = procedure(Sender: TComponent; Errno: Word; Errmsg: string) of object;
  133.   TOnHostResolved = procedure(Sender: TComponent) of object;
  134.   TOnStatus = procedure(Sender: TComponent; Status: string) of object;
  135.   THandlerEvent = procedure(var Handled: Boolean) of object;
  137.   { new basic pointer types }
  138.   PLongint = ^Longint;
  139.   PPLongInt = ^PLongint;
  140.   PPChar = ^PChar;
  141.   PINT = ^PInteger;
  143.   THostInfo = record
  144.     Name: PChar;
  145.     AliasList: PPChar;
  146.     AddressType: Integer;
  147.     AddressSize: Integer;
  148.     AddressList: PPLongInt;
  149.     Reserved: array[1..MAXGETHOSTSTRUCT] of Char;
  150.   end;
  152.   TServerInfo = record
  153.     Name: PChar;
  154.     Aliases: PPChar;
  155.     PORT: Integer;
  156.     Protocol: PChar;
  157.     Reserved: array[1..MAXGETHOSTSTRUCT] of Char;
  158.   end;
  160.   TProtocolInfo = record
  161.     Name: PChar;
  162.     Aliases: PPChar;
  163.     ProtocolID: Integer;
  164.     Reserved: array[1..MAXGETHOSTSTRUCT] of Char;
  165.   end;
  167.   TSocketAddress = record
  168.     Family: Integer;
  169.     PORT: Word;
  170.     Address: Longint;
  171.     Unused: array[1..8] of Char;
  172.   end;
  174.   TSocketList = record
  175.     Count: Integer;
  176.     DescriptorList: array[1..64] of Integer;
  177.   end;
  179.   TTimeValue = record
  180.     Sec: Longint;
  181.     uSec: Longint;
  182.   end;
  184.   {new WINSOCK pointer types}
  185.   PWSAData = ^TWSAData;
  186.   PHostInfo = ^THostInfo;
  187.   PServerInfo = ^TServerInfo;
  188.   PProtocolInfo = ^TProtocolInfo;
  189.   PSocketAddress = ^TSocketAddress;
  190.   PSocketList = ^TSocketList;
  191.   PTimeValue = ^TTimeValue;
  193.   ESockError = class(Exception);
  194.   EAbortError = class(ESockError);
  196.   TThreadTimer = class(TComponent)
  197.   private
  198.     FInterval: Cardinal;
  199.     FWindowHandle: HWND;
  200.     FOnTimer: TNotifyEvent;
  201.     FEnabled: Boolean;
  202.     procedure UpdateTimer;
  203.     procedure SetEnabled(Value: Boolean);
  204.     procedure SetInterval(Value: Cardinal);
  205.     procedure SetOnTimer(Value: TNotifyEvent);
  206.     procedure Wndproc(var Msg: TMessage);
  207.   protected
  208.     procedure Timer; dynamic;
  209.   public
  210.     constructor Create(AOwner: TComponent); override;
  211.     destructor Destroy; override;
  212.   published
  213.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  214.     property Interval: Cardinal read FInterval write SetInterval default 1000;
  215.     property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  216.   end;
  218. {$IFNDEF NMF3}
  220.   { TStringStream }
  221.   TStringStream = class(TStream)
  222.   private
  223.     FDataString: string;
  224.     FPosition: Integer;
  225.   protected
  227.   public
  228.     procedure SetSize(NewSize: Longint);
  229.     constructor Create(const AString: string);
  230.     function Read(var Buffer; Count: Longint): Longint; override;
  231.     function ReadString(Count: Longint): string;
  232.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  233.     function Write(const Buffer; Count: Longint): Longint; override;
  234.     procedure WriteString(const AString: string);
  235.     property DataString: string read FDataString;
  236.   end;
  238.   TThreadList = class
  239.   private
  240.     FList: TList;
  241.   public
  242.     constructor Create;
  243.     destructor Destroy; override;
  244.     procedure Add(Item: Pointer);
  245.     procedure Clear;
  246.     function LockList: TList;
  247.     procedure Remove(Item: Pointer);
  248.     procedure UnlockList;
  249.   end;
  250. {$ENDIF}
  252.   {*******************************************************************************************
  253.   Power Socket class definition
  254.   ********************************************************************************************}
  255.   TPowersock = class(TComponent)
  256.   private
  257.     Buf: array[0..MAX_RECV_BUF] of Char;
  259.     WaitSignal: TEvent;
  261.     {Event Handlers for Asynchronous socket events}
  262.     FOnReadEvent: TNotifyEvent;
  263.     FOnAcceptEvent: TNotifyEvent;
  264.     FOnConnect: TNotifyEvent;
  265.     FOnDisconnect: TNotifyEvent;
  266.     FOnErrorEvent: TOnErrorEvent; {Event handler for error notification}
  268.     FInvalidHost: THandlerEvent;
  269.     FOnHostResolved: TOnHostResolved; {Event handler after a host name is found}
  270.     FOnConnectionRequired: THandlerEvent;
  271.     FOnStatus: TOnStatus; {Event handler on a status change}
  272.     FOnConnectionFailed: TNotifyEvent;
  273.     FWSAInfo: TStringList;
  274.     {Component Internals}
  275.     FBytesSent: Longint; {Number of bytes currently sent}
  277.     Canceled: Boolean; {Flag to indicate request cancelled}
  278.     DestroySocket: Boolean; {flag to indicate socket to be destroyed or not}
  279.     FLastErrorno: Integer; {The last error Encountered}
  280.     FTimeOut: Integer; {Time to wait before timout}
  281.     FReportLevel: Integer; {Reporting Level}
  282.     _Status: string; {Current status}
  283.     FProxy: string; {Name or IP of proxy server}
  284.     FProxyPort: Integer; {Port of proxy server}
  286.     {TimeOut Functions}
  287.     Timer: TThreadTimer; {Timer for synchronous requests}
  289.     {For Documentation of functions and procedures see implementation}
  290.     procedure TimerFired(Sender: TObject);
  291.     procedure Wndproc(var message: TMessage); {}
  293.   protected
  294.     FifoQ: TNMFifoBuffer;
  295.     Succeed: Boolean; {Flag for indicating if synchronous request succeded}
  296.     TimedOut: Boolean; {Flag to indicate process timed out}
  297.     FPort: Integer; {Port at server to connect to}
  298.     FBytesTotal: Longint; {Total number of bytes to send or receive}
  299.     FBytesRecvd: Longint; {Number of bytes currently received}
  300.     FPacketRecvd: TNotifyEvent; {Handler after each packet received for progress reports etc}
  301.     FPacketSent: TNotifyEvent; {Handler after each packet received for progress reports etc}
  302.     Wait_Flag: Boolean; {Flag to indicate if synchronous request completed or not}
  303.     RemoteAddress: TSockAddr; {Address of remote host}
  304.     ServerName: string; {Name of remote host}
  305.     RemoteHost: PHostEnt; {Entity to store remote host linfo from a Hostname request}
  306.     FTransactionReply: string; {Reply to a command request}
  307.     FReplyNumber: Smallint; {Reply number to a command request}
  308.     DataGate: Boolean;
  309.     AbortGate: Boolean;
  310.     StrmType: Boolean;
  312.     OnAbortrestart: TNotifyEvent;
  314.     procedure TimerOn;
  315.     procedure TimerOff;
  316.     procedure InitWinsock;
  317.     procedure ReadToBuffer;
  318.     procedure SetLastErrorNo(Value: Integer);
  319.     function SocketErrorStr(Errno: Word): string;
  320.     function GetLastErrorNo: Integer;
  321.     function ErrorManager(Ignore: Word): string;
  322.     procedure SetWSAError(ErrorNo: Word; ErrorMsg: string);
  323.     procedure StatusMessage(Level: Byte; Value: string);
  324.     function GetRemoteIP: string;
  325.     function GetLocalIP: string;
  327.     procedure SetFifoCapacity(NewCapacity: Longint);
  328.     function GetFifoCapacity: Longint;
  330.     {Properties - Make Public the ones that the User needs to respond to in derived class}
  331.     {Event Handlers for Asynchronous Events}
  332.     property OnAccept: TNotifyEvent read FOnAcceptEvent write FOnAcceptEvent;
  333.     {Event Handler for Errors}
  334.     property OnError: TOnErrorEvent read FOnErrorEvent write FOnErrorEvent;
  335.     {Event Handler for Status changes}
  336.     property OnConnectionRequired: THandlerEvent read FOnConnectionRequired write FOnConnectionRequired;
  337.     property Proxy: string read FProxy write FProxy; {name or IP of proxy server}
  338.     property ProxyPort: Integer read FProxyPort write FProxyPort; {Port of proxy server}
  340.   public
  341.     ThisSocket: TSocket; {The socket number of the Powersocket}
  342.     FSocketWindow: HWND; {Dummy window handle to receive Socket messages}
  343.     FConnected: Boolean; {Flag indicating socket connected or not}
  345.     {For Documentation of functions and procedures see implementation}
  346.     constructor Create(AOwner: TComponent); override;
  347.     destructor Destroy; override;
  349.     {Runtime Properties}
  351.     {Methods}
  352.     function Accept: TSocket; virtual;
  353.     procedure Cancel;
  354.     procedure Connect; virtual;
  355.     procedure Disconnect; virtual;
  356.     procedure Wait;
  357.     procedure Listen(sync: Boolean);
  358.     procedure SendBuffer(Value: PChar; BufLen: Word);
  359.     procedure Write(Value: string);
  360.     procedure Writeln(Value: string);
  361.     function Read(Value: Word): string;
  362.     function Readln: string;
  363.     function Transaction(const CommandString: string): string; virtual;
  364.     procedure SendFile(Filename: string);
  365.     procedure SendStream(MainStream: TStream);
  366.     procedure SendRestStream(MainStream: TStream);
  367.     procedure CaptureFile(Filename: string);
  368.     procedure AppendFile(Filename: string);
  369.     procedure CaptureStream(MainStream: TStream; Size: Longint);
  370.     procedure CaptureString(var AString: string; Size: Longint);
  371.     procedure FilterHeader(HeaderStream: TFileStream);
  372.     procedure ResolveRemoteHost;
  373.     procedure RequestCloseSocket;
  374.     procedure Close(Socket: THandle);
  375.     procedure Abort; virtual;
  376.     procedure CertifyConnect;
  377.     function DataAvailable: Boolean;
  378.     procedure ClearInput;
  379.     procedure CloseAfterData;
  380.     procedure CloseImmediate;
  381.     function GetLocalAddress: string;
  382.     function GetPortString: string;
  383.     property WSAInfo: TStringList read FWSAInfo; {Winsock info}
  384.     property Connected: Boolean read FConnected;
  385.     property LastErrorNo: Integer read GetLastErrorNo write SetLastErrorNo; {Last Socket error}
  386.     property BeenCanceled: Boolean read Canceled write Canceled; {Status of Cancel request}
  387.     property BeenTimedOut: Boolean read TimedOut;
  388.     property ReplyNumber: Smallint read FReplyNumber; {Numerical result from transaction}
  389.     property RemoteIP: string read GetRemoteIP;
  390.     property LocalIP: string read GetLocalIP;
  391.     property TransactionReply: string read FTransactionReply; {Result from commnd request}
  392.     property BytesTotal: Longint read FBytesTotal; {Total bytes to send or receive}
  393.     property BytesSent: Longint read FBytesSent; {Bytes currently sent}
  394.     property BytesRecvd: Longint read FBytesRecvd; {Bytes currently received}
  395.     property Handle: TSocket read ThisSocket; {Power Socket handle}
  396.     property Status: string read _Status; {Current status}
  397.     property OnRead: TNotifyEvent read FOnReadEvent write FOnReadEvent;
  398.     property OnPacketRecvd: TNotifyEvent read FPacketRecvd write FPacketRecvd; {Handler for status messages during send or receive}
  399.     property OnPacketSent: TNotifyEvent read FPacketSent write FPacketSent; {Handler for status messages during send or receive}
  401.     property FifoCapacity: Longint read GetFifoCapacity write SetFifoCapacity;
  402.   published
  403.     {Properties}
  404.     property Host: string read ServerName write ServerName; {Host Nmae or IP of remote host}
  405.     property PORT: Integer read FPort write FPort; {Port of remote host}
  406.     property TimeOut: Integer read FTimeOut write FTimeOut default 0; {Time before being timed out}
  407.     property ReportLevel: Integer read FReportLevel write FReportLevel default Status_Informational;
  408.     {Events}
  409.     property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
  410.     property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
  411.     property OnInvalidHost: THandlerEvent read FInvalidHost write FInvalidHost;
  412.     property OnHostResolved: TOnHostResolved read FOnHostResolved write FOnHostResolved;
  413.     property OnStatus: TOnStatus read FOnStatus write FOnStatus;
  414.     property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write FOnConnectionFailed;
  415.   end;
  417.   {*******************************************************************************************
  418.   PowerSocket Server Class definition
  419.   ********************************************************************************************}
  420.   PTNMGeneralServer = ^TNMGeneralServer;
  422.   TNMGeneralServer = class(TPowersock)
  423.   private
  424.     ATlist: TThreadList;
  425.     FOnClientContact: TNotifyEvent;
  426.     procedure DisPatchResponse(data: Pointer);
  427.   protected
  428.     Chief: TNMGeneralServer;
  429.   public
  430.     ItsThread: TThread;
  431.     constructor Create(AOwner: TComponent); override;
  432.     procedure Connect; override;
  433.     procedure Loaded; override;
  434.     procedure Serve; virtual;
  435.     procedure Abort; override;
  436.     destructor Destroy; override;
  437.     procedure ServerAccept(Sender: TObject);
  438.   published
  439.     property OnClientContact: TNotifyEvent read FOnClientContact write FOnClientContact;
  440.   end;
  442.   {*******************************************************************************************
  443.   Thread to Serve Client in Server Class definition
  444.   ********************************************************************************************}
  445.   TThreadMethod = procedure(data: Pointer) of object;
  446.   TSimpleThread = class(TThread)
  447.   public
  448.     constructor CreateSimple(CreateSuspended: Boolean;
  449.       _Action: TThreadMethod;
  450.       _Data: Pointer);
  451.     procedure AbortThread;
  452.   protected
  453.     ThreadMethod: TThreadMethod;
  454.     data: Pointer;
  456.   private
  457.     procedure Execute; override;
  458.   end;
  460. function ExecuteInThread(Handler: TThreadMethod; data: Pointer): TSimpleThread;
  462. {For Documentation of functions and procedures see implementation}
  463. function NthWord(InputString: string; Delimiter: Char; Number: Integer): string;
  464. function NthPos(InputString: string; Delimiter: Char; Number: Integer): Integer;
  465. procedure StreamLn(AStream: TStream; AString: string);
  466. function PsockAllocateHWnd(Obj: TObject): HWND;
  467. function TmrAllocateHWnd(Obj: TObject): HWND;
  469. implementation
  470. uses
  471.   Shellapi;
  473. var
  474.   SockAvailable: Boolean;
  475.   MyWSAData: TWSAData; {Socket Information}
  477. constructor TSimpleThread.CreateSimple(CreateSuspended: Boolean;
  478.   _Action: TThreadMethod;
  479.   _Data: Pointer);
  480. begin
  481.   ThreadMethod := _Action; // Set these BEFORE calling
  482.   data := _Data; // inherited Create()!
  483.   FreeOnTerminate := True;
  484.   inherited Create(CreateSuspended);
  485. end;
  487. procedure TSimpleThread.Execute;
  488. begin
  489.   ThreadMethod(data);
  490. end;
  492. procedure TSimpleThread.AbortThread;
  493. begin
  494.   Suspend;
  495.   Free; // Kills thread
  496. end;
  498. function ExecuteInThread(Handler: TThreadMethod;
  499.   data: Pointer): TSimpleThread;
  500. begin
  501.   Result := TSimpleThread.CreateSimple(False, Handler, data);
  502. end;
  504. procedure WaitforSync(Handle: THandle);
  505. begin
  506.   repeat
  507.     if MsgWaitForMultipleObjects(1, Handle, False, INFINITE, QS_ALLINPUT) = WAIT_OBJECT_0 + 1 then
  508.       Application.ProcessMessages
  509.     else
  510.       Break;
  511.   until True = False;
  512. end;
  514. {*******************************************************************************************
  515. Create Power Socket
  516. ********************************************************************************************}
  518. constructor TPowersock.Create(AOwner: TComponent);
  519. begin
  520.   StatusMessage(Status_Debug, sPSk_Cons_msg_create); {Inform Status}
  521.   inherited Create(AOwner);
  523. {$IFDEF DEMOVER}
  524.   if not (csDesigning in ComponentState) then
  525.     ShowMessage('This uses the Demo Version of the Netmasters Componnents. Please Register');
  526. {$ENDIF}
  528.   FSocketWindow := PsockAllocateHWnd(self); {Create Window handle to receive message notification}
  529.   WaitSignal := TEvent.Create(nil, True, False, '');
  531.   if not (csDesigning in ComponentState) then
  532.     FifoQ := TNMFifoBuffer.Create;
  534.   FProxy := ''; {Default - No Proxy}
  536.   {Initialize memory }
  537.   GetMem(RemoteHost, MAXGETHOSTSTRUCT); {Initialize memory for host address structure}
  539.   Timer := TThreadTimer.Create(self); {Create timer}
  540.   Timer.Enabled := False; {Timer Disabled}
  541.   Timer.OnTimer := TimerFired; {Set Function to execcute on TimeOut}
  542.   FTimeOut := 0;
  544.   FWSAInfo := TStringList.Create;
  546.   if SockAvailable then
  547.   begin
  548.     FWSAInfo.Add(sPSk_Cons_winfo_ver + IntToStr(HiByte(MyWSAData.wVersion)) + '.' + IntToStr(LoByte(MyWSAData.wVersion)));
  549.     FWSAInfo.Add(sPSk_Cons_winfo_Hiver + IntToStr(HiByte(MyWSAData.wHighVersion)) + '.' + IntToStr(LoByte(MyWSAData.wHighVersion)));
  550.     FWSAInfo.Add(sPSk_Cons_winfo_Descr + MyWSAData.szDescription);
  551.     FWSAInfo.Add(sPSk_Cons_winfo_Sys + MyWSAData.szSystemStatus);
  552.     FWSAInfo.Add(sPSk_Cons_winfo_MaxSoc + IntToStr(MyWSAData.iMaxSockets));
  553.     FWSAInfo.Add(sPSk_Cons_winfo_MaxUdp + IntToStr(MyWSAData.iMaxUdpDg));
  554.   end;
  556.   Canceled := False; {Cancelled flag off}
  557.   DestroySocket := False; {Socket is active}
  558.   FConnected := False; {Socket is not connected}
  560.   {Call Initialization functions }
  561.   InitWinsock;
  562.   {Turn on Messaging.... }
  563. end;
  565. {*******************************************************************************************
  566. Destroy Power Socket
  567. ********************************************************************************************}
  569. destructor TPowersock.Destroy;
  570. begin
  571.   StatusMessage(Status_Debug, sPSk_Cons_msg_Dest); {Inform Status}
  572.   try
  573.     Abort;
  574.     Cancel;
  575.     FWSAInfo.Free;
  576.     Timer.Free;
  577.     FreeMem(RemoteHost, MAXGETHOSTSTRUCT); {Free memory for fetching Host Entity}
  578.     DestroyWindow(FSocketWindow); {Release window handle for Winsock messages}
  579.     WaitSignal.Destroy;
  580.     FifoQ.Free;
  581.     DestroySocket := True; {set flag to destoy socket}
  582.     if not (csDesigning in ComponentState) then
  583.       RequestCloseSocket; {close socket}
  584.   finally
  585.     inherited Destroy;
  586.   end
  587. end;
  589. {*******************************************************************************************
  590. Connect Power Socket to Remote
  591. ********************************************************************************************}
  593. procedure TPowersock.Connect;
  594. var
  595.   CT, I: Integer;
  596.   Handled: Boolean;
  597. begin
  598.   StatusMessage(Status_Debug, sPSk_Cons_msg_Conning); {Inform Status}
  599.   Canceled := False; {Turn Canceled off}
  600.   FifoQ.Clear;
  601.   if FConnected then {If already connected raise exception}
  602.     raise ESockError.Create(sPSk_Cons_msg_Conn);
  603.   CT := 0;
  604.   repeat
  605.     try
  606.       ResolveRemoteHost; {Resolve the IP address of remote host}
  607.     except
  608.       on E: ESockError do
  609.         if (E.message = sPSk_Cons_msg_host_to) or (E.message = sPSk_Cons_msg_host_Can) then
  610.           raise;
  611.     end;
  613.     if RemoteAddress.sin_addr.S_addr = 0 then
  614.       if CT > 0 then
  615.         raise ESockError.Create(sPSk_Cons_msg_add_null) {If Resolving failed raise exception}
  616.       else if not Assigned(OnInvalidHost) then
  617.         raise ESockError.Create(sPSk_Cons_msg_add_null)
  618.       else
  619.       begin
  620.         Handled := False;
  621.         OnInvalidHost(Handled);
  622.         if not Handled then
  623.           raise ESockError.Create(sPSk_Cons_msg_add_null);
  624.         CT := CT + 1;
  625.       end;
  626.   until RemoteAddress.sin_addr.S_addr <> 0;
  627.   RemoteAddress.sin_family := AF_INET; {Make connected true}
  629. {$R-}
  630.   if Proxy = '' then
  631.     RemoteAddress.sin_port := htons(PORT) {If no proxy get port from Port property}
  632.   else
  633.     RemoteAddress.sin_port := htons(FProxyPort); {else get port from ProxyPort property}
  634. {$R+}
  636.   Wait_Flag := False; { Wait for synchronous response}
  637.   I := SizeOf(RemoteAddress); { get size of remoteaddress structure}
  639.   {Connect to remote host}
  640.   Succeed := True;
  641.   I := Winsock.Connect(ThisSocket, RemoteAddress, I);
  642.   if (I = INVALID_SOCKET) then
  643.     ErrorManager(WSAEWOULDBLOCK); {If error handle error}
  645.   TimerOn; {Enable Timer on for TimeOuts}
  646.   try
  647.     while not (FConnected or TimedOut or Canceled or (not Succeed)) do
  648.       Wait;
  649.   finally
  650.     TimerOff; {Disable Timer}
  651.   end;
  653.   CloseAfterData;
  654.   if (TimedOut or Canceled or not Succeed) then
  655.   begin
  656.     if Assigned(FOnConnectionFailed) then
  657.       FOnConnectionFailed(self);
  659.     if TimedOut then
  660.     begin
  661.       try
  662.         Disconnect;
  663.       except
  664.       end;
  665.       raise ESockError.Create(Cons_Msg_ConnectionTimedOut);
  666.     end;
  667.     if Canceled then
  668.       raise ESockError.Create(sPSk_Cons_msg_Conn_can);
  669.     if Succeed = False then
  670.       raise ESockError.Create(sPSk_Cons_msg_Conn_fai);
  671.   end;
  672. end;
  674. {*******************************************************************************************
  675. DisConnect Socket From Remote
  676. ********************************************************************************************}
  678. procedure TPowersock.Disconnect;
  679. begin
  680.   StatusMessage(Status_Debug, sPSk_Cons_msg_Disconn); {Status Message}
  681.   if FConnected then
  682.     RequestCloseSocket; {Close socket and open new one}
  683. end;
  685. procedure TPowersock.Wait;
  686. begin
  687.   WaitforSync(WaitSignal.Handle);
  688.   WaitSignal.ResetEvent;
  689. end;
  691. procedure TPowersock.CertifyConnect;
  692. var
  693.   TryCt: Integer;
  694.   Handled: Boolean;
  695. begin
  696.   StatusMessage(Status_Debug, sPSk_Cons_msg_CertConn); {Status Message}
  697.   TryCt := 0;
  698.   while not Connected do
  699.   begin
  700.     if TryCt > 0 then
  701.       raise Exception.Create(sPSk_Cons_err_NotConn)
  702.     else if not Assigned(FOnConnectionRequired) then
  703.       raise Exception.Create(sPSk_Cons_err_NotConn)
  704.     else
  705.     begin
  706.       Handled := False;
  707.       FOnConnectionRequired(Handled);
  708.       if not Handled then
  709.         raise Exception.Create(sPSk_Cons_err_NotConn);
  710.       TryCt := TryCt + 1;
  711.     end;
  712.   end;
  713. end;
  715. {*******************************************************************************************
  716. Canel current transaction
  717. ********************************************************************************************}
  719. procedure TPowersock.Cancel;
  720. begin
  721.   StatusMessage(Status_Debug, sPSk_Cons_msg_Cancel); {Status Message}
  722.   Canceled := True;
  723.   WaitSignal.SetEvent;
  724. end;
  726. {*******************************************************************************************
  727. Send at value of length buflen
  728. ********************************************************************************************}
  730. procedure TPowersock.SendBuffer(Value: PChar; BufLen: Word);
  731. var
  732.   rc2, LeftB: Integer;
  733. begin
  734.   StatusMessage(Status_Routines, sPSk_Cons_msg_SBuff); {Status Message}
  735.   TimerOn;
  736.   try
  737.     if not Canceled then
  738.     begin
  739.         {If explicit buffer length given use it else get it from string length}
  740.       if BufLen = 0 then
  741.         BufLen := StrLen(Value);
  742.       LeftB := BufLen;
  743.       repeat
  744.         rc2 := Winsock.send(ThisSocket, Value[BufLen - LeftB], LeftB, 0);
  745.         if rc2 = 0 then
  746.           Break;
  748.         if rc2 > -1 then
  749.         begin
  750.           LeftB := LeftB - rc2;
  751.         end
  752.         else
  753.           ErrorManager(WSAEWOULDBLOCK);
  754.       until (LeftB = 0) or Canceled or TimedOut;
  755.     end;
  757.     if Canceled then
  758.     begin
  759.       Canceled := False;
  760.       raise EAbortError.Create(sPSk_Cons_msg_send_a);
  761.       if Assigned(OnAbortrestart) then
  762.         OnAbortrestart(self);
  763.     end;
  764.   finally
  765.     TimerOff;
  766.   end;
  767. end;
  769. {*******************************************************************************************
  770. Write String To Socket
  771. ********************************************************************************************}
  773. procedure TPowersock.Write(Value: string);
  774. var
  775.   MyStringStream: TStringStream;
  776. begin
  777.   StatusMessage(Status_Debug, sPSk_Cons_msg_write); {Report Status}
  778.   if Length(Value) > MAX_RECV_BUF then
  779.   begin
  780.     MyStringStream := TStringStream.Create(Value);
  781.     try
  782.       SendStream(MyStringStream);
  783.     finally
  784.       MyStringStream.Free;
  785.     end;
  786.   end
  787.   else
  788.   begin
  789.     StrPLCopy(Buf, Value, MAX_RECV_BUF); {Copy string to buffer}
  790.     SendBuffer(Buf, 0); {Send the buffer}
  791.   end;
  792. end;
  794. {*******************************************************************************************
  795. Write Line ending with Carriage Return and Line Feed To Socket
  796. ********************************************************************************************}
  798. procedure TPowersock.Writeln(Value: string);
  799. begin
  800.   StatusMessage(Status_Debug, sPSk_Cons_msg_writeln); {Inform Status}
  801.   Value := Value + CRLF;
  802.   Write(Value);
  803. end;
  805. {*******************************************************************************************
  806. Read Given Number of bytes from Socket
  807. ********************************************************************************************}
  809. function TPowersock.Read(Value: Word): string;
  810. begin
  811.   StatusMessage(Status_Debug, sPSk_Cons_msg_read + IntToStr(Value) + ' )'); {Inform status}
  812.   if Value = 0 then
  813.     Value := FifoQ.BufferSize;
  814.   TimerOn;
  815.   while (FifoQ.BufferSize < Value) and (not Canceled) and (not TimedOut) do
  816.     Wait;
  817.   TimerOff;
  818.   if Value = 0 then
  819.     Result := ''
  820.   else
  821.   begin
  822.     SetLength(Result, Value);
  823.     FifoQ.Remove(Pointer(@Result[1]), Value);
  824.   end;
  825.   if Canceled then
  826.   begin
  827.     Canceled := False;
  828.     raise EAbortError.Create(sPSk_Cons_msg_send_a);
  829.     if Assigned(OnAbortrestart) then
  830.       OnAbortrestart(self);
  831.   end;
  832. end;
  834. {*******************************************************************************************
  835. Read Line from Socket
  836. ********************************************************************************************}
  838. function TPowersock.Readln: string;
  839. var
  840.   I: Integer;
  841.   LF: string;
  842. begin
  843.   LF := #10;
  845.   StatusMessage(Status_Debug, sPSk_Cons_msg_readln); {Inform status}
  846.   Result := '';
  847.   I := 0;
  848.   TimerOn;
  849.   try
  850.     while not (TimedOut or Canceled) do
  851.     begin
  852.       if DataAvailable then
  853.       begin
  854.         I := FifoQ.Search(Pointer(LF));
  855.         if I > 0 then
  856.           Break;
  857.       end;
  858.       Wait;
  859.     end;
  861.     if I > 0 then
  862.     begin
  863.       SetLength(Result, I);
  864.       FifoQ.Remove(PChar(@Result[1]), I);
  865.     end;
  867.     if Canceled then
  868.     begin
  869.       Canceled := False;
  870.       raise EAbortError.Create(sPSk_Cons_msg_readln_a);
  871.       if Assigned(OnAbortrestart) then
  872.         OnAbortrestart(self);
  873.     end;
  874.   finally
  875.     TimerOff
  876.   end;
  877. end;
  879. {*******************************************************************************************
  880. Send command To Socket and get Reply
  881. ********************************************************************************************}
  883. function TPowersock.Transaction;
  884. var
  885.   I: Integer;
  886.   temp: string;
  887. begin
  888.   StatusMessage(Status_Debug, sPSk_Cons_msg_transa); {Inform status}
  889.   FReplyNumber := 0; {Initialise Numerical reply}
  890.   Writeln(CommandString); {Write Command string to Socket}
  891.   FTransactionReply := Readln; {Get Reply}
  892.   if Length(FTransactionReply) > 0 then
  893.   begin
  894.     StatusMessage(Status_Informational, FTransactionReply); {Report status}
  895.     temp := '';
  896.     for I := 1 to 10 do
  897.       if (FTransactionReply[I] >= '0') and (FTransactionReply[I] <= '9') then
  898.         temp := temp + FTransactionReply[I]
  899.       else
  900.         Break;
  901.     if temp <> '' then
  902.       FReplyNumber := StrToIntDef(temp, 0); {Extract Numerical Result if any}
  903.   end;
  904.   Result := FTransactionReply; {Return Reply}
  905. end;
  907. {*******************************************************************************************
  908. Send File To Socket
  909. ********************************************************************************************}
  911. procedure TPowersock.SendFile(Filename: string);
  912. var
  913.   strm: TFileStream;
  914.   rc, LeftB, rc2: Integer;
  915. begin
  916.   StatusMessage(Status_Debug, sPSk_Cons_msg_sendf); {Status Message}
  917.   strm := TFileStream.Create(Filename, fmOpenRead);
  918.   try
  919.     repeat
  920.       if not Canceled then
  921.       begin
  922.         rc := strm.Read(Buf, MAX_RECV_BUF);
  923.           {If explicit buffer length given use it else get it from string length}
  924.         LeftB := rc;
  925.         repeat
  926.           rc2 := Winsock.send(ThisSocket, Buf[rc - LeftB], LeftB, 0);
  927.           if rc2 = 0 then
  928.             Break;
  929.           if rc2 > -1 then
  930.           begin
  931.             LeftB := LeftB - rc2;
  932.             FBytesSent := FBytesSent + rc2;
  933.             if Assigned(FPacketSent) then
  934.               FPacketSent(self);
  935.             TimerOn;
  936.           end
  937.           else
  938.             ErrorManager(WSAEWOULDBLOCK);
  939.           Application.ProcessMessages;
  940.         until (LeftB = 0) or Canceled;
  941.       end;
  942.     until (strm.position = strm.Size) or Canceled;
  943.   finally
  944.     strm.Free;
  945.   end;
  946.   if Canceled then
  947.   begin
  948.     Canceled := False;
  949.     raise EAbortError.Create(sPSk_Cons_msg_send_a);
  950.     if Assigned(OnAbortrestart) then
  951.       OnAbortrestart(self);
  952.   end;
  953. end;
  955. {*******************************************************************************************
  956. Send File To Socket
  957. ********************************************************************************************}
  959. procedure TPowersock.SendRestStream(MainStream: TStream);
  960. var
  961.   rc, LeftB, rc2, r3: Longint;
  962. begin
  963.   StatusMessage(Status_Debug, sPSk_Cons_msg_sendstrm); {Status Message}
  964.   if not Canceled then
  965.   begin
  966.       {If explicit buffer length given use it else get it from string length}
  967.     FBytesSent := 0;
  968.     FBytesTotal := MainStream.Size;
  970.     repeat
  971.       r3 := MainStream.Size - MainStream.position;
  972.       if r3 > MAX_RECV_BUF then
  973.         r3 := MAX_RECV_BUF;
  974.       rc := MainStream.Read(Buf, r3);
  975.       LeftB := rc;
  976.       repeat
  977.         rc2 := Winsock.send(ThisSocket, Buf[rc - LeftB], LeftB, 0);
  978.         if rc2 = 0 then
  979.           Exit;
  980.         if rc2 > 0 then
  981.         begin
  982.           LeftB := LeftB - rc2;
  983.           FBytesSent := FBytesSent + rc2;
  984.           TimerOn;
  985.           if Assigned(FPacketSent) then
  986.             FPacketSent(self);
  987.         end
  988.         else
  989.           ErrorManager(WSAEWOULDBLOCK);
  990.         Application.ProcessMessages;
  991.       until (LeftB = 0) or Canceled;
  992.     until (MainStream.Size = MainStream.position) or Canceled;
  993.   end;
  995.   if Canceled then
  996.   begin
  997.     Canceled := False;
  998.     raise EAbortError.Create(sPSk_Cons_msg_send_a);
  999.     if Assigned(OnAbortrestart) then
  1000.       OnAbortrestart(self);
  1001.   end;
  1002. end;
  1004. {*******************************************************************************************
  1005. Send File To Socket
  1006. ********************************************************************************************}
  1008. procedure TPowersock.SendStream(MainStream: TStream);
  1009. var
  1010.   rc, LeftB, rc2, r3: Longint;
  1011. begin
  1012.   StatusMessage(Status_Debug, sPSk_Cons_msg_sendstrm); {Status Message}
  1013.   MainStream.position := 0;
  1015.   if not Canceled then
  1016.   begin
  1017.       {If explicit buffer length given use it else get it from string length}
  1018.     FBytesSent := 0;
  1019.     FBytesTotal := MainStream.Size;
  1020.     repeat
  1021.       r3 := MainStream.Size - MainStream.position;
  1022.       if r3 > MAX_RECV_BUF then
  1023.         r3 := MAX_RECV_BUF;
  1024.       rc := MainStream.Read(Buf, r3);
  1025.       LeftB := rc;
  1026.       repeat
  1027.         rc2 := Winsock.send(ThisSocket, Buf[rc - LeftB], LeftB, 0);
  1028.         if rc2 = 0 then
  1029.           Exit;
  1030.         if rc2 > 0 then
  1031.         begin
  1032.           LeftB := LeftB - rc2;
  1033.           FBytesSent := FBytesSent + rc2;
  1034.           if Assigned(FPacketSent) then
  1035.             FPacketSent(self);
  1036.         end
  1037.         else
  1038.           ErrorManager(WSAEWOULDBLOCK);
  1039.         Application.ProcessMessages;
  1040.       until (LeftB = 0) or Canceled;
  1041.     until (MainStream.Size = MainStream.position) or Canceled;
  1042.   end;
  1044.   if Canceled then
  1045.   begin
  1046.     Canceled := False;
  1047.     raise EAbortError.Create(sPSk_Cons_msg_send_a);
  1048.     if Assigned(OnAbortrestart) then
  1049.       OnAbortrestart(self);
  1050.   end;
  1051. end;
  1053. {*******************************************************************************************
  1054. Append File from Socket
  1055. ********************************************************************************************}
  1057. procedure TPowersock.AppendFile(Filename: string);
  1058. var
  1059.   strm: TFileStream;
  1060. begin
  1061.   StatusMessage(Status_Debug, sPSk_Cons_msg_cap_fil_app); {Send status}
  1062.   strm := TFileStream.Create(Filename, fmOpenWrite); {Create file stream to read from}
  1063.   try
  1064.     strm.position := strm.Size;
  1065.     CaptureStream(strm, -2);
  1066.   finally
  1067.     strm.Free;
  1068.   end;
  1069. end;
  1071. {*******************************************************************************************
  1072. Capture File from Socket
  1073. ********************************************************************************************}
  1075. procedure TPowersock.CaptureFile(Filename: string);
  1076. var
  1077.   strm: TFileStream;
  1078. begin
  1079.   StatusMessage(Status_Debug, sPSk_Cons_msg_cap_fil); {Send status}
  1080.   strm := TFileStream.Create(Filename, fmCreate); {Create file stream to read from}
  1081.   try
  1082.     CaptureStream(strm, -2);
  1083.   finally
  1084.     strm.Free;
  1085.   end;
  1086. end;
  1088. {*******************************************************************************************
  1089. Capture File from Socket
  1090. ********************************************************************************************}
  1092. procedure TPowersock.CaptureStream(MainStream: TStream; Size: Longint);
  1093. var
  1094.   j: Longint;
  1095. begin
  1096.   StatusMessage(Status_Debug, sPSk_Cons_msg_cap_strm); {Send status}
  1097.   FBytesRecvd := 0;
  1098.   TimerOn;
  1099.   try
  1100.     while (not Canceled) do
  1101.     begin
  1102.       while ((not (DataAvailable)) and (not Canceled) and (Connected) and (Size <> -1)) do
  1103.         Wait;
  1104.       j := FifoQ.BufferSize;
  1106.       if j > MAX_RECV_BUF then
  1107.         j := MAX_RECV_BUF;
  1108.       FifoQ.Remove(@Buf, j);
  1109.       MainStream.WriteBuffer(Buf, j); {Write it to stream}
  1110.       FBytesRecvd := FBytesRecvd + j;
  1111.       if Assigned(FPacketRecvd) then
  1112.         FPacketRecvd(self);
  1113.       TimerOn;
  1114.       if ((not Connected) or (MainStream.Size = Size)) or (Size = -1) then
  1115.         Break;
  1116.     end;
  1117.     if Canceled then
  1118.     begin
  1119.       Canceled := False;
  1120.       raise EAbortError.Create(sPSk_Cons_msg_cap_a);
  1121.       if Assigned(OnAbortrestart) then
  1122.         OnAbortrestart(self);
  1123.     end;
  1124.   finally
  1125.     TimerOff;
  1126.   end;
  1127. end;
  1129. {*******************************************************************************************
  1130. Capture File from Socket
  1131. ********************************************************************************************}
  1133. procedure TPowersock.CaptureString(var AString: string; Size: Longint);
  1134. var
  1135.   I, j: Longint;
  1137. begin
  1138.   StatusMessage(Status_Debug, sPSk_Cons_msg_string); {Send status}
  1139.   StatusMessage(Status_Debug, sPSk_Cons_msg_cap_fil);
  1140.   FBytesRecvd := 0;
  1141.   SetLength(AString, 0);
  1142.   TimerOn;
  1143.   try
  1144.     while (not Canceled) do
  1145.     begin
  1146.       while ((FifoQ.BufferSize = 0) and (not Canceled) and (Connected) and (Size <> -1)) do
  1147.         Wait;
  1148.       I := Length(AString);
  1149.       j := FifoQ.BufferSize;
  1151.       if Size <> -1 then
  1152.         if I + j < Size then
  1153.           j := Size - I;
  1155.       if j <> 0 then
  1156.       begin
  1157.         SetLength(AString, I + j);
  1158.         FifoQ.Remove(@AString[I + 1], j);
  1159.         FBytesRecvd := FBytesRecvd + j;
  1160.         TimerOn;
  1161.       end;
  1163.       if Assigned(FPacketRecvd) then
  1164.         FPacketRecvd(self);
  1166.       if not Connected then
  1167.         Break;
  1168.     end;
  1170.     if Canceled then
  1171.     begin
  1172.       Canceled := False;
  1173.       raise EAbortError.Create(sPSk_Cons_msg_cap_a);
  1174.       if Assigned(OnAbortrestart) then
  1175.         OnAbortrestart(self);
  1176.     end;
  1177.   finally
  1178.     TimerOff;
  1179.   end;
  1180. end;
  1182. {*******************************************************************************************
  1183. Filter out a MIME header
  1184. ********************************************************************************************}
  1186. procedure TPowersock.FilterHeader(HeaderStream: TFileStream);
  1187. var
  1188.   StrIn: string;
  1190. begin
  1191.   StatusMessage(Status_Debug, sPSk_Cons_msg_filthead); {Inform status}
  1192.   repeat
  1193.     StrIn := Readln; {Read a line}
  1194.     HeaderStream.WriteBuffer(StrIn[1], Length(StrIn)) {Write it to buffer}
  1195.   until (StrIn = LF) or (StrIn = CRLF) or (StrIn = ''); {Until blank line}
  1196. end;
  1198. {*******************************************************************************************
  1199. Initialize Socket and Listen to It
  1200. ********************************************************************************************}
  1202. procedure TPowersock.Listen(sync: Boolean);
  1204. begin
  1205.   StatusMessage(Status_Debug, sPSk_Cons_msg_Listen); {Report status}
  1207.   {Set Address to blank}
  1208.   RemoteAddress.sin_addr.S_addr := Inet_Addr(StrPCopy(Buf, '0.0.0.0'));
  1209.   RemoteAddress.sin_family := AF_INET; {Family = Internet address}
  1210.   RemoteAddress.sin_port := htons(PORT); {Set port to given port}
  1212.   {Bind Socket to given address}
  1213.   Winsock.bind(ThisSocket, RemoteAddress, SizeOf(RemoteAddress));
  1215.   {Direct reply message to WM_WAITFORRESPONSE handler}
  1216.   if sync then
  1217.     WSAAsyncselect(ThisSocket, FSocketWindow, WM_WAITFORRESPONSE, FD_ALL)
  1218.   else
  1219.     WSAAsyncselect(ThisSocket, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL);
  1221.   {Listen to socket}
  1222.   Winsock.Listen(ThisSocket, 5);
  1223. end;
  1225. {*******************************************************************************************
  1226. Accept Input from Listening Socket
  1227. ********************************************************************************************}
  1229. function TPowersock.Accept;
  1230. var
  1231.   SockHandle: TSocket;
  1232.   ASocKAddr: TSockAddr;
  1233.   Asize: Integer;
  1234. begin
  1235.   StatusMessage(Status_Routines, sPSk_Cons_msg_accept); {Status message}
  1236.   TimerOn;
  1238.   while (not Wait_Flag) and (not Canceled) do
  1239.     Wait;
  1240.   TimerOff;
  1241.   {if error create exception}
  1242.   if Canceled then
  1243.     raise ESockError.Create(sPSk_Cons_msg_acc_can);
  1244.   if not Succeed then
  1245.     raise ESockError.Create(sPSk_Cons_err_data_conn);
  1246.   Asize := SizeOf(ASocKAddr); {Size of Socket address structure}
  1248.   {Accept socket}
  1249. {$IFDEF NMF3}
  1250.   SockHandle := Winsock.Accept(ThisSocket, @ASocKAddr, @Asize);
  1251. {$ELSE}
  1252.   //SockHandle := Winsock.Accept(ThisSocket, ASocKAddr, Asize);
  1253. {$ENDIF}
  1254.   Result := SockHandle; {Make the Accepte socket This Socket}
  1255.   WSAAsyncselect(SockHandle, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL); {To direct messages to clientsocket}
  1256.   RemoteAddress := ASocKAddr; {save remote host address info}
  1258.   if Canceled then
  1259.   begin
  1260.     Canceled := False;
  1261.     raise EAbortError.Create(sPSk_Cons_msg_send_a);
  1262.     if Assigned(OnAbortrestart) then
  1263.       OnAbortrestart(self);
  1264.   end;
  1265. end;
  1267. {*******************************************************************************************
  1268. Return Error Message Corresponding To Error number
  1269. ********************************************************************************************}
  1271. function TPowersock.SocketErrorStr(Errno: Word): string;
  1272. var
  1273.   x: Integer;
  1274. begin
  1275.   StatusMessage(Status_Debug, sPSk_Cons_msg_elookup + Result); {Status message}
  1276.   Result := '';
  1277.   if Errno <> 0 then
  1278.   begin
  1279.     for x := 0 to 50 do {Get error string}
  1280.       if WinsockMessage[x].ErrorCode = Errno then
  1281.         Result := IntToStr(WinsockMessage[x].ErrorCode) + ':' + WinsockMessage[x].Text;
  1282.     if Result = '' then {If not found say unknown error}
  1283.       Result := sPSk_Cons_msg_unknown + IntToStr(Errno);
  1284.   end;
  1285. end;
  1287. procedure TPowersock.CloseAfterData;
  1288. var
  1289.   gudtLinger: Tlinger;
  1290. begin
  1291.   gudtLinger.l_onoff := 0;
  1292.   gudtLinger.l_linger := 0;
  1293.   setsockopt(ThisSocket, SOL_SOCKET, SO_LINGER, @gudtLinger, 4);
  1294. end;
  1296. procedure TPowersock.CloseImmediate;
  1297. var
  1298.   gudtLinger: Tlinger;
  1299. begin
  1300.   gudtLinger.l_onoff := 0;
  1301.   gudtLinger.l_linger := 0;
  1302.   setsockopt(ThisSocket, SOL_SOCKET, SO_DONTLINGER, @gudtLinger, 4);
  1303. end;
  1304. {*******************************************************************************************
  1305. TimeOut Handler
  1306. ********************************************************************************************}
  1308. procedure TPowersock.TimerFired(Sender: TObject);
  1309. begin
  1310.   StatusMessage(Status_Debug, sPSk_Cons_msg_ttrig); {Status Message}
  1311.   TimerOff; {Switch off timer}
  1312.   TimedOut := True; {Set timed out flag}
  1313.   WaitSignal.SetEvent;
  1314.   Abort;
  1315. end;
  1317. {*******************************************************************************************
  1318. Set Timer On
  1319. ********************************************************************************************}
  1321. procedure TPowersock.TimerOn;
  1322. begin
  1323.   StatusMessage(Status_Debug, sPSk_Cons_msg_TimerOn); {Status Message}
  1324.   TimedOut := False; {Timed out flag reset}
  1325.   Timer.Enabled := False; {Enable timer}
  1326.   Timer.Interval := FTimeOut; {Set TimeOut Interval}
  1327.   Timer.Enabled := True; {Enable timer}
  1328. end;
  1330. {*******************************************************************************************
  1331. Set Timer Off
  1332. ********************************************************************************************}
  1334. procedure TPowersock.TimerOff;
  1335. begin
  1336.   StatusMessage(Status_Debug, sPSk_Cons_msg_TimerOff); {Status Message}
  1337.   Timer.Enabled := False; {Disable timer}
  1338. end;
  1340. {*******************************************************************************************
  1341. Initialize WinSock
  1342. ********************************************************************************************}
  1344. procedure TPowersock.InitWinsock;
  1345. var
  1346.   gudtLinger: Tlinger;
  1347. begin
  1348.   StatusMessage(Status_Debug, sPSk_Cons_msg_InitSock); {Status Message}
  1349.   {Startup Winsock}
  1350.   if (not (csDesigning in ComponentState)) and SockAvailable then
  1351.   try
  1352.     ThisSocket := Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  1353.     gudtLinger.l_onoff := 0;
  1354.     gudtLinger.l_linger := 0;
  1355. {$T-}
  1356.     setsockopt(ThisSocket, SO_DONTLINGER, SO_LINGER, @gudtLinger, 4);
  1357. {$T+}
  1358.     if ThisSocket = TSocket(INVALID_SOCKET) then
  1359.       ErrorManager(WSAEWOULDBLOCK); {If error handle error}
  1360.     WSAAsyncselect(ThisSocket, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL);
  1361.   except
  1362.     raise ESockError.Create(sPSk_Cons_err_werr);
  1363.   end;
  1364. end;
  1366. {*******************************************************************************************
  1367. Socket Windows Message handler
  1368. ********************************************************************************************}
  1370. procedure TPowersock.Wndproc(var message: TMessage);
  1371. begin
  1372.   try
  1373.     with message do
  1374.     begin
  1375.       if LParamHi > 0 then
  1376.         Succeed := False {Succeed flag not set}
  1377.       else
  1378.         Succeed := True;
  1380.       case Msg of
  1381.         WM_ASYNCHRONOUSPROCESS:
  1382.           case LParamLo of
  1384.             FD_CONNECT:
  1385.               if Succeed then
  1386.               begin
  1387.                     // If any data has come in, it should be added to the incoming data queue now.
  1388.                 FConnected := True;
  1389.                 WaitSignal.SetEvent;
  1390.                 if Assigned(FOnConnect) then
  1391.                   FOnConnect(self);
  1392.               end;
  1394.             FD_CLOSE:
  1395.               begin
  1396.                 try
  1397.                   if FConnected then
  1398.                   begin
  1399.                     ClearInput;
  1400.                     RequestCloseSocket;
  1401.                   end;
  1402.                 except
  1403.                 end;
  1404.                 WaitSignal.SetEvent;
  1405.                 if Assigned(FOnDisconnect) then
  1406.                   FOnDisconnect(self);
  1407.               end;
  1409.             FD_READ:
  1410.               try
  1411.                 ReadToBuffer;
  1412.                 if Assigned(FOnReadEvent) then
  1413.                   FOnReadEvent(self)
  1414.               except
  1415.               end;
  1417.             FD_ACCEPT:
  1418.               begin
  1419.                 FConnected := True;
  1420.                 WaitSignal.SetEvent;
  1421.                 if Assigned(FOnAcceptEvent) then
  1422.                   FOnAcceptEvent(self);
  1423.               end;
  1424.           end;
  1426.         WM_WAITFORRESPONSE:
  1427.           begin
  1428.             Wait_Flag := True;
  1429.             WaitSignal.SetEvent;
  1431.             if LParamLo = FD_ACCEPT then
  1432.             begin
  1433.               FConnected := True;
  1434.               if not (csDestroying in ComponentState) then
  1435.                 if Assigned(FOnConnect) then
  1436.                   FOnConnect(self);
  1437.             end;
  1438.           end;
  1439.       end;
  1440.     end;
  1441.   except
  1442.   end;
  1443. end;
  1445. procedure TPowersock.ReadToBuffer;
  1446. var
  1447.   rc: Integer;
  1448. begin
  1449.   repeat
  1450.     rc := recv(ThisSocket, Buf, MAX_RECV_BUF, 0);
  1451.     if rc = 0 then
  1452.       RequestCloseSocket;
  1454.     if rc > 0 then
  1455.       FifoQ.Append(Pointer(@Buf), rc);
  1456.     WaitSignal.SetEvent;
  1457.   until rc < MAX_RECV_BUF;
  1458. end;
  1460. {*******************************************************************************************
  1461. Request Socket to be closed
  1462. ********************************************************************************************}
  1464. procedure TPowersock.RequestCloseSocket;
  1465. begin
  1466.   StatusMessage(Status_Routines, sPSk_Cons_msg_RCloseSock); {Report status}
  1467.   FConnected := False;
  1468.   if ThisSocket <> TSocket(INVALID_SOCKET) then
  1469.   begin
  1470.       {Close it}
  1471.     Winsock.CloseSocket(ThisSocket);
  1472.     if not (csDestroying in ComponentState) then
  1473.       if Assigned(FOnDisconnect) then
  1474.         FOnDisconnect(self);
  1475.     if not DestroySocket then
  1476.     begin
  1477.       ThisSocket := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  1478.       WSAAsyncselect(ThisSocket, FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_OOB or FD_ACCEPT or FD_CONNECT or FD_CLOSE or FD_READ);
  1479.     end
  1480.   end;
  1481. end;
  1483. {*******************************************************************************************
  1484. Get The last error
  1485. ********************************************************************************************}
  1487. function TPowersock.GetLastErrorNo: Integer;
  1488. begin
  1489.   StatusMessage(Status_Debug, sPSk_Cons_msg_getLastE); {Report Status}
  1490.   Result := FLastErrorno; {Get Last error to result}
  1491. end;
  1493. {*******************************************************************************************
  1494. Set The Last Error
  1495. ********************************************************************************************}
  1497. procedure TPowersock.SetLastErrorNo(Value: Integer);
  1498. begin
  1499.   StatusMessage(Status_Debug, sPSk_Cons_msg_setLastE); {Report status}
  1500.   FLastErrorno := Value; {Set Last error to value}
  1501. end;
  1503. {*******************************************************************************************
  1504. Handle Power socket error
  1505. ********************************************************************************************}
  1507. function TPowersock.ErrorManager(Ignore: Word): string;
  1508. var
  1509.   slasterror: string;
  1510. begin
  1511.   FLastErrorno := wsagetlasterror; {Set last error}
  1512.   if FLastErrorno <> Ignore then
  1513.     if (FLastErrorno > 10000) then
  1514.     begin
  1515.       slasterror := SocketErrorStr(FLastErrorno); {Get the description string for error}
  1516.       if Assigned(FOnErrorEvent) then {If error handler present excecute it}
  1517.         FOnErrorEvent(self, FLastErrorno, slasterror);
  1518.       raise ESockError.Create(slasterror); {raise exception}
  1519.     end;
  1520.   Result := slasterror; {return error string}
  1521. end;
  1523. {*******************************************************************************************
  1524. Set Powersock error
  1525. ********************************************************************************************}
  1527. procedure TPowersock.SetWSAError(ErrorNo: Word; ErrorMsg: string);
  1528. begin
  1529.   StatusMessage(Status_Debug, sPSk_Cons_msg_SetSockE); {Report status}
  1530.   FLastErrorno := ErrorNo; {Set Last error to error}
  1531.   if Length(ErrorMsg) = 0 then
  1532.     SocketErrorStr(ErrorNo); {If error message not there set it to error no}
  1533.   WSASetLastError(ErrorNo); {Set Socket error to error no}
  1534.   if Assigned(FOnErrorEvent) then {If error handler present excecute it}
  1535.     FOnErrorEvent(self, FLastErrorno, ErrorMsg);
  1536. end;
  1538. {*******************************************************************************************
  1539. Output a Status message: depends on current Reporting Level
  1540. ********************************************************************************************}
  1542. procedure TPowersock.StatusMessage(Level: Byte; Value: string);
  1543. begin
  1544.   try
  1545.     if Level <= ReportLevel then
  1546.     begin
  1547.       _Status := Value; {Set status to vale of error}
  1548.       if not (csDestroying in ComponentState) then
  1549.         if Assigned(FOnStatus) then
  1550.           FOnStatus(self, _Status); {If Status handler present excecute it}
  1551.     end;
  1552.   except
  1553.   end;
  1554. end;
  1556. function TPowersock.DataAvailable: Boolean;
  1557. var
  1558.   rc: Integer;
  1559.   mc: Char;
  1560. begin
  1561.   Result := FifoQ.BufferSize > 0;
  1562.   if not Result then
  1563.   begin
  1564.     rc := recv(ThisSocket, mc, 1, MSG_PEEK);
  1565.     if rc > 0 then
  1566.     begin
  1567.       Result := True;
  1568.       ReadToBuffer;
  1569.     end
  1570.     else if rc = 0 then
  1571.     begin
  1572.       Result := True;
  1573.       try
  1574.         if FConnected then
  1575.         begin
  1576.           ClearInput;
  1577.           RequestCloseSocket;
  1578.         end;
  1579.       except
  1580.       end;
  1581.       WaitSignal.SetEvent;
  1582.       if Assigned(FOnDisconnect) then
  1583.         FOnDisconnect(self);
  1584.     end;
  1585.   end;
  1586. end;
  1588. procedure TPowersock.ClearInput;
  1589. var
  1590.   Buf: array[0..MAX_RECV_BUF] of Char;
  1591. begin
  1592.   StatusMessage(Status_Debug, sPSk_Cons_msg_ClearInput); {Inform status}
  1593.   recv(ThisSocket, Buf, MAX_RECV_BUF, 0);
  1594. end;
  1596. {*******************************************************************************************
  1597. Resolve IP Address of Remote Host
  1598. ********************************************************************************************}
  1600. procedure TPowersock.ResolveRemoteHost;
  1601. begin
  1602.   StatusMessage(Status_Debug, sPSk_Cons_msg_ResolvHos); {Inform status}
  1604.   if FProxy = '' then
  1605.     RemoteAddress.sin_addr.S_addr := Inet_Addr(StrPCopy(Buf, ServerName))
  1606.   else
  1607.     {else use Host address}
  1608.     RemoteAddress.sin_addr.S_addr := Inet_Addr(StrPCopy(Buf, FProxy));
  1610.   if RemoteAddress.sin_addr.S_addr = SOCKET_ERROR then
  1611.     {If given name not an IP address already}
  1612.   begin
  1613.     RemoteAddress.sin_addr.S_addr := 0;
  1614.     TimerOn; {Enable Timer}
  1615.     Wait_Flag := False; {Reset flag indicating wait over}
  1617.       {Resolve IP address}
  1618.     wsaasyncgethostbyname(FSocketWindow, WM_WAITFORRESPONSE, Buf, PChar(RemoteHost), MAXGETHOSTSTRUCT);
  1620.     repeat
  1621.       Wait;
  1622.     until Wait_Flag or TimedOut or Canceled; {Till host name resolved, Timed out or Cancelled}
  1624.     TimerOff; {Disable timer}
  1626.       {Handle errors}
  1627.     if TimedOut then
  1628.       raise ESockError.Create(sPSk_Cons_msg_host_to);
  1630.     if Canceled then
  1631.       raise ESockError.Create(sPSk_Cons_msg_host_Can);
  1633.     if Succeed = False then
  1634.       raise ESockError.Create(sPSk_Cons_msg_host_Fail);
  1636.       {Fill up remote host information with retreived results}
  1637.     with RemoteAddress.sin_addr.S_un_b do
  1638.     begin
  1639.       s_b1 := RemoteHost.h_addr_list^[0];
  1640.       s_b2 := RemoteHost.h_addr_list^[1];
  1641.       s_b3 := RemoteHost.h_addr_list^[2];
  1642.       s_b4 := RemoteHost.h_addr_list^[3];
  1643.     end;
  1645.       {If Remote host handler exists execute it}
  1646.     if Assigned(FOnHostResolved) then
  1647.       FOnHostResolved(self);
  1648.   end;
  1649. end;
  1651. {*******************************************************************************************
  1652. Abort a Socket
  1653. ********************************************************************************************}
  1655. procedure TPowersock.Abort;
  1656. begin
  1657.   StatusMessage(Status_Debug, sPSk_Cons_msg_Abort); {Inform status}
  1658.   Cancel;
  1659. end;
  1661. {*******************************************************************************************
  1662. Close a Socket
  1663. ********************************************************************************************}
  1665. procedure TPowersock.Close(Socket: THandle);
  1666. begin
  1667.   StatusMessage(Status_Debug, sPSk_Cons_msg_CloseSock); {Inform status}
  1668.   CloseSocket(Socket); {Close socket}
  1669. end;
  1671. {*******************************************************************************************
  1672. Get IP Address of remote machine in dotted decimal notation
  1673. ********************************************************************************************}
  1675. function TPowersock.GetRemoteIP: string;
  1676. begin
  1677.   StatusMessage(Status_Debug, sPSk_Cons_msg_GetRemoteIP); {Inform status}
  1678.   Result := inet_ntoa(RemoteAddress.sin_addr);
  1679. end;
  1681. {*******************************************************************************************
  1682. Get IP Address of local machine in dotted decimal notation
  1683. ********************************************************************************************}
  1685. function TPowersock.GetLocalIP: string;
  1686. var
  1687.   pH: PHostEnt;
  1688.   T: PChar;
  1689. begin
  1690.   StatusMessage(Status_Debug, sPSk_Cons_msg_GetLocalIP); {Inform status}
  1691.   T := AllocMem(200);
  1692.   try
  1693.     gethostname(T, 200);
  1694.     pH := gethostbyname(T);
  1695.     Result := Format('%d.%d.%d.%d', [Ord(pH.h_addr_list^[0]), Ord(pH.h_addr_list^[1]), Ord(pH.h_addr_list^[2]), Ord(pH.h_addr_list^[3])]);
  1696.   finally
  1697.     FreeMem(T, 200);
  1698.   end;
  1699. end;
  1701. {*******************************************************************************************
  1702. Get Address String of Local Machine
  1703. ********************************************************************************************}
  1705. function TPowersock.GetLocalAddress;
  1706. var
  1707.   sockaddr: TSockAddrIn;
  1708.   iSize, Commas: Integer;
  1709.   P: PChar;
  1710. begin
  1711.   iSize := SizeOf(TSockAddr); {Size of Address structure}
  1712.   {Get Local Socket info}
  1713.   getsockname(ThisSocket, sockaddr, iSize);
  1714.   P := inet_ntoa(sockaddr.sin_addr);
  1715.   iSize := 0;
  1716.   Commas := 0;
  1718.   while Commas < 3 do
  1719.   begin
  1720.     if P[iSize] = '.' then
  1721.     begin
  1722.       P[iSize] := ',';
  1723.       inc(Commas);
  1724.     end;
  1725.     inc(iSize);
  1726.   end;
  1728.   Result := StrPas(P);
  1729. end;
  1731. {*******************************************************************************************
  1732. Get Port String of a listening Port
  1733. ********************************************************************************************}
  1735. function TPowersock.GetPortString;
  1736. var
  1737.   sockaddr: TSockAddrIn;
  1738.   iSize: Integer;
  1739. begin
  1740.   iSize := SizeOf(TSockAddr); {Size of Address structure}
  1741.   getsockname(ThisSocket, sockaddr, iSize);
  1743.   with sockaddr do {Format IP address to required string type}
  1744.     Result := Format(',%d,%d', [Lo(sin_port), Hi(sin_port)]);
  1745. end;
  1747. procedure TPowersock.SetFifoCapacity(NewCapacity: Longint);
  1748. begin
  1749.   FifoQ.MemoryBufferCapacity := NewCapacity;
  1750. end;
  1752. function TPowersock.GetFifoCapacity: Longint;
  1753. begin
  1754.   Result := FifoQ.MemoryBufferCapacity;
  1755. end;
  1757. {*******************************************************************************************
  1758. ********************************************************************************************
  1759. ********************************************************************************************}
  1761. { TTimer }
  1763. constructor TThreadTimer.Create(AOwner: TComponent);
  1764. begin
  1765.   inherited Create(AOwner);
  1766.   FEnabled := True;
  1767.   FInterval := 1000;
  1768.   FWindowHandle := TmrAllocateHWnd(self);
  1769. end;
  1771. destructor TThreadTimer.Destroy;
  1772. begin
  1773.   FEnabled := False;
  1774.   UpdateTimer;
  1775.   DestroyWindow(FWindowHandle);
  1776.   inherited Destroy;
  1777. end;
  1779. procedure TThreadTimer.Wndproc(var Msg: TMessage);
  1780. begin
  1781.   with Msg do
  1782.     if Msg = WM_TIMER then
  1783.     try
  1784.       Timer;
  1785.     except
  1786.       Application.HandleException(self);
  1787.     end
  1788.     else
  1789.       Result := DefWindowProc(0, Msg, WPARAM, LPARAM);
  1790. end;
  1792. procedure TThreadTimer.UpdateTimer;
  1793. begin
  1794.   KillTimer(FWindowHandle, 1);
  1795.   if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
  1796.     if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then
  1797.       raise Exception.Create(sPSk_Cons_msg_NoTimer);
  1798. end;
  1800. procedure TThreadTimer.SetEnabled(Value: Boolean);
  1801. begin
  1802.   if Value <> FEnabled then
  1803.   begin
  1804.     FEnabled := Value;
  1805.     UpdateTimer;
  1806.   end;
  1807. end;
  1809. procedure TThreadTimer.SetInterval(Value: Cardinal);
  1810. begin
  1811.   if Value <> FInterval then
  1812.   begin
  1813.     FInterval := Value;
  1814.     UpdateTimer;
  1815.   end;
  1816. end;
  1818. procedure TThreadTimer.SetOnTimer(Value: TNotifyEvent);
  1819. begin
  1820.   FOnTimer := Value;
  1821.   UpdateTimer;
  1822. end;
  1824. procedure TThreadTimer.Timer;
  1825. begin
  1826.   if Assigned(FOnTimer) then
  1827.     FOnTimer(self);
  1828. end;
  1830. {*******************************************************************************************
  1831. ********************************************************************************************
  1832. ********************************************************************************************}
  1834. {*******************************************************************************************
  1835. Create Server - If Demo version handles demo Registering
  1836. ********************************************************************************************}
  1838. constructor TNMGeneralServer.Create;
  1839. var
  1840.   Tp: TClass;
  1841. begin
  1842.   inherited Create(AOwner);
  1843.   Tp := AOwner.ClassType;
  1844.   ATlist := nil;
  1845.   repeat
  1846.     if Tp = TNMGeneralServer then
  1847.       Break
  1848.     else
  1849.       Tp := Tp.ClassParent;
  1850.   until Tp = nil;
  1851.   if Tp = nil then
  1852.     ATlist := TThreadList.Create;
  1853. end;
  1855. destructor TNMGeneralServer.Destroy;
  1856. begin
  1857.   try
  1858.     try
  1859.       Abort;
  1860.     finally
  1861.       if ATlist <> nil then
  1862.         ATlist.Free;
  1863.       ATlist := nil;
  1864.     end;
  1865.   finally
  1866.     inherited Destroy;
  1867.   end;
  1868. end;
  1870. {*******************************************************************************************
  1871. Override connect so no inherited connection
  1872. ********************************************************************************************}
  1874. procedure TNMGeneralServer.Connect;
  1875. begin
  1876.   {Does not call inherited connect}
  1877. end;
  1879. {*******************************************************************************************
  1880. On Loading the General Sever. Set the ServerAccept method to handle accepts from
  1881. a client and start listening for connections.
  1882. ********************************************************************************************}
  1884. procedure TNMGeneralServer.Loaded;
  1885. begin
  1886.   inherited Loaded;
  1887.   if not (csDesigning in ComponentState) then
  1888.   begin
  1889.     OnAccept := ServerAccept;
  1890.     Listen(False);
  1891.   end;
  1892. end;
  1894. procedure TNMGeneralServer.Abort;
  1895. var
  1896.   x: Integer;
  1897. begin
  1898.   if ATlist <> nil then
  1899.   begin
  1900.     with ATlist.LockList do
  1901.     try
  1902.       for x := 0 to Count - 1 do
  1903.         TNMGeneralServer(Items[x]).Cancel;
  1904.     finally
  1905.       ATlist.UnlockList;
  1906.     end;
  1907.   end;
  1908. end;
  1910. {*******************************************************************************************
  1911. The method to accept a connection from a client.  It kicks off a thread to handle a client
  1912. and resumes listning on the original socket.
  1913. ********************************************************************************************}
  1915. procedure TNMGeneralServer.ServerAccept;
  1916. begin
  1917.   ExecuteInThread(DisPatchResponse, nil);
  1918. end;
  1920. procedure TNMGeneralServer.DisPatchResponse(data: Pointer);
  1921. var
  1922.   ServSock: TNMGeneralServer;
  1923. begin
  1924.   ServSock := TNMGeneralServer(TComponentClass((self.ClassType())).Create(Owner));
  1925.   ServSock.FConnected := True;
  1926.   ServSock.RemoteAddress := RemoteAddress;
  1927.   ServSock.OnConnect := OnConnect;
  1928.   ServSock.OnDisconnect := OnDisconnect;
  1929.   Winsock.CloseSocket(ServSock.ThisSocket);
  1930.   Wait_Flag := True;
  1931.   ServSock.ThisSocket := Accept;
  1932.   WSAAsyncselect(ServSock.ThisSocket, ServSock.FSocketWindow, WM_ASYNCHRONOUSPROCESS, FD_ALL); {To direct messages to clientsocket}
  1933.   ATlist.Add(ServSock);
  1934.   ServSock.Chief := self;
  1935.   ServSock.Serve;
  1936.   ATlist.Remove(ServSock);
  1937.   ServSock.Destroy;
  1938. end;
  1940. {*******************************************************************************************
  1941. The base server metod for GeneralServer. This has to be overridden by a derived
  1942. server to provide the servers functionality.
  1943. ********************************************************************************************}
  1945. procedure TNMGeneralServer.Serve;
  1946. begin
  1947. end;
  1949. {*******************************************************************************************
  1950. ********************************************************************************************
  1951. ********************************************************************************************}
  1953. {$IFNDEF NMF3}
  1955. { TStringStream }
  1957. constructor TStringStream.Create(const AString: string);
  1958. begin
  1959.   inherited Create;
  1960.   FDataString := AString;
  1961. end;
  1963. function TStringStream.Read(var Buffer; Count: Longint): Longint;
  1964. begin
  1965.   Result := Length(FDataString) - FPosition;
  1966.   if Result > Count then
  1967.     Result := Count;
  1968.   Move(PChar(@FDataString[FPosition + 1])^, Buffer, Result);
  1969.   inc(FPosition, Result);
  1970. end;
  1972. function TStringStream.Write(const Buffer; Count: Longint): Longint;
  1973. begin
  1974.   Result := Count;
  1975.   SetLength(FDataString, (FPosition + Result));
  1976.   Move(Buffer, PChar(@FDataString[FPosition + 1])^, Result);
  1977.   inc(FPosition, Result);
  1978. end;
  1980. function TStringStream.Seek(Offset: Longint; Origin: Word): Longint;
  1981. begin
  1982.   case Origin of
  1983.     soFromBeginning: FPosition := Offset;
  1984.     soFromCurrent: FPosition := FPosition + Offset;
  1985.     soFromEnd: FPosition := Length(FDataString) - Offset;
  1986.   end;
  1987.   if FPosition > Length(FDataString) then
  1988.     FPosition := Length(FDataString)
  1989.   else if FPosition < 0 then
  1990.     FPosition := 0;
  1991.   Result := FPosition;
  1992. end;
  1994. function TStringStream.ReadString(Count: Longint): string;
  1995. var
  1996.   Len: Integer;
  1997. begin
  1998.   Len := Length(FDataString) - FPosition;
  1999.   if Len > Count then
  2000.     Len := Count;
  2001.   SetString(Result, PChar(@FDataString[FPosition + 1]), Len);
  2002.   inc(FPosition, Len);
  2003. end;
  2005. procedure TStringStream.WriteString(const AString: string);
  2006. begin
  2007.   Write(PChar(AString)^, Length(AString));
  2008. end;
  2010. procedure TStringStream.SetSize(NewSize: Longint);
  2011. begin
  2012.   SetLength(FDataString, NewSize);
  2013.   if FPosition > NewSize then
  2014.     FPosition := NewSize;
  2015. end;
  2017. {*******************************************************************************************
  2018. ********************************************************************************************
  2019. ********************************************************************************************}
  2021. { TThreadList }
  2023. constructor TThreadList.Create;
  2024. begin
  2025.   inherited Create;
  2026.   FList := TList.Create;
  2027. end;
  2029. destructor TThreadList.Destroy;
  2030. begin
  2031.   LockList; // Make sure nobody else is inside the list.
  2032.   try
  2033.     FList.Free;
  2034.     inherited Destroy;
  2035.   finally
  2036.     UnlockList;
  2037.   end;
  2038. end;
  2040. procedure TThreadList.Add(Item: Pointer);
  2041. begin
  2042.   LockList;
  2043.   try
  2044.     if FList.IndexOf(Item) = -1 then
  2045.       FList.Add(Item);
  2046.   finally
  2047.     UnlockList;
  2048.   end;
  2049. end;
  2051. procedure TThreadList.Clear;
  2052. begin
  2053.   LockList;
  2054.   try
  2055.     FList.Clear;
  2056.   finally
  2057.     UnlockList;
  2058.   end;
  2059. end;
  2061. function TThreadList.LockList: TList;
  2062. begin
  2063.   Result := FList;
  2064. end;
  2066. procedure TThreadList.Remove(Item: Pointer);
  2067. begin
  2068.   LockList;
  2069.   try
  2070.     FList.Remove(Item);
  2071.   finally
  2072.     UnlockList;
  2073.   end;
  2074. end;
  2076. procedure TThreadList.UnlockList;
  2077. begin
  2078. end;
  2079. {$ENDIF}
  2081. {*******************************************************************************************
  2082. ********************************************************************************************
  2083. ********************************************************************************************}
  2085. {*******************************************************************************************
  2086. Get Nth Word in a string
  2087.   InputString: The string on which the Nth Word is to be found
  2088.   Delimiter: The seperator for words - normally the space charachter but can be anything else
  2089.              for example if you are parsing an URL it can be the '/' charachter
  2090.   Number: The Nth word to be found . ie if you want the third Number:=3
  2091.   Result: The Nth Word as a string
  2092. ********************************************************************************************}
  2094. function NthWord(InputString: string; Delimiter: Char; Number: Integer): string;
  2095. var
  2096.   I, j, K: Integer;
  2097.   temp: string;
  2098. begin
  2099.   if InputString = '' then
  2100.     Result := ''
  2101.   else
  2102.   begin
  2103.     I := 0; {Initialize variables}
  2104.     j := 1;
  2105.     K := Length(InputString) + 1;
  2106.     temp := '';
  2108.     repeat
  2109.       if InputString[j] = Delimiter then
  2110.         inc(I)
  2111.       else
  2112.           {if delimter count is correct, copy to output string}
  2113.         if I = Number - 1 then
  2114.           temp := temp + InputString[j];
  2115.       inc(j); {Go to next character}
  2116.     until ((I = Number) or (j = K)); {Until delimter past count or end of string}
  2118.     Result := temp; {Return result}
  2119.   end;
  2120. end;
  2122. {*******************************************************************************************
  2123. Get Position of Nth Occurrence of a Delimiter
  2124.   InputString: The string on which the Nth Occurence is to be found
  2125.   Delimiter: The charachter for whose Nth Occurence you are surching for
  2126.   Number: The Nth Occurence to be found . ie if you want the third Occurence Number:=3
  2127.   Result: The Positio of the Nth Occurence
  2128. ********************************************************************************************}
  2130. function NthPos(InputString: string; Delimiter: Char; Number: Integer): Integer;
  2131. var
  2132.   I, j, K: Integer;
  2133. begin
  2134.   I := 0;
  2135.   j := 1;
  2136.   K := Length(InputString) + 1; {Initialize variables}
  2138.   repeat
  2139.     if InputString[j] = Delimiter then
  2140.       I := I + 1;
  2141.     j := j + 1; {Go to next word}
  2142.   until ((I = Number) or (j = K)); {Until pos found or end of string}
  2144.   if j <> K then
  2145.     Result := j - 1
  2146.   else
  2147.     Result := K;
  2148. end;
  2150. {*******************************************************************************************
  2151. Append string to stream
  2152.   Astream: The stream to append to
  2153.   AString: The string to be  appended
  2154. ********************************************************************************************}
  2156. procedure StreamLn(AStream: TStream; AString: string);
  2157. var
  2158.   Tempstr: string;
  2159. begin
  2160.   Tempstr := AString + CRLF; {Add Carriage Return  and Line Feed}
  2161.   AStream.WriteBuffer(Tempstr[1], Length(Tempstr)); {Write string to stream}
  2162. end;
  2164. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  2165. { The windows message handler                                               }
  2167. function PsockWindowProc(
  2168.   ahWnd: HWND;
  2169.   auMsg: Integer;
  2170.   awParam: WPARAM;
  2171.   alParam: LPARAM): Integer; stdcall;
  2172. var
  2173.   Obj: TPowersock;
  2174.   MsgRec: TMessage;
  2175. begin
  2176.   Obj := TPowersock(GetWindowLong(ahWnd, 0));
  2177.   if ((not Assigned(Obj)) or (auMsg < WM_ASYNCHRONOUSPROCESS)) then
  2178.     Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
  2179.   else
  2180.   begin
  2181.     MsgRec.Msg := auMsg;
  2182.     MsgRec.WPARAM := awParam;
  2183.     MsgRec.LPARAM := alParam;
  2184.     MsgRec.Result := 0;
  2185.     Obj.Wndproc(MsgRec);
  2186.     Result := MsgRec.Result;
  2187.   end;
  2188. end;
  2190. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  2191. { This global variable is used to store the windows class characteristic    }
  2192. { and is needed to register the window class used by TWSocket               }
  2193. var
  2194.   PsockWindowClass: TWndClass = (
  2195.     Style: 0;
  2196.     lpfnWndproc: @PsockWindowProc;
  2197.     cbClsExtra: 0;
  2198.     cbWndExtra: SizeOf(Pointer);
  2199.     HInstance: 0;
  2200.     HICON: 0;
  2201.     HCURSOR: 0;
  2202.     hbrBackground: 0;
  2203.     lpszMenuName: nil;
  2204.     lpszClassName: 'PsockWindowClass');
  2206. function PsockAllocateHWnd(Obj: TObject): HWND;
  2207. var
  2208.   TempClass: TWndClass;
  2209.   ClassRegistered: Boolean;
  2210. begin
  2211.   { Check if the window class is  registered}
  2212.   if PsockWindowClass.HInstance = 0 then
  2213.     PsockWindowClass.HInstance := HInstance;
  2215.   ClassRegistered := GetClassInfo(HInstance, PsockWindowClass.lpszClassName, TempClass);
  2217.   if not ClassRegistered then
  2218.   begin
  2219.     Result := WinProcs.RegisterClass(PsockWindowClass);
  2220.     if Result = 0 then
  2221.       Exit;
  2222.   end;
  2224.   { Create a new window                                               }
  2225.   Result := CreateWindowEx(WS_EX_TOOLWINDOW,
  2226.     PsockWindowClass.lpszClassName,
  2227.     '', { Window name   }
  2228.     WS_POPUP, { Window Style  }
  2229.     0, 0, { X, Y          }
  2230.     0, 0, { Width, Height }
  2231.     0, { hWndParent    }
  2232.     0, { hMenu         }
  2233.     HInstance, { hInstance     }
  2234.     nil); { CreateParam   }
  2236.   if (Result <> 0) and Assigned(Obj) then
  2237.     SetWindowLong(Result, 0, Integer(Obj));
  2239. end;
  2241. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  2242. { The windows message handler                                               }
  2244. function TmrWindowProc(
  2245.   ahWnd: HWND;
  2246.   auMsg: Integer;
  2247.   awParam: WPARAM;
  2248.   alParam: LPARAM): Integer; stdcall;
  2249. var
  2250.   Obj: TThreadTimer;
  2251.   MsgRec: TMessage;
  2252. begin
  2253.   // OBJ is created by you here every time I get a window message.
  2254.   Obj := TThreadTimer(GetWindowLong(ahWnd, 0));
  2256.   if not Assigned(Obj) then
  2257.     Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
  2258.   else
  2259.   begin
  2260.     MsgRec.Msg := auMsg;
  2261.     MsgRec.WPARAM := awParam;
  2262.     MsgRec.LPARAM := alParam;
  2263.     if (auMsg <> WM_TIMER) then
  2264.       Result := DefWindowProc(ahWnd, auMsg, awParam, alParam)
  2265.     else
  2266.     begin
  2267.       Obj.Wndproc(MsgRec);
  2268.       Result := MsgRec.Result;
  2269.     end;
  2270.   end;
  2271. end;
  2273. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  2274. { This global variable is used to store the windows class characteristic    }
  2275. { and is needed to register the window class used by TWSocket               }
  2276. var
  2277.   TmrWindowClass: TWndClass = (
  2278.     Style: 0;
  2279.     lpfnWndproc: @TmrWindowProc;
  2280.     cbClsExtra: 0;
  2281.     cbWndExtra: SizeOf(Pointer);
  2282.     HInstance: 0;
  2283.     HICON: 0;
  2284.     HCURSOR: 0;
  2285.     hbrBackground: 0;
  2286.     lpszMenuName: nil;
  2287.     lpszClassName: 'TmrWindowClass');
  2289. function TmrAllocateHWnd(Obj: TObject): HWND;
  2290. var
  2291.   TempClass: TWndClass;
  2292.   ClassRegistered: Boolean;
  2293. begin
  2294.   { Check if the window class is  registered}
  2295.   if TmrWindowClass.HInstance = 0 then
  2296.     TmrWindowClass.HInstance := HInstance;
  2297.   ClassRegistered := GetClassInfo(HInstance, TmrWindowClass.lpszClassName, TempClass);
  2299.   if not ClassRegistered then
  2300.   begin
  2301.     Result := WinProcs.RegisterClass(TmrWindowClass);
  2302.     if Result = 0 then
  2303.       Exit;
  2304.   end;
  2306.   { Create a new window                                               }
  2307.   Result := CreateWindowEx(WS_EX_TOOLWINDOW,
  2308.     TmrWindowClass.lpszClassName,
  2309.     '', { Window name   }
  2310.     WS_POPUP, { Window Style  }
  2311.     0, 0, { X, Y          }
  2312.     0, 0, { Width, Height }
  2313.     0, { hWndParent    }
  2314.     0, { hMenu         }
  2315.     HInstance, { hInstance     }
  2316.     nil); { CreateParam   }
  2318.   if (Result <> 0) and Assigned(Obj) then
  2319.     SetWindowLong(Result, 0, Integer(Obj));
  2320. end;
  2322. initialization;
  2323.   try
  2324.     SockAvailable := WSAStartUp($0101, MyWSAData) <> -1;
  2325.   except
  2326.   end;
  2328. finalization;
  2330.   try
  2331.     if SockAvailable then WSACleanUp; {Clean up Winsock}
  2332.   except
  2333.   end;
  2335. end.