thrdsrv1.pas

文件名称：新曦 我的资源 搜索软件 源程序(Borland Delphi 7)说明

{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Fran鏾is Piette
Creation:     Sep 02, 2001
Version:      1.01
Description:  Basic TCP server showing how to use TWSocketServer and
              TWSocketClient components with threads.
              This demo is mostly the same as TcpSrv demo but use a thread to
              run client code. This is needed if client operation is lengthy
              and blocking (such as a long database query) but otherwise will
              consume more CPU cycles in task switching and makes thing much
              more complexe because multithreading requires synchronization.
History:
Feb 24, 2002 V1.01 Wilfried Mestdagh <[e-mail]> added ThreadDetach


 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit ThrdSrv1;

interface

{$IFDEF VER80}
  'This sample program use threads and hence is not compatible with Delphi 1';
{$ENDIF}

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, IniFiles, StdCtrls, ExtCtrls, WSocket, WSocketS;

const
  ThrdSrvVersion = 101;
  CopyRight      = ' ThrdSrv (c) 2001-2002 by Fran鏾is PIETTE. V1.01';
  WM_APPSTARTUP  = WM_USER + 1;

type
  TDisplayProc  = procedure (const Msg : String) of object;

  { TClientThread is our worker thread class. Each time a client connect, a }
  { new TClientThread is instanciated and client socket attached to it so   }
  { events are processed in the thread's context.                           }
  { Remember that multithreading requires synchronization, specially when   }
  { updating GUI or accessing shared data.                                  }
  { TClientThread uses OnDisplay event to display data on the application   }
  { main form. Synchronization is automatically done.                       }
  TClientThread = class(TThread)
  private
      FWSocket        : TWSocket;             { Reference to client socket  }
      FMsg            : String;               { Message to be displayed     }
      FOnDisplay      : TDisplayProc;         { Event variable              }
      FThreadAttached : Boolean;              { TRUE once socket attached   }
      procedure DisplayMsg;                   { Synchronized procedure      }
  public
      procedure Execute; override;            { Main method                 }
      procedure Display(const Msg : String);  { Takes care of synchroniz.   }
  published
      property WSocket   :      TWSocket     read  FWSocket
                                             write FWSocket;
      property ThreadAttached : Boolean      read  FThreadAttached
                                             write FThreadAttached;
      property OnDisplay :      TDisplayProc read  FOnDisplay
                                             write FOnDisplay;
  end;

  { TThrdSrvClient is the class which will be instanciated by server        }
  { component for each new client. N simultaneous clients means N           }
  { TThrdSrvClient will be instanciated. Each being used to handle only a   }
  { single client.                                                          }
  { We can add any data that has to be private for each client, such as     }
  { receive buffer or any other data needed for processing.                 }
  TThrdSrvClient = class(TWSocketClient)
  public
    ClientThread : TClientThread;
    RcvdLine     : String;
    ConnectTime  : TDateTime;
  end;

  { Application main from                                                   }
  TTcpSrvForm = class(TForm)
    ToolPanel: TPanel;
    DisplayMemo: TMemo;
    WSocketServer1: TWSocketServer;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure WSocketServer1ClientConnect(Sender: TObject;
      Client: TWSocketClient; Error: Word);
    procedure WSocketServer1ClientDisconnect(Sender: TObject;
      Client: TWSocketClient; Error: Word);
    procedure WSocketServer1BgException(Sender: TObject; E: Exception;
      var CanClose: Boolean);
    procedure WSocketServer1ClientCreate(Sender: TObject;
      Client: TWSocketClient);
  private
    FIniFileName  : String;
    FInitialized  : Boolean;
    procedure Display(const Msg : String);
    procedure WMAppStartup(var Msg: TMessage); message WM_APPSTARTUP;
    procedure ClientDataAvailable(Sender: TObject; Error: Word);
    procedure ProcessData(Client : TThrdSrvClient);
    procedure ClientBgException(Sender       : TObject;
                                E            : Exception;
                                var CanClose : Boolean);
    procedure ClientLineLimitExceeded(Sender        : TObject;
                                      Cnt           : LongInt;
                                      var ClearData : Boolean);
{$IFDEF VER140}
    { Delphi 6 changed the rules about synchronization... }
    procedure WakeMainThread(Sender: TObject);
{$ENDIF}
  public
    property IniFileName : String read FIniFileName write FIniFileName;
  end;

var
  TcpSrvForm: TTcpSrvForm;

implementation

{$R *.DFM}

const
    SectionWindow      = 'WindowTcpSrv';
    KeyTop             = 'Top';
    KeyLeft            = 'Left';
    KeyWidth           = 'Width';
    KeyHeight          = 'Height';


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTcpSrvForm.FormCreate(Sender: TObject);
begin
    { Compute INI file name based on exe file name. Remove path to make it  }
    { go to windows directory.                                              }
    FIniFileName := LowerCase(ExtractFileName(Application.ExeName));
    FIniFileName := Copy(FIniFileName, 1, Length(FIniFileName) - 3) + 'ini';

{$IFDEF VER140}
    { With Delphi 6, we need to waken mainthread ourself !                  }
    Classes.WakeMainThread := Self.WakeMainThread;
{$ENDIF}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTcpSrvForm.FormShow(Sender: TObject);
var
    IniFile : TIniFile;
begin
    if not FInitialized then begin
        FInitialized := TRUE;

        { Fetch persistent parameters from INI file }
        IniFile      := TIniFile.Create(FIniFileName);
        Width        := IniFile.ReadInteger(SectionWindow, KeyWidth,  Width);
        Height       := IniFile.ReadInteger(SectionWindow, KeyHeight, Height);
        Top          := IniFile.ReadInteger(SectionWindow, KeyTop,
                                            (Screen.Height - Height) div 2);
        Left         := IniFile.ReadInteger(SectionWindow, KeyLeft,
                                            (Screen.Width  - Width)  div 2);
        IniFile.Destroy;
        DisplayMemo.Clear;
        { Delay startup code until our UI is ready and visible }
        PostMessage(Handle, WM_APPSTARTUP, 0, 0);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTcpSrvForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
    IniFile : TIniFile;
begin
    { Save persistent data to INI file }
    IniFile := TIniFile.Create(FIniFileName);
    IniFile.WriteInteger(SectionWindow, KeyTop,         Top);
    IniFile.WriteInteger(SectionWindow, KeyLeft,        Left);
    IniFile.WriteInteger(SectionWindow, KeyWidth,       Width);
    IniFile.WriteInteger(SectionWindow, KeyHeight,      Height);
    IniFile.Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Display a message in our display memo. Delete lines to be sure to not     }
{ overflow the memo which may have a limited capacity.                      }
procedure TTcpSrvForm.Display(const Msg : String);
var
    I : Integer;
begin
    DisplayMemo.Lines.BeginUpdate;
    try
        if DisplayMemo.Lines.Count > 200 then begin
            for I := 1 to 50 do
                DisplayMemo.Lines.Delete(0);
        end;
        DisplayMemo.Lines.Add(Msg);
    finally
        DisplayMemo.Lines.EndUpdate;
        {$IFNDEF VER80}
        { Scroll to makes caret visible }
        SendMessage(DisplayMemo.Handle, EM_SCROLLCARET, 0, 0);
        {$ENDIF}
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This is our custom message handler. We posted a WM_APPSTARTUP message     }
{ from FormShow event handler. Now UI is ready and visible.                 }
procedure TTcpSrvForm.WMAppStartup(var Msg: TMessage);
begin
    Display(Trim(CopyRight));                     { This demo version       }
    Display(Trim(wsocket.Copyright));             { TWSocket version        }
    Display(Trim(wsockets.CopyRight));            { TWSocketServer version  }
    Display('');
    Display('MainThreadID : $' + IntToHex(GetCurrentThreadID, 8));
    WSocketServer1.Proto       := 'tcp';          { Use TCP protocol        }
    WSocketServer1.Port        := 'telnet';       { Use telnet port         }
    WSocketServer1.Addr        := '0.0.0.0';      { Use any interface       }
    WSocketServer1.ClientClass := TThrdSrvClient; { Use our component       }
    WSocketServer1.Listen;                        { Start litening          }
    Display('Waiting for clients on port ''' + WSocketServer1.Port + '''...');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER140}
{ Delphi 6 requires a little help in order for TThread.Synchronize to work. }
{ We just post a do-nothing message to the form which will waken up the     }
{ maine thread and execute waiting synchronized procedures.                 }
procedure TTcpSrvForm.WakeMainThread(Sender: TObject);
begin
    PostMessage(Handle, WM_NULL, 0, 0);
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Called in main thread context.                                            }
procedure TTcpSrvForm.WSocketServer1ClientCreate(
   Sender : TObject;
   Client : TWSocketClient);
begin
    with Client as TThrdSrvClient do begin
        Client.ThreadDetach;
        Client.MultiThreaded         := TRUE;