adftp.pas

测试用例

    DelayTicks(2, True);                                                 {!!.02}
end;

procedure TApdCustomFtpClient.ChangeState(NewState : TFtpProcessState);
  {change state variables, fire events, and cleanup as necessary}
begin
  case NewState of
    psClosed :
      begin
        StopTimer;
        ReplyPacket.Enabled := False;                                    {!!.02}
        DataShutDown;
        Open := False;
        FUserLoggedIn := False;
        CmdsStacked := 0;
        if (ProcessState > psLogin) then begin
          PostStatus(scLogout, nil);
          PostLog(lcLogout);
        end else
          PostStatus(scClose, nil);
      end;
    psIdle : DataDisconnect(True);
    end;
  ProcessState := NewState;
end;

procedure TApdCustomFtpClient.DataConnectPASV(IP : string);          
  {establish a data connection to specified IP}
var
  DataSocketName : TSockAddrIn;
  wPort : Word;
  strPort : string;
  strPortHi : string;
  strPortLo : string;
  strAddr : string;
  i, j : Integer;
begin
  if not Assigned(Sock) then
    Exit;
  strAddr := IP;
  strPortHi := '';
  strPortLo := '';
  for i := 1 to 3 do
    if Pos(',', strAddr) > 0 then
      strAddr[Pos(',', strAddr)]  := '.';
  i := Pos(',', strAddr);
  if (i > 0) then begin
    strPort := Copy(strAddr, i+1, Length(strAddr));
    System.Delete(strAddr, i, Length(strAddr));
    j := Pos(',', strPort);
    strPortHi := Copy(strPort, 1, j - 1);
    strPortLo := Copy(strPort, j + 1, Length(strPort));
  end;
  wPort := (StrToIntDef(strPortHi, 0) shl 8) + StrToIntDef(strPortLo, 0);
  with DataSocketName do begin
    sin_family := AF_INET;
    sin_addr := Sock.String2NetAddr(strAddr);
    sin_port := Sock.htons(wPort);
  end;
  Sock.ConnectSocket(DataSocket, DataSocketName);
end;

function TApdCustomFtpClient.DataConnect : Boolean;
  {establish a data connection}
var
  LocalIP : string;
begin
  Result := False;
  try
    if PassiveMode then begin                                            
      DataSocket := Sock.CreateSocket;                                   
      Result := (DataSocket <> Invalid_Socket);                          
      Sock.SetAsyncStyles(DataSocket, FD_CLOSE or FD_READ or FD_WRITE);  
      SendCommand(PopCommand);                                           
    end else begin                                                       
      if (SockFuncs.GetSockName(Dispatcher.ComHandle, ListenName, SockNameSize) = 0) then begin
        if (ListenSocket = Invalid_Socket) then
          ListenSocket := Sock.CreateSocket;
        if (ListenSocket <> Invalid_Socket) then begin
          Sock.SetAsyncStyles(ListenSocket, FD_ACCEPT or FD_CLOSE or FD_READ or FD_WRITE);
          ListenName.sin_family := AF_INET;
          ListenName.sin_port := Sock.htons(0);
          if (Sock.BindSocket(ListenSocket, ListenName) = 0) then
            if (SockFuncs.GetSockName(ListenSocket, ListenName, SockNameSize) = 0) then begin
              with ListenName do
                LocalIP := Sock.NetAddr2String(sin_addr) + '.' +
                  IntToStr(Lo(sin_port)) + '.' + IntToStr(Hi(sin_port));
              while Pos('.', LocalIP) > 0 do
                LocalIP[Pos('.', LocalIP)]  := ',';
              SendCommand(fcPORT + ' ' + LocalIP);
              if (Sock.ListenSocket(ListenSocket, 5) = 0) then
                Result := True;
            end;
        end;
      end;
    end;
  except
    DataShutDown;
    CmdsStacked := 0;                                                
  end;
end;

procedure TApdCustomFtpClient.DataDisconnect(FlushBuffer : Boolean);
  {retrieve any remaining data and close the data connection}
