程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi Socket 實現編程（3）

Delphi Socket 實現編程（3）

編輯：Delphi

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 .