adftp.pas

测试用例

  CM_APDFTPEVENT = CM_APDSOCKETQUIT + 10;                            
  FtpErrorMsg    = CM_APDFTPEVENT + 1;
  FtpLogMsg      = CM_APDFTPEVENT + 2;
  FtpReplyMsg    = CM_APDFTPEVENT + 3;
  FtpStatusMsg   = CM_APDFTPEVENT + 4;
  FtpTimeoutMsg  = CM_APDFTPEVENT + 5;


{.$DEFINE Debugging}
{$IFDEF Debugging}
const
  DebugLogFile = '\FtpLog.Txt';

procedure DebugTxt(const aStr : string);
var
  F : TextFile;
  S : string;
begin
  try
    AssignFile(F, DebugLogFile);
    Append(F);
  except
    on E : EInOutError do
      if (E.ErrorCode = 2) or (E.ErrorCode = 32) then
        Rewrite(F)
      else
        raise;
  end;

  S := DateTimeToStr(Now) + ' : ' + aStr;
  WriteLn(F, S);
  Close(F);
  if IOResult <> 0 then ;
end;
{$ENDIF}




{ TApdCustomFtpClient }
constructor TApdCustomFtpClient.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPassiveMode := False;                                             
  FDeviceLayer := dlWinsock;
  FWsMode := wsClient;
  FWsPort := DefServicePort;
  AutoOpen := False;
  UseEventWord := False;
  hwndFtpEvent := AllocateHWnd(FtpEventHandler);
  Sock := TApdSocket.Create(Self);
  Sock.OnWsAccept := WsDataAccept;
  Sock.OnWsDisconnect := WsDataDisconnect;
  Sock.OnWsError := WsDataError;
  Sock.OnWsRead := WsDataRead;
  Sock.OnWsWrite := WsDataWrite;
  ListenSocket := Invalid_Socket;
  DataSocket := Invalid_Socket;
  ProcessState := psClosed;
  FTransferTimeout := DefTransferTimeout;
  FConnectTimeout := 0;                                              
  FUserLoggedIn := False;
  FFileType := ftBinary;
  MultiLine := False;
  ReplyPacket := TApdDataPacket.Create(self);
  ReplyPacket.ComPort := Self;
  ReplyPacket.StartCond := scAnyData;
  ReplyPacket.EndString := CRLF;
  ReplyPacket.EndCond := [ecString];
  ReplyPacket.Timeout := 0;                                          
  ReplyPacket.OnStringPacket := ReplyPacketHandler;
  ReplyPacket.Enabled := False;
{$IFDEF Debugging}
  if FileExists(DebugLogFile) then
    DeleteFile(DebugLogFile);
  FileClose(FileCreate(DebugLogFile));
{$ENDIF}
end;

destructor TApdCustomFtpClient.Destroy;
begin
  ReplyPacket.Free;
  NoEvents := True;
  DataShutDown;
  Open := False;
  {$IFDEF APAX}                                                          {!!.04}
  DelayTicks (4, True);
  {$ENDIF}                                                               {!!.04}
  if (hwndFtpEvent <> 0) then
    DeallocateHWnd(hwndFtpEvent);
  Sock.Free;
  inherited Destroy;
end;

function TApdCustomFtpClient.Abort : Boolean;
  {terminate file transfer in progress}
begin
  Result := (ProcessState > psIdle);
  if Result then begin
    AbortXfer := True;
    SendCommand(fcABOR);
    PostLog(lcUserAbort);
  end;
end;

function TApdCustomFtpClient.ChangeDir(const RemotePathName : string) : Boolean;
  {change the current working directory}
begin
  Result := (ProcessState = psIdle);
  if Result then begin
    ChangeState(psCmd);
    if (RemotePathName <> '') then
      SendCommand(fcCWD + ' ' + RemotePathName)
    else
      SendCommand(fcPWD);
  end;
end;

function TApdCustomFtpClient.CurrentDir : Boolean;
  {get the name of the current working directory}
begin
  Result := (ProcessState = psIdle);
  if Result then begin
    ChangeState(psCmd);
    SendCommand(fcPWD);
  end;
end;

function TApdCustomFtpClient.Delete(const RemotePathName : string) : Boolean;
  {delete specified remote file or directory}
