56.htm

水木清华的BBS文章

  lpszNewFile: PChar;            // Where to put it on your PC <br>
  fFailIfExists: BOOL;           // Overwrite existing files? <br>
  dwFlagsAndAttributes: DWORD;   // File attribute-See CreateFile. <br>
  dwFlags: DWORD;                // Binary or ASCII transfer <br>
  dwContext: DWORD):             // Usually zero <br>
BOOL stdcall;                    // True on success <br>
BOOL stdcall;                    // True on success <br>
  <br>
下面是一个如何使用该函数的例子： <br>
  <br>
  <br>
function TMyFtp.GetFile(FTPFile, NewFile: string): Boolean; <br>
begin <br>
  Result := FtpGetFile(FFTPHandle, PChar(FTPFile), PChar(NewFile), <br>
               False, File_Attribute_Normal, <br>
               Ftp_Transfer_Type_Binary, 0); <br>
end; <br>
  <br>
    如果要知道 dwFlagsAndAttributes 参数中的变量是怎样传递的，请查阅随 Delphi <br>
附送的 WIN32 帮助文件。 <br>
  <br>
  <br>
典型控制 <br>
  <br>
   下面的 Delphi 控制给了你一个通过 WININET FTP 部分建立可视工具的起点。只是因 <br>
为，这个控制可以让您是用 Object Inspector 来定义远程服务器(RemoteServer)、用户 <br>
身份(UserID)和密码(Password)。 <br>
  <br>
  <br>
  <br>
unit Ftp1; <br>
  <br>
{ FTP example using WININET.PAS rather than <br>
  an ACTIVEX control. Requires WININET.PAS and <br>
  WININET.DLL. WININET.DLL you can get from <br>
  Microsoft, WININET.PAS is available from <br>
  www.borland.com, or with some versions of <br>
  Delphi 2.0. <br>
  <br>
  You might Respond to OnNewDir events as follows: <br>
  <br>
  procedure TForm1.FTP1NewDir(Sender: TObject); <br>
  begin <br>
    ListBox1.Items := MyFtp1.FindFiles; // Get the directory list <br>
  end; <br>
} <br>
  <br>
interface <br>
  <br>
uses <br>
  Windows, Classes, WinINet, <br>
  SysUtils; <br>
  SysUtils; <br>
  <br>
type <br>
  TMyFtp = class(TComponent) <br>
  private <br>
    FContext: Integer; <br>
    FINet: HInternet; <br>
    FFtpHandle: HInternet; <br>
    FCurFiles: TStringList; <br>
    FServer: string; <br>
    FOnNewDir: TNotifyEvent; <br>
    FCurDir: string; <br>
    FUserID: string; <br>
    FPassword: string; <br>
    function GetCurrentDirectory: string; <br>
    procedure SetUpNewDir; <br>
  protected <br>
    destructor Destroy; override; <br>
  public <br>
    constructor Create(AOwner: TComponent); override; <br>
    function Connect: Boolean; <br>
    function FindFiles: TStringList; <br>
    function ChangeDirExact(S: string): Boolean; <br>

    function ChangeDirCustom(S: string): Boolean; <br>
    function BackOneDir: Boolean; <br>
    function GetFile(FTPFile, NewFile: string): Boolean; <br>
    function SendFile1(FTPFile, NewFile: string): Boolean; <br>
    function SendFile2(FTPFile, NewFile: string): Boolean; <br>
    function CustomToFileName(S: string): string; <br>
  published <br>
    property CurFiles: TStringList read FCurFiles; <br>
    property CurDir: string read FCurDir; <br>
    property UserID: string read FUserID write FUserID; <br>
    property Password: string read FPassword write FPassword; <br>
    property Server: string read FServer write FServer; <br>
    property OnNewDir: TNotifyEvent read FOnNewDir <br>
                write FOnNewDir; <br>
  end; <br>
  <br>
procedure Register; <br>
  <br>
implementation <br>
  <br>
uses <br>
  Dialogs; <br>
  Dialogs; <br>
  <br>
// A few utility functions <br>
  <br>
function GetFirstToken(S: string; Token: Char): string; <br>
var <br>
  Temp: string; <br>
  Index: INteger; <br>
begin <br>
  Index := Pos(Token, S); <br>
  if Index < 1 then begin <br>
    GetFirstToken := ''; <br>
    Exit; <br>
  end; <br>
  Dec(Index); <br>
  SetLength(Temp, Index); <br>
  Move(S[1], Temp[1], Index); <br>
  GetFirstToken := Temp; <br>
end; <br>
  <br>
function StripFirstToken(S: string; Ch: Char): string; <br>
var <br>
  i, Size: Integer; <br>

begin <br>
  i := Pos(Ch, S); <br>
  if i = 0 then begin <br>
    StripFirstToken := S; <br>
    Exit; <br>
  end; <br>
  Size := (Length(S) - i); <br>
  Move(S[i + 1], S[1], Size); <br>
  SetLength(S, Size); <br>
  StripFirstToken := S; <br>
