Wprowadzanie Serwera FTP - Kod
Teraz, że GUI jest zrobiony, przejdźmy do kodu. Większość procedur poniżej daje tobie wskazówkę, jeśli chodzi o co kod jest wszystek około. Skomentowałem większość kodu, żeby to, które możesz łatwo pracować z czym szło dalej w szczególnej procedurze.
Funkcja setslashes zastępuje podwójnego backslashes z pojedynczym jak również backslashes zastępuje pojedynczego frontslash z backslash. To ma upewnić się, że jakieś nazwy ścieżki, które są wysłane przez podanie klienta FTP są przetworzone w poprawnym rozkazie. Na przykład jeżeli użytkownik dostarcza nazwę ścieżki jak "c:afilename" wtedy ta funkcja poprawi to, by "c:afilename," który poprawna droga jest, by poradzić nazwy ścieżki.
function setSlashes(APath:String):String;
var
slash:string;
begin
slash := StringReplace(APath, '/', '', [rfReplaceAll]);
slash := StringReplace(slash, '', '', [rfReplaceAll]);
Result := slash;
end;
Wydarzenie poniżej zostaje strzelany kiedy podanie klienta FTP jest człowiekiem sukcesu do serwera. Możesz użyć tego wydarzenia, by wyśledzić co szczególny klient robi. Na przykład możesz dostać adresu IP, z którego klient był człowiekiem sukcesu i czas, który klient był człowiekiem sukcesu. Wydarzenie jest całkowicie opcjonalne.
procedure TForm1.IdFTPServer1Connect(AContext: TIdContext);
begin
//Here you could take the client IP address, time that a particular
//client logged in etc, for tracking purposes
end;
Sznur Vdirectory zawiera katalogu, do którego potrzebujesz zmienić. Directory imię jest wysłane przez podanie klienta FTP.:
procedure TForm1.IdFTPServer1ChangeDirectory(ASender:
TIdFTPServerContext; var VDirectory: String); begin
ASender.CurrentDir:= VDirectory; end;###
Wprowadzanie Serwera FTP - Usuwając Pliki
Klient wysyła imię pliku, by zostać usunięty w zmiennej APathName. Procedura poniżej zasadniczo bierze, że nazwa ścieżki i sprawdza, by zobaczyć, czy plik istnieje przed usuwaniem tego.
procedure TForm1.IdFTPServer1DeleteFile(ASender:TIdFTPServerContext;
const APathName: String);
begin
if fileexists(APathName) then
begin
DeleteFile(APathName);
end;
end;
To wydarzenie zostaje strzelany kiedy klient chce zweryfikować, czy plik istnieje. Procedura używa pliku istnieje() funkcja, by przeprowadzić prośbę:
procedure TForm1.IdFTPServer1FileExistCheck(ASender:TIdFTPServerContext;
const APathName: String; var VExist: Boolean);
begin
if fileexists(APathName) then
begin
VExist:=true;
end
else
begin
VExist:=False;
end;
end;
procedure TForm1.IdFTPServer1GetFileDate(ASender: TIdFTPServerContext;
const AFilename: String; var VFileDate: TDateTime);
var
fdate:tdatetime;
begin
//put the file date in a variable
fdate:= FileAge(AFilename);
if not (fdate=-1) then begin
VFileDate:=fdate;
end;
end;
Używamy FindNext i funkcji FindFirst, by dostać poproszoną wielkość pliku jako pod:
procedure TForm1.IdFTPServer1GetFileSize(ASender:TIdFTPServerContext;
const AFilename: String; var VFileSize: Int64);
Var
LFile : String;
rec:tsearchrec;
ASize: Int64 ;
begin
LFile := setslashes(homedir + AFilename );
try
if FindFirst(Lfile, faAnyFile, rec) = 0 then repeat
Asize:=rec.Size;
until FindNext(rec) <> 0;
finally
FindClose(rec);
end;
if Asize > 1 then
VFileSize:= Asize
else
VFilesize:=0;
end;
Wprowadzanie Serwera FTP - Sporządzając listę Pliki
To jest być może najważniejszą procedurą ze wszystkich. To wydarzenie sporządza listę wszystkie pliki w danym katalogu. To jest stąd, że możesz zmanipulować wszystkimi plikami na systemie pliku. Tak stąpnijmy ostrożnie przez kod.
Pierwsza rzecz, że robimy jest użyciem FindFirst / FindNext funkcje, by przebiec przez jakieś pliki, który mogą być w katalogu. Więc używamy ścieżki, którą klient wysłał, który jest wprowadzony do pamięci zmienną Apath:
SRI := FindFirst(HomeDir +APath + '*.*', faAnyFile - faHidden -
faSysFile, SR);Wtedy, ponieważ FindFirst znajduje pliki, używamy specjalnie utworzonego typu rzeczy listy, by zgromadzić różne komponenty plików:
LFTPItem := ADirectoryListing.Add;
LFTPItem.FileName := SR.Name;
LFTPItem.Size := SR.Size;
LFTPItem.ModifiedDate := FileDateToDateTime(SR.Time);
Wtedy sprawdzamy, by zobaczyć, czy katalog został znaleziony i zgromadzić związany typ pliku.
if SR.Attr = faDirectory then
LFTPItem.ItemType := ditDirectory
else
LFTPItem.ItemType := ditFile;
SRI := FindNext(SR);
Wtedy po prostu zamykamy operację przeszukać pliku i ustawiamy katalog aktualny :
FindClose(SR);
SetCurrentDir(HomeDir + APath + '..');
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(HomeDir + 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(HomeDir + APath + '..');
end;
The Implementation of an FTP Server - Making and Removing Directories
The MakeDirectory command enables us to create a new directory on the server side. The event below does that by using Delphi's CreateDir function:
procedure TForm1.IdFTPServer1MakeDirectory(ASender:TIdFTPServerContext;
var VDirectory: String);
var
ldir:string;
begin
ldir:= setslashes(Homedir+VDirectory);
if not DirectoryExists(ldir) then
if not CreateDir(ldir) then
raise Exception.Create('Cannot create '+ldir);
end;The retrieve file event enables the client to download a file. We use Tstreams to open and read a given file:
procedure TForm1.IdFTPServer1RetrieveFile(ASender:TIdFTPServerContext;
const AFileName: String; var VStream: TStream);
begin
VStream := TFileStream.Create(setSlashes
(HomeDir+AFilename),fmOpenRead);
end;
procedure TForm1.IdFTPServer1RenameFile(ASender:TIdFTPServerContext;
const ARenameFromFile, ARenameToFile: String);
begin
if not Renamefile(ARenameFromFile,ARenameToFile) then
begin
Raise Exception.Create('Could not rename file');
end;
end;
The event below executes when the client requests a directory to be removed. Here we use Delphi's RemoveDir() function to delete a directory:
procedure TForm1.IdFTPServer1RemoveDirectory(ASender:TIdFTPServerContext;
var VDirectory: String);
Var
LFile : String;
begin
LFile := setslashes(homedir + VDirectory);
if directoryexists(LFile) then begin
RemoveDir(LFile);
end
else
begin
Raise Exception.Create('Could not remove directory');
end;
end;Wprowadzanie Serwera FTP - Poświadczając Użytkowników
To wydarzenie poświadcza użytkownika, który próbuje użyć serwera FTP. To jest wskazane, by użyć bazy danych, by poświadczyć szczególnego użytkownika. W kodzie poniżej, użyłem "myusername" i "mypassword" jako nazwa użytkownika i hasło:
procedure TForm1.IdFTPServer1UserLogin(ASender:TIdFTPServerContext;
const AUsername, APassword: String; var AAuthenticated:Boolean);
begin
if (AUsername = edit1.Text) and (APassword = edit2.Text) then
begin
AAuthenticated:=True
end
else
begin
AAuthenticated := False;
end;
end;
procedure TForm1.IdFTPServer1StoreFile(ASender:TIdFTPServerContext;
const AFileName: String; AAppend: Boolean; var VStream:TStream);
begin
if not Aappend then
VStream := TFileStream.Create(AFileName,fmCreate)
else
VStream := TFileStream.Create(AFileName,fmOpenWrite)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
idftpserver1.DefaultPort:=strtoint(edit3.text);
idftpserver1.Active:=true;
showmessage('Connected');
end;
procedure TForm1.IdFTPServer1AfterUserLogin(ASender:TIdFTPServerContext);
begin
//set home dir here
homedir:='c:';
end;
To wydarzenie jest opcjonalne. To umożliwia ciebie, by pokazać wiadomość kiedy wyjątek następuje:
procedure TForm1.IdFTPServer1Exception(AContext: TIdContext;
AException: Exception);
begin
showmessage(AException.Message);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
idftpserver1.Active:=false;
close;
end;
Wydarzenie stanu serwera po prostu pokazuje stan serwera kiedy jest zmiana stanu:
procedure TForm1.IdFTPServer1Status(ASender: TObject;
const AStatus: TIdStatus; const AStatusText: String);
begin
memo1.lines.add(Astatustext);
end;
procedure TForm1.IdFTPServer1Stat(ASender:TIdFTPServerContext;
AStatusInfo: TStrings);
var
i:integer;
begin
for i:= 0 to astatusinfo.Count-1 do
begin
memo1.Lines.Add(astatusinfo.Strings);
end;
end;
To wydarzenie zostaje strzelany kiedy serwer pisze dane do klienta. Zawarłem to głównie dla debagowania celów. To zarejestruje wszystkie komunikacje między serwerem i klientem:
procedure TForm1.IdFTPServer1Execute(AContext: TIdContext);
begin
logfile1.DoLogWriteString(AContext.Connection.IOHandler.AllData);
end;
To jest wszystek tam, by wprowadza w życie roboczy serwer FTP. Ponieważ nie jesteś zawiadomieniem bez wątpienia, nie wprowadziłem wszystkiego rozkazy, ale wprowadziłem pokrycie wszystko to jest wymagane dla serwera FTP, by zadziałać dobrze.
Wniosek
Najlepsza droga, by przetestować to podanie jest z graficznym klientem FTP takie jak Dreamweaver zamiast telnet. Dla jakiegoś powodu podanie serwera odmawia stracić rozkaz LIST kiedy telnet jest użyty. I, ponieważ stwierdziłem wiele razów przed, nie możesz zrobić niczego z serwerem FTP, który nie może pokazać tobie plików w danym katalogu. Zawiadomiłem producentów Indy o tym problemie i jak dobrze pójdzie oni będą pracowali nad tym.
DISCLAIMER: Zawartość dostarczona w tym artykule nie jest zagwarantowana albo jest gwarantowana przez Producenta Zrzucił, Inc. Zawartość dostarczona jest przeznaczona dla rozrywki i / albo edukacyjne cele żeby wprowadzić do pomysłów klucza czytelnika, pojęć i / albo przeglądy wyrobów. Jako taki to jest ciążące na czytelniku, by zatrudnić prawdziwy światową taktykę dla bezpieczeństwa i wprowadzania najlepszych praktyk. Jesteśmy nie odpowiedzialny za jakieś przeczące konsekwencje, który mogą być skutkiem wprowadzanie w życie jakąś informację zakopaną nasze artykuły albo podręczniki. Jeżeli to jest recenzja sprzętu komputerowego, to nie jest polecone, by otworzyć i / albo zmodyfikować twój sprzęt komputerowy.
