www.pudn.com > 灰鸽子VIP1.2.rar > FTPThread.pas

unit FTPThread; 
 
interface 
 
uses 
  SysUtils, Classes; 
 
type 
   TFTPMode = (ftpSend, ftpGet); 
   TStatusProc = procedure(Sender: TObject; const StatMsg: string) of object; 
 
   TFTPThread = class(TThread) 
   protected 
      NumBytes    : integer; 
      ModeStr     : string; 
      TmpStat     : string; 
      procedure   Execute; override; 
      procedure   DoFTP; 
      procedure   SendStat(const StatMsg: string); 
      procedure   CallStatProc; 
   public 
      LocalFile   : string; 
      RemoteFile  : string; 
      Host        : string; 
      FtpPorts    : integer; 
      UserName    : string; 
      Password    : string; 
      FTPMode     : TFTPMode; 
      StatProc    : TStatusProc;    // This is called inside of "Synchronize" 
      ErrMsg      : string; 
   end; 
 
 
implementation 
 
uses Windows, WinINet, INetUtil; 
 
// *************************************************************************** 
// TWorkThread 
 
procedure TFTPThread.SendStat(const StatMsg: string); 
begin 
   TmpStat := StatMsg; 
   Synchronize(CallStatProc); 
end; 
 
procedure TFTPThread.CallStatProc; 
begin 
   if Assigned(StatProc) then 
      StatProc(Self, TmpStat); 
end; 
 
procedure FTP_Status(hi: HINTERNET; Context: integer; Status: integer; 
   StatusInfo: pointer; StatusInfoLen: integer); stdcall; 
var 
   ft : TFTPThread; 
begin 
   ft := TFTPThread(Context); 
 
   case Status of 
      INTERNET_STATUS_REQUEST_SENT: begin 
         ft.NumBytes := ft.NumBytes + PINT(StatusInfo)^; 
         end; 
   end; 
 
   ft.SendStat(Format('%s = %1.0n', [ft.ModeStr, 0.0 + ft.NumBytes])); 
end; 
 
procedure TFTPThread.DoFTP; 
var 
   hi, fi   : HINTERNET; 
begin 
   SendStat('Initializing Internet Functions'); 
   hi := InternetOpen('VCS FTP', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0); 
   INetCheck(LongBool(hi)); 
 
   SendStat('正在连接FTP服务器...');     //INTERNET_DEFAULT_FTP_PORT 
   fi := InternetConnect(hi, PChar(Host), FtpPorts , 
       PChar(UserName), PChar(Password), INTERNET_SERVICE_FTP, 0, 0); 
   INetCheck(LongBool(fi)); 
 
   NumBytes := 0; 
   if FTPMode = ftpSend then begin 
      SendStat('正在更新IP文件...'); 
      ModeStr := 'Bytes Sent'; 
      InternetSetStatusCallback(fi, @FTP_Status); 
      INetCheck(FtpPutFile(fi, PChar(LocalFile), PChar(RemoteFile), FTP_TRANSFER_TYPE_BINARY, integer(Self))); 
      ModeStr := '发送完成.'; 
   end else begin 
      SendStat('Receiving File'); 
      ModeStr := 'Bytes Received'; 
      InternetSetStatusCallback(fi, @FTP_Status); 
      INetCheck(FtpGetFile(fi, PChar(RemoteFile), PChar(LocalFile), False, 0, 
         FTP_TRANSFER_TYPE_BINARY, integer(Self))); 
      ModeStr := 'Receive Complete'; 
   end; 
 
   InternetCloseHandle(fi); 
   InternetCloseHandle(hi); 
 
   SendStat(Format('%s  %1.0n bytes', [ModeStr, 0.0 + NumBytes])); 
end; 
 
procedure TFTPThread.Execute; 
begin 
   try 
      DoFTP; 
   except 
      on e: Exception do begin 
         ErrMsg := e.Message; 
         SendStat(ErrMsg); 
      end; 
   end; 
end; 
 
 
end.