Delphi 2

FTP4W32.DLL и Delphi 2.0

Вот модуль, который у меня работает. Сейчас я работаю над компонентом, инкапсулирующим данную 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]