mysock.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

Unit MySock;

// *****************************************************************************
//                          TSOCK 2.0b
// Changed By Carlo Kok                   http://cajsoft.cjb.net/
// Originally made by Beach Dog Software  http://www.beachdogsoftware.com
//
// Bugreport: [e-mail]
// *****************************************************************************
//
// Registering:
// Please register when you like mysock. You can register by sending an
// email with you name, companyname, country and what you think of mysock.
// To [e-mail]. Registered will cost you nothing.
//
//
// Copyright (C) 1999 by Carlo Kok ([e-mail])
// Copyright (C) 1998 by Beachdog software (www.beachdogsoftware.com)
//
// This software is provided 'as-is', without any express or implied
// warranty. In no event will the author be held liable for any damages
// arising from the use of this software.
//
// Permission is granted to anyone to use this software for any purpose,
// including commercial applications, and to alter it and redistribute
// it freely, subject to the following restrictions:
//
// 1. The origin of this software must not be misrepresented, you must
// not claim that you wrote the original software. If you use this
// software in a product, an acknowledgment in the product
// documentation would be appreciated but is not required.
//
// 2. Altered source versions must be plainly marked as such, and
// must not be misrepresented as being the original software.
//
// 3. This notice and the copyright string may not be removed
// or altered from any source distribution.
{
Changes for version 2.0a:
  - Created seperate components for client and server.
  - Removed some procedures/functions/properties
  - When turning TCustomServersock.active to false, function returns
    until client has stopped.
  - Added maxClient property, so you can set the maximum number of clients.
    Use 0 for infinite number of clients.
Version 2.0b
  - Removed severalbugs
}
{$IFDEF VER100}
{$DEFINE VER3ORABOVE}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE VER3ORABOVE}
{$ENDIF}

Interface

Uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     WinSock;

Const
  Copyright : STring = 'zhongjun';

Const WM_SOCK = WM_USER + 72;

