Советы по Delphi

         

я работаю над компонентом, инкапсулирующим


Вот модуль, который у меня работает. Сейчас я работаю над компонентом, инкапсулирующим данную DLL. Если кто хочет потестировать данный код, направьте мне письмо по адресу bstowers@pobox.com и я вышлю Вам демонстрационный проект.

    unit FTP4W;
{ Обновлено в феврале 1997 Брадом Стоверсом (Brad Stowers               }
{ bstowers@pobox.com) для использования с FTP4W v2.6.                   }
{ Добавлены новые функции, исправлены некоторые ошибки, включен         }
{ "cleaner (стиратель)" и переделано для работы c Delphi 2. Т.к. я      }
{ уже не использую Delphi 1, существует большая вероятность, что данный }
{ модуль не сможет быть откомпилен в Delphi 1, например, из-за наличия  }
{ директивы 'stdcall'. В паскалевском файле-оболочке 'UseFTP4W.pas'     }


{ Delphi 1 удалил все директивы 'stdcall'. Данный код основан на на     }
{ разработках следующих людей:                                          }

{ Barbara Tikart Polarwolf Hard & Software, D-63906 Erlenbach am Main   }
{ и AStA Uni Konstanz (AStA = Allgemeiner Studierenden Ausschuss)       }
{ eMail для Andreas.Tikart@uni-konstanz.de или AStA@uni-konstanz.de     }
{ Требования к FTP: 'FTP4W' версии 2.2g или выше                        }
{ Предназначено для свободного распространения                          }
{ Последняя версия модуля доступна по адресу                            }
{ http://www.uni-konstanz.de/studis/asta/software/index.html            }

interface

uses
Windows, WinSock, SysUtils;

const
FTP4W_Loaded: boolean = FALSE;        { Проверка загруженности DLL        } FTP4W_RightVersion: boolean = FALSE;  { Проверка корректности версии DLL. }

const
{ Режим передачи. }
TYPE_A       = 'A'; { ASCII } TYPE_I       = 'I'; { Изображение (Двоичный) } TYPE_L8      = 'L'; { Локальная 8 } TYPE_DEFAULT = #0;  { Значение по умолчанию для сервера. }
{ Зарегистрированные действия пользователя.... Какими они могут быть? }
FTP_STORE_ON_SERVER  = 65; FTP_APPEND_ON_SERVER = 87; FTP_GET_FROM_SERVER  = 223;
{ Возможный тип брэндмауэра. }
FTP4W_FWSITE          = 100; FTP4W_FWPROXY         = 103; FTP4W_FWUSERWITHLOGON = 106; FTP4W_FWUSERNOLOGON   = 109;
{ Коды, возвращаемые FTP-функциями }
FTPERR_OK            = 0; { успешное завершение функции                              } FTPERR_ENTERPASSWORD = 1; { требуется пароль для userid                              } FTPERR_ENTERACCOUNT  = 2; { user/pass OK, но требуется бюджет пользователя (account) } FTPERR_ACCOUNTNEEDED = 2; { user/pass OK, но требуется бюджет пользователя (account) } FTPERR_RESTARTOK     = 3; { успешная команда перезапуска                             } FTPERR_ENDOFDATA     = 4; { сервер закончил передачу данных                          } FTPERR_CANCELBYUSER = -1; { передача данных прервана пользователем (FtpAbort)        }

{ Ошибки пользователя или программиста }
FTPERR_INVALIDPARAMETER    = 1000; { Ошибка в параметрах } FTPERR_SESSIONUSED         = 1001; { Пользователь уже имеет сеанс FTP } FTPERR_NOTINITIALIZED      = 1002; { Отсутствует инициализация (не вызван FtpInit) } FTPERR_NOTCONNECTED        = 1003; { Пользователь не подключен к серверу } FTPERR_CANTOPENFILE        = 1004; { невозможно открыть определенный файл } FTPERR_CANTWRITE           = 1005; { невозможно передать файл (переполнен диск?) } FTPERR_NOACTIVESESSION     = 1006; { FtpRelease без FtpInit } FTPERR_STILLCONNECTED      = 1007; { FtpRelease без какого-либо Close } FTPERR_SERVERCANTEXECUTE   = 1008; { неудачное действие с файлом } FTPERR_LOGINREFUSED        = 1009; { Сервер отверг usrid/passwd } FTPERR_NOREMOTEFILE        = 1010; { сервер не может открыть файл } FTPERR_TRANSFERREFUSED     = 1011; { Сервер отклонил передачу } FTPERR_WINSOCKNOTUSABLE    = 1012; { Требуется winsock.DLL версии 1.1 } FTPERR_CANTCLOSE           = 1013; { неудачное закрытие (осуществляетcя cmd) } FTPERR_FILELOCKED          = 1014; { ошибка удаления файла (FtpDelete) } FTPERR_FWLOGINREFUSED      = 1015; { Брэндмауэр отверг usrid/passwd } FTPERR_ASYNCMODE           = 1016; { FtpMGet только в синхронном режиме }
{ Ошибки TCP }
FTPERR_UNKNOWNHOST         = 2001; { сервер по адресу не найден } FTPERR_NOREPLY             = 2002; { сервер не отвечает на запрос } FTPERR_CANTCONNECT         = 2003; { Ошибка во время связи } FTPERR_CONNECTREJECTED     = 2004; { сервер не поддерживает FTP } FTPERR_SENDREFUSED         = 2005; { невозможна передача данных (сеть недоступна) } FTPERR_DATACONNECTION      = 2006; { ошибка связи с портом данных } FTPERR_TIMEOUT             = 2007; { время ожидания истекло } FTPERR_FWCANTCONNECT       = 2008; { Ошибка с брандмауэром в течение сеанса } FTPERR_FWCONNECTREJECTED   = 2009; { Брэндмауэр не поддерживает FTP-соединений }
{ Ошибки FTP }
FTPERR_UNEXPECTEDANSWER    = 3001; { истек срок ожидания ответа } FTPERR_CANNOTCHANGETYPE    = 3002; { сервер отверг команду TYPE } FTPERR_CMDNOTIMPLEMENTED   = 3003; { сервер признал, но не смог осуществить команду } FTPERR_PWDBADFMT           = 3004; { Пароль опознан, но команды не проходят } FTPERR_PASVCMDNOTIMPL      = 3005; { Сервер не поддерживает пассивный режим }
{ Ошибки ресурсов }
FTPERR_CANTCREATEWINDOW    = 5002; { Недостаточно свободных ресурсов } FTPERR_INSMEMORY           = 5003; { Недостаточная куча памяти } FTPERR_CANTCREATESOCKET    = 5004; { нет свободного гнезда (socket) } FTPERR_CANTBINDSOCKET      = 5005; { Неудача связи (bind) } FTPERR_SYSTUNKNOWN         = 5006; { сервер отсутствует в списке }

{ Внутренние структуры данных FTP4W. Но это Вам вряд ли понадобится. }
const
FTP_DATABUFFER = 4096; { хорошая величина для X25/Ethernet/Token Ring}
type
PFtp_FtpData = ^TFtp_FtpData; TFtp_FtpData = packed record ctrl_socket: TSocket;             { управляющий поток    init INVALID_SOCKET }
data_socket: TSocket;             { поток данных         init INVALID_SOCKET }
cType: Char;                      { тип (ASCII/двоичный) init TYPE_A }
bVerbose: Bool;                   { режим избыточности   init FALSE } bPassif: Bool;                    { VRAI -> пассивный режим }
nPort: u_short;                   { порт связи           init FTP_DEFPORT    }
nTimeOut: u_int;                  { TimeOut в секундах   init FTP_DEFTIMEOUT }
hLogFile: HFile;                  { Журнальный файл }
szInBuf: Array [0..2047] of Char; { входной буфер }
saSockAddr: TSockAddrIn;          { никогда не используется }
saAcceptAddr: TSockAddrIn;        { никогда не используется }
end; { TFtp_FtpData }
PFtp_FileTrf = ^TFtp_FileTrf; TFtp_FileTrf = packed record hf: HFile;          { дескриптор передаваемого файла                                   } nCount: uint;       { число записей/считываний блоков файла                            } nAsyncAlone: uint;  { пауза каждого N-го кадра в ассинхронном режиме (по умолчанию 40) } nAsyncMulti: uint;  { Возможное количество FTP-сеансов (по умолчанию 10)               } nDelay: uint;       { время паузы в миллисекундах                                      } bAborted: Bool;     { передача данных была отменена                                    } szBuf : Array [0..FTP_DataBuffer-1] Of Char; { Буфер данных                            } bNotify: Bool;      { приложение получает сообщение с каждым пакетом данных            } bAsyncMode: Bool;   { синхронный или асинхронный режим                                 } lPos: LongInt;      { Передано байтов                                                  } lTotal: LongInt;    { должно быть передано байтов                                      } end; { TFtp_FileTrf }
PFtp_Msg = ^TFtp_Msg; TFtp_MSG = packed record hParentWnd: hWnd;        { окно, которому предназначено сообщение } nCompletedMessage: uint; { сообщение, посланное в конце функции   } end; { TFtp_Msg }
PFtp_Verbose = ^TFtp_Verbose; TFtp_Verbose = packed record hVerboseWnd: hWnd;  { окно, которому предназначено сообщение                  } nVerboseMsg: uint;  { сообщение, посылающееся каждый раз при получении строки } end; { TFtp_Verbose }
PFtp_ProcData = ^TFtp_ProcData; TFtp_ProcData = packed record { Данные задачи } hTask: HTask;              { Идентификатор задачи                       } hFtpWindow: hWnd;          { Дескриптор собственного (внутреннего) окна } hParentWnd: hWnd;          { Дескриптор функции FtpInit                 } hInstance: HInst;          { Экземпляр задачи                           } bRelease:  Bool;           { Для вызова FtpRelease                      } { Информация о сообщении } MSG: TFtp_Msg; VMSG: TFtp_Verbose; { Информация о файле } FileTrf: TFtp_FileTrf; {Ftp-информация} Ftp: TFtp_FtpData; {Список связей} Next, Prev: PFtp_ProcData; end; { TFtp_ProcData }
{ Тип функции обратной связи FtpMGet. }
TFtpMGetCallback = Function (szRemFile, szLocalFile: PChar; Rc: integer): bool; stdcall;

{ FTP4W-функции }

var
{ Вспомогательные функции }
FtpDataPtr:     function: PFtp_ProcData; stdcall; FtpBufferPtr:   function: PChar; stdcall; FtpErrorString: function(Rc: integer): PChar; stdcall; Ftp4wVer:       function(szVerStr: PChar; nStrSize: integer): Integer; stdcall;

{ Изменение параметров по умолчанию }
FtpSetVerboseMode:       function(bVerboseMode: bool; hWindow: hWnd; wMsg: UINT): Integer; stdcall; FtpBytesTransferred:     function: LongInt; stdcall; FtpBytesToBeTransferred: function: LongInt; stdcall; FtpSetDefaultTimeOut:    procedure(nTo_in_sec: Integer); stdcall; FtpSetDefaultPort:       procedure(nDefPort: Integer); stdcall; FtpSetAsynchronousMode:  procedure; stdcall; FtpSetSynchronousMode:   procedure; stdcall; FtpIsAsynchronousMode:   function: Bool; stdcall; FtpSetNewDelay:          procedure(X: Integer); stdcall; FtpSetNewSlices:         procedure(X, Y: Integer); stdcall; FtpSetPassiveMode:       procedure(bPassive: Bool); stdcall; FtpLogTo:                procedure(hLogFile: HFile); stdcall;
{ Функции инициализации }
FtpRelease: function: Integer; stdcall; FtpInit:    function(hWindow: hWnd): Integer; stdcall; FtpFlush:   function: Integer; stdcall;
{ Соединение }
FtpLogin:           function(Host, User, Password: PChar; hWindow: hWnd; wMSG: UINT): Integer; stdcall;
FtpOpenConnection:  function(Host: PChar): Integer; stdcall; FtpCloseConnection: function: Integer; stdcall; FtpLocalClose:      function: Integer; stdcall;
{ Аутентификация }
FtpSendUserName: function(UserName: PChar): Integer; stdcall; FtpSendPasswd:   function(Passwd: PChar): Integer; stdcall; FtpSendAccount:  function(Acct: PChar): integer; stdcall;
{ Команды }
FtpHelp:       function(Arg, Buf: PChar; BufSize: UINT): Integer; stdcall;
FtpDeleteFile: function(szRemoteFile: PChar): Integer; stdcall; FtpRenameFile: function(szFrom, szTo: PChar): Integer; stdcall; FtpQuote:      function(Cmd, ReplyBuf: PChar; BufSize: UINT): Integer; stdcall;
FtpSyst:       function(var szSystemStr: PChar): Integer; stdcall; FtpSetType:    function(cType: char): Integer; stdcall; FtpCWD:        function(Path: PChar): Integer; stdcall; FtpCDUP:       function: Integer; stdcall; FtpPWD:        function(szBuf: PChar; uBufSize: UINT): Integer; stdcall; FtpMKD:        function(szPath, szFullDir: PChar; uBufSize: UINT): Integer; stdcall;
FtpRMD:        function(szPath: PChar): Integer; stdcall;
{ передача файла } FtpAbort:              function: Integer; stdcall; FtpSendFile:           function(Local, Remote: PChar; cType: char; Notify: Bool;
hWindow: hWnd; wMSG: UINT): Integer; stdcall;
FtpAppendToRemoteFile: function(Local, Remote: PChar; cType: char; Notify: Bool;
hWindow: hWnd; wMSG: UINT): Integer; stdcall;
FtpRecvFile:           function(Remote, Lcl: PChar; cType: char; Notify: Bool;
hWindow: hWnd; wMSG: UINT): Integer; stdcall;
FtpAppendToLocalFile:  function(Remote, Lcl: PChar; cType: char; Notify: Bool;
hWindow: hWnd; wMSG: UINT): Integer; stdcall;
FtpGetFileSize:        function: DWORD; stdcall; FtpMGet:               function(szFilter: PChar; cType: char; bNotify: bool;
Callback: TFtpMGetCallback): integer; stdcall;
FtpRestart:            function(ByteCount: longint): integer; stdcall; FtpRestartSendFile:    function(hLocal: HFile; szRemote: PChar; cType: char;
bNotify: bool; ByteCount: Longint; hWindow: hWnd; wMsg: UINT): integer; stdcall;
FtpRestartRecvFile:    function(szRemote: PChar; hLocal: HFile; cType: char;
bNotify: bool; ByteCount: Longint; hWindow: hWnd; wMsg: UINT): integer; stdcall;

{ Каталог }
FtpDir: function (Def, LocalFile: PChar; LongDir: Bool; hWindow: hWnd; wMSG: UINT): Integer; stdcall;
{ Дополнительно }
FtpOpenDataConnection:        function(szRemote: pchar; nAction: integer; cType: char): integer; stdcall; FtpRecvThroughDataConnection: function(szBuf: Pchar; var BufSize: UINT): integer; stdcall;
FtpSendThroughDataConnection: function(szBuf: PChar; BufSize: UINT): integer; stdcall;
FtpCloseDataConnection:       function: integer; stdcall;
{ Брэндмауэр }
FtpFirewallLogin: function (szFWHost, szFWUser, szFWPass, szRemHost, szRemUser,
szRemPass: PChar; nFirewallType: integer; hParentWnd: hWnd; wMsg: UINT): integer; stdcall;

{ Прочее }
InitFtpGetAnswerCode: function: integer; stdcall;

implementation

const
ftp4wdll = 'FTP4W32.dll'; { Имя DLL-файла }
var
hFtp4W: THandle; { Дескриптор DLL }

{ Загрузка DLL и получение адресов всех процедур. }
function LoadFtp4WDLL: boolean;
var
OldMode: UINT; begin
if hFtp4W <> 0 then FreeLibrary (hFtp4W); OldMode := SetErrorMode(SEM_NOOPENFILEERRORBOX); { Если DLL не грузится, запрещаем вывод системных сообщений. }
hFtp4W := LoadLibrary (ftp4wdll); Result := hFtp4W <> 0; SetErrorMode(OldMode); if not Result then exit;
{ Получаем адреса всех функций } @FtpDataPtr :=                   GetProcAddress(hFtp4W, 'FtpDataPtr'); @FtpBufferPtr :=                 GetProcAddress(hFtp4W, 'FtpBufferPtr'); @FtpErrorString :=               GetProcAddress(hFtp4W, 'FtpErrorString'); @Ftp4wVer :=                     GetProcAddress(hFtp4W, 'Ftp4wVer'); @FtpSetVerboseMode :=            GetProcAddress(hFtp4W, 'FtpSetVerboseMode'); @FtpBytesTransferred :=          GetProcAddress(hFtp4W, 'FtpBytesTransferred'); @FtpBytesToBeTransferred :=      GetProcAddress(hFtp4W, 'FtpBytesToBeTransferred'); @FtpSetDefaultTimeOut :=         GetProcAddress(hFtp4W, 'FtpSetDefaultTimeOut'); @FtpSetDefaultPort :=            GetProcAddress(hFtp4W, 'FtpSetDefaultPort'); @FtpSetAsynchronousMode :=       GetProcAddress(hFtp4W, 'FtpSetAsynchronousMode'); @FtpSetSynchronousMode :=        GetProcAddress(hFtp4W, 'FtpSetSynchronousMode'); @FtpIsAsynchronousMode :=        GetProcAddress(hFtp4W, 'FtpIsAsynchronousMode');
@FtpSetNewDelay :=               GetProcAddress(hFtp4W, 'FtpSetNewDelay');
@FtpSetNewSlices :=              GetProcAddress(hFtp4W, 'FtpSetNewSlices');
@FtpSetPassiveMode :=            GetProcAddress(hFtp4W, 'FtpSetPassiveMode');
@FtpLogTo :=                     GetProcAddress(hFtp4W, 'FtpLogTo'); @FtpRelease :=                   GetProcAddress(hFtp4W, 'FtpRelease'); @FtpInit :=                      GetProcAddress(hFtp4W, 'FtpInit'); @FtpFlush :=                     GetProcAddress(hFtp4W, 'FtpFlush'); @FtpLogin :=                     GetProcAddress(hFtp4W, 'FtpLogin'); @FtpOpenConnection :=            GetProcAddress(hFtp4W, 'FtpOpenConnection');
@FtpCloseConnection :=           GetProcAddress(hFtp4W, 'FtpCloseConnection');
>@FtpLocalClose :=               GetProcAddress(hFtp4W, 'FtpLocalClose'); @FtpSendUserName :=              GetProcAddress(hFtp4W, 'FtpSendUserName');
@FtpSendPasswd :=                GetProcAddress(hFtp4W, 'FtpSendPasswd'); @FtpSendAccount :=               GetProcAddress(hFtp4W, 'FtpSendAccount');
@FtpHelp :=                      GetProcAddress(hFtp4W, 'FtpHelp'); @FtpDeleteFile :=                GetProcAddress(hFtp4W, 'FtpDeleteFile'); @FtpRenameFile :=                GetProcAddress(hFtp4W, 'FtpRenameFile'); @FtpQuote :=                     GetProcAddress(hFtp4W, 'FtpQuote'); @FtpSyst :=                      GetProcAddress(hFtp4W, 'FtpSyst'); @FtpSetType :=                   GetProcAddress(hFtp4W, 'FtpSetType'); @FtpCWD :=                       GetProcAddress(hFtp4W, 'FtpCWD'); @FtpCDUP :=                      GetProcAddress(hFtp4W, 'FtpCDUP'); @FtpPWD :=                       GetProcAddress(hFtp4W, 'FtpPWD'); @FtpMKD :=                       GetProcAddress(hFtp4W, 'FtpMKD'); @FtpRMD :=                       GetProcAddress(hFtp4W, 'FtpRMD'); @FtpAbort :=                     GetProcAddress(hFtp4W, 'FtpAbort'); @FtpSendFile :=                  GetProcAddress(hFtp4W, 'FtpSendFile'); @FtpAppendToRemoteFile :=        GetProcAddress(hFtp4W, 'FtpAppendToRemoteFile');
@FtpRecvFile :=                  GetProcAddress(hFtp4W, 'FtpRecvFile'); @FtpAppendToLocalFile :=         GetProcAddress(hFtp4W, 'FtpAppendToLocalFile');
@FtpGetFileSize :=               GetProcAddress(hFtp4W, 'FtpGetFileSize');
@FtpMGet :=                      GetProcAddress(hFtp4W, 'FtpMGet'); @FtpRestart :=                   GetProcAddress(hFtp4W, 'FtpRestart'); @FtpRestartSendFile :=           GetProcAddress(hFtp4W, 'FtpRestartSendFile');
@FtpRestartRecvFile :=           GetProcAddress(hFtp4W, 'FtpRestartRecvFile');
@FtpDir :=                       GetProcAddress(hFtp4W, 'FtpDir'); @FtpOpenDataConnection :=        GetProcAddress(hFtp4W, 'FtpOpenDataConnection');
@FtpRecvThroughDataConnection := GetProcAddress(hFtp4W, 'FtpRecvThroughDataConnection');
@FtpSendThroughDataConnection := GetProcAddress(hFtp4W, 'FtpSendThroughDataConnection');
@FtpCloseDataConnection :=       GetProcAddress(hFtp4W, 'FtpCloseDataConnection');
@FtpFirewallLogin :=             GetProcAddress(hFtp4W, 'FtpFirewallLogin');
@InitFtpGetAnswerCode :=         GetProcAddress(hFtp4W, 'InitFtpGetAnswerCode');
end;

{ Вызов процедуры при завершении модуля, т.е. при закрытии приложения. }
procedure MyExitProc; far;
begin
if hFtp4W <> 0 then begin { Необходимо убедиться что все закрыто и FTP4W выгружена из памяти. } FtpAbort; FtpFlush; FtpCloseConnection; FtpLocalClose; FTPRelease; { Выгружаем DLL. } FreeLibrary(hFtp4W) end; end;

var
VerInfo: array[0..100] of char; FVer: integer; Begin
hFtp4W := 0; AddExitProc(MyExitProc); FTP4W_Loaded := LoadFtp4WDLL; if FTP4W_Loaded then begin { Проверка корректности версии DLL. } if @Ftp4wVer = NIL then FVer := 0 else FVer := Ftp4wVer(VerInfo, sizeof(VerInfo)); FTP4W_RightVersion := not ((HiByte(FVer) < 2) or ((HiByte(FVer) = 2) and (LoByte(FVer) < 96)));
end; end.
[000082]


Содержание раздела