初学delphi 请教如何把d:/send目录下的文件传到apache服务器建立的ftp上 ( 积分: 100 )

  • 主题发起人 主题发起人 a1121
  • 开始时间 开始时间
A

a1121

Unregistered / Unconfirmed
GUEST, unregistred user!
我用delphi把一个文件改名copy到d:/send目录下,同时生成一个同名的后缀为ctrl
的文件 我希望把这两个文件同时上传到一个ftp上
初学希望能给出原码
谢谢


procedure Tform1.Fcopy(Sender:TObject);
var ok1:boolean;
begin
NewName:='';
NewName1:='';
oldname:='';
oldname1:='';
FailCount:=0;
SuccCount:=0;

edit5.Text:=FormatDateTime('YYYYMMDDHHMMSS',now);
time1:=FormatDateTime('DD'+'/'+'MM'+'/'+'YYYY',now);

testi:=length(trim(edit1.Text));
if edit1.Text[testi]='/'
then
oldname:=trim(edit1.Text)+trim(memo1.Lines.Strings[0])
else
oldname:=trim(edit1.Text)+'/'+trim(memo1.Lines.Strings[0]);

NewName:='d:/send'+'/'+'test_'+trim(edit4.text)+'_test_'+trim(edit5.Text)+'.PDF';
NewName1:='d:/send'+'/'+'test_'+trim(edit4.text)+'_test_'+trim(edit5.Text)+'.CTRL';

ok1:=true;
if copyfile(pchar(OldName),pchar(NewName),ok1) =false then //AND copyfile(pchar(OldName1),pchar(NewName1),ok1)
FailCount:=FailCount+1
else
SuccCount:=SuccCount+1;
//AND copyfile(pchar(OldName1),pchar(NewName1),ok1)
statusbar1.Panels[1].Text:='成功:'+inttostr(SuccCount)+' 失败: '+IntToStr(FailCount);

statusbar1.Panels[0].Text:='重命名';

NewName2:=trim(edit3.text)+#10+'0'+#10+'(NO TITLE SUPPLIED) -- ID: '+trim(edit2.text)+#10+trim(time1)+#10+'1'+#10+'20'+#10;
//NewName2:='sdfsd';
// Buffer[0]:=10;
//Buffer[1]:=13;
ch:=#10;

begin
assignfile(ctl,NewName1);
rewrite(ctl);
//try
write(ctl,NewName2);
//write(ctl,ch);
//ch=13;
//write(ctl,NewName2);
//finally
closefiLE(ctl);
//end
end;
我用delphi把一个文件改名copy到d:/send目录下,同时生成一个同名的后缀为ctrl
的文件 我希望把这两个文件同时上传到一个ftp上
初学希望能给出原码
谢谢
 
我用delphi把一个文件改名copy到d:/send目录下,同时生成一个同名的后缀为ctrl
的文件 我希望把这两个文件同时上传到一个ftp上
初学希望能给出原码
谢谢


procedure Tform1.Fcopy(Sender:TObject);
var ok1:boolean;
begin
NewName:='';
NewName1:='';
oldname:='';
oldname1:='';
FailCount:=0;
SuccCount:=0;

edit5.Text:=FormatDateTime('YYYYMMDDHHMMSS',now);
time1:=FormatDateTime('DD'+'/'+'MM'+'/'+'YYYY',now);

testi:=length(trim(edit1.Text));
if edit1.Text[testi]='/'
then
oldname:=trim(edit1.Text)+trim(memo1.Lines.Strings[0])
else
oldname:=trim(edit1.Text)+'/'+trim(memo1.Lines.Strings[0]);

NewName:='d:/send'+'/'+'test_'+trim(edit4.text)+'_test_'+trim(edit5.Text)+'.PDF';
NewName1:='d:/send'+'/'+'test_'+trim(edit4.text)+'_test_'+trim(edit5.Text)+'.CTRL';

ok1:=true;
if copyfile(pchar(OldName),pchar(NewName),ok1) =false then //AND copyfile(pchar(OldName1),pchar(NewName1),ok1)
FailCount:=FailCount+1
else
SuccCount:=SuccCount+1;
//AND copyfile(pchar(OldName1),pchar(NewName1),ok1)
statusbar1.Panels[1].Text:='成功:'+inttostr(SuccCount)+' 失败: '+IntToStr(FailCount);

