Советы по 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 recordctrl_socket: TSocket; { управляющий поток initINVALID_SOCKET }
data_socket: TSocket; { поток данных initINVALID_SOCKET }
cType: Char; { тип (ASCII/двоичный) init TYPE_A}
bVerbose: Bool; { режим избыточности init FALSE}bPassif: Bool; { VRAI -> пассивный режим}
nPort: u_short; { порт связи initFTP_DEFPORT }
nTimeOut: u_int; { TimeOut в секундах initFTP_DEFTIMEOUT }
hLogFile: HFile; { Журнальный файл}
szInBuf: Array [0..2047] of Char; { входной буфер}
saSockAddr: TSockAddrIn; { никогда не используется}
saAcceptAddr: TSockAddrIn; { никогда не используется}
end; { TFtp_FtpData }
PFtp_FileTrf = ^TFtp_FileTrf;TFtp_FileTrf = packed recordhf: 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 recordhParentWnd: hWnd; { окно, которому предназначено сообщение }nCompletedMessage: uint; { сообщение, посланное в конце функции }end; { TFtp_Msg }
PFtp_Verbose = ^TFtp_Verbose;TFtp_Verbose = packed recordhVerboseWnd: 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 thenFreeLibrary (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 thenFVer := 0elseFVer := Ftp4wVer(VerInfo, sizeof(VerInfo));FTP4W_RightVersion := not ((HiByte(FVer) < 2) or ((HiByte(FVer) = 2)and (LoByte(FVer) < 96)));
end;end.
[000082]


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