FTP4W32.DLL & Delphi 2.0

From: bstowers@pobox.com (Brad Stowers)

Here's a unit that works for me. Also, I'm working on a component that wraps up the DLL. If anyone is interested in testing it, let me know by email (bstowers@pobox.com) and I'll send it to you.

unit FTP4W;

{ Updated Feb. 1997 by Brad Stowers (bstowers@pobox.com) for use with }

{ FTP4W v2.6. Modified to add new functions, fix some errors, make it }

{ "cleaner", and work with Delphi 2. I do not use Delphi 1 at all, so }

{ it is extremely likely that this won't work with Delphi 1, i.e. }

{ 'stdcall' won't compile. If you need to use with Delphi 1, use the }

{ Pascal 'UseFTP4W.pas' sample file, or try deleting all the 'stdcall' }

{ directives. This code based on previous work as credited below: }

{by Barbara Tikart Polarwolf Hard & Software, D-63906 Erlenbach am Main}

{and AStA Uni Konstanz (AStA = Allgemeiner Studierenden Ausschuss)}

{eMail to Andreas.Tikart@uni-konstanz.de or AStA@uni-konstanz.de}

{Declarations for FTP module to use with 'FTP4W' Version 2.2g or higher}

{Released into Public Domain}

{Get the newest version via

http://www.uni-konstanz.de/studis/asta/software/index.html}

interface

uses Windows, WinSock, SysUtils;

const

FTP4W_Loaded: boolean = FALSE; { Check to see if the DLL was

loaded. }

FTP4W_RightVersion: boolean = FALSE; { Check to see if we have right

version of DLL. }

const

{ Transfer modes. }

TYPE_A = 'A'; { ASCII }

TYPE_I = 'I'; { Image (Bin) }

TYPE_L8 = 'L'; { Local 8 }

TYPE_DEFAULT = #0; { Whatever server thinks it is. }

{ Actions requested by user.... What are these? }

FTP_STORE_ON_SERVER = 65;

FTP_APPEND_ON_SERVER = 87;

FTP_GET_FROM_SERVER = 223;

{ Firewall Types, for when Philippe gets firewall done. }

FTP4W_FWSITE = 100;

FTP4W_FWPROXY = 103;

FTP4W_FWUSERWITHLOGON = 106;

FTP4W_FWUSERNOLOGON = 109;

{ Return codes of FTP functions }

FTPERR_OK = 0; { succesful function }

FTPERR_ENTERPASSWORD = 1; { userid need a password }

FTPERR_ENTERACCOUNT = 2; { user/pass OK but account required }

FTPERR_ACCOUNTNEEDED = 2; { user/pass OK but account required }

FTPERR_RESTARTOK = 3; { Restart command successful }

FTPERR_ENDOFDATA = 4; { server has closed the data-conn }

FTPERR_CANCELBYUSER = -1; {Transfer aborted by user FtpAbort}

{ User's or programmer's errors }

FTPERR_INVALIDPARAMETER = 1000; { Error in parameters }

FTPERR_SESSIONUSED = 1001; { User has already a FTP session }

FTPERR_NOTINITIALIZED = 1002; { FtpInit has not been call }

FTPERR_NOTCONNECTED = 1003; { User is not connected to a server }

FTPERR_CANTOPENFILE = 1004; { can not open specified file }

FTPERR_CANTWRITE = 1005; { can't write into file (disk full?) }

FTPERR_NOACTIVESESSION = 1006; { FtpRelease without FtpInit }

FTPERR_STILLCONNECTED = 1007; { FtpRelease without any Close }

FTPERR_SERVERCANTEXECUTE = 1008; { file action not taken }

FTPERR_LOGINREFUSED = 1009; { Server rejects usrid/passwd }

FTPERR_NOREMOTEFILE = 1010; { server can not open file }

FTPERR_TRANSFERREFUSED = 1011; { Host refused the transfer }

FTPERR_WINSOCKNOTUSABLE = 1012; { A winsock.DLL ver 1.1 is required }

FTPERR_CANTCLOSE = 1013; { close failed (cmd is in progress) }

FTPERR_FILELOCKED = 1014; { temporary error during FtpDelete }

FTPERR_FWLOGINREFUSED = 1015; { Firewallrejects usrid/passwd }

FTPERR_ASYNCMODE = 1016; { FtpMGet only in synchronous mode }

{ TCP errors }

FTPERR_UNKNOWNHOST = 2001; { can not resolve host adress }

FTPERR_NOREPLY = 2002; { host does not send an answer }

FTPERR_CANTCONNECT = 2003; { Error during connection }

FTPERR_CONNECTREJECTED = 2004; { host has no FTP server }

FTPERR_SENDREFUSED = 2005; { can't send data (network down) }

FTPERR_DATACONNECTION = 2006; { connection on data-port failed }

FTPERR_TIMEOUT = 2007; { timeout occurred }

FTPERR_FWCANTCONNECT = 2008; { Error during connection with FW }

FTPERR_FWCONNECTREJECTED = 2009; { Firewall has no FTP server }

{ FTP errors }

FTPERR_UNEXPECTEDANSWER = 3001; {answer was not expected}

FTPERR_CANNOTCHANGETYPE = 3002; { host rejects the TYPE command }

FTPERR_CMDNOTIMPLEMENTED = 3003; { host recognize but can't exec cmd }

FTPERR_PWDBADFMT = 3004; { PWD cmd OK, but answer has no " }

FTPERR_PASVCMDNOTIMPL = 3005; { Server don't support passive mode }

{ Resource errors }

FTPERR_CANTCREATEWINDOW = 5002; { Insufficent free resources }

FTPERR_INSMEMORY = 5003; { Insufficient Heap memory }

FTPERR_CANTCREATESOCKET = 5004; { no more socket }

FTPERR_CANTBINDSOCKET = 5005; { bind is not succesful }

FTPERR_SYSTUNKNOWN = 5006; { host system not in the list }

{ FTP4W internal data structures You'll probably never need these. }

const

FTP_DATABUFFER = 4096; {a good value for X25/Ethernet/Token Ring}

type

PFtp_FtpData = ^TFtp_FtpData;

TFtp_FtpData = packed record

ctrl_socket: TSocket; { control stream init

INVALID_SOCKET }

data_socket: TSocket; { data stream init

INVALID_SOCKET }

cType: Char; { type (ASCII/binary) init TYPE_A

}

bVerbose: Bool; { verbose mode init FALSE

}

bPassif: Bool; { VRAI -> mode passif

}

nPort: u_short; { connexion Port init

FTP_DEFPORT }

nTimeOut: u_int; { TimeOut in seconds init

FTP_DEFTIMEOUT }

hLogFile: HFile; { Log file

}

szInBuf: Array [0..2047] of Char; { incoming Buffer

}

saSockAddr: TSockAddrIn; { not used anymore

}

saAcceptAddr: TSockAddrIn; { not used anymore

}

end; { TFtp_FtpData }

PFtp_FileTrf = ^TFtp_FileTrf;

TFtp_FileTrf = packed record

hf: HFile; { handle of the file which is being transfered }

nCount: uint; { number of writes/reads made on a file }

nAsyncAlone: uint; { pause each N frame in Async mode (Def 40) }

nAsyncMulti: uint; { Idem but more than one FTP sssion (Def 10) }

nDelay: uint; { time of the pause in milliseconds }

bAborted: Bool; { data transfer has been canceled }

szBuf : Array [0..FTP_DataBuffer-1] Of Char; { Data buffer }

bNotify: Bool; { application receives a msg each data packet }

bAsyncMode: Bool; { synchronous or asynchronous Mode }

lPos: LongInt; { Bytes transfered }

lTotal: LongInt; { bytes to be transfered }

end; { TFtp_FileTrf }

PFtp_Msg = ^TFtp_Msg;

TFtp_MSG = packed record

hParentWnd: hWnd; { window which the msg is to be passed }

nCompletedMessage: uint; { msg to be sent at end of the function }

end; { TFtp_Msg }

PFtp_Verbose = ^TFtp_Verbose;

TFtp_Verbose = packed record

hVerboseWnd: hWnd; { window which the message is to be passed }

nVerboseMsg: uint; { msg to be sent each time a line is received }

end; { TFtp_Verbose }

PFtp_ProcData = ^TFtp_ProcData;

TFtp_ProcData = packed record

{ Task data }

hTask: HTask; { Task Id }

hFtpWindow: hWnd; { Handle of the internal window }

hParentWnd: hWnd; { Handle given to the FtpInit function }

hInstance: HInst; { Task Instance }

bRelease: Bool; { FtpRelease has been called }

{ Mesasge information }

MSG: TFtp_Msg;

VMSG: TFtp_Verbose;

{ File information }

FileTrf: TFtp_FileTrf;

{Ftp information}

Ftp: TFtp_FtpData;

{Linked list}

Next,

Prev: PFtp_ProcData;

end; { TFtp_ProcData }

{ FtpMGet callback function type. }

TFtpMGetCallback = Function (szRemFile, szLocalFile: PChar; Rc: integer):

bool; stdcall;

{ FTP4W Functions }

var

{ Utilities functions}

FtpDataPtr: function: PFtp_ProcData; stdcall;

FtpBufferPtr: function: PChar; stdcall;

FtpErrorString: function(Rc: integer): PChar; stdcall;

Ftp4wVer: function(szVerStr: PChar; nStrSize: integer): Integer;

stdcall;

{ Change default parameters}

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;

{ Init functions}

FtpRelease: function: Integer; stdcall;

FtpInit: function(hWindow: hWnd): Integer; stdcall;

FtpFlush: function: Integer; stdcall;

{ Connection }

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;

{ Authentification}

FtpSendUserName: function(UserName: PChar): Integer; stdcall;

FtpSendPasswd: function(Passwd: PChar): Integer; stdcall;

FtpSendAccount: function(Acct: PChar): integer; stdcall;

{ Commands }

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;

{ file transfer }

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;

{ Directory }

FtpDir: function (Def, LocalFile: PChar; LongDir: Bool;

hWindow: hWnd; wMSG: UINT): Integer; stdcall;

{ Advanced }

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;

{ Firewall }

FtpFirewallLogin: function (szFWHost, szFWUser, szFWPass, szRemHost,

szRemUser,

szRemPass: PChar; nFirewallType: integer;

hParentWnd: hWnd; wMsg: UINT): integer;

stdcall;

{ Misc }

InitFtpGetAnswerCode: function: integer; stdcall;

implementation

const

ftp4wdll = 'FTP4W32.dll'; { DLL file name }

var

hFtp4W: THandle; { DLL handle }

{ Load the DLL and get all the procedure addresses. }

function LoadFtp4WDLL: boolean;

var

OldMode: UINT;

begin

if hFtp4W <> 0 then

FreeLibrary (hFtp4W);

OldMode := SetErrorMode(SEM_NOOPENFILEERRORBOX); { No system messages if

can't load. }

hFtp4W := LoadLibrary (ftp4wdll);

Result := hFtp4W <> 0;

SetErrorMode(OldMode);

if not Result then exit;

{ Get all the function addresses }

@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 called when unit is finished, i.e. app exiting. }

procedure MyExitProc; far;

begin

if hFtp4W <> 0 then begin

{ Make sure we shut everything down so we don't cause FTP4W to leak. }

FtpAbort;

FtpFlush;

FtpCloseConnection;

FtpLocalClose;

FTPRelease;

{ Unload the 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

{ Check to make sure we have a version we can use. }

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.