Prosty serwerek FTP (INDY)

Cześć tu Agent_Ziemba. Jest to mój pierwszy artykuł, proszę o wyrozumiałość. Starałem się poprawić wszystkie błędy jakie
znalazłem. W tym gotowcu napiszemy sobie jak postawić prosty serwerek FTP. Możemy to zrobić na 2 sposoby:
1. Zainstalować sobie jakiś gotowy serwerek :P (ale to nie dla nas)
2. Napisać sobie serwerek (chyba trochę większa frajda)
Zaczynamy

Robiłem to w Delphi7 z zainstalowanym INDY 10. Uruchamiamy sobie Delphi i wrzucamy IdFTPServer. Teraz zabieramy się za edycję
kodu.

Deklarujemy globalną zmienną Folder

var 
  Folder  :  String;

Jest to zmienna typu String. Do tej zmiennej będzie przypisana ścieżka której użyjemy jako główny folder FTP (root dir).
Następnie piszemy sobie funkcję która zamienia znaki ze stylu UNIX na styl WINDOWS. Czyli '/' na '\' i '\\' na '\' .

function TForm1.ZamienZnaki(APath:String) :String;
var  s:String;
begin
  s:=StringReplace(APath, '/', '\', [rfReplaceAll]);
  s:=StringReplace(s, '\\', '\', [rfReplaceAll]);
  Result:=s;
end;

Teraz piszemy sobie funkcję podającą rozmiar plików:

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;

Powyzsza funkcja otwiera strumien pliku, sprawdza jego rozmiar i przypisuje do zmiennej Result.

Każdy serwer FTP musi wyświetlić listę plików do pobrania napiszmy więc obsługę eventu OnListDirectory

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;

Teraz przydałoby się zareagować jeżeli jakiś user będzie chciał uploadować plik, napiszmy więc obsługę eventu OnStoreFile :

begin
 if not Aappend then
   VStream := TFileStream.Create(ZamienZnaki(Folder+AFilename),fmCreate)
 else
   VStream := TFileStream.Create(ZamienZnaki(Folder+AFilename),fmOpenWrite)
end;

Teraz uzupełnimy event OnRetrieveFile , który będzie odpowiedzialny za downloadowanie plików:

begin
  VStream := TFileStream.Create(ZamienZnaki(Folder+AFilename),fmOpenRead);
end;

Z kolei w evencie OnMakeDirectory umieścimy następujący kod:

begin
  if not ForceDirectories(ZamienZnaki(Folder + VDirectory)) then
  begin
    Raise Exception.Create('Nie mozna utworzyc katalogu');
  end;
end;

Jeżeli user będzie chciał zmienić katalog roboczy to zadziała event OnChangeDirectory , który to uzupełniamy o poniższy kod:

begin
  ASender.CurrentDir := VDirectory;
end;

Poniższy kod będzie pobierał rozmiar pliku w systemie plików serwera. Wrzucamy go do eventu OnGetFileSize

Var
 LFile : String;
begin 
 LFile := ZamienZnaki( Folder + AFilename );
 try
 If FileExists(LFile) then
   VFileSize :=  RozmiarPliku(LFile)
 else
   VFileSize := 0;
 except
   VFileSize := 0;
 end;
end;

Teraz uzupełnimy event OnDeleteFile odpowiedzialny za kasowanie plików z serwera.

begin
  DeleteFile(ZamienZnaki(Folder+ASender.CurrentDir+'\'+APathname));
end;

Na koniec tego gotowca zostawiłem logowanie. Kod Logowania należy wrzucić do eventu OnUserLogin .

begin
  if (AUsername='maniek') and (APassword='pankoski') then begin
   AAuthenticated := True;
 end
 else begin
  AAuthenticated := False;
 end;
end;

Trochę wyjaśnienia. Jeżeli użytkownik poda nazwę użytkownika maniek i hasło pankoski to uzyska dostęp do serwera,
jeżeli poda coś innego to jego logowanie zostanie odrzucone. To był tylko przykład, jeżeli chcecie mieć bardzo niewielu
userów to możecie wrzucić nazwy userów do kodu, ale nie polecam tego z kilku powodów:
1. Trudność ze zmianą hasła usera (powtórna kompilacja)
2. Trudność z dodaniem usera (powtórna kompilacja)
3. Trudność z usunięciem usera (powtórna kompilacja)
Radze zrobić jakiś plik z hasłami i podczas logowania sprawdzać login i hasło.
Jeszcze tylko musimy uruchamiać i zamykać nasz serwerek. Wrzucamy na formę edita i dwa buttony. W edicie będzie podawana
ścieżka do katalogu wirtualnego. Button1 będzie uruchamiał serwer:

begin
  Folder:=Edit1.Text;
  IdFTPServer1.Active:=True;
end;

Button2 będzie zamykał serwer

begin
  IdFTPServer1.Active:=False;
end;

A oto cały listing unita:

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;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
      const AUsername, APassword: string; var AAuthenticated: Boolean);
    procedure IdFTPServer1MakeDirectory(ASender: TIdFTPServerContext;
      var VDirectory: string);
    procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
      const AFileName: string; var VStream: TStream);
    procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerContext;
      const AFilename: string; var VFileSize: Int64);
    procedure IdFTPServer1StoreFile(ASender: TIdFTPServerContext;
      const AFileName: string; AAppend: Boolean; var VStream: TStream);
    procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerContext;
      const APath: string; ADirectoryListing: TIdFTPListOutput; const ACmd,
      ASwitches: string);
    procedure IdFTPServer1DeleteFile(ASender: TIdFTPServerContext;
      const APathName: string);
    procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerContext;
      var VDirectory: string);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    function ZamienZnaki(APath: String): String;
    function RozmiarPliku(AFile : String) : Integer;
    { Private declarations }
  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.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.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.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.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.IdFTPServer1RetrieveFile(ASender: TIdFTPServerContext;
  const AFileName: string; var VStream: TStream);
