sbftpcli.pas

著名的SecureBlackBox控件完整源码

    ControlSocketDataAvailable(Sender, Error);
  end
  else
    if FState = FTP_STATE_AUTH_RECEIVED then
  begin
    if TElSecureWSocket(FControlSocket).SSLEnabled and TElSecureWSocket(FControlSocket).SSLActive then
    begin
      FState := FTP_STATE_SSL_ENABLED;
      FServerSupportsSSL := true;
    end;
  end
  else
    if FState = FTP_STATE_AUTH_SENT then
  begin
    Len := FControlSocket.Receive(@Buf[0], BUFFER_SIZE);
    SetLength(S, Len - 2);
    Move(Buf[0], S[1], Len - 2);
    S := '< ' + S;
    if Assigned(FOnDisplay) then
      FOnDisplay(Self, S);
    case ReadCode(Buf[0], Len) of
      234:
        begin
          FState := FTP_STATE_AUTH_RECEIVED;
          TElSecureWSocket(FControlSocket).SSLEnabled := true;
        //TElSecureWSocket(FControlSocket).NegotiateSSL;
        end;
      500:
        begin
          if not FAuthSSLSent then
          begin
            FControlSocket.SendStr('AUTH SSL'#13#10);
            S := '> AUTH SSL';
            if Assigned(FOnDisplay) then
              FOnDisplay(Self, S);
            FAuthSSLSent := true;
          end
          else
          begin
            FServerSupportsSSL := false;
            TElSecureWSocket(FControlSocket).SSLEnabled := false;
            if FEncryptDataChannel then
              TElSecureWSocket(FDataSocket).SSLEnabled := false;
            FState := FTP_STATE_SSL_ENABLED;
            if Length(FOutBuffer) > 0 then
              inherited SendCommand(FOutBuffer);
          end;
        end;
    else
      begin
        FServerSupportsSSL := false;
        TElSecureWSocket(FControlSocket).SSLEnabled := false;
        if FEncryptDataChannel then
          TElSecureWSocket(FDataSocket).SSLEnabled := false;
        FState := FTP_STATE_SSL_ENABLED;
        if Length(FOutBuffer) > 0 then
          inherited SendCommand(FOutBuffer);
      end;
    end;
  end
  else
    if FState = FTP_STATE_PROTP_SENT then
  begin
    Len := FControlSocket.Receive(@Buf[0], BUFFER_SIZE);
    SetLength(S, Len - 2);
    Move(Buf[0], S[1], Len - 2);
    S := '< ' + S;
    if Assigned(FOnDisplay) then
      FOnDisplay(Self, S);

    case ReadCode(Buf[0], Len) of
      200:
        begin
          FState := FTP_STATE_SSL_ENABLED;
          if FOutBuffer <> '' then
            inherited SendCommand(FOutBuffer);
          FOutBuffer := '';
          ControlSocketSessionConnected(Self, Error);
          if Assigned(FOldOnSessionConnected) then
            FOldOnSessionConnected(Sender, Error);
        end;
    else
      begin
        FState := FTP_STATE_SSL_ENABLED;
        if FOutBuffer <> '' then
          inherited SendCommand(FOutBuffer);
        FOutBuffer := '';
        ControlSocketSessionConnected(Self, Error);
        if Assigned(FOldOnSessionConnected) then
          FOldOnSessionConnected(Sender, Error);
      end;
    end;
  end
  else
    if FState = FTP_STATE_PBSZ_SENT then
  begin
    Len := FControlSocket.Receive(@Buf[0], BUFFER_SIZE);
    SetLength(S, Len - 2);
    Move(Buf[0], S[1], Len - 2);
    S := '< ' + S;
    if Assigned(FOnDisplay) then
      FOnDisplay(Self, S);

    HandleControlSocketSessionConnected(Self, 0);
  end;
end;

procedure TElSecureFtpClient.HandleControlSocketSessionConnected(Sender: TObject;
  Error: word);
begin
  if FSSLEnabled and FServerSupportsSSL then
  begin
    if (FState = FTP_STATE_AUTH_RECEIVED) or (FState = FTP_STATE_SSL_ENABLED) then
    begin
      inherited SendCommand('PBSZ ' + IntToStr(FProtectedBufferSize));
      FState := FTP_STATE_PBSZ_SENT;
    end
    else
      if FState = FTP_STATE_PBSZ_SENT then
    begin
      if FEncryptDataChannel then
        inherited SendCommand('PROT P')
      else
        inherited SendCommand('PROT C');
      FState := FTP_STATE_PROTP_SENT;
    end
    else
    begin
      FConnected := true;
    end;
  end
  else
    if (SSLEnabled) and (not FServerSupportsSSL) then
  begin
    ControlSocketSessionConnected(Self, Error);
    if Assigned(FOldOnSessionConnected) then
      FOldOnSessionConnected(Sender, Error);
  end;
end;

function TElSecureFtpClient.ReadCode(const Buf; Len: integer): integer;
const
  ASCII_0 = 48;
begin
  if Len < 3 then
    Result := 0
  else
    Result := (PByteArray(@Buf)[0] - ASCII_0) * 100 +
      (PByteArray(@Buf)[1] - ASCII_0) * 10 + PByteArray(@Buf)[2] - ASCII_0;
end;

procedure TElSecureFtpClient.SendCommand(Cmd: string);
begin
  if FSSLEnabled and FServerSupportsSSL then
  begin
    if FState <> FTP_STATE_SSL_ENABLED then
      FOutBuffer := FOutBuffer + Cmd
    else
      if ((Pos('STOR', Cmd) = 1) or (Pos('APPE', Cmd) = 1)) and (FPassive) then
    begin
      inherited SendCommand(Cmd);
      FDataSocket.OnSessionConnected := nil;
      //if FEncryptDataChannel then
      //  TElSecureWSocket(FDataSocket).NegotiateSSL;
    end
    else
      if ((Pos('STOR', Cmd) = 1) or (Pos('APPE', Cmd) = 1)) and (not FPassive) then
    begin
      inherited SendCommand(Cmd);
      FOldDataSocketOnSessionAvailable := DataSocketPutSessionAvailable;
      FDataSocket.OnSessionAvailable := HandleDataSocketSessionAvailable;
      //if FEncryptDataChannel then
      //   TElSecureWSocket(FDataSocket).SSLEnabled := true;
    end
    else
      if ((Pos('RETR', Cmd) = 1) or (Pos('LIST', Cmd) = 1) or (Pos('NLST', Cmd) = 1)) and (not FPassive) then // or other GET commands
    begin
      inherited SendCommand(Cmd);
      FOldDataSocketOnSessionAvailable := DataSocketGetSessionAvailable;
      FDataSocket.OnSessionAvailable := HandleDataSocketSessionAvailable;
    end
    else
      if ((Pos('RETR', Cmd) = 1) or (Pos('LIST', Cmd) = 1) or (Pos('NLST', Cmd) = 1)) and (FPassive) then
    begin
      inherited SendCommand(Cmd);
//      FDataSocket.OnSessionConnected := nil;
//      TElSecureWSocket(FDataSocket).SSLEnabled := true;
      FOldDataSocketOnSessionConnected := DataSocketGetSessionConnected;
      FDataSocket.OnSessionConnected := HandleDataSocketSessionConnected;
    end
    else
      inherited SendCommand(Cmd);
  end
  else
    inherited SendCommand(Cmd);
end;

procedure TElSecureFtpClient.PutAsync;
begin
//  if (FSSLEnabled) and (FEncryptDataChannel) then
//    TElSecureWSocket(FDataSocket).SSLEnabled := false;
  inherited PutAsync;
end;

procedure TElSecureFtpClient.RestPutAsync;
begin
//  if (FSSLEnabled) and (FEncryptDataChannel) then
//    TElSecureWSocket(FDataSocket).SSLEnabled := false;
  inherited RestPutAsync;
end;

procedure TElSecureFtpClient.HandleDataSocketSessionAvailable(Sender: TObject; Error: word);
begin
  if Assigned(FOldDataSocketOnSessionAvailable) then
    FOldDataSocketOnSessionAvailable(Sender, Error);
  if FEncryptDataChannel then
    TElSecureWSocket(FDataSocket).NegotiateSSL;
end;

procedure TElSecureFtpClient.HandleDataSocketSessionConnected(Sender: TObject; Error: word);
begin
  FDataSocket.OnSessionConnected := FOldDataSocketOnSessionConnected;
  if FEncryptDataChannel then
    TElSecureWSocket(FDataSocket).NegotiateSSL
  else
    if Assigned(FOldDataSocketOnSessionConnected) then
    FOldDataSocketOnSessionConnected(Sender, 0);
end;

procedure TElSecureFtpClient.HandleDataSocketCertificate(Sender: TObject; Certificate:
  TElX509Certificate; var Validate: boolean);
begin
  Validate := true;
  if assigned(FOnCertificateValidate) then
    FOnCertificateValidate(Self, Certificate, Validate);
end;

function TElSecureFtpClient.GetCipherSuites(Index: TSBCipherSuite): boolean;
begin
  Result := FCipherSuites[Index];
end;

procedure TElSecureFtpClient.SetCipherSuites(Index: TSBCipherSuite; Value: boolean);
begin
  FCipherSuites[Index] := Value;
end;

procedure TElSecureFtpClient.SetCertStorage(Storage: TElCustomCertStorage);
begin
  FCertStorage := Storage;
  if FCertStorage <> nil then
    FCertStorage.FreeNotification(Self)
end;

function TElSecureFtpClient.GetCertStorage: TElCustomCertStorage;
begin
  Result := FCertStorage;
end;

procedure TElSecureFtpClient.Notification(AComponent: TComponent; AOperation: TOperation);
begin
  inherited;
  if (AComponent = FCertStorage) and (AOperation = opRemove) then
    CertStorage := nil;
end;

procedure TElSecureFtpClient.InternalValidate(var Validity: TSBCertificateValidity;
  var Reason: TSBCertificateValidityReason);
begin
  if FControlSocket.ClassType = TElSecureWSocket then
    TElSecureWSocket(FControlSocket).InternalValidate(Validity, Reason)
  else
  begin
    Validity := cvStorageError;
    Reason := [];
  end;
end;

procedure TElSecureFtpClient.QuitAsync;
begin
  inherited;
  FState := FTP_STATE_BEFORE;
  FOldOnSessionConnected := nil;
  FOnSessionConnected := ControlSocketSessionConnected;
end;

function TElSecureFtpClient.GetCipherSuite: TSBCipherSuite;
begin
  if Assigned(FControlSocket) and (FControlSocket.ClassType = TElSecureWSocket) then
    Result := TElSecureWSocket(FControlSocket).CipherSuite
  else
    Result := 0;
end;

function TElSecureFtpClient.GetCompressionAlgorithm: TSBSSLCompressionAlgorithm;
begin
  if Assigned(FControlSocket) and (FControlSocket.ClassType = TElSecureWSocket) then
    Result := TElSecureWSocket(FControlSocket).CompressionAlgorithm
  else
    Result := SSL_CA_NONE;
end;

function TElSecureFtpClient.GetCompressionAlgorithms(Index:
  TSBSSLCompressionAlgorithm): boolean;
begin
  Result := FCompressionAlgorithms[Index];
end;

function TElSecureFtpClient.GetVersion: TSBVersion;
begin
  if Assigned(FControlSocket) and (FControlSocket.ClassType = TElSecureWSocket) then
    Result := TElSecureWSocket(FControlSocket).CurrentVersion
  else
    Result := sbSSL2;
end;

procedure TElSecureFtpClient.HandleControlSocketError(Sender: TObject;
  ErrorCode: Integer; Fatal, Remote: Boolean);
begin
  FState := FTP_STATE_SSL_ENABLED;
  FServerSupportsSSL := false;

  if assigned(FOnError) then
    FOnError(Self, ErrorCode, Fatal, Remote);
end;

procedure TElSecureFtpClient.RenegotiateCiphers;
begin
  TElSecureWSocket(FControlSocket).RenegotiateCiphers;
end;

procedure TElSecureFtpClient.SetCompressionAlgorithms(Index:
  TSBSSLCompressionAlgorithm; Value: boolean);
begin
  FCompressionAlgorithms[Index] := Value;
end;

procedure TElSecureFtpClient.SetOnSSLEstablished(Value: TSBSSLEstablishedEvent);
begin
  if FControlSocket is TElSecureWSocket then
    TElSecureWSocket(FControlSocket).OnSSLEstablished := Value;
  FOnSSLEstablished := Value;
end;

end.