Delphi. Учимся на примерах - Сергей Парижский

end;

Событие в случае возникновения некоторой ошибки — OnError:

procedure TForml.ftpError(Sender: TComponent; Errno: Word; Errmsg: String);

begin

 status1.Lines.Add('Ошибка: ' + errmsg);

end;

Событие в случае возникновения ошибки при подключении к серверу — OnInvaIidHost:

procedure TForm1.ftpInvalidHost(var Handled: Boolean);

begin

 status1.Lines.Add('Ошибка при подключении к серверу');

end;

Событие при изменении состояния — OnStatus:

procedure TForm1.ftpStatus(Sender: TComponent; Status: String);

begin

 status1.Lines.Add(Status);

end;

Событие при успешном выполнении операции — OnSuccess:

procedure TForm1.ftpSuccess(Trans_Type: TCmdType);

begin

 status1.Lines.Add('Успешно');

end;

Событие начала передачи данных — OnTransactionStart:

procedure TForm1.ftpTransactionStart(Sender: TObject);

begin

 status1.Lines.Add('Начало передачи данных');

end;

Событие завершения передачи данных — OnTransactionStop :

procedure TForm1.ftpTransactionStop(Sender: TObject);

begin

 statusl.Lines.Add('Конец передачи данных');

end;

Теперь программа полностью готова к использованию. Если у вас нет собственного Web-сайта, то для тестирования FTP-клиента можете зарегистрировать сайт на бесплатном хостинге.

Полный исходный код модуля

Полный код программного модуля FTP-клиента представлен в листинге 18.1.

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, NMFtp, StdCtrls, Psock;

type

 TForm1 = class(TForm)

 ftp: TNMFTP;

 ftpserver: TEdit;

 Label1: TLabel;

 Label2: TLabel;

 name: TEdit;

 Label3: TLabel;

 pass: TEdit;

 Label4: TLabel;

 port: TEdit;

 Button1: TButton;

 Button2: TButton;

 status1: TMemo;

 Button3: TButton;

 Open1: TOpenDialog;

 Button4: TButton;

 del: TEdit;

 Button5: TButton;

 cd: TEdit;

 cmd: TEdit;

 Button6: TButton;

 md: TEdit;

 Button7: TButton;

 rd: TEdit;

 Button8: TButton;

 download: TEdit;

 Button9: TButton;

 Save1: TSaveDialog;

 procedure Button1Click(Sender: TObject);

 procedure ftpStatus(Sender: TComponent; Status: String);

 procedure ftpError(Sender: TComponent; Errno: Word; Errmsg : String);

 procedure ftpDisconnect(Sender: TObject);

 procedure ftpConnect(Sender: TObject);

 procedure ftpConnectionFailed(Sender: TObject);

 procedure ftpInvalidHost(var Handled: Boolean);

 procedure ftpSuccess(Trans_Type: TCmdType);

 procedure ftpTransactionStart(Sender: TObject);

 procedure ftpTransactionStop(Sender: TObject);

 procedure ftpAuthenticationFailed(var Handled: Boolean);

 procedure Button2Click(Sender: TObject);

 procedure Button3Click(Sender: TObject);

 procedure FormDestroy(Sender: TObject);

 procedure Button5Click(Sender: TObject);

 procedure Button4Click(Sender: TObject);

 procedure Button6Click(Sender: TObject);

 procedure Button7Click(Sender: TObject);

 procedure Button8Click(Sender: TObject);

 procedure Button9Click(Sender: TObject);

private

 { Private declarations }

public

 { Public declarations }

end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(sender: TObject);

begin

 ftp.Host:= ftpserver.Text; //ftp-сервер

 ftp.UserID:= name.Text;//логин

 ftp.Password:= pass.Text;// пароль

 ftp.Port:= StrToInt(port.Text); //порт для подключения

 //соединяемся с сервером

 if not ftp.Connected then ftp.Connect;

end;

procedure TForm1.ftpStatus(Sender: TComponent; Status: String);

begin

 status1.Lines.Add(Status);

end;

procedure TForml.ftpError(Sender: TComponent; Errno: Word; Errmsg: String);

begin

 status1.Lines.Add('Ошибка: ' + errmsg);

end;

procedure TForm1.ftpDisconnect(Sender: TObject);

begin

 status1.Lines.Add('Отключено');

end;

