[DELPHI]+INDY 10 Serwer FTP

0

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.
0

moze w funkji odpowiaajacej sprawdzaj aktualny katalog i jesli np jest wartosc "Komputer" to wtedy jako foldery zwróc liste dysków?

1 użytkowników online, w tym zalogowanych: 0, gości: 1