FTP Demo不採用元件設計,傳檔完成才回傳是否成功 採用wininet不需任何元件 Delphi 5.0 附執行檔 傳統上傳FTP的方法程式需自行偵測是否傳完,是否成功,是否連不上主機... 現提供Function三個: function FtpDownload(host,user,password,fn1,fn2:string):boolean; function FtpUpload(host,user,password,fn1,fn2:string):boolean; function FtpDelete(host,user,password,fn1:string):boolean; 是不是很方便在程式中上下傳FTP檔案呢? 尤其適合程式自動更新系統! 快下載用看看吧!使用上有問題歡迎上網發言!

------
～～～Delphi K.Top討論區站長～～～

附加檔案：00000200_FtpDemo.exe

一直到今天才知道原來未將原始程式放入 2002/06/20 補上傳Source code ～～～Delphi K.Top討論區站長～～～

------
～～～Delphi K.Top討論區站長～～～

原始程式 uses wininet; function FtpDownload(host,user,password,fn1,fn2:string):boolean; var Fcontext,position:integer; FINet,FFtpHandle:Hinternet; Transfer:boolean; Str:string; begin result:=false; FContext := 255; Finet := internetopen(Pchar('Pftp'),1,nil,nil,0); Fftphandle := internetconnect(Finet,Pchar(host),21,Pchar(user),Pchar(password),internet_Service_Ftp,0,Fcontext); if Fftphandle <> nil then if FtpGetFile(Fftphandle,Pchar(fn1),Pchar(fn2),False,ftp_transfer_type_binary,0,FContext) then result:=true; InternetCloseHandle(Fftphandle); end; function FtpUpLoad(host,user,password,fn1,fn2:string):boolean; var Fcontext,position:integer; FINet,FFtpHandle:Hinternet; Transfer:boolean; Str:string; begin result:=false; FContext := 255; Finet := internetopen(Pchar('Pftp'),1,nil,nil,0); Fftphandle := internetconnect(Finet,Pchar(host),21,Pchar(user),Pchar(password),internet_Service_Ftp,0,Fcontext); if Fftphandle <> nil then if FtpPutFile(Fftphandle,Pchar(fn1),Pchar(fn2),0,FContext) then result:=true; InternetCloseHandle(Fftphandle); end; function FtpDelete(host,user,password,fn1:string):boolean; var Fcontext,position:integer; FINet,FFtpHandle:Hinternet; begin result:=false; FContext := 255; Finet := internetopen(Pchar('Pftp'),1,nil,nil,0); Fftphandle := internetconnect(Finet,Pchar(host),21,Pchar(user),Pchar(password),internet_Service_Ftp,0,Fcontext); if Fftphandle <> nil then if FtpDeleteFile(Fftphandle,Pchar(fn1)) then result:=true; InternetCloseHandle(Fftphandle); end; P.S:站長的範例程式的原始程式不見了,請網友用上面Source,寫一個範例上傳給網友分享,謝謝! ～～～Delphi K.Top討論區站長～～～

------
～～～Delphi K.Top討論區站長～～～