end; <br>
  <br>
function ReverseStr(S: string): string; <br>
var <br>
  Len: Integer; <br>
  Temp: String; <br>
  i,j: Integer; <br>
begin <br>
  Len := Length(S); <br>
  SetLength(Temp, Len); <br>
  j := Len; <br>
  for i := 1 to Len do begin <br>
  for i := 1 to Len do begin <br>
    Temp[i] := S[j]; <br>
    dec(j); <br>
  end; <br>
  ReverseStr := Temp; <br>
end; <br>
  <br>
function StripLastToken(S: string; Token: Char): string; <br>
var <br>
  Temp: string; <br>
  Index: INteger; <br>
begin <br>
  SetLength(Temp, Length(S)); <br>
  S := ReverseStr(S); <br>
  Index := Pos(Token, S); <br>
  Inc(Index); <br>
  Move(S[Index], Temp[1], Length(S) - (Index - 1)); <br>
  SetLength(Temp, Length(S) - (Index - 1)); <br>
  StripLastToken := ReverseStr(Temp); <br>
end; <br>
  <br>
  <br>
procedure Register; <br>

begin <br>
  RegisterComponents('Unleash', [TMyFtp]); <br>
end; <br>
  <br>
constructor TMyFtp.Create(AOwner: TComponent); <br>
begin <br>
  inherited Create(AOwner); <br>
  FCurFiles := TStringList.Create; <br>
  FINet := InternetOpen('WinINet1', 0, nil, 0, 0); <br>
end; <br>
  <br>
destructor TMyFtp.Destroy; <br>
begin <br>
  if FINet <> nil then <br>
    InternetCloseHandle(FINet); <br>
  if FFtpHandle <> nil then <br>
    InternetCloseHandle(FFtpHandle); <br>
  inherited Destroy; <br>
end; <br>
  <br>
function TMyFtp.Connect: Boolean; <br>
begin <br>
begin <br>
  FContext := 255; <br>
  FftpHandle := InternetConnect(FINet, PChar(FServer), 0, <br>
   PChar(FUserID), PChar(FPassWord), <br>
   Internet_Service_Ftp, 0, FContext); <br>
  if FFtpHandle = nil then <br>
    Result := False <br>
  else begin <br>
    SetUpNewDir; <br>
    Result := True; <br>
  end; <br>
end; <br>
  <br>
function TMyFtp.GetCurrentDirectory: string; <br>
var <br>
  Len: Integer; <br>
  S: string; <br>
begin <br>
  Len := 0; <br>
  ftpGetCurrentDirectory(FFTPHandle, PChar(S), Len); <br>
  SetLength(S, Len); <br>
  ftpGetCurrentDirectory(FFTPHandle, PChar(S), Len); <br>
  Result := S; <br>
  Result := S; <br>
end; <br>
  <br>
procedure TMyFtp.SetUpNewDir; <br>
begin <br>
  FCurDir := GetCurrentDirectory; <br>
  if Assigned(FOnNewDir) then <br>
    FOnNewDir(Self); <br>
end; <br>
  <br>
function GetDots(NumDots: Integer): string; <br>
var <br>
  S: string; <br>
  i: Integer; <br>
begin <br>
  S := ''; <br>
  for i := 1 to NumDots do <br>
    S := S + ' '; <br>
  Result := S; <br>
end; <br>
  <br>
function GetFindDataStr(FindData: TWin32FindData): string; <br>
var <br>
var <br>
  S: string; <br>
  Temp: string; <br>
begin <br>
  case FindData.dwFileAttributes of <br>
    FILE_ATTRIBUTE_ARCHIVE: S := 'A'; <br>
//    FILE_ATTRIBUTE_COMPRESSED: S := 'C'; <br>
    FILE_ATTRIBUTE_DIRECTORY: S := 'D'; <br>
    FILE_ATTRIBUTE_HIDDEN: S := 'H'; <br>
    FILE_ATTRIBUTE_NORMAL: S := 'N'; <br>
    FILE_ATTRIBUTE_READONLY: S := 'R'; <br>
    FILE_ATTRIBUTE_SYSTEM: S := 'S'; <br>
    FILE_ATTRIBUTE_TEMPORARY: S := 'T'; <br>
  else <br>
    S := IntToStr(FindData.dwFileAttributes); <br>
  end; <br>
  S := S + GetDots(75); <br>
  Move(FindData.CFilename[0], S[6], StrLen(FindData.CFileName)); <br>
  Temp := IntToStr(FindData.nFileSizeLow); <br>
  Move(Temp[1], S[25], Length(Temp)); <br>
  Result := S; <br>
end; <br>
  <br>
  <br>
function TMyFtp.FindFiles: TStringList; <br>
var <br>
  FindData: TWin32FindData; <br>
  FindHandle: HInternet; <br>
