ut_srvthrd.~pas

罗小平<<delphi精要>>一书源码

unit UT_SRVTHRD;

interface

uses
  Classes, ScktComp, ComCtrls;

type
  TServerThread = class(TServerClientThread)
  private
    WriteSizes{B}: Integer;
    FilesName: TStrings;
    FilesStrm: Array of TFileStream;
    FilesLength: Array of Integer;
    AllFilesLength, FileCurrLength: Integer;
    ListItem: TListItem;
    Fileth: Integer;
    ErrorRaise: Boolean;
    procedure ListItemAdd;
    procedure ListItemEnd;
    procedure ListItemErr;
    procedure ThreadCountDec;
  protected
    procedure ClientExecute; override;
  public
    constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket;
      AFilesName: TStrings; AWriteSize: Integer);overload;
    destructor Destroy; override;
  end;

implementation

uses
  UT_DL_SRV, SysUtils, FundAndProc;

{ ServerThread }

constructor TServerThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket;
      AFilesName: TStrings; AWriteSize: Integer);
var
  I: Integer;
begin
  inherited Create(CreateSuspended, ASocket);
  FilesName := TStringList.Create;
  FilesName.Assign(AFilesName);
  WriteSizes := AWriteSize*1024;
  Fileth := 0;
  FileCurrLength := 0;   
  SetLength(FilesStrm, FilesName.Count);
  SetLength(FilesLength, FilesName.Count);
  AllFilesLength := 0;
  for I := 0 to FilesName.Count-1 do
  begin
    FilesStrm[I] := TFileStream.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(FilesStrm[I]);
  FreeAndNil(FilesName);
  if ErrorRaise then
    Synchronize(ListItemErr)
  else
    Synchronize(ListItemEnd);
  Synchronize(ThreadCountDec);
  inherited;
end;

procedure TServerThread.ClientExecute;
var
  pStream: TWinSocketStream;
  Buffer: Pointer;
  ReadText, SendText: String;
  I: Integer;
const
  ReadLen = 1024;
begin
  pStream := TWinSocketStream.Create(ClientSocket, 60000);
  try
    while (not Terminated) and ClientSocket.Connected do
    begin
      try
        Buffer := AllocMem(ReadLen);
        if pStream.WaitForData(6000) then
        begin
          pStream.Read(Buffer^, ReadLen);
          ReadText := PChar(Buffer);
          FreeMem(Buffer);
          //客户请求文件名
          if ReadText = KEY_Clt[1] then
          begin
            Synchronize(ListItemAdd);
            SendText := KEY_Srv[1] + StringsToString(FilesNameSepStr, FilesName, True);
            pStream.Write(SendText[1], Length(SendText)+1);
          end
          //客户请求文件长度
          else if ReadText = KEY_Clt[2]  then
          begin
            SendText := '';
            for I := Low(FilesStrm) to High(FilesStrm) do
              SendText := SendText + FilesLengthSepStr + IntToStr(FilesStrm[I].Size);
            Delete(SendText, 1, 1);
            SendText := KEY_Srv[2] + SendText;
            pStream.Write(SendText[1], Length(SendText)+1);
          end
          else if ReadText = KEY_Clt[3] then  //请求开始发送文件
          begin
            if FileCurrLength >= FilesLength[Fileth] then
            begin
              Inc(Fileth);
              FileCurrLength := 0;
            end;
            Buffer := AllocMem(WriteSizes);
            Inc(FileCurrLength, pStream.Write(Buffer^, FilesStrm[Fileth].Read(Buffer^, WriteSizes)));
            FreeMem(Buffer);
          end else if ReadText = KEY_Clt[4] then
            Terminate;
        end;
      except
        ErrorRaise := True;
        Terminate;
      end;
    end;
  finally
    ClientSocket.Close;
    pStream.Free;
  end;
end;       

procedure TServerThread.ListItemAdd;
begin
  ListItem := FM_DL_SRV.UserInfo.Items.Add;
  ListItem.Caption := DateTimeToStr(Now);
  with ListItem.SubItems do
  begin
    Add(ClientSocket.RemoteHost);
    Add(ClientSocket.RemoteAddress);
    Add(IntToStr(ClientSocket.RemotePort));
    Add(StringsToString(';', FilesName));
    Add(IntToStr(FilesName.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(ActiveThreadNum);
    sbSRV.Panels.Items[0].Text := '当前线程数：' + IntToStr(ActiveThreadNum);
  end;
end;  


end.