[code delphi]
unit FTP_DEMO;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,WININET,
StdCtrls,
Dialogs;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
ftp: TEdit;
id: TEdit;
pw: TEdit;
l_file: TEdit;
r_file: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
PATH:String;
{ Private declarations }
public
{function FtpDownload(host,user,password,fn1,fn2:string):boolean;
function FtpUpLoad(host,user,password,fn1,fn2:string):boolean;
function FtpDelete(host,user,password,fn1:string):boolean; }
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function FtpDownload(host,user,password,fn1,fn2:string):boolean;
var Fcontext,position:integer;
FINet,FFtpHandle:Hinternet;
Transfer:boolean;
Str:string;
begin
result:=false;
FContext := 255;
Finet := internetopen(Pchar('Pftp'),1,nil,nil,0);
Fftphandle := internetconnect(Finet,Pchar(host),21,Pchar(user),Pchar(password),internet_Service_Ftp,0,Fcontext);
if Fftphandle <> nil then
if FtpGetFile(Fftphandle,Pchar(fn1),Pchar(fn2),False,ftp_transfer_type_binary,0,FContext) then result:=true;
InternetCloseHandle(Fftphandle);
end;
function FtpUpLoad(host,user,password,fn1,fn2:string):boolean;
var Fcontext,position:integer;
FINet,FFtpHandle:Hinternet;
Transfer:boolean;
Str:string;
begin
result:=false;
FContext := 255;
Finet := internetopen(Pchar('Pftp'),1,nil,nil,0);
Fftphandle := internetconnect(Finet,Pchar(host),21,Pchar(user),Pchar(password),internet_Service_Ftp,0,Fcontext);
if Fftphandle <> nil then
if FtpPutFile(Fftphandle,Pchar(fn1),Pchar(fn2),0,FContext) then result:=true;
InternetCloseHandle(Fftphandle);
end;
function FtpDelete(host,user,password,fn1:string):boolean;
var Fcontext,position:integer;
FINet,FFtpHandle:Hinternet;
begin
result:=false;
FContext := 255;
Finet := internetopen(Pchar('Pftp'),1,nil,nil,0);
Fftphandle := internetconnect(Finet,Pchar(host),21,Pchar(user),Pchar(password),internet_Service_Ftp,0,Fcontext);
if Fftphandle <> nil then
if FtpDeleteFile(Fftphandle,Pchar(fn1)) then result:=true;
InternetCloseHandle(Fftphandle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FtpUpLoad(ftp.Text,id.Text,pw.Text,path '\' l_file.Text,r_file.Text) then
ShowMessage('上傳' l_file.Text '成功')else
ShowMessage('上傳' l_file.Text '失敗');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if FtpDownload(ftp.Text,id.Text,pw.Text,r_file.Text,path '\' l_file.Text) then
ShowMessage('下載' r_file.Text '成功')else
ShowMessage('下載' r_file.Text '失敗');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if FtpDelete(ftp.Text,id.Text,pw.Text,r_file.Text) then
ShowMessage('刪除' r_file.Text '成功')else
ShowMessage('刪除' r_file.Text '失敗');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
path:=GetCurrentDir;
end;
end.

//下面另存為FTP_DEMO.dfm
object Form1: TForm1
Left = 205
Top = 141
BorderStyle = bsSingle
Caption = 'Form1'
ClientHeight = 263
ClientWidth = 301
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = '細明體'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 12
object Label1: TLabel
Left = 40
Top = 75
Width = 66
Height = 12
Caption = 'FTP站台網址'
end
object Label2: TLabel
Left = 40
Top = 99
Width = 36
Height = 12
Caption = 'UserId'
end
object Label3: TLabel
Left = 40
Top = 123
Width = 48
Height = 12
Caption = 'PassWord'
end
object Label4: TLabel
Left = 40
Top = 147
Width = 72
Height = 12
Caption = '當地檔案名稱'
end
object Label5: TLabel
Left = 40
Top = 171
Width = 72
Height = 12
Caption = '遠端檔案名稱'
end
object Button1: TButton
Left = 42
Top = 211
Width = 75
Height = 25
Caption = '上傳檔案'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 122
Top = 211
Width = 75
Height = 25
Caption = '下載檔案'
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton
Left = 202
Top = 211
Width = 75
Height = 25
Caption = '刪除檔案'
TabOrder = 2
OnClick = Button3Click
end
object ftp: TEdit
Left = 120
Top = 72
Width = 121
Height = 20
TabOrder = 3
Text = '127.0.0.1'
end
object id: TEdit
Left = 120
Top = 96
Width = 121
Height = 20
TabOrder = 4
end
object pw: TEdit
Left = 120
Top = 120
Width = 121
Height = 20
TabOrder = 5
end
object l_file: TEdit
Left = 120
Top = 144
Width = 121
Height = 20
TabOrder = 6
end
object r_file: TEdit
Left = 120
Top = 168
Width = 121
Height = 20
TabOrder = 7
end
end
[/code]

編輯記錄