adftp.pas

测试用例

    if (Result > 0) then begin
      FBytesTransferred := FBytesTransferred + Result;
      LocalStream.WriteBuffer(DataBuffer, Result);
      PostStatus(scProgress, nil);
    end;
  end else begin
    Result := Sock.ReadSocket(DataSocket, DataBuffer[FBytesTransferred],
                              SizeOf(DataBuffer) - FBytesTransferred, 0);
    if (Result > 0) then
      FBytesTransferred := FBytesTransferred + Result;
  end;
end;

function TApdCustomFtpClient.GetInProgress : Boolean;
  {check if data transfer is in progress}
begin
  Result := not ((ProcessState = psClosed) or (ProcessState = psIdle));
end;

procedure TApdCustomFtpClient.Notification(AComponent : TComponent;
                                           Operation : TOperation);
  {new/deleted log component}
begin
  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) then begin
    if (AComponent = FFtpLog) then
        FtpLog := nil;
  end else if (Operation = opInsert) then
    if (AComponent is TApdFtpLog) then
      if not Assigned(FFtpLog) then
        if not Assigned(TApdFtpLog(AComponent).FFtpClient) then
          FtpLog := TApdFtpLog(AComponent);
end;

function TApdCustomFtpClient.PopCommand : string;
  {pop ftp command off of command stack}
begin
  if (CmdsStacked > 0) then begin
    Dec(CmdsStacked);
    Result := CmdStack[CmdsStacked];
    SendCommand(Result);
  end else
    Result := '';
end;

procedure TApdCustomFtpClient.PostError(Code : Integer; Info : PChar);
  {place error event in message queue}
var
  PData : PChar;
begin
  PData := nil;
  if (ProcessState > psIdle) then
    ChangeState(psIdle);
    { filter out the 2xx codes, those are successful replies }