begin
  Result := (ProcessState = psIdle) and (RemotePathName <> '');
  if Result then begin
    ChangeState(psCmd);
    FRemoteFile := RemotePathName;
    SendCommand(fcDELE + ' ' + RemotePathName);
    PostLog(lcDelete);
  end;
end;

function TApdCustomFtpClient.Help(const Command : string) : Boolean;
  {Obtain help for the specified Ftp command}
var
  Cmd : string;
begin
  Result := (ProcessState = psIdle);
  if Result then begin
    ChangeState(psCmd);
    Cmd := fcHELP;
    if (Command <> '') then
      Cmd := Cmd + ' ' + Command;
    SendCommand(Cmd);
  end;
end;

function TApdCustomFtpClient.ListDir(const RemotePathName : string;
                                     FullList : Boolean) : Boolean;
  {list contents of remote directory}
var
  S : string;
begin
  Result := (ProcessState = psIdle);
  if Result then begin
    ChangeState(psDir);
    if FullList then
      S := fcLIST
    else
      S := fcNLST;
    if (RemotePathName <> '') then
      S := S + ' ' + RemotePathName;
    PushCommand(S);
    FillChar(DataBuffer, SizeOf(DataBuffer), #0);
    FBytesTransferred := 0;
    if PassiveMode then                                            
      PushCommand(fcPASV);                                         
    PushCommand(fcType + ' ' + TypeChar[ftAscii]);
    Result := DataConnect;                                         
  end;
end;

function TApdCustomFtpClient.MakeDir(const RemotePathName : string) : Boolean;
  {create specified remote directory}
begin
  Result := (ProcessState = psIdle);
  if Result then begin
    ChangeState(psMkDir);                                              
    SendCommand(fcMKD + ' ' + RemotePathName);
  end;
end;

function TApdCustomFtpClient.RemoveDir (const RemotePathName : string) : Boolean; 
  {delete specified remote file or directory}                          
begin                                                                  
  Result := (ProcessState = psIdle) and (RemotePathName <> '');        
  if Result then begin                                                 
    ChangeState(psCmd);                                                
    FRemoteFile := RemotePathName;                                     
    SendCommand(fcRMD + ' ' + RemotePathName);                         
    PostLog(lcDelete);                                                 
  end;                                                                 
end;                                                                   

function TApdCustomFtpClient.Rename(const RemotePathName, NewPathName : string) : Boolean;
  {rename specified remote file or directory}
begin
  Result := (ProcessState = psIdle) and
            (RemotePathName <> '') and (NewPathName <> '');
  if Result then begin
    ChangeState(psRen);
    PushCommand(fcRNTO + ' ' + NewPathName);
    FRemoteFile := RemotePathName;
    PostLog(lcRename);
    SendCommand(fcRNFR + ' ' + RemotePathName);
  end;
end;

function TApdCustomFtpClient.Retrieve(const RemotePathName, LocalPathName : string;
                                      RetrieveMode : TFtpRetrieveMode) : Boolean;
  {transfer a file from the server}
var
  FH : Integer;
begin
  Result := (ProcessState = psIdle) and
            (RemotePathName <> '') and (LocalPathName <> '');
  if Result then begin
    ChangeState(psGet);
    PushCommand(fcRETR + ' ' + RemotePathName);
    FRemoteFile := RemotePathName;
    FLocalFile := LocalPathName;
    if not FileExists(LocalPathName) then begin
      FH := FileCreate(LocalPathName);
      FileClose(FH);
    end;
    if (RetrieveMode = rmReplace) then begin
      DeleteFile(LocalPathName);                                         {!!.04}
      LocalStream := TFileStream.Create(LocalPathName, fmCreate);        {!!.04}
      LocalStream.Position := 0;
      PostLog(lcReceive);
    end else if (RetrieveMode = rmAppend) then begin
      LocalStream := TFileStream.Create(LocalPathName, fmOpenReadWrite);
      LocalStream.Position := LocalStream.Size;
      PostLog(lcReceive);
    end else begin {RetrieveMode = rmRestart}
      LocalStream := TFileStream.Create(LocalPathName, fmOpenReadWrite);
      if (FRestartAt > LocalStream.Size) or (FRestartAt < 0) then
        FRestartAt := LocalStream.Size;
      LocalStream.Position := FRestartAt;
      PushCommand(fcREST + ' ' + IntToStr(FRestartAt));
      PostLog(lcRestart);
    end;
    FBytesTransferred := 0;
    AbortXfer := False;
    if PassiveMode then                                           
      PushCommand(fcPASV);                                        
    PushCommand(fcType + ' ' + TypeChar[FFileType]);
    Result := DataConnect;                                        
  end;
end;

function TApdCustomFtpClient.SendFtpCommand(const FtpCmd : string) : Boolean;
  {send any FTP command}
begin
  Result := (ProcessState = psIdle);
  if Result then begin
    ChangeState(psCmd);
    SendCommand(FtpCmd);
  end;
end;

function TApdCustomFtpClient.Status(const RemotePathName : string) : Boolean;
  {obtain status of server or optional directory listing}
var
  Cmd : string;
begin
  Result := (ProcessState = psIdle);
  if Result then begin
    ChangeState(psCmd);
    Cmd := fcSTAT;
    if (RemotePathName <> '') then
      Cmd := Cmd + ' ' + RemotePathName;
    SendCommand(Cmd);
  end;
end;

function TApdCustomFtpClient.Store(const RemotePathName, LocalPathName : string;
                                   StoreMode : TFtpStoreMode) : Boolean;
  {transfer a file to the server}
begin
  Result := (ProcessState = psIdle) and
            (RemotePathName <> '') and FileExists(LocalPathName);
  if Result then begin
    ChangeState(psPut);
    FRemoteFile := RemotePathName;
    FLocalFile := LocalPathName;
    if Assigned(LocalStream) then
      LocalStream.Free;
    LocalStream := TFileStream.Create(LocalPathName, fmOpenRead);
    FFileLength := LocalStream.Size;
    LocalStream.Position := 0;
    if (StoreMode = smAppend) then begin
      PushCommand(fcAPPE + ' ' + RemotePathName);
      PostLog(lcStore);
    end else if (StoreMode = smReplace) then begin
      PushCommand(fcSTOR + ' ' + RemotePathName);
      PostLog(lcStore);
    end else if (StoreMode = smUnique) then begin
      PushCommand(fcSTOU + ' ' + RemotePathName);
      PostLog(lcStore);
    end else begin {StoreMode = smReplace}
      if (FRestartAt > LocalStream.Size) or (FRestartAt < 0) then
        FRestartAt := 0;
      LocalStream.Position := FRestartAt;
      PushCommand(fcSTOR + ' ' + RemotePathName);
      PushCommand(fcREST + ' ' + IntToStr(FRestartAt));
      PostLog(lcRestart);
    end;
    FBytesTransferred := 0;
    AbortXfer := False;
    if PassiveMode then                                           
      PushCommand(fcPASV);                                        
    PushCommand(fcType + ' ' + TypeChar[FFileType]);
    Result := DataConnect;                                      
  end;
end;

function TApdCustomFtpClient.Login : Boolean;
  {log on to ftp server}
begin
  Result := (ProcessState in [psClosed, psLogin]);
  if Result then begin
    if (FConnectTimeout > 0) then                                        
      SetTimer(hwndFtpEvent, tmConnectTimer, FConnectTimeout * 55, nil); 
    if ProcessState = psClosed then begin
      { port is closed, connect and log in normally }
      try                                                                {!!.02}
        Open := True;
      except                                                             {!!.02}
        { if we got an exception here, the destination address was invalid }
        { if an OnWsError event is around, we'll let that notify the app;  }
        { if it's not there, then we'll let the exception do the notifying }
        if not Assigned(FOnWsError) then                                 {!!.02}
          raise;                                                         {!!.02}
      end;                                                               {!!.02}
      Result := Open;
    end else begin                                                     
      { port is already open, must be trying to re-log in }
      SendCommand(fcUSER + ' ' + FUserName);                           
    end;
    if Result then                                                       {!!.06}
      ChangeState(psLogin);
  end;                                                                 
end;

function TApdCustomFtpClient.Logout : Boolean;
  {log off of ftp server}
begin
  Result := (Open = True);
  if Result then
    //SendCommand(fcQUIT);
    PutString(fcQuit + CRLF);
  while Open do                                                          {!!.02}