Delphi Socket 实现编程(3)

页面导航:首页 > 软件编程 > Delphi > Delphi Socket 实现编程(3)

Delphi Socket 实现编程(3)

来源: 作者: 时间:2016-01-18 15:41 【

1. Socket 定义:网络上两个程序为了相互通讯运行,构成服务端客户端结构,连接的每一端可称为一个Socket(或者套接字)。客户程序可以向服务端Socket 发送请求,服务端收到后处理此请

1. Socket 定义:

网络上两个程序为了相互通讯运行,构成服务端客户端结构,连接的每一端可称为一个Socket
(或者套接字)。

客户程序可以向服务端Socket 发送请求,服务端收到后处理此请求,然后将处理结果发送给客户端Socket ,从而形成一次应答。如此重复必要次数,就完成了一次通讯

2. 属性

Port:    在哪个端口侦听。
Service: 服务的描述。一般情况下可以设为空;如果是“FTP ”、 “HTTP”、“ Finger ”、“ Time”等公开的协议名,实际侦听 端口会被自动指定为这些公开协议默认的端口。
ServerType: 其中:TServerType = (stNonBlocking, stThreadBlocking); 用于指定线程模式。

              stNonBlocking表示单线程执行

                       stThreadBlocking 表示多线程执行

Address用IP 地址表示,

Host 用计算机名表示。

 

实现服务端
公用库文件(定义了服务端和客户端使用的令牌,客户端也要使用此文件):


[]
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 . 

Tags:

文章评论

最 近 更 新
热 点 排 行
Js与CSS工具
代码转换工具

<