dll.htm

对于学习很有帮助

{ 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.


</PRE><HR>

<!---------------------------------------------------------------------------------------------------------------------------------------------------->
<P><H1><A NAME="dll1">About Thunking D2 to 16bit DLL<IMG SRC="../images/new.gif" WIDTH=28 HEIGHT=11 BORDER=0 ALT=" [NEW]"></P></A></H1>
<P><I>From: Mike Heacock &lt;[e-mail]&gt;</I></P>

Please include this URL...as it has an article and sample code
within its pages. <p>

<A HREF="http://members.aol.com/delphimag/index.htm">http://members.aol.com/delphimag/index.htm</A>

<HR SIZE="6" COLOR="LIME">
<FONT SIZE="2">
<a href="mailto:[e-mail]">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</BODY>
</HTML>