statusbar1.Panels[0].Text:='重命名';

NewName2:=trim(edit3.text)+#10+'0'+#10+'(NO TITLE SUPPLIED) -- ID: '+trim(edit2.text)+#10+trim(time1)+#10+'1'+#10+'20'+#10;
//NewName2:='sdfsd';
// Buffer[0]:=10;
//Buffer[1]:=13;
ch:=#10;

begin
assignfile(ctl,NewName1);
rewrite(ctl);
//try
write(ctl,NewName2);
//write(ctl,ch);
//ch=13;
//write(ctl,NewName2);
//finally
closefiLE(ctl);
//end
end;
我用delphi把一个文件改名copy到d:/send目录下,同时生成一个同名的后缀为ctrl
的文件 我希望把这两个文件同时上传到一个ftp上
初学希望能给出原码
谢谢
 
原码以前有,现在手头没有,但我以前是在www.playicq.com上下载的,你可以去找一下,肯定有的。
 
这个网站联不上
告诉我几个关键命令我试试
 
不可能连不上,我试了一下,可以。不过你可以查找用DELPHI编的FTP源码。
 
我參考下面的文章寫過ftp下載,原文如下

如何用idFTP遍历整个目录—下载、删除


这两天做一个项目,其中需要用ftp下载服务器上的整个目录,并且下载完成后,删除整个目录。由于ftp不能穿透子目录,只能在当前目录下操作,所以用一般的方法根本无法达到预期效果。可能我想偷懒吧!于是想从网上搜搜,看有没有现成的东东拿来使用 :)

结果令我非常失望,不是无法运行就是达不到我的预期效果。其实论坛上也有人问过这样的问题,可一直也没有满意的结果。哎!还得靠自己呀!小日本可没有那么听话,不知道大家听没听说钓鱼岛,去没去参加游行。

下面的程序是用delphi7.0 + idFTP 实现的。可能还会有bug,不过希望能给需要他的人带来一点点帮助和提示!,程序中只有下载与删除的代码,至于上传的code自己写吧,稍微思考一下就可以实现。

unit Unit1;


interface


uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,IdFTPList,

IdTCPClient, IdFTP ;


type

TForm1 = class(TForm)

Btt_DownLoadDir: TButton;

IdFTP1: TIdFTP;

Btt_DeleteDir: TButton;

Label1: TLabel;

lb_num: TLabel; //处理文件个数提示。

procedure Btt_DownLoadDirClick(Sender: TObject);

procedure Btt_DeleteDirClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation


{$R *.dfm}







{ 下载整个目录,并遍历所有子目录

首先 ChangeDir(Root) 到根目录

然后创建本地目录 + RemoteDir

然后用 list 得到所有目录名

循环判断,进入 RemoteDir 目录内部

如果是目录继续第归。否则 get 该文件到本地目录,当 get 完所有文件后返回上一级目录

用List再取得信息,继续循环

}


procedure FTP_DownloadDir(var idFTP : TIdFtp;RemoteDir,LocalDir : string);

label Files ;

var

i,DirCount : integer;

begin

if not DirectoryExists(LocalDir + RemoteDir) then

ForceDirectories(LocalDir + RemoteDir);

idFTP.ChangeDir(RemoteDir);

idFTP.List(nil);

DirCount := idFTP.DirectoryListing.Count ;

if DirCount = 0 then

begin

idFTP.ChangeDirUp;

idFTP.List(nil);

end;

for i := 0 to DirCount - 1 do

begin

if DirCount <> idFTP.DirectoryListing.Count then

begin

repeat

idFTP.ChangeDirUp;

idFTP.List(nil);

until DirCount = idFTP.DirectoryListing.Count ;

end;

if idFTP.DirectoryListing.ItemType = ditDirectory then

FTP_DownloadDir(idFTP,idFTP.DirectoryListing.FileName,LocalDir + RemoteDir + '/')

else begin

idFTP.Get(idFTP.DirectoryListing.FileName,LocalDir + RemoteDir + '/' +

idFTP.DirectoryListing.FileName,true);

