Delphi Socket 實現編程（3）

1. Socket 定義：

網絡上兩個程序為了相互通訊運行，構成服務端客戶端結構，連接的每一端可稱為一個Socket
（或者套接字）。

客戶程序可以向服務端Socket 發送請求，服務端收到後處理此請求，然後將處理結果發送給客戶端Socket ，從而形成一次應答。如此重復必要次數，就完成了一次通訊

2. 屬性

Port:    在哪個端口偵聽。
Service: 服務的描述。一般情況下可以設為空；如果是“FTP ”、 “HTTP”、“ Finger ”、“ Time”等公開的協議名，實際偵聽 端口會被自動指定為這些公開協議默認的端口。
ServerType: 其中：TServerType = (stNonBlocking, stThreadBlocking); 用於指定線程模式。

              stNonBlocking表示單線程執行

                       stThreadBlocking 表示多線程執行

Address用IP 地址表示，

Host 用計算機名表示。

實現服務端
公用庫文件（定義了服務端和客戶端使用的令牌，客戶端也要使用此文件）：

[delphi]
unit FunAndProc;  
  
interface  
  
uses Windows, Classes, SysUtils;  
  
const     
  DefaultPort = 5643 ;                 { 服務器缺省偵聽端口}  
  KEY_Clt: Array[1..4] of String =  { 從客戶端發出以下令牌}  
    (’AskForFilesName’ ,               { 請求文件名}  
     ’AskForFilesLengt h’,             { 請求文件長度}  
     ’AskForFilesData’ ,               { 請求發送文件}  
     ’WanttoDisConnect ’);             { 文件發送完成，告知服務端連接可以關閉了}  
  KEY_Srv: Array[1..2] of String =  { 從服務端發出以下令牌：}  
    (’Return1’ ,    { 後面跟的是所有文件名，文件名之間用FilesNameSepStr分隔} 
 
         ’Return2’) ;   { 後面跟的是所有文件長度，文件長度之間用FilesLengthSepStr 
                                分隔}  
  FilesNameSepStr = ’| ’;  
  FilesLengthSepStr =  ’,’;  
  
{StringToStrings 將一個字符串轉化為字符串列表，轉化方法由字符串中的分隔符SepStr 決 
        定}  
function  StringToStrings(SepStr: String; S: String): TStrings;  
  
{ 將字符串列表轉化為字符串，由SepStr 分隔}  
function  StringsToString(SepStr: String; Strs: TStrings;    
       GetFileName: Bo olean = False): String;  
  
{ 返回本機的名字}  
function  Get_ComputerName: String;  
  
implementation  
  
function  StringToStrings(SepStr: String; S: String): TStrings;  
var   
  P: Integer ;    
begin  
  Result := TStringLis t.Create;  
  P := Pos(SepStr, S);  
  while P <> 0  do  
  begin  
    Result.Add(Copy(S,  1, P-1));  
    Delete(S, 1, P-1+L ength(SepStr));  
    P := Pos(SepStr,S) ;  
  end ;  
  Result.Add(S);  
end ;  
  
function  StringsToString(SepStr: String; Strs: TStrings;   
        GetFileName: Bo olean = False): String;  
var   
  I: Integer;  
begin  
  Result := ’’;  
  for  I := 0  to Strs.Count-1 do 
 
 if not  GetFileName  then  
    Result := Result +  SepStr + Strs[I]  
  else  
    Result := Result +  SepStr + ExtractFileName(Strs[I]);  
  Delete(Result, 1, Le ngth(SepStr));  
end ;  
  
function  Get_ComputerName: String;  
var   
  iSize: LongWord;  
  ComputerName: PChar;  
begin  
  iSize := MAX_COMPUTE RNAME_LENGTH + 1;  
  GetMem(ComputerName, iSize);  
  GetComputerName(Comp uterName,iSize);  
  Result := ComputerNa me;  
  FreeMem(ComputerName );  
end ;  
  
end . 

unit FunAndProc;
 
interface
 
uses Windows, Classes, SysUtils;
 
