Глава 6. CsShopper: FTP-клиент 

Отправляйтесь в Internet за бесплатным барахлом! В этом вам поможет компонент, выполняющий функции FTP-клиента, и полноцен ное приложение для пересылки файлов, построенное на его основе.

Популярность Internet в немалой степени обусловлена возможностью обмена информацией между компьютерами. Такой обмен становится возможным благодаря протоколу пересылки файлов FTP (File Transfer Protocol) — одному из самых старых протоколов, используемых в Internet. Формальная спецификация используемого в настоящее время протокола FTP содержится в документе RFC959. 

Протокол FTP, как и другие Internet-протоколы, берет свое начало в классической модели клиент/сервер. FTP-сервер иногда представляется мне в виде старомодного продавца, который снимает товар с полки и передает его покупателю (FTP-клиенту). В этой главе мы реализуем компонент Delphi с весьма подходящим именем CsShopper, выполняющий функции FTP-клиента. 

Компонент CsShopper построен на основе CsSocket — простейшего компонента-оболочки для функций Winsock API, созданного в главе 5. CsSocket обеспечивает базовые возможности, необходимые для работы протокола FTP в сети TCP/IP. Таким образом, о мелочах есть кому позаботиться, и мы можем сразу же прейти к более пристальному рассмотрению процесса FTP глазами клиента. 

Вас обслуживают? 

Это обстоятельство не лучшим образом сказывается на скорости работы, но зато человеку становится значительно легче уследить за взаимодействием двух Internet-программ. На каждую команду, полученную от клиента, сервер обычно посылает код ответа. Код состоит из трех цифр, за которыми следует дефис или пробел, а затем — некоторый текст. Типичные сообщения могут выглядеть следующим образом: 

200 PORT command successful.
230-Welcome to your I-SITE Internet server! 

Дефис или пробел, следующий за числовым кодом, содержит важную для клиента информацию. Дефис сообщает клиенту о том, что данное сообщение является комментарием и его можно спокойно игнорировать. Пробел указывает клиенту на необходимость перехода к следующей фазе текущей операции. Текст, который идет дальше, обычно содержит информацию о статусе или инструкцию для пользователя. 

Диаграмма, изображенная на рис. 6.1, описывает взаимодействие клиента с сервером во время регистрации. FTP-сеанс начинается с посылки клиентом команды USER, за которой следует имя пользователя, и получения со стороны сервера кода ответа, состоящего из трех цифр. Если имя пользовате ля признается допустимым, сервер отвечает кодом 331 или 230. При недопустимом имени пользователя генерируется код 4xx или 5xx, где xx описывает код конкретной ошибки. 

Ответ 230 означает, что имя пользователя признано допустимым и для доступа к системе не требуется никакой дополнительной информации. Сервер обычно выдает этот код в ответ при знаменитой «анонимной» регистрации пользователей. Ответ 331 означает, что имя пользователя также признано допустимым, но для доступа к системе необходим пароль. В этом случае клиент посылает команду PASS, за которой следует пароль. 

Неверный пароль вызывает ответ 4xx или 5xx, свидетельствующий об ошибке. Если пароль принят, сервер может послать код 230, чтобы сообщить о завершении регистрации. Если для регистрации необходимы сведения об используемых ресурсах (account), сервер снова отвечает кодом 331, чтобы клиент послал команду ACCT и требуемые сведения. 

Рис. 6.1. Регистрация FTP-клиента на FTP-сервере 

После того как соединение будет успешно установлено, клиент может продолжить посылку команд. Однако при возникновении проблемы (например, посылке команды с неверным синтаксисом) или слишком большом количестве пользователей, работающих в системе, сервер посылает код 4xx или 5xx и закрывает соединение. 

Компонент CsShopper 

Свойство Service базового VCL-компонента CsSocket имеет значение NoService. Компонент CsShopper всегда выполняет функции FTP-клиента, поэтому в конструкторе TCsShopper.Create свойство Service получает значение FTP. В остальном протокол FTP использует стандартные настройки CsSocket — все-таки отличная штука эти компоненты! Как показано на рис. 6.2, помимо Service CsShopper содержит 10 других свойств: Access, AddrType, Asynchronous, Debug, HomeServer, LogOn, Password, Protocol, SockType и UserName. 

Рис. 6.2. Свойства CsShopper в инспекторе
объектов Delphi 3 

Свойство Asynchronous определяет режим работы CsShopper — блокирующий или асинхронный . Хотя данное свойство не относится к протоколу FTP, выбор режима может повлиять на скорость пересылки данных, надежность приложения и его гибкость. Например, когда CsShopper работает в асинхронном режиме (то есть свойство Asynchronous равно TRUE), пользователь может прервать чересчур затянувшуюся пересылку файла. В блокирующем режиме такая возможность отсутствует (впрочем, если ChShopper написан как многопоточное приложение, то пересылку файла можно прервать и в блокирующем режиме, но это совсем другая история). 

Асинхронный режим устроен несколько сложнее, поэтому сначала мы посмотрим, как CsShopper работает в блокирующем режиме. Асинхронный режим будет описан позднее в этой главе. 

Самые полезные FTP-команды (в том числе USER, PASSWORD, RETR и PUT) реализованы в CsShopper в виде свойств. Эти свойства находятся в public-секции TCsShopper и потому доступны для пользователей компонента. В блокирующем режиме соответствующие методы используют процедуру FTPCommand, которая является «сердцем» компонента CsShopper. FTPCommand представляет собой простейший анализатор, реализованный в виде большого оператора case. Недостаток изящества подобной конструкции возмещается ее простотой. В асинхронном режиме CsShopper использует другой подход. 

Полный исходный текст компонента, находящийся в файле CSSHOPPER.PAS, занимает около 3000 строк, и я не стал включать его в эту главу. Будут приведены лишь отдельные фрагменты, поясняющие некоторые аспекты его работы. Для более подробного знакомства вы можете распечатать полный файл
с CD-ROM. 

Организация вывода 

procedure TCsSocket.InfoEvent(Msg : String);
begin
if Assigned(FOnInfoEvent) then
FOnInfoEvent(Self, Msg);
end; 

Когда через управляющее соединение отправляется или принимается сообщение, локальная переменная TempStr в процедуре FTPCommand задает значение свойства Info, после чего FTPCommand вызывает процедуру InfoEvent. Внутри InfoEvent проверка Assignеd возвращает значение True, а процедура CsShopper1Info из приложения отображает Info.

Чтобы такое взаимодействие между CsShopper и клиентским приложением стало возможным, я создал процедуру CsShopper1Info с помощью вкладки Events инспектора объектов. Содержимое окна memLog, в котором отображаются все эти сообщения, обновляется с каждым событием FOnInfoEvent. CsShopper1Info содержит следующий фрагмент кода: 

procedure TfrmMain.CsShopper1Info(Sender: TObject; Msg: String);
begin
memLog.Lines.Add(Msg);
end; 

SHOPPER32 за работой 

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, 
  Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, FileCtrl, 
  ComCtrls, CsSocket,
  CsShopper, MkDirFrm, CsFtpMsg, ToolWin, 
  Registry, ExtCtrls;

Рис. 6.3. Приложение SHOPPER32

