贴一个indy9的ftpserver程序,提点问题

jieguo 2009-07-09 05:47:14
下面是我的一个indy9的ftpserver程序,开发环境为delphi7和xp,客户端用 cmd->ftp测试的时候,基本没有问题,
但是用浏览器作为客户端得时候,浏览和下载中文名称文件时,就会出错,不知道如何解决,请各位大侠帮忙。
还有我用C#的ftpWebRequest做的客户端程序,也出现这个中文文件问题,我生成Uri的时候已经指定编码格式为GB2312了,
也不对。

var
MainFrm: TMainFrm;
AppDir : String;
implementation

uses StrUtils,IniFiles;

{$R *.dfm}

procedure TMainFrm.AppendLog(sFileId:string);
var
txtF:TextFile;
begin
AssignFile(txtF,sFileId);
try
if (not FileExists(sFileId) ) then
begin
Rewrite(txtF);
end
else
begin
Append(txtF);
end;

Writeln(txtf,mmolog.lines.text);

finally
CloseFile(txtF);
end;

end;
procedure TMainFrm.logto(str:string);
begin
if mmoLog.Lines.Count>2000 then
begin
AppendLog(ExtractFilePath(Application.ExeName)+'logAuto.log' );

mmoLog.Lines.Clear;
end;
mmoLog.Lines.Add(DateTimeToStr(now)+' '+str);