const   
  DefaultPort = 5643 ;                 { 服務器缺省偵聽端口}
  KEY_Clt: Array[1..4] of String =  { 從客戶端發出以下令牌}
    (’AskForFilesName’ ,               { 請求文件名}
     ’AskForFilesLengt h’,             { 請求文件長度}
     ’AskForFilesData’ ,               { 請求發送文件}
     ’WanttoDisConnect ’);             { 文件發送完成，告知服務端連接可以關閉了}
  KEY_Srv: Array[1..2] of String =  { 從服務端發出以下令牌：}
    (’Return1’ ,    { 後面跟的是所有文件名，文件名之間用FilesNameSepStr分隔}

         ’Return2’) ;   { 後面跟的是所有文件長度，文件長度之間用FilesLengthSepStr
                                分隔}
  FilesNameSepStr = ’| ’;
  FilesLengthSepStr =  ’,’;
 
{StringToStrings 將一個字符串轉化為字符串列表，轉化方法由字符串中的分隔符SepStr 決
        定}
function  StringToStrings(SepStr: String; S: String): TStrings;
 
{ 將字符串列表轉化為字符串，由SepStr 分隔}
function  StringsToString(SepStr: String; Strs: TStrings;  
       GetFileName: Bo olean = False): String;
 
{ 返回本機的名字}
function  Get_ComputerName: String;
 
implementation
 
function  StringToStrings(SepStr: String; S: String): TStrings;
var 
  P: Integer ;  
begin
  Result := TStringLis t.Create;
  P := Pos(SepStr, S);
  while P <> 0  do
  begin
    Result.Add(Copy(S,  1, P-1));
    Delete(S, 1, P-1+L ength(SepStr));
    P := Pos(SepStr,S) ;
  end ;
  Result.Add(S);
end ;
 
function  StringsToString(SepStr: String; Strs: TStrings; 
        GetFileName: Bo olean = False): String;
var 
  I: Integer;
begin
  Result := ’’;
  for  I := 0  to Strs.Count-1 do

 if not  GetFileName  then
    Result := Result +  SepStr + Strs[I]
  else
    Result := Result +  SepStr + ExtractFileName(Strs[I]);
  Delete(Result, 1, Le ngth(SepStr));
end ;
 
function  Get_ComputerName: String;
var 
  iSize: LongWord;
  ComputerName: PChar;
begin
  iSize := MAX_COMPUTE RNAME_LENGTH + 1;
  GetMem(ComputerName, iSize);
  GetComputerName(Comp uterName,iSize);
  Result := ComputerNa me;
  FreeMem(ComputerName );
end ;
 
end .

服務端主界面程序：

[delphi]
unit UT_DL_SRV;  
  
interface  
  
uses  
  Windows, Messages, S ysUtils, Classes, Controls, Forms, ScktComp,   
          StdCtrls, Com Ctrls ;  
  
type  
  TFM_DL_SRV =  class(TForm)  
    SrvSocket: TServer Socket;  
    sbSRV: TStatusBar;  
    pcSRV: TPageContro l;  
    TabSheet1: TTabShe et;  
    UserInfo: TListVie w;  
    procedure SrvSocketGetThread(Sender: TObject;  
      ClientSocket: TS erverClientWinSocket;  
      var  SocketThread : TServerClientThread);  
    procedure FormCreate(Sender: TObject); 
 
  procedure FormDestroy(Sender: TObject);  
  private  
    FilesName: TString s;  
  public  
    ActiveThreadsCount , BufferSize{ 以KB為單位}: Integer;  
  end ;  
  
var   
  FM_DL_SRV: TFM_DL_SR V;  
  
implementation  
  
{$R *.dfm}  
uses  
  UT_SRVTHRD, FunAndPr oc;  
  
procedure TFM_DL_SRV.FormCreate(Sender: TObject);  
var   
  Path:  String;  