type
  TfrmMain = class(TForm)
    CsShopper1: TCsShopper;
    pcShopper: TPageControl;
    tsConnect: TTabSheet;
    tsOptions: TTabSheet;
    tsAbout: TTabSheet;
    gbLocal: TGroupBox;
    gbRemote: TGroupBox;
    gbActions: TGroupBox;
    dcbLocal: TDriveComboBox;
    dlbLocal: TDirectoryListBox;
    flbLocal: TFileListBox;
    sbStatus: TStatusBar;
    pbDataTransfer: TProgressBar;
    lbRemoteFiles: TListBox;
    bbtnExit: TBitBtn;
    bbtnConnect: TBitBtn;
    bbtnAbort: TBitBtn;
    gbUserName: TGroupBox;
    gbPassword: TGroupBox;
    gbDefLocalDir: TGroupBox;
    gbDefTextEditor: TGroupBox;
    edDefUserName: TEdit;
    edDefPassword: TEdit;
    edDefLocalDir: TEdit;
    edDefTextEditor: TEdit;
    bbtnFtpCmds: TBitBtn;
    bbtnLocateTxtEditor: TBitBtn;
    bbtnLocateDefLocalDir: TBitBtn;
    gbMoreActions: TGroupBox;
    bbtnRefresh: TBitBtn;
    bbtnFTPHelp: TBitBtn;
    bbtnSite: TBitBtn;
    bbtnNewDir: TBitBtn;
    bbtnDelDir: TBitBtn;
    bbtnViewFile: TBitBtn;
    memLog: TMemo;
    rgFileType: TRadioGroup;
    bbtnRestart: TBitBtn;
    bbtnQuit: TBitBtn;
    tsProfiles: TTabSheet;
    gbSetProfile: TGroupBox;
    gbPrName: TGroupBox;
    gbPrHostName: TGroupBox;
    gbPrUserName: TGroupBox;
    gbPrPassWord: TGroupBox;
    gbPrRemDir: TGroupBox;
    gbPrLocDir: TGroupBox;
    edPrName: TEdit;
    edPrHostName: TEdit;
    edPrUserName: TEdit;
    edPrPassword: TEdit;
    edPrRemDir: TEdit;
    edPrLocDir: TEdit;
    gbPrList: TGroupBox;
    lbPrList: TListBox;
    bbtnPrNew: TBitBtn;
    bbtnPrSave: TBitBtn;
    bbtnPrDelete: TBitBtn;
    rgFTPMode: TRadioGroup;
    sbbtnRetr: TSpeedButton;
    sbbtnStor: TSpeedButton;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    bbtnStat: TBitBtn;
    gbHints: TGroupBox;
    cbHints: TCheckBox;
    gbFTPOptions: TGroupBox;
    BitBtn2: TBitBtn;
    rgFileStructure: TRadioGroup;
    rgTransfer: TRadioGroup;
    bbtnAddNew: TBitBtn;
    procedure bbtnConnectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bbtnFtpCmdsClick(Sender: TObject);
    procedure CsShopper1Info(Sender: TObject; 
    Msg: String);
    procedure CsShopper1UpDateList(Sender: 
    TObject; List: TStringList);
    procedure lbRemoteFilesDblClick(Sender: 
    TObject);
    procedure CsShopper1List(Sender: 
    TObject; List: TStringList);
    procedure bbtnSiteClick(Sender: TObject);
    procedure bbtnFTPHelpClick(Sender: TObject);
    procedure CsShopper1Busy(Sender: 
    TObject; BusyFlag: Boolean);
    procedure CsShopper1Progress(Sender: TObject; 
    Position: Integer);
    procedure rgFileTypeClick(Sender: TObject);
    procedure CsShopper1FileType(Sender: TObject; 
    FileType: TFileTypes);
    procedure CsShopper1Error(Sender: TObject; 
    Status: TConditions;
      Msg: String);
    procedure bbtnNewDirClick(Sender: TObject);
    procedure bbtnDelDirClick(Sender: TObject);
    procedure CsShopper1Connect(Sender: TObject; 
    sSocket: Integer);
    procedure bbtnQuitClick(Sender: TObject);
    procedure rgFTPModeClick(Sender: TObject);
    procedure bbtnRefreshClick(Sender: TObject);
    procedure sbbtnRetrClick(Sender: TObject);
    procedure sbbtnStorClick(Sender: TObject);
    procedure CsShopper1DataDone(Sender: TObject; 
    Done: Boolean);
    procedure bbtnStatClick(Sender: TObject);
    procedure bbtnRestartClick(Sender: TObject);
    procedure flbLocalDblClick(Sender: TObject);
    procedure lbRemoteFilesClick(Sender: TObject);
    procedure flbLocalClick(Sender: TObject);
    procedure lbPrListDblClick(Sender: TObject);
    procedure bbtnConnectMouseDown(Sender: 
    TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure bbtnViewFileClick(Sender: TObject);
    procedure bbtnAbortClick(Sender: TObject);
    procedure bbtnPrSaveClick(Sender: TObject);
    procedure bbtnExitClick(Sender: TObject);
    procedure lbPrListClick(Sender: TObject);
    procedure bbtnPrNewClick(Sender: TObject);
    procedure bbtnAddNewClick(Sender: TObject);
    procedure edPrNameExit(Sender: TObject);
    procedure edPrHostNameExit(Sender: TObject);
    procedure edPrUserNameExit(Sender: TObject);
    procedure edPrPasswordExit(Sender: TObject);
    procedure edPrRemDirExit(Sender: TObject);
    procedure edPrLocDirExit(Sender: TObject);
    procedure bbtnPrDeleteClick(Sender: TObject);
    procedure bbtnLocateDefLocalDirClick(Sender
    : TObject);
    procedure bbtnLocateTxtEditorClick(Sender: 
    TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   HelpCmd  : String;
   UsedProfile,
   UsedQFTP,
   NewProfile : Boolean;
   OldTransferMode,
   OldFileStruct : String;
   OldProfiles,
   HostNameList,
   UsernameList,
   PasswordList,
   RemoteDirList,
   LocalDirList,
   CurrentProfiles,
   ProfileNameList : TStringList;
   NoOfUsers,
   LastProfileUsed,
   NoProfiles : Integer;
   procedure LoadSettings;
   procedure SaveOptions;
   procedure SaveProfiles;
  end;

var
  frmMain: TfrmMain;

implementation

uses RMDirFrm, HelpFrm, QuickFTPfrm, 
LocateDirFrm, LocateEdFrm;

{$R *.DFM}


const
     FtpClientKey = 'Software\High Performance 
     Delphi\Shopper32';
procedure TfrmMain.LoadSettings;
var
 Reg      : TRegistry;
 Count    : Integer;
 ProfileName   : String;
begin
 Reg := TRegistry.Create;
// Считываем имя пользователя по умолчанию
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('UserName') then
   edDefUserName.Text := Reg.ReadString('UserName')
  else
   edDefUserName.Text := 'anonymous';
  finally
   Reg.CloseKey;
  end;
// Считываем пароль по умолчанию
  try
   Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('Password') then
   edDefPassword.Text := Reg.ReadString('Password')
  else
   edDefPassword.Text := 'guest';
  finally
   Reg.CloseKey;
  end;
// Считываем локальный каталог по умолчанию
  try
   Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('DefLocalDir') then
   edDefLocalDir.Text 
   := Reg.ReadString('DefLocalDir')
  else
   edDefLocalDir.Text := 'C:\';
  finally
   Reg.CloseKey;
  end;
// Считываем редактор, используемый по умолчанию
  try
   Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('Editor') then
   edDefTextEditor.Text 
   := Reg.ReadString('Editor')
  else
   edDefTextEditor.Text := 'NOTEPAD ';
  finally
   Reg.CloseKey;
  end;
// Задаем свойства
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('Asynchronous') then
  begin
   with CsShopper1 do
   begin
    Asynchronous 
    := Reg.ReadBool('Asynchronous');
    if Asynchronous then
     rgFTPMode.ItemIndex := 0
    else
     rgFTPMode.ItemIndex := 1;
   end;
  end
  else
  begin
   CsShopper1.Asynchronous := FALSE;
   rgFTPMode.ItemIndex := 0;
  end;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('Hints') then
   cbHints.Checked := Reg.ReadBool('Hints')
  else
   cbHints.Checked := FALSE;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('DTransferMode') then
  begin
   OldTransferMode 
   := Reg.ReadString('DTransferMode');
   if UpperCase(OldTransferMode) 
   = UpperCase(FtpTransferStr[STREAM]) then
   begin
    CsShopper1.Transfer := STREAM;
    rgTransfer.ItemIndex := 0;
   end;
   if UpperCase(OldTransferMode) 
   = UpperCase(FtpTransferStr[BLOCK]) then
   begin
    CsShopper1.Transfer := BLOCK;
    rgTransfer.ItemIndex := 1;
   end;
   if UpperCase(OldTransferMode) 
   = UpperCase(FtpTransferStr[COMPRESSED]) then
   begin
    CsShopper1.Transfer := COMPRESSED;
    rgTransfer.ItemIndex := 2;
   end;
  end else
  begin
   OldTransferMode 
   := UpperCase(FtpTransferStr[STREAM]);
   CsShopper1.Transfer := STREAM;
   rgTransfer.ItemIndex := 0;
  end;
 finally
  Reg.CloseKey;
 end;
// Свойство файловой структуры
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('DFileStructure') then
  begin
   OldFileStruct := Reg.ReadString('DFileStructure');
   if UpperCase(OldFileStruct) 
   = UpperCase(FtpFileStructStr[NOREC]) then
   begin
    CsShopper1.FileStruct := NOREC;
    rgFileStructure.ItemIndex := 0;
   end;
   if UpperCase(OldFileStruct) 
   = UpperCase(FtpFileStructStr[REC]) then
   begin
    CsShopper1.FileStruct := REC;
    rgFileStructure.ItemIndex := 1;
   end;
   if UpperCase(OldFileStruct) 
   = UpperCase(FtpFileStructStr[PAGE]) then
   begin
    CsShopper1.FileStruct := PAGE;
    rgFileStructure.ItemIndex := 2;
   end;
  end else
  begin
   OldFileStruct 
   := UpperCase(FtpFileStructStr[NOREC]);
   CsShopper1.FileStruct := NOREC;
   rgFileStructure.ItemIndex := 0;
  end;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('LastProfileUsed') then
   LastProfileUsed 
   := Reg.ReadInteger('LastProfileUsed')
  else
   LastProfileUsed := 0;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if Reg.ValueExists('NoProfiles') then
   NoProfiles := Reg.ReadInteger('NoProfiles')
  else
   NoProfiles := 1;
 finally
  Reg.CloseKey;
 end;
// Список профилей
 for Count := 0 to NoProfiles - 1 do
 begin
  ProfileName := Concat('ProfileName', 
  IntToStr(Count));
  try
   Reg.OpenKey(FtpClientKey + '\Profiles' + '\
   ' + ProfileName, TRUE);
   if Reg.ValueExists('ProfileName') then
    ProfileNameList.Add(Reg.ReadString
    ('ProfileName'))
   else
    ProfileNameList.Add('PROFILE');
   OldProfiles.Add(Reg.ReadString('ProfileName'));
   if Reg.ValueExists('Host') then
    HostNameList.Add(Reg.ReadString('Host'))
   else
    HostNameList.Add('HOST');
   if Reg.ValueExists('User') then
    UserNameList.Add(Reg.ReadString('User'))
   else
    UserNameList.Add('ANONYMOUS');
   if Reg.ValueExists('Password') then
    PasswordList.Add(Reg.ReadString('Password'))
   else
    PasswordList.Add('GUEST');
   if Reg.ValueExists('RemoteDir') then
    RemoteDirList.Add(Reg.ReadString('RemoteDir'))
   else
    RemoteDirList.Add('\');
   if Reg.ValueExists('LocalDir') then
    LocalDirList.Add('LocalDir')
   else
    LocalDirList.Add('\');
  finally
   Reg.CloseKey;
  end;
 end; // цикл for
 Reg.Free;
 lbPrList.Items      := ProfileNameList;
 lbPrList.ItemIndex  := LastProfileUsed;
 edPrName.Text       
 := ProfileNameList.Strings[lbPrList.ItemIndex];
 edPrHostName.Text   
 := HostNameList.Strings[lbPrList.ItemIndex];
 edPrUserName.Text   
 := UserNameList.Strings[lbPrList.ItemIndex];
 edPrPassword.Text   
 := PasswordList.Strings[lbPrList.ItemIndex];
 edPrRemDir.Text     
 := RemoteDirList.Strings[lbPrList.ItemIndex];
 edPrLocDir.Text     
 := LocalDirList.Strings[lbPrList.ItemIndex];
 CsShopper1.UserName := edPrUserName.Text;
 CsShopper1.Password := edPrPassword.Text;
 lbPrList.Refresh;
end;

procedure TfrmMain.SaveProfiles;
var
 Reg : TRegistry;
 Count : Integer;
 ProfileName : String;
begin
 Reg := TRegistry.Create;
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  Reg.WriteInteger('LastProfileUsed',
  LastProfileUsed);
 finally
  Reg.CloseKey;
 end;
 NoProfiles := lbPrList.Items.Count;
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  Reg.WriteInteger('NoProfiles',NoProfiles);
 finally
  Reg.CloseKey;
 end;
 for Count := 0 to NoProfiles - 1 do
 begin
  ProfileName := Concat('ProfileName',
  IntToStr(Count));
  try
   Reg.OpenKey(FtpClientKey + '\Profiles' + '\
   ' + ProfileName, TRUE);
   Reg.WriteString('ProfileName',
   lbPrList.Items.Strings[Count]);
   Reg.WriteString('ProfileName',
   ProfileNameList.Strings[Count]);
   Reg.WriteString('Host',
   HostNameList.Strings[Count]);
   Reg.WriteString('User',
   UserNameList.Strings[Count]);
   Reg.WriteString('Password',
   PasswordList.Strings[Count]);
   Reg.WriteString('RemoteDir',
   RemoteDirList.Strings[Count]);
   Reg.WriteString('LocalDir',
   LocalDirList.Strings[Count]);
  finally
   Reg.CloseKey;
  end;
 end;
 Reg.Free;
end;


procedure TfrmMain.SaveOptions;
var
 Reg : TRegistry;
begin
 Reg := TRegistry.Create;
// Сохраняем имя пользователя по умолчанию
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  Reg.WriteString('UserName', edDefUserName.Text);
 finally
  Reg.CloseKey;
 end;
// Сохраняем пароль по умолчанию
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  Reg.WriteString('Password', edDefPassword.Text);
 finally
  Reg.CloseKey;
 end;
// Сохраняем локальный каталог по умолчанию
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  Reg.WriteString('DefLocalDir', 
  edDefLocalDir.Text);
 finally
  Reg.CloseKey;
 end;
// Сохраняем редактор, используемый по умолчанию
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  Reg.WriteString('Editor', edDefTextEditor.Text);
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey,TRUE);
  case rgFTPMode.ItemIndex of
   0 : Reg.WriteBool('Asynchronous',TRUE);
   1 : Reg.WriteBool('Asynchronous',FALSE);
  end;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey, TRUE);
  if cbHints.Checked then
   Reg.WriteBool('Hints',TRUE)
  else
   Reg.WriteBool('Hints',FALSE); 
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey,TRUE);
  case rgTransfer.ItemIndex of
   0 :Reg.WriteString('DTransferMode',
   FtpTransferStr[STREAM]);
   1 :Reg.WriteString('DTransferMode',
   FtpTransferStr[BLOCK]);
   2 :Reg.WriteString('DTransferMode',
   FtpTransferStr[COMPRESSED]);
  end;
 finally
  Reg.CloseKey;
 end;
 try
  Reg.OpenKey(FtpClientKey,TRUE);
  case rgFileStructure.ItemIndex of
   0 :Reg.WriteString('DFileStructure',
   FtpFileStructStr[NOREC]);
   1 :Reg.WriteString('DFileStructure',
   FtpFileStructStr[REC]);
   2 :Reg.WriteString('DFileStructure',
   FtpFileStructStr[PAGE]);
  end;
 finally
  Reg.CloseKey;
 end;
 Reg.Free;
end;

procedure TfrmMain.bbtnConnectClick(Sender: 
TObject);
begin
 if (not UsedQFtp) and (not UsedProfile) then
 begin
  with CsShopper1 do
  begin
   HostName := HomeServer;
   if Status = Success then
    Start;
  end;
 end else
 if UsedQFtp then
  CsShopper1.Start
 else
 if UsedProfile then
 begin
  with CsShopper1 do
  begin
   UserName := edPrUserName.Text;
   Password := edPrPassword.Text;
   RemoteDir:= edPrRemDir.Text;
   LocalDir := edPrLocDir.Text;
   EditName := edDefTextEditor.Text;
   HostName := edPrHostName.Text;
   if Status = Success then
    Start;
  end;
 end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
 bbtnQuit.Enabled       := FALSE;
 bbtnRefresh.Enabled    := FALSE;
 bbtnViewFile.Enabled   := FALSE;
 bbtnFtpCmds.Enabled    := FALSE;
 bbtnAbort.Enabled      := FALSE;
 rgFileType.Enabled     := FALSE;
 gbMoreActions.Visible  := FALSE;
 pbDataTransfer.Visible := FALSE;
 sbbtnRetr.Enabled      := FALSE;
 sbbtnStor.Enabled      := FALSE;
 OldProfiles            := TStringList.Create;
 ProfileNameList        := TStringList.Create;
 HostNameList           := TStringList.Create;
 UserNameList           := TStringList.Create;
 PasswordList           := TStringList.Create;
 RemoteDirList          := TStringList.Create;
 LocalDirList           := TStringList.Create;
 LoadSettings;
 if CsShopper1.Asynchronous then
 begin
  sbStatus.Panels[2].Text := Concat('Mode : ',
  'Asynchronous');
  rgFTPMode.ItemIndex := 0;
 end
 else
 begin
  sbStatus.Panels[2].Text := Concat('Mode : ',
  'Non-Asynchronous');
  rgFTPMode.ItemIndex := 1;
 end;
 sbStatus.Panels[0].Text 
 := Concat('Local Host : ',
  CsShopper1.LocalName);
 sbStatus.Panels[3].Text  
 := Concat('Status : ', 'Idle');
 pcShopper.ActivePage := tsProfiles;
 UpDate;
end;

procedure TfrmMain.bbtnFtpCmdsClick(Sender: 
TObject);
begin
 gbMoreActions.Visible 
 := not gbMoreActions.Visible;
 if gbMoreActions.Visible then
 begin
  bbtnFtpCmds.Hint    := 'Click here to 
  close the panel of FTP commands';
  bbtnFtpCmds.Caption := 'Close';
 end
 else
 begin
  bbtnFtpCmds.Hint    := 'Click here to 
  get more FTP commands';
  bbtnFtpCmds.Caption := 'FTP Cmds';
 end;
end;

procedure TfrmMain.CsShopper1Info(Sender: TObject; 
Msg: String);
begin
 memLog.Lines.Add(Msg);
end;

procedure TfrmMain.CsShopper1UpDateList(Sender: 
TObject;
  List: TStringList);
begin
 LbRemoteFiles.Items := List;
 lbRemoteFiles.UpDate;
 gbRemote.Caption := Concat('Files on ',
 CsShopper1.HostName);
 sbStatus.Panels[1].Text := Concat('Remote Host : 
 ',CsShopper1.HostName);
end;

procedure TfrmMain.lbRemoteFilesDblClick
(Sender: TObject);
begin
 pbDataTransfer.Visible := TRUE;
 if lbRemoteFiles.ItemIndex <> -1 then
  CsShopper1.Get := lbRemoteFiles.Items.Strings
  [lbRemoteFiles.ItemIndex]
 else
 pbDataTransfer.Visible := FALSE;  
end;

procedure TfrmMain.CsShopper1List
(Sender: TObject; List: TStringList);
begin
 lbRemoteFiles.Clear;
 lbRemoteFiles.Items := List;
 lbRemoteFiles.UpDate;
 gbRemote.Caption := CsShopper1.RemoteDir;
end;

procedure TfrmMain.bbtnSiteClick(Sender: TObject);
begin
 CsShopper1.SiteFtp;
end;

procedure TfrmMain.bbtnFTPHelpClick(Sender: 
TObject);
var
 Counter : Integer;
begin
 frmHelp := TfrmHelp.Create(Application);
 for Counter := SFtpUser to SFtpNoop do
  frmHelp.lbHelpFtpCmds.Items.Add
  (LoadStr(Counter));
 frmHelp.ShowModal;
 CsShopper1.FtpHelp := HelpCmd;
 HelpFtpCmdList.Free;
 frmHelp.Free;
end;

procedure TfrmMain.CsShopper1Busy
(Sender: TObject; BusyFlag: Boolean);
begin
 if BusyFlag then
 begin
  lbRemoteFiles.Enabled := FALSE;
  sbStatus.Panels[3].Text 
  := Concat('Status : ','Busy');
 end else
 begin
  lbRemoteFiles.Enabled := TRUE;
  sbStatus.Panels[3].Text 
  := Concat('Status : ','Idle');
 end;
 Update;
end;

procedure TfrmMain.CsShopper1Progress
(Sender: TObject; Position: Integer);
begin
 pbDataTransfer.Position := Position;
 pbDataTransfer.UpDate;
end;

procedure TfrmMain.rgFileTypeClick
(Sender: TObject);
begin
 with CsShopper1 do
  case rgFileType.ItemIndex of
   0 : FileType := ASCII;
   1 : FileType := IMAGE;
   2 : FileType := AUTO;
  end;
end;

procedure TfrmMain.CsShopper1FileType
(Sender: TObject;
  FileType: TFileTypes);
begin
 case FileType of
  ASCII : rgFileType.ItemIndex := 0;
  IMAGE : rgFileType.ItemIndex := 1;
  AUTO  : rgFileType.ItemIndex := 2;
 end;
end;

procedure TfrmMain.CsShopper1Error
(Sender: TObject; Status: TConditions;
  Msg: String);
begin
 memLog.Lines.Add(Msg);
end;

procedure TfrmMain.bbtnNewDirClick
(Sender: TObject);
begin
 frmMkNewDir := TfrmMkNewDir.Create(Application);
 frmMkNewDir.ShowModal;
 if Length(NewDirName) > 0 then
  CsShopper1.MkDirName := NewDirName;
 frmMkNewDir.Free;
end;

procedure TfrmMain.bbtnDelDirClick(Sender: 
TObject);
begin
 if lbRemoteFiles.ItemIndex <> -1 then
  CsShopper1.RmDirName :=

emoteFiles.Items.Strings[lbRemoteFiles.ItemIndex];
 CsShopper1.FilesList;
end;
procedure TfrmMain.CsShopper1Connect(Sender: 
TObject; sSocket: Integer);
begin
 bbtnQuit.Enabled        := TRUE;
 bbtnRefresh.Enabled     := TRUE;
 bbtnViewFile.Enabled    := TRUE;
 bbtnFtpCmds.Enabled     := TRUE;
 rgFileType.Enabled      := TRUE;
 if rgFTPMode.ItemIndex = 1 then
 begin
  sbbtnRetr.Enabled       := TRUE;
  sbbtnStor.Enabled       := TRUE;
 end
 else
 begin
  sbbtnRetr.Enabled       := FALSE;
  sbbtnStor.Enabled       := FALSE;
 end;
 bbtnConnect.Enabled     := FALSE;
 bbtnExit.Enabled        := FALSE;
 rgFTPMode.Enabled       := FALSE;
 gbRemote.Caption        
 := 'Remote : ' + CsShopper1.RemoteDir;
 sbStatus.Panels[1].Text 
 := 'Remote Host : ' + CsShopper1.HostName;
 sbStatus.Panels[3].Text := 'Status : Connected';
 Update;
end;

procedure TfrmMain.bbtnQuitClick(Sender: TObject);
begin
 bbtnQuit.Enabled       := FALSE;
 bbtnRefresh.Enabled    := FALSE;
 bbtnViewFile.Enabled   := FALSE;
 bbtnFtpCmds.Enabled    := FALSE;
 bbtnAbort.Enabled      := FALSE;
 rgFileType.Enabled     := FALSE;
 sbbtnRetr.Enabled      := FALSE;
 sbbtnStor.Enabled      := FALSE;
 gbMoreActions.Visible  := FALSE;
 pbDataTransfer.Visible := FALSE;
 bbtnConnect.Enabled    := TRUE;
 bbtnExit.Enabled       := TRUE;
 rgFTPMode.Enabled      := TRUE; 
 with sbStatus do
 begin
  Panels[1].Text := 'Remote Host : ';
  Panels[3].Text := 'Status : Idle';
 end;
 lbRemoteFiles.Clear;
 Update;
 CsShopper1.Finish;
end;
(*
procedure TfrmMain.Exit1Click(Sender: TObject);
begin
 Close;
end;
*)
procedure TfrmMain.rgFTPModeClick(Sender: 
TObject);
begin
 if rgFTPMode.ItemIndex = 0 then
 begin
  CsShopper1.Asynchronous := TRUE;
  sbStatus.Panels[2].Text := 'Mode : ' + 
  'Asynchronous';
  sbbtnRetr.Enabled       := FALSE;
  sbbtnStor.Enabled       := FALSE;
 end
 else
 begin
  CsShopper1.Asynchronous := FALSE;
  sbStatus.Panels[2].Text := 'Mode : ' + 
  'Non-Asynchronous';
  sbbtnRetr.Enabled       := TRUE;
  sbbtnStor.Enabled       := TRUE;
 end;
 sbStatus.Update;
end;

procedure TfrmMain.bbtnRefreshClick(Sender: 
TObject);
begin
 CsShopper1.FilesList
end;

procedure TfrmMain.sbbtnRetrClick(Sender: 
TObject);
begin
 pbDataTransfer.Visible := TRUE;
 bbtnAbort.Enabled      := TRUE;
 CsShopper1.MGet;
end;

procedure TfrmMain.sbbtnStorClick(Sender: 
TObject);
begin
 pbDataTransfer.Visible := TRUE;
 bbtnAbort.Enabled      := TRUE;
 CsShopper1.MPut; 
end;
procedure TfrmMain.CsShopper1DataDone(Sender: 
TObject; Done: Boolean);
begin
 if Done then
 begin
  pbDataTransfer.Visible := FALSE;
  bbtnAbort.Enabled      := FALSE
 end
 else
 begin
  pbDataTransfer.Visible := TRUE;
  bbtnAbort.Enabled      := TRUE
 end;
 pbDataTransfer.Update;
end;

procedure TfrmMain.bbtnStatClick(Sender: TObject);
begin
 CsShopper1.Stat;
end;

procedure TfrmMain.bbtnRestartClick(Sender: 
TObject);
begin
 ShowMessage('Not implemented in this version');
end;

procedure TfrmMain.flbLocalDblClick(Sender: 
TObject);
begin
 pbDataTransfer.Visible := TRUE;
 if flbLocal.ItemIndex <> -1 then
  CsShopper1.Put 
  := flbLocal.Items.Strings[flbLocal.ItemIndex]
 else
 pbDataTransfer.Visible := FALSE;  
end;

procedure TfrmMain.lbRemoteFilesClick(Sender: 
TObject);
begin
 CsShopper1.RemoteFiles.Add
 (lbRemoteFiles.Items.Strings
 [lbRemoteFiles.ItemIndex]);
end;

procedure TfrmMain.flbLocalClick(Sender: TObject);
begin
 CsShopper1.LocalFiles.Add
 (flbLocal.Items.Strings[flbLocal.ItemIndex]); 
end;

procedure TfrmMain.lbPrListDblClick(Sender: 
TObject);
begin
 UsedProfile := TRUE;
 pcShopper.ActivePage := tsConnect;
 ActiveControl        := bbtnConnect;
 bbtnConnect.Click;
end;

procedure TfrmMain.bbtnConnectMouseDown(Sender: 
TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: 
  Integer);
begin
 if Button = mbRight then // Выполняем 
 упрощенный ftp
 begin
  UsedQFtp := TRUE;
  UsedProfile := FALSE;
  frmQuickFtp := TfrmQuickFTP.Create(Application);
  frmQuickFtp.ShowModal;
  with CsShopper1 do
  begin
   UserName := frmQuickFtp.edUserName.Text;
   Password := frmQuickFtp.edPassword.Text;
   HostName := frmQuickFtp.edHostName.Text;
  end;
  frmQuickFtp.Free;
  ActiveControl := bbtnConnect;
  bbtnConnect.Click;
 end else
  UsedQFtp := FALSE;
end;

procedure TfrmMain.bbtnViewFileClick(Sender: 
TObject);
begin
 if lbRemoteFiles.ItemIndex <> -1 then
  CsShopper1.View := lbRemoteFiles.Items.Strings
  [lbRemoteFiles.ItemIndex];
end;

procedure TfrmMain.bbtnAbortClick(Sender: 
TObject);
begin
 CsShopper1.Abort;
 bbtnAbort.Enabled := FALSE;
end;

procedure TfrmMain.bbtnPrSaveClick(Sender: 
TObject);
begin
 SaveProfiles;
end;

procedure TfrmMain.bbtnExitClick(Sender: TObject);
begin
 OldProfiles.Free;
 ProfileNameList.Free;
 HostNameList.Free;
 UserNameList.Free;
 PasswordList.Free;
 RemoteDirList.Free;
 LocalDirList.Free;
end;

procedure TfrmMain.lbPrListClick(Sender: TObject);
begin
 if lbPrList.ItemIndex <> -1 then
 begin
  LastProfileUsed   := lbPrList.ItemIndex;
  edPrName.Text     
  := ProfileNameList.Strings[LastProfileUsed];
  edPrHostName.Text 
  := HostNameList.Strings[LastProfileUsed];
  edPrUserName.Text 
  := UserNameList.Strings[LastProfileUsed];
  edPrPassword.Text 
  := PasswordList.Strings[LastProfileUsed];
  edPrRemDir.Text   
  := RemoteDirList.Strings[LastProfileUsed];
  edPrLocDir.Text   
  := LocalDirList.Strings[LastProfileUsed];
  Update;
 end;
end;

procedure TfrmMain.bbtnPrNewClick(Sender: 
TObject);
begin
 NewProfile          := TRUE;
 edPrName.Text       := '';
 edPrHostName.Text   := '';
 edPrUserName.Text   := edDefUserName.Text;
 edPrPassword.Text   := edDefPassword.Text;

 edPrLocDir.Text     := edDefLocalDir.Text;
 edPrRemDir.Text     := '\';
 lbPrList.Visible    := FALSE;
end;

procedure TfrmMain.bbtnAddNewClick(Sender: 
TObject);
begin
 ProfileNameList.Add(edPrName.Text);
 HostNameList.Add(edPrHostName.Text);
 UserNameList.Add(edPrUserName.Text);
 PasswordList.Add(edPrPassword.Text);
 RemoteDirList.Add(edPrRemDir.Text);
 LocalDirList.Add(edPrLocDir.Text);
 lbPrList.Items.Add(edPrName.Text);
 lbPrList.Visible := TRUE;
 lbPrList.refresh;
 NewProfile := FALSE;
end;

procedure TfrmMain.edPrNameExit(Sender: 
TObject);
begin
 if (edPrName.Modified) and (not NewProfile) 
 then
 begin
  lbPrList.Items.Strings[lbPrList.ItemIndex] 
  := edPrName.Text;
  lbPrList.Refresh;
  ProfileNameList.Strings[lbPrList.ItemIndex] 
  := edPrName.Text;
 end;
end;

procedure TfrmMain.edPrHostNameExit(Sender: 
TObject);
begin
 if (edPrHostName.Modified) and (not NewProfile) 
 then
  HostNameList.Strings[lbPrList.ItemIndex] 
  := edPrHostName.Text;
end;

procedure TfrmMain.edPrUserNameExit(Sender: 
TObject);
begin
 if (edPrUserName.Modified) and (not NewProfile) 
 then
  UserNameList.Strings[lbPrList.ItemIndex] 
  := edPrUserName.Text;
end;

procedure TfrmMain.edPrPasswordExit(Sender: 
TObject);
begin
 if (edPrPassword.Modified) and (not NewProfile) 
 then
  PasswordList.Strings[lbPrList.ItemIndex] 
  := edPrPassword.Text;
end;

procedure TfrmMain.edPrRemDirExit(Sender: TObject);
begin
 if (edPrRemDir.Modified) and (not NewProfile) then
  RemoteDirList.Strings[lbPrList.ItemIndex] 
  := edPrRemDir.Text;
end;

procedure TfrmMain.edPrLocDirExit(Sender: TObject);
begin
 if (edPrLocDir.Modified) and (not NewProfile)
  then
  LocalDirList.Strings[lbPrList.ItemIndex] 
  := edPrLocDir.Text;
end;

procedure TfrmMain.bbtnPrDeleteClick(Sender: 
TObject);
var
 Reg : TRegistry;
 Profile : String;
begin
 Reg := TRegistry.Create;
 Profile := Concat('ProfileName',IntToStr
 (lbPrList.ItemIndex));
 if Reg.DeleteKey(FtpClientKey + '\Profiles\' + 
 Profile) then
 begin
  ProfileNameList.Delete(lbPrList.ItemIndex);
  HostNameList.Delete(lbPrList.ItemIndex);
  UserNameList.Delete(lbPrList.ItemIndex);
  PasswordList.Delete(lbPrList.ItemIndex);
  RemoteDirList.Delete(lbPrList.ItemIndex);
  LocalDirList.Delete(lbPrList.ItemIndex);
  lbPrList.Items.Delete(lbPrList.ItemIndex);
  edPrName.Clear;
  edPrHostName.Clear;
  edPrUserName.Clear;
  edPrRemDir.Clear;
  edPrLocDir.Clear;
  NoProfiles := lbPrList.Items.Count;
  lbPrList.Refresh;
 end;
 Reg.Free;
end;

procedure TfrmMain.bbtnLocateDefLocalDirClick
(Sender: TObject);
begin
 frmLocateDir := TfrmLocateDir.Create(Application);
 frmLocateDir.ShowModal;
 edDefLocalDir.Text := frmLocateDir.LocateDir;
 frmLocateDir.Free;
end;

procedure TfrmMain.bbtnLocateTxtEditorClick(Sender: 
TObject);
begin
 frmLocateEditor := TfrmLocateEditor.Create
 (Application);
 frmLocateEditor.ShowModal;
 edDefTextEditor.Text 
 := frmLocateEditor.EditorPath;
 frmLocateEditor.Free;
end;

procedure TfrmMain.BitBtn2Click(Sender: 
TObject);
begin
 SaveOptions;
end;

end.

Не забудьте предварительно включить CsSocket и CsShopper в палитру компонентов. Поместите компонент CsShopper на главную форму. Создайте на форме кнопку для каждой команды FTP. Например, кнопка Connect вызывает процедуру 

CsShopper1.Start:

procedure TfrmMain.bbtnConnectClick(Sender: TObject); begin
if (not UsedQFtp) and (not UsedProfile) then begin
with CsShopper1 do
begin
HostName := HomeServer;
if Status = Success then
Start;
end;
end else
if UsedQFtp then
CsShopper1.Start
else
if UsedProfile then
begin
with CsShopper1 do
begin
UserName := edPrUserName.Text;
Password := edPrPassword.Text;
RemoteDir:= edPrRemDir.Text;
LocalDir := edPrLocDir.Text;
EditName := edDefTextEditor.Text;
HostName := edPrHostName.Text;
if Status = Success then
Start;
end;
end;
end;

Профили SHOPPER32

Перед тем как подключаться к FTP-серверу с помощью программы SHOPPER32, вы должны создать на вкладке Profiles некий «профиль», включающий имя FTP-сервера, а также пользовательское имя и пароль для регистрации (см. рис. 6.4). 

Профили сохраняются в системном реестре Windows и извлекаются из него перед регистрацией, чтобы вам не пришлось всякий раз вводить информацию для доступа к FTP-серверу. 

Чтобы добавить новый профиль, нажмите кнопку New; при этом стирается содержимое всех текстовых полей на вкладке Profiles. Затем введите имя профиля, имя FTP-сервера, имя пользователя и пароль в текстовых полях edPrName, edPrHostName, edPrUserName и edPrPassword соответственно. Для анонимной регистрации следует ввести в поле edPrUserName строку anonymous, а в поле edPrPassword — ваш адрес электронной почты. 

Рис. 6.4. Типичный вид профиля на вкладке Profiles 

Нажмите кнопку Add, чтобы внести профиль в список, и затем сохраните новые данные в реестре кнопкой Save. Если потребуется удалить профиль из реестра, выделите его имя в списке Profiles и нажмите кнопку Delete. Чтобы подключиться к FTP-серверу, щелкните на имени профиля в списке Profiles, перейдите на вкладку Connect и нажмите кнопку Connect. Существует и другой, более удобный способ — дважды щелкнуть на имени профиля в списке. При этом автоматически активизируется вкладка Connect, и на ней нажимается кнопка Connect, как показано в следующем фрагменте обработчика события OnDblClick для списка 

lbPrList:

procedure TfrmMain.lbPrListDblClick(Sender: TObject);
begin
UsedProfile := TRUE;
pcShopper.ActivePage := tsConnect; ActiveControl := bbtnConnect; bbtnConnect.Click;
end; 

Чтобы процесс регистрации стал еще проще, мы сохраняем информацию о локальном и удаленном каталогах в текстовых полях edPrLocDir и edPrRemDir соответственно. CsShopper пользуется этой информацией для автоматиче ского, не требующего вмешательства пользователя, перехода к нужному каталогу. 

Чтобы обратиться к редко используемому FTP-серверу, для которого нет смысла заводить специальный профиль, активизируйте кнопку Connect (на вкладке Connect) и щелкните на ней правой кнопкой мыши — на экране появится диалоговое окно Quick FTP. В нем следует ввести имя пользователя и пароль. Значения по умолчанию берутся с вкладки Options. Если они окажутся подходящими, вы сразу же начинаете сеанс работы кнопкой OK. 

Замечание

Для получения доступа к некоторым FTP-серверам и выполнения некоторых FTP-команд (например, удаления каталога командой RMD) необходимо ввести информацию об используемом ресурсе (она посылается серверу командой ACCT). Если вы хотите работать с таким сервером, придется добавить на вкладку Profiles дополнительное текстовое поле и изменить компонент CsShopper для посылки команды ACCT с соответствующей информацией. 

Подключение 

Чтобы получить список каталогов, Start посылает команду LIST с помощью FTPCommand. Результат сохраняется, а последующий вызов Decode анализирует полученные данные и ищет в них информацию о каталогах и файлах. 

Замечание

Механизм анализа несложен, однако описание каталогов и файлов на разных системах может выглядеть по-разному. Анализатор CsShopper работает с серверами, использующими Unix и Unix-подобные системы. Для других операционных систем он иногда выдает неверную информацию о каталогах. 

Decode сравнивает первый символ каждой строки файла FTPFILE.TMP с «d» (для каталогов) или два начальных символа — с «-r» (для файлов). Если будет найден символ «d», Decode удаляет его, проверяет оставшуюся часть строки и преобразует ее в знакомый формат \ddd. Обратная косая черта сообщает SHOPPER32 о том, что строка содержит имя каталога. Аналогично в случае файлов Decode удаляет символы «-r» и ищет в строке имя, время, дату и размер файла, выделяя их в подстроки. Затем эти составные части переставляются так, чтобы получившаяся строка подходила для просмотра в окне списка SHOPPER32 (см. рис. 6.5). 

Метод FRemFiles.Add, используемый внутри Decode, читает каждую сформатированную строку и заносит ее в FRemFiles. Свойство FRemFiles представляет собой список строк, производный от класса TStringList и созданный в конструкторе TCsShopper.Create. 

После того как процедура Decode завершит построение списка, CsShopper передает FRemFiles процедуре TCsShopper.ChangeList, вызывающей обработчик

 OnList:

procedure TCsShopper.ChangeList(List : TStringList);
begin
if Assigned(FUpDateList) then
FUpDateList(Self, List);
end; 

Рис. 6.5. Отображение файлов и каталогов в SHOPPER32 

Обработчик события OnList в программе SHOPPER32 обновляет содержимое списка lbRemoteFiles: 

procedure TfrmMain.CsShopper1List(Sender: TObject; List:TStringList);
begin
lbRemoteFiles.Items := List;
lbRemoteFiles.UpDate;
gbRemote.Caption := CsShopper1.RemoteDir;
end; 

Закрываем соединение 

procedure TfrmMain.bbtnQuitClick(Sender: TObject);
begin
 bbtnQuit.Enabled       := FALSE;
 bbtnRefresh.Enabled    := FALSE;
 bbtnViewFile.Enabled   := FALSE;
 bbtnFtpCmds.Enabled    := FALSE;
 bbtnAbort.Enabled      := FALSE;
 rgFileType.Enabled     := FALSE;
 sbbtnRetr.Enabled      := FALSE;
 sbbtnStor.Enabled      := FALSE;
 gbMoreActions.Visible  := FALSE;
 pbDataTransfer.Visible := FALSE;
 bbtnConnect.Enabled    := TRUE;
 bbtnExit.Enabled       := TRUE;
 with sbStatus do
 begin
  Panels[1].Text := 'Remote Host : ';
  Panels[3].Text := 'Status : Idle';
 end;
 lbRemoteFiles.Clear;
 CsShopper1.Finish;
 Update;
end;

Прием и передача файлов 

Ключевым моментом при этом является создание нового события. После того как вы поместите список lbRemoteFiles на вкладку Connect, создайте обработчик для его события ObDblClick на вкладке Events инспектора объектов. Это событие обрабатывается процедурой TfrmMain.lbRemoteFilesDblClick. Как показано в следующем фрагменте, в результате имя файла присваивается свойству 

CsShopper.Get:

procedure TfrmMain.lbRemoteFilesDblClick(Sender: TObject); begin
pbDataTransfer.Visible := TRUE;
if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.Get := lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]
else
pbDataTransfer.Visible := FALSE; end; 

Внутри компонента CsShopper свойство Get передает имя файла в виде параметра Name процедуре Retrieve. Чтобы обеспечить правильную пересылку и сохранение файла, SetUpFileTransfer проверяет расширение файла. Для двоичных файлов (например, EXE, DLL и ZIP) SetUpFileTransfer приказывает FTP Command выдать команду TYPE IMAGE, в результате чего сервер будет пересылать файл в виде непрерывного потока байтов. Для недвоичных файлов SetUp FileTransfer выдает команду TYPE A. После того как FTP-сервер подтвердит получение команды TYPE, SetUpFileTransfer через FTPCommand посылает команду RETR имя_файла.

Изменение каталогов для пересылки файлов 

Передача файлов 

Все эти списки синхронизированы друг с другом. При выборе в dcbLocal другого дискового устройства немедленно изменяется содержимое dlbLocal и flb Local. Как и в случае списка lbRemoteFiles, я воспользовался вкладкой Events инспектора объектов и создал новый обработчик события OnDblClick — Tfrm Main.flbLocalDblClick — для двойного щелчка на имени файла в списке flbLocal. Таким образом, двойной щелчок на имени передаваемого файла вызывает TfrmMain.flbLocalDblClick, в результате чего имя файла назначается свойству CsShopper1.Put. 

Пересылка нескольких файлов 

procedure TfrmMain.lbRemoteFilesClick
(Sender: TObject);
begin
CsShopper1.RemoteFiles.Add
(lbRemoteFiles.Items.Strings
[lbRemoteFiles.ItemIndex]);
end;

На рис. 6.6 видно несколько файлов, выделенных в каталоге удаленного хоста и готовых к приему. После того как будут выделены все принимаемые файлы, начинайте пересылку с помощью кнопки , расположенной вверху рядом со списком lbRemoteFiles. При этом будет вызван метод CsShopper.MGet. Соответствующий код выглядит так:

procedure TfrmMain.sbbtnRetrClick(Sender: TObject);
begin
 pbDataTransfer.Visible := TRUE;
 bbtnAbort.Enabled      := TRUE;
 CsShopper1.MGet;
end;

Рис. 6.6. Выделенные файлы готовы к пакетному приему 

Однако для того, чтобы описанная схема работала, нам придется изменить два свойства списка lbRemoteFiles в инспекторе объектов: во-первых, измените значение ExtendedSelect с FALSE на TRUE, а во-вторых, измените значение MultiSelect также с FALSE на TRUE. Если теперь щелкнуть на имени файла в списке lbRemoteFiles, оно заносится в строковый список CsShopper1.RemoteFiles (относящийся к типу TStringList). Аналогично в случае пакетной передачи вам придется изменить те же два свойства для списка flbLocal. 

Замечание

Учтите, что возможность пакетной пересылки отсутствует в асинхронном режиме — это обусловлено трудностями с синхронизацией файловых операций. 

Асинхронная пересылка файлов 

Перед тем как подключаться к FTP-серверу в асинхронном режиме, следует установить переключатель Asynchronous в групповом поле FTP Mode вкладки Options. Этот переключатель управляет режимом всего соединения; после того как SHOPPER32 подключится к FTP-серверу, групповое поле FTP Mode блокируется до окончания сеанса. 

Процесс выбора принимаемого файла в асинхронном режиме происходит так же, как и в блокирующем режиме; другими словами, перед вызовом Retrieve мы присваиваем имя файла свойству Get. Отличия начинаются внутри Retrieve. Определив тип файла, мы присваиваем флагу состояния FFtpCmd значение FTP_TYPEI и тем самым приказываем серверу переслать файл как непрерывный поток байтов. Команда TYPE передается через процедуру SendFtpCmd. 

Когда Winsock получает событие сокета FD_READ, которое происходит в результате ответа FTP-сервера на команду TYPE, он посылает процедуре FtpEvent сообщение с описанием события. В FtpEvent сообщение анализируется на предмет поиска событий FD_READ, FD_WRITE и FD_CLOSE. Для распознавания события сокета используется оператор case. 

При получении события FD_READ процедура InfoEvent отправляет все содержимое буфера FRcvBuffer для вывода в приложении SHOPPER32. В буфере FRcv Buffer, содержащем код ответа от сервера, ищется символ 4 или 5, свидетель ствующий об ошибке FTP. Если поиск окажется успешным, FFtpCmd присваивается значение FTP_FAIL, которое сигнализирует приложению о возникнове нии ошибки. 

В противном случае процедура ProcessRecvData обрабатывает FRcvBuffer и флаг состояния FFtpCmd с использованием оператора case. Так как FFtpCmd имеет значение FTP_TYPEI, ProcessRecvData вызывает процедуру ProcessTypeI, в которой выполняется подробный анализ содержимого FRcvBuffer. Следующий фрагмент кода показывает, как это делается:

procedure TCsShopper.ProcessTypeI;
begin
 case GetReplyCode(FRcvBuffer) of
  200 : begin
         if Pos('200-',String(FRcvBuffer)) = 0 
then // Сервер ждет, пока мы создадим 
// соединение данных и пошлем команду USER
         begin
          ProcessPort;
         end;
{ остаток кода пропущен }
  end; // case
  FillChar(FRcvBuffer, SizeOf(FRcvBuffer),#0);
end;

Если код ответа равен 200, вызывается процедура ProcessPort, из которой в свою очередь вызывается InitDataConn, выполняющая четыре задачи: 

	создание сокета для соединения данных;
	вызов WSAAsyncSelect для создания логического номера окна, позволяю щего FtpDataEvent перехватывать события сокета, связанные с соедине нием данных;
	вызов функции Winsock API bind для связывания нового сокета данных;
	вызов listen для перевода сокета данных в состояние «прослушивания» (listening).

Если в результате вызова InitDataConn будет создан допустимый сокет данных, ProcessPort создает для соединения данных уникальный номер порта, который затем передается процедурой SendFtpCmd. Наконец, флагу состояния FFtpCmd присваивается значение FTP_RETR, которое сигнализирует CsShopper о том, что следующее событие сокета FD_READ должно анализироваться в контекс те приема файла. 

Когда на управляющем соединении происходит следующее событие FD_READ (при условии отсутствия ошибок сокета или отрицательных кодов ответа), вызывается процедура ProcessRecvData, которая в свою очередь инициирует ProcessGet. 

В ProcessGet при получении кода ответа 200 (признак успеха) создается локальный файл, имя которого совпадает с именем файла на сервере. В дальнейшем код ответа 150 сигнализирует FTP-клиенту о том, что сервер приступил к пересылке информации через соединение данных. 

Сразу же после того, как FTP-сервер свяжется с клиентом через соединение данных, Winsock уведомляет об этом процедуру FtpDataEvent с помощью события FD_ACCEPT. В ветви FD_ACCEPT оператора case вызывается функция WSAAsyncSelect, которая инициализирует сокет данных для приема только следующих событий: FD_READ, FD_WRITE и FD_CLOSE. Следующий фрагмент процедуры FtpDataEvent показывает, как это делается:

FD_ACCEPT :  begin
 FStartTime := GetTickCount;
 FIntTime   := FStartTime;
 if FListenSocket <> INVALID_SOCKET then
 begin
  nLen := SizeOf(TSockAddr);
  FDataSocket := accept(FListenSocket,
                        @FRemoteHost, @nLen);
  if FDataSocket = SOCKET_ERROR then
  begin
   InfoEvent(Concat('Error : ',WSAErrorMsg));
   FFtpCmd := FTP_FAIL;
   Exit;
  end;
nStat := WSAAsyncSelect(FDataSocket, FDataWnd,
                        DATA_EVENT, 
                        FD_READ or 
                        FD_WRITE or 
                        FD_CLOSE);
if nStat = SOCKET_ERROR then
  begin
   InfoEvent(Concat('Error : ',WSAErrorMsg));
   FFtpCmd := FTP_FAIL;
   Exit;
  end;
 { остаток кода пропущен }
end;
end;

При приеме первого и последнего пакета данных через соединение данных Winsock уведомляет FtpDataEvent с помощью события FD_READ, что приводит к вызову RecvData для получения и сохранения поступающих данных в локальном файле. После завершения пересылки FTP-сервер закрывает соединение данных со своей стороны, заставляя Winsock послать сообщение FD_CLOSE. На этом пересылку файла логично было бы завершить, но иногда в сокете данных FTP-клиента все еще остаются непрочитанные данные. Чтобы избежать потерь информации, мы присваиваем флагу FTransferDone значение TRUE. Все сказанное демонстрируется следующим фрагментом кода из процедуры FtpDataEvent:

FD_CLOSE   : begin
                 FTransferDone := TRUE;
                 case FFTPCmd of
                  FTP_RETR,
                  FTP_LIST,
                  FTP_VIEW : RecvData;
                  FTP_STOR : SendData;
                 end;
                end; 

Флаг FTransferDone сообщает о необходимости продолжить чтение оставшихся данных сокета в цикле while, как показано в следующем фрагменте кода процедуры RecvData:

FTP_RETR : begin
  { часть кода пропущена }
  if FTransferDone then // Работа с 
  //FTP-сервером закончена, 
// однако необходимо прочитать
// и сохранить данные, оставшиеся
// в сокете данных
  begin
   Done := FALSE;
   while not Done do
   begin
    BlockWrite(FRetrFile, FDataBuffer, Response);
    { часть кода пропущена }
    Response := recv(FDataSocket, FDataBuffer,
                     SizeOf(FDataBuffer), 0);
    if Response = SOCKET_ERROR then
    begin
      Done := TRUE;
WSAAsyncSelect(FDataSocket,     
// Прекратить посылку
               FDataWnd, 0, 0); // уведомлений
      CloseSocket(FDataSocket);
      System.CloseFile(FRetrFile);
      ChangeBusy(FALSE);
      ChangeDataDone(TRUE);
      InfoEvent(Concat('ERROR : ',WSAErrorMsg));
    end;
    if Response = 0 then   // Данных не осталось
    begin
      { часть кода пропущена }
      Done := TRUE;
      WSAAsyncSelect(FDataSocket, 
      FDataWnd, 0, 0);
      CloseSocket(FDataSocket);
      System.CloseFile(FRetrFile);
      ChangeBusy(FALSE);
      ChangeDataDone(TRUE);
      GetList;
    end;
  end;
end else
if Response > 0 then  
// FTP-сервер продолжает
// посылать данные, 
// их необходимо обработать
begin
  BlockWrite(FRetrFile, FDataBuffer, Response);
  { часть кода пропущена }
end;
end;

Передача файла FTP-серверу в асинхронном режиме выполняется по тому же принципу, что и прием. 

Положи на место! 

procedure TCsShopper.Abort;
begin
  ChangeBusy(TRUE);
  SendFtpCmd(LoadStr(SFtpAbor));
  FFtpCmd := FTP_ABORT;
  ChangeBusy(FALSE);
end;

При получении кода ответа 226, означающего успешную отмену пересылки, CsShopper.ProcessAbort закрывает соединение данных, а в случае приема файла — стирает локальный файл. 

Заключение