Form1.lb_num.Caption := IntToStr(StrToInt(Form1.lb_num.Caption) + 1);

Form1.lb_num.Update;

if i = DirCount - 1 then

begin

idFTP.ChangeDirUp;

idFTP.List(nil);

end;

end;

end;

end;


{删除整个ftp目录,包括下面的文件,

RootDir = 要删除的根目录,一般情况下 RemoteDir 与 RootDir 相等}

procedure FTP_DeleteAllFiles(var idFTP : TIdFtp;RemoteDir,RootDir : string);

label Files;

var

i,DirCount : integer;

Temp : string;

begin

idFTP.ChangeDir(RemoteDir);

if Pos(RootDir,idFTP.RetrieveCurrentDir) = 0 then Exit;

Files :

idFTP.List(nil);

DirCount := idFTP.DirectoryListing.Count ;

while DirCount = 0 do

begin

Temp := idFTP.RetrieveCurrentDir;

idFTP.ChangeDirUp;

idFTP.RemoveDir(Temp);

idFTP.List(nil);

DirCount := idFTP.DirectoryListing.Count ;

for i := 0 to DirCount - 1 do

if idFTP.DirectoryListing.FileName = RootDir then Exit;

end;

for i := 0 to DirCount - 1 do

begin

if Pos(RootDir,idFTP.RetrieveCurrentDir) = 0 then Break ;

if idFTP.DirectoryListing.ItemType = ditDirectory then

begin

FTP_DeleteAllFiles(idFTP,idFTP.DirectoryListing.FileName,RootDir);

end else begin

idFTP.Delete(idFTP.DirectoryListing.FileName);

Form1.lb_num.Caption := IntToStr(StrToInt(Form1.lb_num.Caption) + 1);

Form1.lb_num.Update;

goto Files ;

end;

end;

end;


procedure TForm1.Btt_DownLoadDirClick(Sender: TObject);

begin

IdFTP1.Connect(true,-1);

if IdFTP1.Connected then

begin

IdFTP1.ChangeDir('bigimage');

FTP_DownloadDir(IdFTP1,'1002.1002.1002','g:/ftpdir/');

end;

IdFTP1.Disconnect ;

end;


procedure TForm1.Btt_DeleteDirClick(Sender: TObject);

begin

IdFTP1.Connect(true,-1);

if IdFTP1.Connected then

begin

IdFTP1.ChangeDir('bigimage');

FTP_DeleteAllFiles(IdFTP1,'1002.1002.1002','1002.1002.1002');

end;

IdFTP1.Disconnect ;

end;


end.



运行环境 win2000 advanced server + delphi7.0 + iis6.0
 
我从教育网连接这个网站怎么这么慢
谢谢china_peng我编一下试试
 
最好下载个源码看看,到www.2ccc.com上找找。
 
dxmylove@yahoo.com.cn,qq:171833017,http://www.websamba.com/dxmylove
免费软件 文件上传下载 基于indytcp,刚写的,如果不能正常下载,可直接联系我
 
可以上传了 但是似乎容错处理没有
问题基本解决
谢谢大家

begin
//下面判断是否已经建立连接
if IdFTP1.Connected then
begin
if MessageDlg('是否中止当前连接及下载过程?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
try
if IsTransParent then
IdFTP1.Abort;
IdFTP1.Quit;
Except
ShowMessage('中止当前下载过程出错');
end;
end
else
exit;
end;

try
IdFTP1.UserName:='******' ;
IdFTP1.Password:='******' ;
IdFTP1.Host:='127.0.0.1';
IdFTP1.Port:=21;
IdFTP1.Connect;
//DisConnect.Enabled :=true;
// MemoMsg.Lines.AddStrings(FTPClient.LoginMsg.Text);
// ComboHistory.Clear;
// ComboHistory.Items.Add('/');
//ComboHistory.ItemIndex :=0;
//RemoteChangeDirExecute(Sender);
IdFTP1.Put(NewName, NewName3);
IdFTP1.Put(NewName1, NewName4);
IdFTP1.Disconnect ;;
except
ShowMessage('连接服务器出错');
end;

end;


end;
 
后退
顶部