begin  
  FilesName := TString List.Create;  
  Path := ExtractFileP ath(ParamStr(0));  
  FilesName.Add(Path +  ’\’ + ’ 待傳輸文件1.txt’);  
  FilesName.Add(Path +  ’\’ + ’ 待傳輸文件2.txt’);  
  ActiveThreadsCount : = 0;  
  { 設定數據緩沖區大小為3K}   
  BufferSize := 3;  
  { 初始化SrvSocket的參數並開始偵聽}  
  with SrvSocket do  
  begin  
    Port := DefaultPor t;  
    ServerType := stTh readBlocking;  
    Open;  
  end ;  
end ;  
procedure TFM_DL_SRV.FormDestroy(Sender: TObject);  
begin  
  FreeAndNil(FilesName );  
end ;  
  
procedure TFM_DL_SRV.SrvSocketGetThread(Sender: TObject; C lientSocket: TServerClientWinSocket;  
  var  SocketThread: TServerClientThread);  
begin  
  { 建立服務端線程ServerThread，並傳給參數SocketThread}   
  SocketThread := TSer verThread.Create(   
         True,ClientSoc ket, FilesName, BufferSize);  
  { 設定該線程結束時自動析構}  
  SocketThread.FreeOnT erminate := True;  
  { 啟動線程}  
  SocketThread.Resume;  
  Inc(ActiveThreadsCou nt);  
  sbSRV.Panels.Items[0 ].Text := ’當前線程數：’ +   
      IntToStr(ActiveT hreadsCount);;  
end ;  
  
end . 

unit UT_DL_SRV;
 
interface
 
uses
  Windows, Messages, S ysUtils, Classes, Controls, Forms, ScktComp, 
          StdCtrls, Com Ctrls ;
 
type
  TFM_DL_SRV =  class(TForm)
    SrvSocket: TServer Socket;
    sbSRV: TStatusBar;
    pcSRV: TPageContro l;
    TabSheet1: TTabShe et;
    UserInfo: TListVie w;
    procedure SrvSocketGetThread(Sender: TObject;
      ClientSocket: TS erverClientWinSocket;
      var  SocketThread : TServerClientThread);
    procedure FormCreate(Sender: TObject);

  procedure FormDestroy(Sender: TObject);
  private
    FilesName: TString s;
  public
    ActiveThreadsCount , BufferSize{ 以KB為單位}: Integer;
  end ;
 
var 
  FM_DL_SRV: TFM_DL_SR V;
 
implementation
 
{$R *.dfm}
uses
  UT_SRVTHRD, FunAndPr oc;
 
procedure TFM_DL_SRV.FormCreate(Sender: TObject);
var 
  Path:  String;
begin
  FilesName := TString List.Create;
  Path := ExtractFileP ath(ParamStr(0));
  FilesName.Add(Path +  ’\’ + ’ 待傳輸文件1.txt’);
  FilesName.Add(Path +  ’\’ + ’ 待傳輸文件2.txt’);
  ActiveThreadsCount : = 0;
  { 設定數據緩沖區大小為3K} 
  BufferSize := 3;
  { 初始化SrvSocket的參數並開始偵聽}
  with SrvSocket do
  begin
    Port := DefaultPor t;
    ServerType := stTh readBlocking;
    Open;
  end ;
end ;
procedure TFM_DL_SRV.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FilesName );
end ;
 
procedure TFM_DL_SRV.SrvSocketGetThread(Sender: TObject; C lientSocket: TServerClientWinSocket;
  var  SocketThread: TServerClientThread);
begin
  { 建立服務端線程ServerThread，並傳給參數SocketThread} 
  SocketThread := TSer verThread.Create( 
         True,ClientSoc ket, FilesName, BufferSize);
  { 設定該線程結束時自動析構}
  SocketThread.FreeOnT erminate := True;
  { 啟動線程}
  SocketThread.Resume;
  Inc(ActiveThreadsCou nt);
  sbSRV.Panels.Items[0 ].Text := ’當前線程數：’ + 
      IntToStr(ActiveT hreadsCount);;
end ;
 
end .
以下是線程TServerThread的實現代碼：

[delphi]
unit UT_SRVTHRD;  
  
