Советы по 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. |
