下面是我的一个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.