Type TClientSockServ = Class;
     TCustomServerSock = Class;

     ESockException = Class(Exception);
     TNotifyReadEvent = Procedure(Sender : TObject; Count : Integer) Of Object;
     TNotifyAutoEvent = Procedure(Sender : TObject; NewSock : TClientSockServ) Of Object;

     // TSock for creating socket window
     TSock = class(TComponent)
     private
       HWND : THandle;
     protected
       property Handle : THandle read HWND;
       Procedure OnSockMessage(Var Message : TMessage);virtual;abstract;
     public
       procedure ProcessMessages;
       Constructor Create(AOwner : TComponent); Override;
       Destructor Destroy; Override;
     end;
     
     TClientSock = Class(TSock)
        Private
           FSockAddrIn : TSockAddrIn;  // Address Information Block
           FRecvAddrIn : TSockAddrIn;  // Address Information Block For RecvFrom

           // Character Buffer (Most WINSOCK.DLLs Max At 32k)
           FCharBuf    : Array[1..32768] Of Char;
           FHostName   : String;       // Host Name Or IP Address
           FPortName   : String;       // Port Name Or Well-Known Number
           FSocket     : TSocket;      // Socket Handle
           FInBuffer   : String;       // Input Buffer
           FOutBuffer  : String;       // Output Buffer For Non-Blocking
           FBlocking   : Boolean;      // Do Blocking Calls?
           FConnected  : Boolean;      // Are We Connected?
           FBlockTime  : Integer;      // How Long To Wait For Blocking Operation
           FOnConnect    : TNotifyEvent;
           FOnDisconnect : TNotifyEvent;
           FOnRead       : TNotifyReadEvent;
           FOnWrite      : TNotifyEvent;
           // Property Set/Get Routines
           Procedure SetHostName(Value : String);
           Procedure SetPortName(Value : String);
           Function GetText : String;
           Procedure SetText(Value : String);
           Procedure SetBlocking(Value : Boolean);
           Procedure SetConnected(Value : Boolean);
           Function GetConnected : Boolean;
           Function GetRemoteHost : String;
        Protected
           Procedure OnSockMessage(Var Message : TMessage);override;
           Procedure Loaded; Override;
           Constructor CreateWithSocket(AOwner : TComponent; NewSocket : TSocket); Virtual;
        Public
           Constructor Create(AOwner : TComponent); Override;
           Destructor Destroy; Override;
           Function Open : Boolean;
           Procedure Abort;
           Function Close : Boolean;
           Function Send(Value : String) : Boolean;
           Function ReceiveCount(Count : Integer) : String;
           Function Receive : String;
           Function HostLookup(Value : String) : TInAddr;
           Function PortLookup(Value : String) : U_Short;
           Property Text : String Read GetText Write SetText;
           Property Connected : Boolean Read GetConnected Write SetConnected; // Used To Read FConnected
           Property Socket : TSocket Read FSocket;
           Property RemoteHost : String Read GetRemoteHost;
        Public
           Property HostName : String Read FHostName Write SetHostName;
           Property PortName : String Read FPortName Write SetPortName;
           Property Blocking : Boolean Read FBlocking Write SetBlocking;
           Property BlockingTimeout : Integer Read FBlockTime Write FBlockTime;
           Property OnConnect : TNotifyEvent Read FOnConnect Write FOnConnect;
           Property OnDisconnect : TNotifyEvent Read FOnDisconnect Write FOnDisconnect;
           Property OnRead : TNotifyReadEvent Read FOnRead Write FOnRead;
           Property OnWrite : TNotifyEvent Read FOnWrite Write FOnWrite;
     End;
     TClientSockServ = class(TClientsock)
     private
       FMustClose : Boolean;
       FServerSock : TCustomServerSock;
     public
       property MustClose : Boolean read FMustClose;
       property ServerSock : TCustomServerSock read FServerSock;
     end;
     TMaxClientEvent   = procedure (Sender : TObject; Client : TClientSockServ) of object;
     TCustomServerSock = Class(TSock)
        Private
           FClientList : TThreadList;
           FPortName   : String;       // Port Name Or Well-Known Number
           FSocket     : TSocket;      // Socket Handle
           FActive     : Boolean;
           FOnMaxClient: TMaxClientEvent;
           FMaxClient  : Integer;
           Procedure SetPortName(Value : String);
           Procedure SetListen(Value : Boolean);
           Function Close : Boolean;
        Protected
           Procedure OnSockMessage(Var Message : TMessage);override;
           Procedure Loaded; Override;
           Procedure DoAutoAccept(Sender : TObject; NewSock : TClientSockServ);virtual;abstract;
        Public
           Constructor Create(AOwner : TComponent); Override;
           Destructor Destroy; Override;
           function GetClientCount : Integer;
           Function PortLookup(Value : String) : U_Short;
        protected
           Property MaxClient : Integer read FMaxClient write FMaxClient;
           Property Active : Boolean read FActive write SetListen;
           Property PortName : String Read FPortName Write SetPortName;
           Property OnMaxClient : TMaxClientEvent read FOnMaxClient write FOnMaxClient;
     End;
     TServerSock = class(TCustomServerSock)
     private
           FOnAutoAccept : TNotifyAutoEvent;
     protected
           Procedure DoAutoAccept(Sender : TObject; NewSock : TClientSockServ);override;
     published
           Property OnAutoAccept : TNotifyAutoEvent Read FOnAutoAccept Write FOnAutoAccept;
           Property Active;
           Property PortName;
           Property MaxClient;
           Property OnMaxClient;
     end;

// Global IP Caching Mechanism.  Uses A String List That Stores The 32-Bit IP
// Address Of It's Associated Hostname In The Object Property Of The List.  You
// Should Never Have To Manipulate This Object Directly, But It Is Made Public
// For The Purpose Of Calling The Clear Method To Empty It.
Var IPCache : TStringList;

function LocalHostName : String; // Returns the name of this computer.
function IpAddress : string; // Returns the ipaddress of this computer.
Function WSDescription : String; // Returns A Description Of The WinSock Driver
Function WSSystemStatus : String; // Returns System Status From The WinSock Driver
Function ErrToStr(Value : Integer) : String; // Converts A WinSock Error To Text
Function Base64Encode(Value : String) : String; // Converts Passed Value To MIME Base64
Function Base64Decode(Value : String) : String; // Converts Passed Value From MIME Base64
Function URLEncode(Value : String) : String; // Converts String To A URLEncoded String
Function URLDecode(Value : String) : String; // Converts String From A URLEncoded String

