Сергей Парижский - 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.
Листинг 18.1. Программный модуль FTP-клиента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>');