begin <br>
   FindHandle := FtpFindFirstFile(FFtphandle, '*.*', <br>
     FindData, 0, 0); <br>
   if FindHandle = nil then begin <br>
     Result := nil; <br>
     Exit; <br>
   end; <br>
   FCurFiles.Clear; <br>
   FCurFiles.Add(GetFindDataStr(FindData)); <br>
   while InternetFindnextFile(FindHandle, @FindData) do <br>
     FCurFiles.Add(GetFindDataStr(FindData)); <br>
   InternetCloseHandle(Findhandle); <br>
   GetCurrentDirectory; <br>
   Result := FCurFiles; <br>
end; <br>
  <br>
function TMyFtp.CustomToFileName(S: string): string; <br>
const <br>
const <br>
  PreSize = 6; <br>
var <br>
  Temp: string; <br>
  TempSize: Integer; <br>
begin <br>
  Temp := ''; <br>
  TempSize := Length(S) - PreSize; <br>
  SetLength(Temp, TempSize); <br>
  Move(S[PreSize], Temp[1], TempSize); <br>
  Temp := GetFirstToken(Temp, ' '); <br>
  Result := Temp; <br>
end; <br>
  <br>
function TMyFtp.BackOneDir: Boolean; <br>
var <br>
  S: string; <br>
begin <br>
  S := FCurDir; <br>
  S := StripLastToken(S, '/'); <br>
  if S = '/' then begin <br>
    Result := False; <br>
    Exit; <br>
    Exit; <br>
  end; <br>
  <br>
  if S <> '' then begin <br>
    ChangeDirExact(S); <br>
    Result := True; <br>
  end else begin <br>
    ChangeDirExact('/'); <br>
    Result := True; <br>
  end; <br>
  <br>
end; <br>
  <br>
// Changes to specific directory in S <br>
function TMyFtp.ChangeDirExact(S: string): Boolean; <br>
begin <br>
  if S <> '' then <br>
    FtpSetCurrentDirectory(FFTPHandle, PChar(S)); <br>
  Result := True; <br>
  FindFiles; <br>
  SetUpNewDir; <br>
end; <br>
  <br>
  <br>
// Assumes S has been returned by GetFindDataString; <br>
function TMyFtp.ChangeDirCustom(S: string): Boolean; <br>
begin <br>
  S := CustomToFileName(S); <br>
  if S <> '' then <br>
    FtpSetCurrentDirectory(FFTPHandle, PChar(S)); <br>
  Result := True; <br>
  FindFiles; <br>
  SetUpNewDir; <br>
end; <br>
  <br>
function TMyFtp.GetFile(FTPFile, NewFile: string): Boolean; <br>
begin <br>
  Result := FtpGetFile(FFTPHandle, PChar(FTPFile), PChar(NewFile), <br>
               False, File_Attribute_Normal, <br>
               Ftp_Transfer_Type_Binary, 0); <br>
end; <br>
  <br>
function TMyFtp.SendFile1(FTPFile, NewFile: string): Boolean; <br>
const <br>
  Size:DWord = 3000; <br>
var <br>
var <br>
  Transfer: Bool; <br>
  Error: DWord; <br>
  S: string; <br>
begin <br>
  Transfer := FtpPutFile(FFTPHandle, PChar(FTPFile), <br>
                         PChar(NewFile), <br>
                         Ftp_Transfer_Type_Binary, 0); <br>
  <br>
  if not Transfer then begin <br>
    Error := GetLastError; <br>
    ShowMessage(Format('Error Number: %d. Hex: %x', <br>
                       [Error, Error])); <br>
    SetLength(S, Size); <br>
    if not InternetGetLastResponseInfo(Error, PChar(S), Size) then <br>
    begin <br>
      Error := GetLastError; <br>
      ShowMessage(Format('Error Number: %d. Hex: %x', <br>
        [Error, Error])); <br>
    end; <br>
    ShowMessage(Format('Error Number: %d. Hex: %x Info: %s', <br>
                       [Error, Error, S])); <br>
  end else <br>

    ShowMessage('Success'); <br>
  Result := Transfer; <br>
end; <br>
  <br>
function TMyFtp.SendFile2(FTPFile, NewFile: string): Boolean; <br>
var <br>
  FHandle: HInternet; <br>
begin <br>
  FHandle :=  FtpOpenFile(FFTPHandle, 'sam.txt', GENERIC_READ, <br>
                           FTP_TRANSFER_TYPE_BINARY, 0); <br>
  if FHandle <> nil then <br>
  InternetCloseHandle(FHandle) <br>
  else <br>
    ShowMessage('Failed'); <br>
  Result := True; <br>
end; <br>
  <br>
end. <br>
</small><hr>
<p align="center">[<a href="index.htm">回到开始</a>][<a href="10.htm">上一层</a>][<a href="57.htm">下一篇</a>]
<p align="center"><a href="http://cterm.163.net">欢迎访问Cterm主页</a></p>
</body>
</html>