Prosty serwerek FTP (INDY) :: 4programmers.net

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: Delphi » Gotowce

12 komentarzy

Napisany 2010-10-06 00:25 przez agent_ziemba

Baaaardzo dawno tutaj nie bylem, jakie zmiany w gotowcu? Pobierznie z tela zerknalem, odnosnie userow tylko zmiany?

Napisany 2008-08-18 15:42 przez pingvin

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

Napisany 2007-08-25 17:50 przez york_daro

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

Napisany 2006-09-19 10:12 przez agent_ziemba

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

Napisany 2005-12-09 23:09 przez Dziadek

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

Napisany 2005-07-10 10:06 przez agent_ziemba

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

Napisany 2005-07-09 19:14 przez DJ ProG

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

Napisany 2005-07-08 22:07 przez agent_ziemba

Jak będzie czas to zrobie multiuser.

Napisany 2005-07-08 10:47 przez maly186

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

Napisany 2005-07-08 10:46 przez maly186

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

Napisany 2005-07-03 18:17 przez agent_ziemba

Na INDY 9 raczej nie zadziała :(

Napisany 2005-07-03 12:25 przez abc

Długie i dobre :P
Tylko ciekawe czy zadziala na indy 9 - bo jednak 9 chyba ma wiecej osob :P
Zreszta nie wazne fajnie jest :)

Prosty serwerek FTP (INDY)

12 komentarzy

Programowanie

Forum dyskusyjne

4programmers.net

O nas