unit1.pas

用delphi+indy写的一个传送文件的范例。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, Buttons, UPTTreeList, UPTShellControls,
  UPTSplitter, UPTFrame;

type
  TForm1 = class(TForm)
    Client: TIdTCPClient;
    st: TStatusBar;
    Panel1: TPanel;
    Memo1: TMemo;
    Panel2: TPanel;
    Label1: TLabel;
    txt_Server: TEdit;
    label2: TLabel;
    txt_port: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    PTSplitter1: TPTSplitter;
    tree: TPTShellTree;
    list: TPTShellList;
    BitBtn3: TBitBtn;
    Panel3: TPanel;
    prg: TProgressBar;
    Label3: TLabel;
    Label4: TLabel;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure ClientStatus(axSender: TObject; const axStatus: TIdStatus;
      const asStatusText: string);
    procedure treeChange(Sender: TObject; Node: TTreeNode);
    procedure BitBtn3Click(Sender: TObject);
    procedure ClientConnected(Sender: TObject);
    procedure ClientDisconnected(Sender: TObject);
    procedure ClientWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure ClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure ClientWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
  private
    { Private declarations }
  public
    procedure sendFile(FileName: string);
    { Public declarations }
  end;

var
  Form1: TForm1;
procedure Addmsg(MSg: string);
implementation

{$R *.DFM}

procedure Addmsg(MSg: string);
begin
  with form1 do begin
    if memo1.lines.count > 200 then
      memo1.lines.clear;
    memo1.lines.Add(Msg);
  end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  client.Disconnect;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  client.Host := txt_server.text;
  client.Port := strtoint(txt_port.text);
  client.Connect;
end;

procedure TForm1.ClientStatus(axSender: TObject; const axStatus: TIdStatus;
  const asStatusText: string);
begin
  addmsg('Msg:' + asstatusText)
end;

procedure TForm1.treeChange(Sender: TObject; Node: TTreeNode);
begin
  list.Folder.PathName := tree.SelectedPathName;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  if not client.Connected then exit;
  if list.SelectedItem = nil then exit;
  if list.SelectedItem.IsFolder then exit;
  if not list.SelectedItem.IsValid then exit;
  sendFile(list.SelectedItem.PathName);
  addmsg(client.ReadLn);
end;

procedure TForm1.ClientConnected(Sender: TObject);
begin
  BitBtn3.Enabled := true;
end;

procedure TForm1.ClientDisconnected(Sender: TObject);
begin
  BitBtn3.Enabled := false;
end;

procedure TForm1.sendFile(FileName: string);
var l_f: string;
  l_Str: Tmemorystream;
begin
  l_f := Extractfilename(FileName);
  l_STr := TMemorystream.Create;
  try
    l_Str.LoadFromFile(FileName);
    client.WriteLn(l_f);
    Client.WriteInteger(l_STr.Size);
    Client.WriteStream(l_Str);
  finally
    l_Str.free;
  end;
end;

procedure TForm1.ClientWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  panel3.Visible := true;
  prg.position := 0;
  prg.Max := AWorkCountMax;
  if AWorkMode = wmwrite then
    label3.Caption := 'Sending ...'
  else
    label3.Caption := 'Rending ...';

end;

procedure TForm1.ClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  panel3.Visible := false;
end;

procedure TForm1.ClientWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  prg.Position := AWorkCount;
  label4.caption := formatfloat('###.##%', prg.Position / prg.Max * 100);
  application.ProcessMessages;
end;

end.