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.
From: Mike Heacock <cerebus@islandnet.com>
Please include this URL...as it has an article and sample code within its pages.http://members.aol.com/delphimag/index.htm
![[NEW]](/file/23368/Chip_1998-07_cd.bin/zkuste/delphi/uddf/IMAGES/NEW.JPG)
> I was wondering is there any way that I can have a main form compiled > into a EXE and > EACH SECONDARY FORM COMPILED INDIVIDUALLY > and then dynamically load in these other secondary forms in runtime > ( DLL concept)Why not?
(* The DLL unit *)
library MyLib;
type
TMyDLLForm = class(TForm)
...
end;
{$IF dynamically creation}
function CreateForm: TForm; {$IFDEF WIN32} stdcall;{ENDIF} export;
begin
Result := TMyDLLForm.Create(Nil);
Result.OnClose := @FreeForm;
end;
{$ELSE}
var
MyDllForm: TForm;
function CreateForm: TForm; {$IFDEF WIN32} stdcall;{ENDIF} export;
begin
Result := MyDLLForm;
end;
{$ENDIF}
exports
CreateForm;
end.
(****************)
(* The Main Form in exe module. Calling the MyDLLForm *)
function CreateForm: TForm; {$IFDEF WIN32} stdcall;{ENDIF} external
'MyLib';
procedure TMyMainExeForm.OnOpenDllFormBtnClick(Sender: TObject);
var
form: TForm;
begin
form := CreateForm;
form.owner := self;
form.parent := self;
end;