end;
function TMainFrm.ReplaceChars(APath:String):String;
var
s:string;
begin
s := StringReplace(APath, '/', '\', [rfReplaceAll]);
s := StringReplace(s, '\\', '\', [rfReplaceAll]);
Result := s;
end;
function TMainFrm.GetSizeOfFile(AFile : String) : Integer;
var
FStream : TFileStream;
begin
Try
FStream := TFileStream.Create(AFile, fmOpenRead);
Try
Result := FStream.Size;
Finally
FreeAndNil(FStream);
End;
Except
Result := 0;
End;
end;

procedure TMainFrm.FormShow(Sender: TObject);
begin
Setskin;
spgcntrl1.ActivePageIndex:=0;
ReadIni();
if Trim(edtFilePath.Text)='' then
edtFilePath.Text:=ExtractFilePath(Application.ExeName)+'smj';
AppDir:=edtFilePath.Text;

if RightStr(AppDir,1)<>'\' then
AppDir:=AppDir+'\';

try
if not idftpsrvrMain.Active then
begin
idftpsrvrMain.Active:=true;
logto('ftp扫描件服务器端启动...');

end;
sbtbtnStop.Enabled:=true;
sbtbtnOk.Enabled:=False;
except
MessageDlg('服务启动失败,原因:21端口被使用!',mtInformation,[mbok],0);
end;
end;

procedure TMainFrm.sbtbtnCloseClick(Sender: TObject);
begin
close;
end;

procedure TMainFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if idftpsrvrMain.Active then
idftpsrvrMain.Active:=false;
end;

procedure TMainFrm.sbtbtnStopClick(Sender: TObject);
begin
if not (idftpsrvrMain.Active ) then
exit;
try
idftpsrvrMain.Active:=false;
logto('ftp扫描件服务器端关闭!');
sbtbtnStop.Enabled:=false;
sbtbtnOk.Enabled:=True;
except
end;
end;

procedure TMainFrm.sbtbtnOkClick(Sender: TObject);
begin
if (idftpsrvrMain.Active ) then
exit;
try
idftpsrvrMain.Active:=true;
logto('ftp服务器端开启...');
sbtbtnStop.Enabled:=true;
sbtbtnOk.Enabled:=false;
except
end;
end;


procedure TMainFrm.sbtbtnSaveAsClick(Sender: TObject);
var sFile:string;
begin
try
sFile:=ExtractFilePath(Application.ExeName)+'log'+trim(dateTostr(Now))+'.log';
mmoLog.Lines.SaveToFile(sFile);
MessageDlg('日志文件已保存至'+sFile,mtInformation,[mbOK],0 );
except
MessageDlg('保存失败!原因未知!',mtWarning,[mbOK],0);
end;
end;

procedure TMainFrm.idftpsrvrMainChangeDirectory(
ASender: TIdFTPServerThread; var VDirectory: String);
begin
try
ASender.CurrentDir := VDirectory;
logto(ASender.Username+ '切换目录至:'+Vdirectory );
except
end;
end;

procedure TMainFrm.idftpsrvrMainDeleteFile(ASender: TIdFTPServerThread;
const APathName: String);
begin
DeleteFile(ReplaceChars(AppDir+ASender.CurrentDir+'\'+APathname));
logto(ASender.Username+ '删除文件:'+APathName );
end;

procedure TMainFrm.idftpsrvrMainListDirectory(ASender: TIdFTPServerThread;
const APath: String; ADirectoryListing: TIdFTPListItems);
var
LFTPItem :TIdFTPListItem;
SR : TSearchRec;
SRI : Integer;

sPath:string;
begin
// ADirectoryListing. .DirFormat :=doUnix;

sPath:= ReplaceChars( appDir+APath+'\*.*' );
SRI := FindFirst(sPath, faAnyFile - faHidden - faSysFile, SR);

While SRI = 0 do
begin
LFTPItem := ADirectoryListing.Add;
LFTPItem.FileName :=SR.Name; // SR.FindData.cFileName; //
LFTPItem.Size := SR.Size;
LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);

LFTPItem.OwnerName:='guojie';
LFTPItem.GroupName:='guojie';

if SR.Attr = faDirectory then
LFTPItem.ItemType := ditDirectory
else
LFTPItem.ItemType := ditFile;
SRI := FindNext(SR);
end;
FindClose(SR);
SetCurrentDir( ReplaceChars( AppDir + APath + '\..') );
logto(ASender.Username+ '获取文件列表:'+ ReplaceChars(APath ) );

end;

procedure TMainFrm.idftpsrvrMainStoreFile(ASender: TIdFTPServerThread;
const AFileName: String; AAppend: Boolean; var VStream: TStream);
begin
try
if not Aappend then
begin
VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmCreate)
end
else
begin
VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenWrite);
end;
logto(ASender.Username+' 上传文件'+ ReplaceChars( AFileName));
except
end;

end;

procedure TMainFrm.idftpsrvrMainGetFileSize(ASender: TIdFTPServerThread;
const AFilename: String; var VFileSize: Int64);
Var
LFile : String;
begin
LFile := ReplaceChars( AppDir + AFilename );
try
If FileExists(LFile) then
VFileSize := GetSizeOfFile(LFile)
else
VFileSize := 0;
except
VFileSize := 0;
end;
end;

procedure TMainFrm.idftpsrvrMainRetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
begin
VStream := TFileStream.Create(ReplaceChars(AppDir+AFilename),fmOpenRead);
logto(ASender.Username+' 获取文件'+ ReplaceChars( AFileName));
end;

procedure TMainFrm.idftpsrvrMainMakeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
if not ForceDirectories(ReplaceChars(AppDir + VDirectory)) then
begin
Raise Exception.Create('Unable to create directory');
end
else
begin
logto(Asender.Username+'创建目录'+VDirectory);

//nnd,创建目录后 Asender的currentdir会跳到该创建目录下,转化回来
ASender.CurrentDir:= '\';
logto('当前活动路径:'+ ReplaceChars( Asender.CurrentDir ));

end;
end;

procedure TMainFrm.idftpsrvrMainRemoveDirectory(
ASender: TIdFTPServerThread; var VDirectory: String);
Var
LFile : String;
begin
LFile := ReplaceChars(AppDir + VDirectory);
try
DeleteFile(LFile);
logto('删除文件(目录)'+ LFile);
except
Raise Exception.Create('删除文件失败!');
end;

end;


procedure TMainFrm.edtFilePathChange(Sender: TObject);
begin
AppDir:=edtFilePath.Text;
if RightStr(AppDir,1)<>'\' then
AppDir:=AppDir+'\';

end;

procedure TMainFrm.idftpsrvrMainRenameFile(ASender: TIdFTPServerThread;
const ARenameFromFile, ARenameToFile: String);
var src:string;
dest:string;
begin
src:=ReplaceChars(AppDir+ASender.CurrentDir+'\'+ARenameFromFile) ;
dest:=ReplaceChars(AppDir+ASender.CurrentDir+'\'+ARenameToFile ) ;


try
MoveFile( pchar(src),pchar(dest) ) ;
logto(Asender.Username+'将'+ ARenameFromFile+'重命名为'+ ARenameToFile );
except
raise Exception.Create('不能rename文件...');
end;

end;

procedure TMainFrm.idftpsrvrMainUserLogin(ASender: TIdFTPServerThread;
const AUsername, APassword: String; var AAuthenticated: Boolean);
begin
// We just set AAuthenticated to true so any username / password is accepted
// You should check them here - AUsername and APassword
AAuthenticated := True;
end;

procedure TMainFrm.sbtbtnClearClick(Sender: TObject);
begin
mmoLog.Clear;

end;

end.
...全文
116 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
jieguo 2009-07-13
  • 打赏
  • 举报
回复
我测试了一下,发送过来的命令 到服务器端后会自动转化为 本地设置后的字符编码格式。但是 我对这样的编码进行解码后 再进行同类编码得不到完全相同的字符串。郁闷了
jieguo 2009-07-10
  • 打赏
  • 举报
回复
[Quote=引用 1 楼 sz_haitao 的回复:]
监控一下浏览器是不是发了一些特别的设置、获取格式的命令。。。。。。。。
[/Quote]
怎么监控撒,
haitao 2009-07-09
  • 打赏
  • 举报
回复
监控一下浏览器是不是发了一些特别的设置、获取格式的命令。。。。。。。。

1,593

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 网络通信/分布式开发
社区管理员
  • 网络通信/分布式开发社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