?? unit1.~pas
字號:
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;
application.ProcessMessages;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -