TIdTCPServer & Client 傳檔工具

Server程式
須要新增1個按鈕TButton、2個TLabel、1個TLsitBox屬性PopupMenu=PopupMenu1及屬性MultiSelect=true、1個TOpenDialog、1個TPopupMenu、1個TIdTCPServer屬性Bindings=:9999及屬性DefaltPort=9999，並加入OnExecute

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,
  IdThreadMgr, IdThreadMgrDefault;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    FConnectionCount: Integer;
    procedure IncrConnectionCount;
    procedure DecrConnectionCount;
    { Private declarations }
  public
    { Public declarations }
  end;

function SendString(Sender: Tobject; iMsg: string): Boolean;
function SendFile(Sender: Tobject; iFileName: string): Boolean;

var
  Form1: TForm1;
  AppPath: string;

implementation

{$R *.dfm}

//傳送訊息出去
function SendString(Sender: Tobject; iMsg: string): Boolean;
var
  AStream: TStringStream;
  AThread: TIdPeerThread;
begin
  AThread := (sender as TIdPeerThread);
  AStream := TStringStream.Create(iMsg);
  try
    AThread.Connection.OpenWriteBuffer;
    AThread.Connection.WriteStream(AStream);
    AThread.Connection.CloseWriteBuffer;
    result := true;
  finally
    AStream.Free;
  end;
end;

//傳送檔案出去
function SendFile(Sender: Tobject; iFileName: string): Boolean;
var
  FStream: TFileStream;
  AThread: TIdPeerThread;
  i: integer;
  itmpFileName: string;
begin
  //========依client 所傳的檔名取出server 端的完整路徑檔名

  for i := 0 to Form1.Listbox1.Count - 1 do
    if iFileName = UpperCase(ExtractFileName(Form1.ListBox1.Items.Strings[i])) then
      itmpFileName := Form1.ListBox1.Items.Strings[i];

  //=============================================
  AThread := (sender as TIdPeerThread);

  if itmpFileName = '' then
  begin
    AThread.Connection.WriteLn('Filename not fount!');
    result:=False;
    exit;
  end;
  FStream := TfileStream.Create(itmpFileName, fmOpenRead);
  try
    AThread.Connection.OpenWriteBuffer;
    FStream.Seek(0, soFromBeginning);
    AThread.Connection.WriteStream(FStream, False, False, FStream.Size);
    AThread.Connection.CloseWriteBuffer;
    result := true;
  finally
    FStream.Free;
  end;
end;

procedure TForm1.IncrConnectionCount;
begin
    Inc(FConnectionCount);
    Label2.Caption := '連線數：' + IntToStr(FConnectionCount); //顯示連線數
end;

procedure TForm1.DecrConnectionCount;
begin
    Dec(FConnectionCount);
    Label2.Caption := '連線數：' + IntToStr(FConnectionCount); //顯示連線數
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenDialog1.Execute; //開啟檔案盒
  ListBox1.Items.AddStrings(OpenDialog1.Files); //將所選檔案累加至ListBox1
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  SRequest: string;
  //SOutline: string;
  //AStream: TStringStream;
  //FStream: TFileStream;
  //i: integer;
begin

  AThread.Synchronize(IncrConnectionCount);

  AThread.Connection.WriteLn('Welcome to Auto Update Server');
  try
    SRequest := UpperCase(AThread.Connection.ReadLn);

    //檔案資訊
    if SRequest = 'GETFILEINFO' then
      SendString(AThread, ListBox1.Items.Text); //傳給Client檔名

    //傳送檔案
    if SRequest = 'GETFILE' then //傳檔需求
    begin
      AThread.Connection.WriteLn('FILENAME?'); //尋問要取那一個檔
      SRequest := UpperCase(AThread.Connection.ReadLn);
      SendFile(AThread, SRequest);
    end;

  finally
    AThread.Connection.Disconnect;
    AThread.Synchronize(DecrConnectionCount);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.Active := True; //啟動Server
  AppPath := GetCurrentDir; //先取得程式執行目錄，並儲存
  OpenDialog1.Options := [ofAllowMultiSelect]; //檔案對話框多選

  //載入下載檔案列表
  if FileExists(AppPath + '\UpdateFiles.txt') then
    listbox1.Items.LoadFromFile(AppPath + '\UpdateFiles.txt');
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  ListBox1.SelectAll; //全選
end;

procedure TForm1.N2Click(Sender: TObject);
var
  i: integer;
begin
  for i := ListBox1.Count - 1 downto 0 do //由最後一筆開始刪index才不會出錯
    if ListBox1.Selected[i] = True then
      ListBox1.Items.Delete(i);
end;
end.

Client程式
5個TLabel、2個TPanel、3個TEdit(都有初始文字；請參考圖)、1個TButton、1個TListBox及1個TIdTCPClient

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    ListBox1: TListBox;
    Panel2: TPanel;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    IdTCPClient1: TIdTCPClient;
    procedure Button1Click(Sender: TObject);
  private
    procedure GetFiles(SaveFilePath: string; iFileName: string);
    function GetFileName(): TStrings;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//-----------讀取檔案列表-------------
function TForm1.GetFileName(): TStrings;
var
  AStream: TStringStream;
  SResponse: string;
begin
  AStream := TStringStream.Create('');
  result := TStringList.Create;
  try
    IdTCPClient1.Connect();
    SResponse := UpperCase(IdTCPClient1.ReadLn); //讀取伺服器回應
    if Pos('WELCOME', SResponse) = 0 then exit; //若無回應則離開


    IdTCPClient1.WriteLn('GETFILEINFO'); //讀取檔案資訊
    IdTCPClient1.ReadStream(AStream, -1, True);
    AStream.Seek(0, soFromBeginning);
    result.LoadFromStream(AStream);
  finally
    AStream.Free;
    IdTCPClient1.Disconnect;
  end;
end;

procedure TForm1.GetFiles(SaveFilePath: string; iFileName: string);
var
  FStream: TFileStream;
  SResponse: string;
begin
  try
    IdTCPClient1.Connect();
    while IdTCPClient1.Connected do
    begin
      SResponse := UpperCase(IdTCPClient1.ReadLn); //讀取伺服器回應
      if Pos('WELCOME', SResponse) = 0 then
        break; //若無回應則離開

      IdTCPClient1.WriteLn('GETFILE');
      SResponse := UpperCase(IdTCPClient1.ReadLn); //讀取伺服器回應
      IdTCPClient1.WriteLn(iFileName);
      FStream := TFileStream.Create(SaveFilePath + '\' + iFileName, fmCreate);
      try
        FStream.Seek(0, soFromBeginning);
        IdTCPClient1.ReadStream(FStream, -1, True);
      finally
          FStream.Free;
      end;
    end;
  finally
    IdTCPClient1.Disconnect;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tmpFileName: string;
  i: Integer;
begin
  IdTCPClient1.Host := Edit1.Text;
  IdTCPClient1.Port := strtoint(Edit2.Text);
  listbox1.Items := GetFileName; //取得檔名
 label5.Caption  :='傳檔中，請稍候....';
  for i := 0 to listbox1.Count - 1 do
  begin
    tmpFileName := ExtractFileName(Listbox1.Items.Strings[i]);
    GetFiles(IncludeTrailingBackslash(Edit3.Text), tmpFileName);
  end;
 label5.Caption  :='傳檔完成....';
end;
end.