鸿 网 互 联 www.68idc.cn

当前位置 : 服务器租用 > 编程语言开发 > delphi > >

DelphiSocket实现编程(3)

来源:互联网 作者:佚名 时间:2015-07-05 21:32
1. Socket 定义: 网络上两个程序为了相互通讯运行,构成服务端客户端结构,连接的每一端可称为一个Socket (或者套接字)。 客户程序可以向服务端Socket 发送请求,服务端收到后处理此请求,然后将处理结果发送给客户端Socket ,从而形成一次应答。如此重复

    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 lean = 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 lean = 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 lean = 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 lean = 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 .

网友评论
<