Исходник FTP сервера - Free Pascal
Решение задачи: «Исходник FTP сервера»
textual
Листинг программы
Procedure TForm1.FormCreate Begin FTP := THumFTP.Create; FTP.OnConnectNew := ConnectNewUser; FTP.OnLogin := Login; FTP.OnList := FileList; FTP.OnCWD := CWD; FTP.OnRetr := RetrFile; FTP.OnDisconnect := Disconnect; FTP.Open; End; Procedure TForm1.ConnectNewUser(Th : TServerClientThread; var SQL : THumMySQL); Begin Memo1.Lines.Add('Подключение с адреса '+Th.IP); End; Procedure TForm1.Login(Th : TServerClientThread; var SQL : THumMySQL; User : String; Password : String; var Logined : Boolean); Begin If User='Anonymous' then Logined := True else Logined := False; // Разрешить только Anonymous'а. End; Procedure TForm1.FileList(Th : TServerClientThread; var SQL : THumMySQL; User : String; Dir : String; var FileList : TStringList); Begin FileList.Add('d0 2006-01-01 15:22 Папка'); FileList.Add('-0 2006-01-01 15:22 Файл1'); FileList.Add('-0 2007-01-01 15:22 Файл2'); FileList.Add('-0 2008-01-01 15:22 Файл3'); End; Procedure TForm1.CWD(Th : TServerClientThread; var SQL : THumMySQL; var Dir : String; var ErrCode : Byte); Begin Memo1.Lines.Add('Клиент перешел в папку '+Dir); // Dir можно и изменить насильно ErrCode := 0; End; Procedure TForm1.Disconnect(Th : TServerClientThread; var SQL : THumMySQL; User : String); Begin // Клиент отключился End; Procedure TForm1.RetrFile(Th : TServerClientThread; var SQL : THumMySQL; var FName : String; var ErrCode : Byte; Data : String); Begin // Изначально имя запрашиваемого файла находится в FName // Можно указать FName := '', тогда содержимое файла можно указать в Data... например Data := 'Это содержимое файла '+FName; FName := ''; // Либо можно в FName указать имя реального файла на диске, тогда Data игнорируется FName := 'C:\blabla.txt'; // Либо можно указать ErrCode: // FTP_NOERR - нет ошибки (по умолчанию) // FTP_ERR_DENY - доступ к файлу запрещен // FTP_ERR_NOTFOUND - файл не найден End;
Объяснение кода листинга программы
- Объявлены процедуры для работы с FTP сервером: ConnectNewUser, Login, FileList, CWD, Disconnect, RetrFile.
- В процедуре ConnectNewUser добавляется строка в Memo1 с адресом подключившегося пользователя.
- В процедуре Login проверяется логин пользователя. Разрешено только для Anonymous.
- В процедуре FileList добавляются строки в список FileList, имитирующие структуру директории.
- В процедуре CWD обрабатывается переход клиента в другую директорию. В Memo1 добавляется строка с новым путем.
- В процедуре Disconnect обрабатывается отключение клиента.
- В процедуре RetrFile обрабатывается запрос на получение файла. В Data можно указать содержимое файла или путь к файлу на диске. ErrCode может принимать разные значения в зависимости от ошибки.