Witam,
Więc tworzę najprostszy Serwerek FTP. Mam pytanie, jak wyświetlić zawartość większej ilości dysków? Chciałbym aby po zalogowaniu wyswietlalo mi wszystko to co jest w Mój Komputer. Ma ktoś jakiś pomysł?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
IdBaseComponent, IdComponent, IdTCPServer, IdCmdTCPServer, IdFTPList,
IdExplicitTLSClientServerBase, IdFTPServer, StdCtrls, IdFTPListOutput,
IdCustomTCPServer;
type
TForm1 = class(TForm)
IdFTPServer1: TIdFTPServer;
procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
const APath: String; ADirectoryListing: TIdFTPListOutput; const ACmd,
ASwitches: String);
procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
const AFileName: String; var VStream: TStream);
procedure IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
const AFileName: String; AAppend: Boolean; var VStream: TStream);
procedure IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
var VDirectory: String);
procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerContext;
var VDirectory: String);
procedure IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
const APathName: String);
procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
const AFilename: String; var VFileSize: Int64);
procedure FormCreate(Sender: TObject);
private
function ZamienZnaki(APath: String): String;
function RozmiarPliku(AFile : String) : Integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
Folder : String;
implementation
{$R *.dfm}
function TForm1.ZamienZnaki(APath:String):String;
var
s:string;
begin
s := StringReplace(APath, '/', '\', [rfReplaceAll]);
s := StringReplace(s, '\\', '\', [rfReplaceAll]);
Result := s;
end;
function TForm1.RozmiarPliku(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 TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
const APath: String; ADirectoryListing: TIdFTPListOutput; const ACmd,
ASwitches: String);
var
LFTPItem :TIdFTPListItem;
SR : TSearchRec;
SRI : Integer;
begin
ADirectoryListing.DirFormat := doUnix;
SRI := FindFirst(Folder + APath + '\*.*', faAnyFile - faHidden - faSysFile, SR);
While SRI = 0 do
begin
LFTPItem := ADirectoryListing.Add;
LFTPItem.FileName := SR.Name;
LFTPItem.Size := SR.Size;
LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);
if SR.Attr = faDirectory then
LFTPItem.ItemType := ditDirectory
else
LFTPItem.ItemType := ditFile;
SRI := FindNext(SR);
end;
FindClose(SR);
SetCurrentDir(Folder + APath + '\..');
end;
procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
const AFileName: String; var VStream: TStream);
begin
VStream := TFileStream.Create(ZamienZnaki(Folder+AFilename),fmOpenRead);
end;
procedure TForm1.IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
const AFileName: String; AAppend: Boolean; var VStream: TStream);
begin
if not Aappend then
VStream := TFileStream.Create(ZamienZnaki(Folder+AFilename),fmCreate)
else
VStream := TFileStream.Create(ZamienZnaki(Folder+AFilename),fmOpenWrite)
end;
procedure TForm1.IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
var VDirectory: String);
begin
if not ForceDirectories(ZamienZnaki(Folder + VDirectory)) then
begin
Raise Exception.Create('Nie mozna utworzyc katalogu');
end;
end;
procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerContext;
var VDirectory: String);
begin
ASender.CurrentDir := VDirectory;
end;
procedure TForm1.IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
const APathName: String);
begin
DeleteFile(ZamienZnaki(Folder+ASender.CurrentDir+'\'+APathname));
end;
procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
const AFilename: String; var VFileSize: Int64);
Var
LFile : String;
begin
LFile := ZamienZnaki( Folder + AFilename );
try
If FileExists(LFile) then
VFileSize := RozmiarPliku(LFile)
else
VFileSize := 0;
except
VFileSize := 0;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
folder:='C:\';
IdFTPServer1.Active:=True;
end;
end.