Procedure Register;
Implementation


Const Base64Table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
      ValidURLChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';


Type TSockThread = Class(TThread)
        Private
           ParentSock : TCustomServerSock;
           ClientSock : TClientSockServ;
           AcSck : THandle;
           FHostName : string;
        Public
           Procedure Execute; Override;
           Procedure RunThread(ParentSock : TCustomServerSock;Handle : THandle; Host : String);
     End;

Var
  WSAData : TWSAData;
  HostName : string;


Procedure TSockThread.Execute;
Begin
  ClientSock:= TClientSockserv.CreateWithSocket(ParentSock, AcSck);
  ClientSock.FServerSock:=ParentSock;
  ClientSock.FMustClose:=false;
  ClientSock.FPortName := ParentSock.fPortName;
  ClientSock.FHostName := fHostName;
  ParentSock.FClientList.Add(self);
  try
    ParentSock.DoAutoAccept(ParentSock, ClientSock);
  except
  end;
  ParentSock.FClientList.Remove(self);
  ClientSock.Free;
End;


Procedure TSockThread.RunThread(ParentSock : TCustomServerSock;Handle : THandle; Host : String);
Begin
   Self.ParentSock := ParentSock;
   Self.AcSck := Handle;
   Self.FHostName := Host;
   FreeOnTerminate := True;
   Resume;
End;
// TSock
procedure TSock.ProcessMessages;
var
  Msg : TMsg;
begin
  while PeekMessage(Msg, Handle, 0, 0, PM_REMOVE) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;
Constructor TSock.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  hwnd:=forms.AllocateHWnd(OnSockMessage);
end;

Destructor TSock.Destroy;
begin
  DeallocateHWnd(hwnd);
  inherited Destroy;
end;

// TClientSock

Procedure TClientSock.SetHostName(Value : String);
Begin
  if Connected then
    raise ESockException.Create('Can''t change hostname while active');
  FHostName := Value;
End;

Procedure TClientSock.Abort;
var
  B : Cardinal;
begin
  b:=1;
  SetSockOpt(FSocket, SOL_SOCKET, SO_DONTLINGER, @b, sizeof(B)); // set don't linger to true 
  Close;
end;

Procedure TClientSock.SetPortName(Value : String);
Begin
  if Connected then
    raise ESockException.Create('Can''t change portname while active');
   FPortName := Value;
End;

Function TClientSock.GetText : String;
Begin
  Result := Receive;
End;

Procedure TClientSock.SetText(Value : String);
Begin
  Send(Value);
End;


Procedure TClientSock.SetBlocking(Value : Boolean);
Var Il : U_Long;
    Ev : U_Long;
Begin
   If (Not (csDesigning In ComponentState)) And (csReading In ComponentState) Then
      Begin
         // If We Haven't Fully Loaded Yet, Just Set The Value And Exit
         FBlocking := Value;
         Exit;
      End;
   If FSocket = INVALID_SOCKET Then
      FBlocking := Value
   Else
      Begin
         Ev := 0;
         FBlocking := Value;
         If FBlocking  Then
            Begin
               Il := 0;
               // Turn Off Async Checking And Set Blocking On
               WinSock.WSAAsyncSelect(FSocket, Handle, WM_SOCK, Ev);
               WinSock.IOCtlSocket(FSocket, FIONBIO, Il);
            End
         Else
            Begin
              Ev := FD_READ Or FD_CLOSE Or FD_CONNECT Or FD_WRITE Or FD_READ;
              WinSock.WSAAsyncSelect(FSocket, Handle, WM_SOCK, Ev);
            End;
      End;
  ProcessMessages;
End;

Procedure TClientSock.SetConnected(Value : Boolean);
Begin
   If Value Then
      Open
   Else
      Close;
End;

Function TClientSock.GetConnected : Boolean;