delphi
初階會員
發表:52 回覆:64 積分:38 註冊:2002-05-21
發送簡訊給我
|
請教各位大大:
我現在要寫一個ftpㄉ程式,想參考delphi裡ㄉdemo但會出錯
請教要如何修改或又什麼更好ㄉ範例請指教^O^
{***************************************************************
*
* Project : FTPDemo
* Unit Name: mainf
* Purpose : This demo demonstrates the use of IdFTP and IdDebugLog components
* : supports both UNIX and DOS directory listings
* Version : 1.0
* Date : Wed 25 Apr 2001 - 01:15:09
* Author : Doychin Bondzhev
* History :
* Tested : Wed 25 Apr 2001 // Allen O'Neill
*
****************************************************************} unit mainf; interface uses
{$IFDEF Linux}
QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QComCtrls, QMenus, QTypes,
{$ELSE}
windows, messages, graphics, controls, forms, dialogs, stdctrls, extctrls, comctrls,
menus,
{$ENDIF}
SysUtils, Classes, IdIntercept, IdLogBase, IdLogDebug, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP,
IdAntiFreezeBase, IdAntiFreeze; type
TMainForm = class(TForm)
DirectoryListBox: TListBox;
IdFTP1: TIdFTP;
IdLogDebug1: TIdLogDebug;
DebugListBox: TListBox;
Panel1: TPanel;
FtpServerEdit: TEdit;
ConnectButton: TButton;
Splitter1: TSplitter;
Label1: TLabel;
UploadOpenDialog1: TOpenDialog;
Panel3: TPanel;
SaveDialog1: TSaveDialog;
StatusBar1: TStatusBar;
TraceCheckBox: TCheckBox;
CommandPanel: TPanel;
UploadButton: TButton;
AbortButton: TButton;
BackButton: TButton;
DeleteButton: TButton;
DownloadButton: TButton;
UserIDEdit: TEdit;
PasswordEdit: TEdit;
Label2: TLabel;
Label3: TLabel;
IdAntiFreeze1: TIdAntiFreeze;
ProgressBar1: TProgressBar;
UsePassive: TCheckBox;
CurrentDirEdit: TEdit;
ChDirButton: TButton;
CreateDirButton: TButton;
PopupMenu1: TPopupMenu;
Download1: TMenuItem;
Upload1: TMenuItem;
Delete1: TMenuItem;
N1: TMenuItem;
Back1: TMenuItem;
procedure ConnectButtonClick(Sender: TObject);
procedure IdLogDebug1LogItem(ASender: TComponent; var AText: String);
procedure UploadButtonClick(Sender: TObject);
procedure DirectoryListBoxDblClick(Sender: TObject);
procedure DeleteButtonClick(Sender: TObject);
procedure IdFTP1Disconnected(Sender: TObject);
procedure AbortButtonClick(Sender: TObject);
procedure BackButtonClick(Sender: TObject);
procedure IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
procedure TraceCheckBoxClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DirectoryListBoxClick(Sender: TObject);
procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure UsePassiveClick(Sender: TObject);
procedure ChDirButtonClick(Sender: TObject);
procedure CreateDirButtonClick(Sender: TObject);
private
{ Private declarations }
AbortTransfer: Boolean;
TransferrignData: Boolean;
BytesToTransfer: LongWord;
STime: TDateTime;
procedure ChageDir(DirName: String);
procedure SetFunctionButtons(AValue: Boolean);
procedure SaveFTPHostInfo(Datatext, header: String);
function GetHostInfo(header: String): String;
public
{ Public declarations }
end; var
MainForm: TMainForm; implementation {$IFDEF MSWINDOWS}{$R *.dfm}{$ELSE}{$R *.xfm}{$ENDIF} Uses
IniFiles; Var
AverageSpeed: Double = 0; procedure TMainForm.SetFunctionButtons(AValue: Boolean);
Var
i: Integer;
begin
with CommandPanel do
for i := 0 to ControlCount - 1 do
if Controls[i].Name <> 'AbortButton' then Controls[i].Enabled := AValue; with PopupMenu1 do
for i := 0 to Items.Count - 1 do Items[i].Enabled := AValue; ChDirButton.Enabled := AValue;
CreateDirButton.Enabled := AValue;
end; procedure TMainForm.ConnectButtonClick(Sender: TObject);
begin
ConnectButton.Enabled := false;
if IdFTP1.Connected then try
if TransferrignData then IdFTP1.Abort;
IdFTP1.Quit;
finally
//Panel3.Caption := 'Current directory is: ';
CurrentDirEdit.Text := '/';
DirectoryListBox.Items.Clear;
SetFunctionButtons(false);
ConnectButton.Caption := 'Connect';
ConnectButton.Enabled := true;
ConnectButton.Default := true;
end
else with IdFTP1 do try
User := UserIDEdit.Text;
Password := PasswordEdit.Text;
Host := FtpServerEdit.Text;
Connect;
Self.ChageDir(CurrentDirEdit.Text);
SetFunctionButtons(true);
SaveFTPHostInfo(FtpServerEdit.Text, 'FTPHOST');
finally
ConnectButton.Enabled := true;
if Connected then begin
ConnectButton.Caption := 'Disconnect';
ConnectButton.Default := false;
end;
end;
end; procedure TMainForm.IdLogDebug1LogItem(ASender: TComponent;
var AText: String);
begin
DebugListBox.ItemIndex := DebugListBox.Items.Add(AText);
end; procedure TMainForm.UploadButtonClick(Sender: TObject);
begin
if IdFTP1.Connected then begin
if UploadOpenDialog1.Execute then try
SetFunctionButtons(false);
IdFTP1.TransferType := ftBinary; IdFTP1.Put(UploadOpenDialog1.FileName, ExtractFileName(UploadOpenDialog1.FileName));
ChageDir(idftp1.RetrieveCurrentDir);
finally
SetFunctionButtons(true);
end;
end;
end; procedure TMainForm.ChageDir(DirName: String);
begin
try
SetFunctionButtons(false);
IdFTP1.ChangeDir(DirName);
IdFTP1.TransferType := ftASCII; CurrentDirEdit.Text := IdFTP1.RetrieveCurrentDir; {Panel3.Caption := 'Current directory is: ' IdFTP1.RetrieveCurrentDir
' Remote system is ' IdFTP1.SystemDesc;}
DirectoryListBox.Items.Clear;
IdFTP1.List(DirectoryListBox.Items);
finally
SetFunctionButtons(true);
end;
end; function GetNameFromDirLine(Line: String; Var IsDirectory: Boolean): String;
Var
i: Integer;
DosListing: Boolean;
begin
IsDirectory := Line[1] = 'd';
DosListing := false;
for i := 0 to 7 do begin
if (i = 2) and not IsDirectory then begin
IsDirectory := Copy(Line, 1, Pos(' ', Line) - 1) = ' ';
if not IsDirectory then
DosListing := Line[1] in ['0'..'9']
else DosListing := true;
end;
Delete(Line, 1, Pos(' ', Line));
While Line[1] = ' ' do Delete(Line, 1, 1);
if DosListing and (i = 2) then break;
end;
Result := Line;
end; procedure TMainForm.DirectoryListBoxDblClick(Sender: TObject);
Var
Name, Line: String;
IsDirectory: Boolean;
begin
if not IdFTP1.Connected then exit;
Line := DirectoryListBox.Items[DirectoryListBox.ItemIndex];
Name := GetNameFromDirLine(Line, IsDirectory);
if IsDirectory then begin
// Change directory
SetFunctionButtons(false);
ChageDir(Name);
SetFunctionButtons(true);
end
else begin
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then begin
SetFunctionButtons(false);
IdFTP1.TransferType := ftBinary;
BytesToTransfer := IdFTP1.Size(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
finally
SetFunctionButtons(true);
end;
end;
end; procedure TMainForm.DeleteButtonClick(Sender: TObject);
Var
Name, Line: String;
IsDirectory: Boolean;
begin
if not IdFTP1.Connected then exit;
Line := DirectoryListBox.Items[DirectoryListBox.ItemIndex];
Name := GetNameFromDirLine(Line, IsDirectory);
if IsDirectory then try
SetFunctionButtons(false);
idftp1.RemoveDir(Name);
ChageDir(idftp1.RetrieveCurrentDir);
finally
end
else
try
SetFunctionButtons(false);
idftp1.Delete(Name);
ChageDir(idftp1.RetrieveCurrentDir);
finally
end;
end; procedure TMainForm.IdFTP1Disconnected(Sender: TObject);
begin
StatusBar1.Panels[1].Text := 'Disconnected.';
end; procedure TMainForm.AbortButtonClick(Sender: TObject);
begin
AbortTransfer := true;
end; procedure TMainForm.BackButtonClick(Sender: TObject);
begin
if not IdFTP1.Connected then exit;
try
ChageDir('..');
finally end;
end; procedure TMainForm.IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
begin
DebugListBox.ItemIndex := DebugListBox.Items.Add(asStatusText);
StatusBar1.Panels[1].Text := asStatusText;
end; procedure TMainForm.TraceCheckBoxClick(Sender: TObject);
begin
IdLogDebug1.Active := TraceCheckBox.Checked;
DebugListBox.Visible := TraceCheckBox.Checked;
if DebugListBox.Visible then Splitter1.Top := DebugListBox.Top 5;
end; procedure TMainForm.FormCreate(Sender: TObject);
begin
SetFunctionButtons(false);
IdLogDebug1.Active := true; FtpServerEdit.Text := GetHostInfo('FTPHOST'); ProgressBar1.Parent := StatusBar1;
ProgressBar1.Top := 2;
ProgressBar1.Left := 1;
{$IFDEF Linux}
ProgressBar1.Width := 142;
{$ENDIF}
end; procedure TMainForm.DirectoryListBoxClick(Sender: TObject);
Var
Line: String;
IsDirectory: Boolean;
begin
if not IdFTP1.Connected then exit;
Line := DirectoryListBox.Items[DirectoryListBox.ItemIndex];
GetNameFromDirLine(Line, IsDirectory);
if IsDirectory then DownloadButton.Caption := 'Change dir'
else DownloadButton.Caption := 'Download';
end; procedure TMainForm.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
Var
S: String;
TotalTime: TDateTime;
H, M, Sec, MS: Word;
DLTime: Double;
begin
TotalTime := Now - STime;
DecodeTime(TotalTime, H, M, Sec, MS);
Sec := Sec M * 60 H * 3600;
DLTime := Sec MS / 1000;
if DLTime > 0 then
AverageSpeed := {(AverageSpeed }(AWorkCount / 1024) / DLTime{) / 2}; S := FormatFloat('0.00 KB/s', AverageSpeed);
case AWorkMode of
wmRead: StatusBar1.Panels[1].Text := 'Download speed ' S;
wmWrite: StatusBar1.Panels[1].Text := 'Uploade speed ' S;
end; if AbortTransfer then IdFTP1.Abort; ProgressBar1.Position := AWorkCount;
AbortTransfer := false;
end; procedure TMainForm.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
TransferrignData := true;
AbortButton.Visible := true;
AbortTransfer := false;
STime := Now;
if AWorkCountMax > 0 then ProgressBar1.Max := AWorkCountMax
else ProgressBar1.Max := BytesToTransfer;
AverageSpeed := 0;
end; procedure TMainForm.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
AbortButton.Visible := false;
StatusBar1.Panels[1].Text := 'Transfer complete.';
BytesToTransfer := 0;
TransferrignData := false;
ProgressBar1.Position := 0;
AverageSpeed := 0;
end; procedure TMainForm.UsePassiveClick(Sender: TObject);
begin
IdFTP1.Passive := UsePassive.Checked;
end; procedure TMainForm.ChDirButtonClick(Sender: TObject);
begin
SetFunctionButtons(false);
ChageDir(CurrentDirEdit.Text);
SetFunctionButtons(true);
end; procedure TMainForm.CreateDirButtonClick(Sender: TObject);
Var
S: String;
begin
S := InputBox('Make new directory', 'Name', '');
if S <> '' then
try
SetFunctionButtons(false);
IdFTP1.MakeDir(S);
ChageDir(CurrentDirEdit.Text);
finally
SetFunctionButtons(true);
end;
end; procedure TMainForm.SaveFTPHostInfo(Datatext, header: String);
var
ServerIni: TIniFile;
begin
ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) 'FtpHost.ini');
ServerIni.WriteString('Server', header, Datatext);
ServerIni.UpdateFile;
ServerIni.Free;
end; function TMainForm.GetHostInfo(header: String): String;
var
ServerName: String;
ServerIni: TIniFile;
begin
ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) 'FtpHost.ini');
ServerName := ServerIni.ReadString('Server', header, header); ServerIni.Free;
result := ServerName;
end; end.
|