begin
  VStream := TFileStream.Create(ZamienZnaki(Folder+AFilename),fmOpenRead);
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.IdFTPServer1UserLogin(ASender: TIdFTPServerContext;
  const AUsername, APassword: string; var AAuthenticated: Boolean);
begin
  if (AUsername='maniek') and (APassword='pankoski') then begin
   AAuthenticated := True;
 end
 else begin
  AAuthenticated := False;
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Folder:=Edit1.Text;
idFTPServer1.Active:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
IdFtpServer1.Active:=False;
end;

end.

No to koniec gotowca. Mam nadzieje że to się komuś przyda. Pozdro

Kategoria: Gotowce

Ostatnia modyfikacja	04-12-2009 10:14	Ostatni autor	woolfik
Ilość wyświetleń	15754	Wersja	2

pingvin dnia 18-08-2008 15:42

jak by ktoś miał problem sprawdźcie czy nie macie załączonego innego serwera ftp

york_daro dnia 25-08-2007 17:50

macie problemy ludzie... przerobienie tego kodu tak zeby dzialal na indy 9 to 5 minut bo roznia sie tylko nazwy zmiennych

agent_ziemba dnia 19-09-2006 10:12

To, że większość woli INDY 9 to nie znaczy, że źle z tym artykułem.

Dziadek dnia 09-12-2005 23:09

Raczej słabo, z tym artykułem, większość zdecydowanie woli indy 9, a tam zrobić serwerek jest trochę trudniej

agent_ziemba dnia 10-07-2005 10:06

Ja napisałem serwer, a ty musisz mieć klienta ziom. Oto adres http://www.indyproject.org/DemoDownloads/Indy_10_FTPClient.zip
Pozdro

DJ ProG dnia 09-07-2005 19:14

ja mam indy10, kompiluje i co dalej??? moze ktos wyjasni mnie obsluge?
http://forum.ks-ekspert.pl/index.php?showtopic=51174

agent_ziemba dnia 08-07-2005 22:07

Jak będzie czas to zrobie multiuser.

maly186 dnia 08-07-2005 10:47

Dobre,dobre al tylko dla jednego user\'a. Zmienna Folder zawiera aktulaną ścieżkę, ale ta zmienna ma taką samą wartość dla wszytskich user\'ów. Zamiast tego lepiej użyć ASender.CurrentDir

maly186 dnia 08-07-2005 10:46

Na INDY 9 zadziała będzie tylko inny typ parametru ASender, tzn. ASender: TIdFTPServerThread. Ale poza tym wszytsko tak samo

agent_ziemba dnia 03-07-2005 18:17

Na INDY 9 raczej nie zadziała

abc dnia 03-07-2005 12:25

Długie i dobre

Tylko ciekawe czy zadziala na indy 9 - bo jednak 9 chyba ma wiecej osob

Zreszta nie wazne fajnie jest

więcej »

więcej »