begin
  try
    if (DataSocket <> Invalid_Socket) then begin
      Sock.SetAsyncStyles(DataSocket, 0);
      Sock.ShutdownSocket(DataSocket, SD_Send);
      if (ProcessState = psDir) or (ProcessState = psGet) then
        if FlushBuffer then
          repeat until (GetData <= 0);
      Sock.ShutdownSocket(DataSocket, SD_Both);
    end;
  finally
    DataShutDown;
  end;
end;

procedure TApdCustomFtpClient.DataShutDown;
  {shutdown data connection}
begin
  try
    if (DataSocket <> Invalid_Socket) then
      Sock.CloseSocket(DataSocket);
  except
  end;
  try
    if (ListenSocket <> Invalid_Socket) then
      Sock.CloseSocket(ListenSocket);
  except
  end;
  ListenSocket := Invalid_Socket;
  DataSocket := Invalid_Socket;
  if Assigned(LocalStream) then
    LocalStream.Free;
  LocalStream := nil;
  FFileLength := 0;
end;

procedure TApdCustomFtpClient.DoConnect;
  {control connection now established}
begin
  KillTimer(hwndFtpEvent, tmConnectTimer);                           
  ReplyPacket.Enabled := True;
  Dispatcher.RegisterEventTriggerHandler(TimerTrigger);
  ChangeState(psLogin);
end;

procedure TApdCustomFtpClient.DoDisconnect;
  {control connection now closed}
begin
  KillTimer(hwndFtpEvent, tmConnectTimer);
  if Assigned(Dispatcher) then                                           {!!.02}
    Dispatcher.DeRegisterEventTriggerHandler(TimerTrigger);
  ReplyPacket.Enabled := False;
  ChangeState(psClosed);
end;

procedure TApdCustomFtpClient.FtpEventHandler(var Msg : TMessage);
  {message handler to decouple events from the control connection}
var
  PInfo : PChar;
begin
  PInfo := Pointer(Msg.lParam);
  case Msg.Msg of

    WM_TIMER :
      begin                                                          
        ChangeState(psClosed);
        KillTimer(hwndFtpEvent, tmConnectTimer);
        if Assigned(FOnFtpError) then
          FOnFtpError(Self, ecFtpConnectTimeout, nil);
      end;

    FtpErrorMsg :
      if Assigned(FOnFtpError) then
        FOnFtpError(Self, Msg.wParam, PInfo);

    FtpLogMsg :
      if Assigned(FFtpLog) then
        TApdFtpLog(FFtpLog).UpdateLog(TFtpLogCode(Msg.wParam))
      else if Assigned(FOnFtpLog) then
        FOnFtpLog(Self, TFtpLogCode(Msg.wParam));

    FtpReplyMsg :
      begin
        FtpReplyHandler(Msg.wParam, PInfo);
        if Assigned(FOnFtpReply) and (not NoEvents) then
          FOnFtpReply(Self, Msg.wParam, PInfo);
      end;

    FtpStatusMsg :
      if Assigned(FOnFtpStatus) then
        FOnFtpStatus(Self, TFtpStatusCode(Msg.wParam), PInfo);

    FtpTimeoutMsg :
      begin
        AbortXfer := True;
        if (ProcessState > psLogin) then
          ChangeState(psIdle)
        else
          ChangeState(psClosed);
        if Assigned(FOnFtpStatus) then
          FOnFtpStatus(Self, TFtpStatusCode(Msg.wParam), PInfo);
      end;
  else
    Exit;
  end; {case}

  if Assigned(PInfo) then
    StrDispose(PInfo);
end;

procedure TApdCustomFtpClient.FtpReplyHandler(ReplyCode : Integer; PData : PChar);
  { Server reply handler - state machine }
var
  S : string;
  PReply : PChar;

  procedure Error(Code : Integer; PInfo : PChar);
  begin
    CmdsStacked := 0;
    case Code of
      221, 421 : ChangeState(psClosed);
    else
      PostError(Code, PInfo);
    end;
  end;