(*  from RFC 959, 2xx codes are successful replies, with the exception of
  202 and 221, which require special handling, all 2xx codes are:
         200 Command okay.
         202 Command not implemented, superfluous at this site.
         211 System status, or system help reply.
         212 Directory status.
         213 File status.
         214 Help message.
             On how to use the server or the meaning of a particular
             non-standard command.  This reply is useful only to the
             human user.
         215 NAME system type.
             Where NAME is an official system name from the list in the
             Assigned Numbers document.
         220 Service ready for new user.
         221 Service closing control connection.
             Logged out if appropriate.
         225 Data connection open; no transfer in progress.
         226 Closing data connection.
             Requested file action successful (for example, file
             transfer or file abort).
         227 Entering Passive Mode (h1,h2,h3,h4,p1,p2).
         230 User logged in, proceed.
         250 Requested file action okay, completed.
         257 "PATHNAME" created.
*)
  { section reorganized to fix mem leak (#3605)}                         {!!.05}
  if not NoEvents then begin
    if (Code = 202) or (Code > 299) then begin
      if Assigned(Info) then
        PData := StrNew(Info);
      PostMessage(hwndFtpEvent, FtpErrorMsg, Integer(Code), Longint(PData));
    end;
  end;
end;

procedure TApdCustomFtpClient.PostLog(Code : TFtpLogCode);
  {place log event in message queue}
begin
  PostMessage(hwndFtpEvent, FtpLogMsg, Integer(Code), 0);
end;

procedure TApdCustomFtpClient.PostStatus(Code : TFtpStatusCode; Info : PChar);
  {place status event in message queue}
var
  PData : PChar;
begin
  PData := nil;
  if (Code > scLogin) and (Code <> scProgress) then
    ChangeState(psIdle);
  if not NoEvents then begin
    if Assigned(Info) then
      PData := StrNew(Info);
    PostMessage(hwndFtpEvent, FtpStatusMsg, Integer(Code), Longint(PData));
  end;
end;

procedure TApdCustomFtpClient.PushCommand(const Cmd : string);
  {push ftp command onto command stack - dont call from an event handler}
begin
  if (CmdsStacked < MaxCmdStack) then begin
    CmdStack[CmdsStacked] := Cmd;
    Inc(CmdsStacked);
  end else begin
    CmdsStacked := 0;
    raise Exception.Create('FTP Command stack full');
  end;
end;

function TApdCustomFtpClient.PutData : Integer;
  {send as much data as possible}
var
  N, M : Longint;
  Done : Boolean;
begin
  Result := 0;
  if (DataSocket = Invalid_Socket) or (not Assigned(LocalStream)) then begin
    if (ProcessState > psIdle) then
      ChangeState(psIdle);
    Exit;
  end;

  Done := (LocalStream.Position = LocalStream.Size) or AbortXfer;
  while (not Done) do begin
    ResetTimer;                                                      
    if (LocalStream.Size - LocalStream.Position) < SizeOf(DataBuffer) then
      N := LocalStream.Size - LocalStream.Position
    else
      N := SizeOf(DataBuffer);
    LocalStream.ReadBuffer(DataBuffer, N);
    M := Sock.WriteSocket(DataSocket, DataBuffer, N, 0);
    if (M < N) then begin
      if (M > 0) then
        LocalStream.Position := LocalStream.Position - (N-M)
      else begin
        LocalStream.Position := LocalStream.Position - N;
        break;
      end;
    end;
    FBytesTransferred := FBytesTransferred + M;
    PostStatus(scProgress, nil);
    Done := (LocalStream.Position = LocalStream.Size) or AbortXfer;
  end;
  if Done then
    Sock.ShutDownSocket(DataSocket, SD_SEND);
end;

procedure TApdCustomFtpClient.ResetTimer;
  {reset transfer timeout timer}
begin
  if (Timer <> 0) and (FTransferTimeout > 0) then
    Dispatcher.SetTimerTrigger(Timer, FTransferTimeout, True);
end;

procedure TApdCustomFtpClient.SendCommand(const Cmd : string);
  {send FTP command string via control connection}
begin
  StartTimer;
{$IFDEF Debugging}
  DebugTxt(Cmd);
{$ENDIF}
  PutString(Cmd + CRLF);
end;

procedure TApdCustomFtpClient.SetFtpLog(const NewLog : TApdFtpLog);
  {set a new Ftp log component}
begin
  if (NewLog <> FFtpLog) then begin
    FFtpLog := NewLog;
    if Assigned(FFtpLog) then
      FFtpLog.FtpClient := Self;
  end;
end;

procedure TApdCustomFtpClient.StartTimer;
  {intialize transfer timeout timer}
begin
  StopTimer;
  if (FTransferTimeout > 0) and (Assigned(Dispatcher)) then begin        {!!.06}
    Timer := Dispatcher.AddTimerTrigger;
    Dispatcher.SetTimerTrigger(Timer, FTransferTimeout, True);
  end;
end;

procedure TApdCustomFtpClient.StopTimer;
  {remove transfer timeout timer}
begin
  if (Timer <> 0) then begin
    if Assigned(Dispatcher) then begin                                   {!!.04}
      Dispatcher.SetTimerTrigger(Timer, 0, False);
      Dispatcher.RemoveTrigger(Timer);
    end;                                                                 {!!.04}
    Timer := 0;
  end;
end;

procedure TApdCustomFtpClient.ReplyPacketHandler(Sender : TObject; Data : string);
var
  RCode : Integer;
  PReply : PChar;
begin
  RCode := StrToIntDef(Copy(Data, 1, 3), 0);
  PReply := StrAlloc(Length(Data)+ 1);
  StrPCopy(PReply, Data);
  PostMessage(hwndFtpEvent, FtpReplyMsg, RCode, Longint(PReply));
end;

procedure TApdCustomFtpClient.TimerTrigger(Msg, wParam : Cardinal; lParam : Longint);
  {control connection trigger handler}
begin
  if (Msg = apw_TriggerTimer) and (Integer(wParam) = Timer) then begin
    StopTimer;
    if (ProcessState <> psIdle) then
      PostMessage(hwndFtpEvent, FtpTimeoutMsg, 0, 0);
  end;
end;

procedure TApdCustomFtpClient.WsDataAccept(Sender : TObject; Socket : TSocket);
  {accept server request to open data connection}
begin
  DataSocket := Sock.AcceptSocket(ListenSocket, DataName);
end;

procedure TApdCustomFtpClient.WsDataDisconnect(Sender : TObject; Socket : TSocket);
  {data connection now closed}
var
  PInfo : PChar;
begin
  if (Socket = DataSocket) then begin
    if (ProcessState = psDir) then begin
      PInfo := StrAlloc(SizeOf(DataBuffer));
      StrCopy(PInfo, @DataBuffer);
      PostStatus(scDataAvail, PInfo);
    end else if (ProcessState = psGet) or (ProcessState = psPut) then
      PostStatus(scTransferOK, nil);
  end;
end;

procedure TApdCustomFtpClient.WsDataError(Sender : TObject; Socket : TSocket;
                                          ErrorCode : Integer);
  {data socket error - terminate FTP operation}
begin
  if not AbortXfer then begin                                          
    AbortXfer := True;                                                 
    PostError(ErrorCode, nil);
  end;                                                                 
end;

procedure TApdCustomFtpClient.WsDataRead(Sender : TObject; Socket : TSocket);
  {process reply from the ftp server}
begin
  if (Socket = DataSocket) then
    if (ProcessState = psDir) or (ProcessState = psGet) then
      GetData;
end;

procedure TApdCustomFtpClient.WsDataWrite(Sender : TObject; Socket : TSocket);
  {send blocks of file data as needed}
begin
  if (Socket = DataSocket) and (ProcessState = psPut) then
    PutData;
end;


{ TApdFtpLog }
constructor TApdFtpLog.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FFtpHistoryName := DefFtpHistoryName;
  FEnabled := False;
end;

destructor TApdFtpLog.Destroy;
begin
  if Assigned(FFtpClient) then
    FFtpClient.FtpLog := nil;
  inherited Destroy;
end;

procedure TApdFtpLog.Notification(AComponent : TComponent;
                                  Operation: TOperation);
  {new/deleted ftp client component}
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then begin
    if (AComponent = FFtpClient) then
      FFtpClient := nil;
  end;
end;

procedure TApdFtpLog.UpdateLog(const LogCode : TFtpLogCode);
var
  F : TextFile;
  S : string;
begin
  if (not FEnabled) or (FFtpHistoryName = '') then
    Exit;
  try
    AssignFile(F, FFtpHistoryName);
    Append(F);
  except
    on E : EInOutError do
      if (E.ErrorCode = 2) or (E.ErrorCode = 32) then
        Rewrite(F)
      else
        raise;
  end;

  S := DateTimeToStr(Now) + ' : ';
  case LogCode of
    lcOpen :
      S := S + 'Connected to ' + FtpClient.ServerAddress;
    lcClose :
      S := S + 'Disconnected';
    lcLogin :
      S := S + FtpClient.UserName + ' logged in';
    lcLogout :
      S := S + FtpClient.UserName + ' logged out';
    lcDelete :
      S := S + 'Deleting ' + FtpClient.FRemoteFile;
    lcRename :
      S := S + 'Renaming ' + FtpClient.FRemoteFile;
    lcReceive :
      S := S + 'Downloading ' + FtpClient.FRemoteFile;
    lcStore :
      S := S + 'Uploading ' + FtpClient.FLocalFile;
    lcComplete :
      S := S + 'Transfer complete. ' +
             IntToStr(FtpClient.FBytesTransferred) + ' bytes Transferred';
    lcRestart :
      S := S + 'Attempting re-transfer at ' +
             IntToStr(FtpClient.FRestartAt) + ' bytes';
    lcTimeout :
      S := S + 'Transfer timed out';
    lcUserAbort :
      S := S + 'Transfer aborted by user';
  end;
  WriteLn(F, S);
  Close(F);
  if IOResult <> 0 then ;
end;


end.