全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:1122
推到 Plurk!
推到 Facebook!

ftp

缺席
delphi
初階會員


發表:52
回覆:64
積分:38
註冊:2002-05-21

發送簡訊給我
#1 引用回覆 回覆 發表時間:2003-01-24 13:17:44 IP:61.63.xxx.xxx 未訂閱
請教各位大大: 我現在要寫一個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; 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.ConnectButt 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 := 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.UploadButt 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.DeleteButt 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.AbortButt true; end; procedure TMainForm.BackButt 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.ChDirButt 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.
zrweng
一般會員


發表:0
回覆:8
積分:16
註冊:2002-10-22

發送簡訊給我
#2 引用回覆 回覆 發表時間:2003-01-24 14:52:27 IP:218.5.xxx.xxx 未訂閱
这么长呀,提示什么错误? ———— 我輕輕地來時 不希冀能收獲一片綠葉 你卻給了我整個春天 我悄悄走時 不渴望帶走一絲回憶 你卻給了我一生的掛念
------
————
我輕輕地來時 不希冀能收獲一片綠葉
你卻給了我整個春天

我悄悄走時 不渴望帶走一絲回憶
你卻給了我一生的掛念
系統時間:2017-12-14 14:20:17
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!