begin
  if not MultiLine then begin
    FillChar(ReplyBuffer, SizeOf(ReplyBuffer), #0);
    StrCopy(ReplyBuffer, PData);
    if (PData[3] = '-') then begin
      MultiLine := True;
      MultiLineTerm := IntToStr(ReplyCode) + ' ';
      Exit;
    end;
  end else begin
    if (Pos(MultiLineTerm, StrPas(PData)) <> 1) then begin
      StrCat(ReplyBuffer, PData);
      Exit;
    end else
      MultiLine := False
  end;
  PReply := ReplyBuffer;
  {$IFDEF Debugging}
  DebugTxt(StrPas(PReply));
  {$ENDIF}

  case ProcessState of
    psClosed, psIdle :
      case ReplyCode of
        125 : ; {ignore for now}
        150 : ; {ignore for now}
        226 : DataDisconnect(True);
      else
        Error(ReplyCode, PReply);
      end;
    psLogin :
      case ReplyCode of
        202 : ; {ignore}
        220 : begin
                PostStatus(scOpen, PReply + 4);
                SendCommand(fcUSER + ' ' + FUserName);
              end;
        230 : begin
                ChangeState(psIdle);
                FUserLoggedIn := True;
                PostStatus(scLogin, nil);                              
              end;
        331 : SendCommand(fcPASS + ' ' + FPassword);
        332 : SendCommand(fcACCT + ' ' + FAccount);
      else
        Error(ReplyCode, PReply);
      end; {case for psLogin}
    psDir, psGet, psPut :
      if (ReplyCode >= 200) then
        case ReplyCode of
          125 : ; {ignore for now}
          150 : ; {ignore for now}
          200 : PopCommand;
          226 : ; {ignore for now}
          227 :
            begin
              S := StrPas(PReply);
              S := Copy(S, Pos('(', S) + 1, Length(S));
              S := Copy(S, 1, Pos(')', S) - 1);
              DataConnectPASV(S);
              PopCommand;
            end;
          250 : ChangeState(psIdle);
          350 : PopCommand;                                          
        else
          Error(ReplyCode, PReply);
        end; {case for psDir, psGet, psPut}
    psRen :
      case ReplyCode of
        226 : ; {ignore for now}
        250 : begin
                ChangeState(psIdle);
                PostStatus(scComplete, nil);
              end;
        350 : PopCommand;
      else
        Error (ReplyCode, PReply);
      end; {case for psRen}
    psCmd :
      case ReplyCode of
        211, 212, 213, 214, 215 :
          begin
            PostStatus(scDataAvail, PReply + 4);
          end;
        225, 226 :
          begin
            ChangeState(psIdle);
          end;
        250 :
          begin
            PostStatus(scComplete, nil);
          end;
        257 :
          begin
            S := StrPas(PReply);
            S := Copy(S, Pos('"', S) + 1, Length(S));
            S := Copy(S, 1, Pos('"', S) - 1);
            StrPCopy(PReply, S);
            PostStatus(scCurrentDir, PReply);
          end;
      else
        Error(ReplyCode, PReply);
      end; {case for psCmd}

    psMkDir :                                                          
      case ReplyCode of                                                
        250, 257 : ChangeState(psIdle);                                
      else                                                             
        Error(ReplyCode, PReply);                                      
      end; {case for psMkDir}                                          
  end; {case ProcessState of}
end;

function TApdCustomFtpClient.GetConnected : Boolean;
  {check control connection status}
begin
  Result := (ProcessState <> psClosed);
end;

function TApdCustomFtpClient.GetData : Integer;
  {retrieve data via data connection}
begin
  Result := 0;
  if (DataSocket = Invalid_Socket) then
    Exit;

  if (ProcessState = psGet) then begin
    if (not Assigned(LocalStream)) or AbortXfer then
      Exit;
    ResetTimer;
    Result := Sock.ReadSocket(DataSocket, DataBuffer, SizeOf(DataBuffer), 0);