interface  
  
uses Classes, ScktComp, ComCtrls;  
  
type  
  TServerThread =  class(TServerClientThread)  
  private  
    WriteSizes { 以字節為單位}: Integer; { 向客戶端發送文件數據時使用的緩沖區大小} 
    FilesName: TString s;  { 文件名列表}  
    FilesStrm:  Array of TFileStream; { 文件流數組}  
    FilesLength:  Array  of Integer;  { 文件長度數組}  
    AllFilesLength, Fi leCurrLength: Integer;  
    { 所有文件長度；已經對某個文件讀取了多少長度的數據；當該長度等於該文件的長度時，
          應該開始讀下一個文件}  
    Fileth: Integer ;  { 當前正在讀第幾個文件}  
    ListItem: TListIte m;  
    ErrorRaise: Boolea n;  
    procedure ListItemAdd;  
    procedure ListItemEnd;  
    procedure ListItemErr;  
    procedure ThreadCountDec; 
 
protected  
    { TServerClientThr ead 類的執行過程，相當於普通線程的TThread.Execute}  
    procedure ClientExecute; override ;  
  public  
    { 重載構造函數，增加兩個參數：AFilesName表示要傳輸的文件名，AWriteSize表示向 
            客戶端寫數據時使用的緩沖區大小}  
    constructor Create(CreateSuspended: Boolean;    
      ASocket: TServer ClientWinSocket; AFilesName: TStrings;    
          AWriteSize: I nteger); overload ;  
    destructor Destroy ; override ;  
  end ;  
  
implementation  
  
uses  
  UT_DL_SRV, SysUtils,  FunAndProc;  
  
{ ServerThread }  
  
constructor TServerThread.Create(  
        CreateSuspended : Boolean; ASocket: TServerClientWinSocket;    
        AFilesName: TSt rings; AWriteSize: Integer);  
var   
  I: Integer;  
begin  
  inherited Create(CreateSuspended, ASocket);  
  FilesName := TString List.Create;  
  FilesName.Assign(AFi lesName);    
  WriteSizes := AWrite Size*1024;  { 向客戶端寫數據時使用的緩沖區大小}  
  { 初始化所有變量}  
  Fileth := 0 ;    
  FileCurrLength := 0;     
  SetLength(FilesStrm,  FilesName.Count);  
  SetLength(FilesLengt h, FilesName.Count);  
  AllFilesLength := 0;  
  { 創建對應個數的文件流對象}  
  for  I := 0  to FilesName.Count-1 do  
  begin  
    FilesStrm[I] := TF ileStream.Create(  
           FilesName[I] , fmOpenRead  or fmShareDenyNone);  
    FilesLength[I] :=  FilesStrm[I].Size; 
 
    Inc(AllFilesLength , FilesLength[I]);  
  end ;  
  ErrorRaise := False;  
end ;  
  
destructor TServerThread.Destroy;  
var   
  I: Integer;  
begin  
  for  I := Low(FilesStrm) to High(FilesStrm) do  
    FreeAndNil(FilesSt rm[I]);  
  FreeAndNil(FilesName );  
  if ErrorRaise then  
    { 在一個子線程中對主線程的對象操作時，應該將這些操作定義在一個過程中，並使用 
            Synchronize 來調用這個過程，以保證操作安全}  
    Synchronize(ListIt emErr)  
  else  
    Synchronize(ListIt emEnd);  
  Synchronize(ThreadCo untDec);  
  inherited;  
end ;  
  
procedure TServerThread.ClientExecute;  
var   
  pStream: TWinSocketS tream;  
  Buffer: Pointer;  
  ReadText, SendText:  String;  
  I: Integer;  
const  
  {讀客戶端令牌時使用的緩沖區大小，因為它們都是一些字符串，所以定義為1024Byte 足夠了}  
  ReadLen = 1024;  