procedure TForm1.ftpConnect(Sender:tobject);

begin

 status1.Lines.Add('Подключено');

 //локальный ip-адрес

 status1Lines.Add('IP клиента: ' + ftp.LocalIP);

 //удаленный ip-адрес

 status1Lines.Add('IPсервера: ' + ftp.RemoteIP);

end;

procedure TForm1.ftpConnectionFailed(Sender: TObject);

begin

 status1.Lines.Add('He удалось подключиться к серверу');

end;

procedure TForm1.ftpInvalidHost(var Handled: Boolean);

begin

 status1.Lines.Add('Ошибка при подключении к серверу');

end;

procedure TForm1.ftpSuccess(Trans_Type: TCmdType);

begin

 status1.Lines.Add('Успешно');

end;

procedure TForm1.ftpTransactionStart(Sender: TObject);

begin

 status1.Lines.Add('Начало передачи данных');

end;

procedure TForm1.ftpTransactionStop(Sender: TObject);

begin

 statusl.Lines.Add('Конец передачи данных');

end;

procedure TForm1.ftpAuthenticationFailed(var Handled: Boolean);

begin

 status1.Lines.Add('Неверное имя или пароль');

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

 if ftp.Connected then//если соединен

  ftp.Disconnect;//отключиться от сервера

end;

procedure TForm1.Button3Click(Sender: TObject);

var

 i: integer;

 FName, temp: string; //для получения имени файла

begin

 if not Open1.Execute then ShowMessage('Файл не выбран!')

 else begin

 //очищаем переменные, которые содержат имя файла

 temp:= '';

 FName:= '';

 //получаем имя файла

 for i: = Length(Open1.FileName) downto 1 do

 begin

  if Open1.FileName[i] = '' then break;

  temp:= temp+ Open1.FileName[i];

 end;

 for i:=length(temp) downto 1 do

  fname:= fname + temp[i];

  ftp.Upload(Open1.FileName, FName); //загружаем файл

 end;

end;

procedure TForm1.FormDestroy(Sender: TObject) ;

begin

 if ftp.Connected then ftp.Disconnect;

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

 ftp.ChangeDir(cd.Text); //изменяем каталог

end;

procedure TForm1.Button4Click(Sender : TObject);

begin

 ftp.Delete(del.text); //удалить файл

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

 ftp.DoCommand(cmd.Text); //выполнение команды

end;

procedure TForm1.Button7Click(Sender: TObject);

begin

 ftp.MakeDirectory(md.Text); //создать каталог

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

 ftp.RemoveDir(rd.Text); //удалить каталог

end;

procedure TForm1.Button9Click(Sender: TObject);

begin

 //открытие диалогового окна сохранения файла

 if Save1.Execute

 then //скачиваем указанный файл

  ftp.Download(download.Text, save1.FileName)

 else ShowMessage('File not saved!'); {если пользователь отказался сохранять файл}

end;

end.

⊚ Все файлы проекта и исполняемый файл рассмотренной программы находятся на прилагаемом к книге компакт-диске в папке Chapter_18.

Глава 19

Написание CGI-приложений

Постановка задачи

Разработать CGI-сценарий на Delphi. В качестве примера, при активации через форму сценарий будет выводить определенную фразу.

Разработка проекта

К удивлению некоторых программистов, в Delphi можно разрабатывать CGI-сценарии. Для примера, разработаем сценарий, при обращении к которому будет создаваться HTML-страница с текстом "Это мой первый CGI-сценарий".

Поскольку это будет не обычная выполняемая программа, то стандартный проект, который по умолчанию предлагает нам Delphi, не подходит. Выполните команду меню File→New→Other, в результате чего откроется диалоговое окно New Items (рис. 19.1).

Рис. 19.1. Диалоговое окно New Items

Выберите тип программы Console Application и нажмите кнопку OK. В появившемся окне сотрите весь текст и введите следующий код:

program cgi_test;//название сценария

{$APPTYPE CONSOLE}

{$Е cgi}//расширение приложения будет .cgi

begin

 //способ отображения – text/html

 WriteLn('Content-Type: text/html');

 WriteLn;

 WriteLn;

 WriteLn('<HTML>'); //начало страницы

 WriteLn('<HEAD>');

 //заголовок

 WriteLn('<TITLE>Первый cgi-сценарий на Delphi</TITLE>');