begin  
  { 創建連接流對象，以便和客戶端交流}  
  pStream := TWinSocke tStream.Create(ClientSocket, 60000);  
  try   
  {ClientSocket 是TServerClient Thread類內置的一個對象，它是和客戶端連接的套接字}  
    while (not  Termina ted) and  ClientSocket.Connected do  
    begin  
      try   
        { 分配讀數據緩沖區}   
        Buffer := Alloc Mem(ReadLen); 
 
 if pStream.Wait ForData(6000) then  
        begin  
          pStream.Read( Buffer^, ReadLen);  
          ReadText := P Char(Buffer);  
          FreeMem(Buffe r);  
          { 客戶端請求文件名}  
          if ReadText = KEY_Clt[1] then  
          begin  
            Synchronize (ListItemAdd);  
            SendText :=  KEY_Srv[1] + StringsToString(  
                    FilesNameSepStr, FilesName, True);  
            { 特別注意SendText 後應該加上索引1 ，指定Write方法從SendText 第一個字符 
                    開始讀，否則默認從0 開始。那樣的話就錯了}  
            pStream.Wri te(SendText[1], Length(SendText)+1);  
          end   
          { 客戶端請求文件長度}  
          else if ReadText = KEY_Clt[2]  then  
          begin  
            SendText :=  ’’;  
            for  I := Lo w(FilesStrm)  to High(FilesStrm) do  
              SendText : = SendText + FilesLengthSepStr +   
                  IntToS tr(FilesStrm[I].Size);  
            Delete(Send Text, 1, 1);  
            SendText :=  KEY_Srv[2] + SendText;  
            pStream.Wri te(SendText[1], Length(SendText)+1);  
          end   
          { 客戶端請求發送文件}  
          else if ReadText = KEY_Clt[3] then    
          begin  
             { 如果當前文件讀取完畢，應該開始讀取下一個文件}  
            if FileCurrLength >= FilesLength[Fileth] then  
            begin  
              Inc(Fileth );  
              FileCurrLe ngth := 0;  
            end ;  
            { 分配寫入數據緩沖區}  
            Buffer := A llocMem(WriteSizes);  
            { 從文件流中讀取WriteSizes字節的數據並寫入連接流，最後累加 
                   FileCurrLength}   
            Inc(FileCur rLength, pStream.Write(Buffer^,   
                FilesStr m[Fileth].Read(Buffer^, WriteSizes))); 
 
FreeMem(Buf fer);  
           { 客戶端完成了所有文件的接收，請求關閉連接}  
          end  else if ReadText = KEY_Clt[4]  then  
            Terminate;  
        end ;  
      { 如果發生錯誤，則結束線程}  
      except  
        ErrorRaise := T rue;  
        Terminate;  
      end ;  
    end ;  
  finally  
    pStream.Free;  
    CltSocket.Close;  
  end ;  
end ;         
  
procedure TServerThread.ListItemAdd;  
begin  
  ListItem := FM_DL_SR V.UserInfo.Items.Add;  
  ListItem.Caption :=  DateTimeToStr(Now);  
  with ListItem.SubItems  do  
  begin  
    Add(ClientSocket.R emoteHost);  
    Add(ClientSocket.R emoteAddress);  
    Add(IntToStr(Clien tSocket.RemotePort));  
    Add(StringsToStrin g(’;’, FilesName));  
    Add(IntToStr(Files Name.Count));  
    Add(’ 傳送文件’);  
  end ;          
end ;  
  
procedure TServerThread.ListItemEnd;  
begin  
  if ListItem <>  nil  then with ListItem.SubItems do  
    Strings[Count-1] : = ’ 傳送完畢’;  
end ;  
  
procedure TServerThread.ListItemErr;  
begin      
  if ListItem <>  nil  then with ListItem.SubItems do 
 
  Strings[Count-1] : = ’ 傳送錯誤’;  
end ;  
  
procedure TServerThread.ThreadCountDec;  
begin  
  with FM_DL_SRV do  
  begin  
    Dec(ActiveThreadsC ount);  
    sbSRV.Panels.Items [0].Text := ’ 當前線程數：’ +   
        IntToStr(Active ThreadsCount);  
  end ;  
end ;    
  
end .