sbidftpiohandler.pas

著名的SecureBlackBox控件完整源码

  Certificate : TElX509Certificate; var Validate : boolean);
begin
  FDataIOHandler.InternalValidate(FValidity, FReason);
  if Assigned(FOnCertificateValidate) then
    FOnCertificateValidate(Self, Certificate, Validate);
end;

procedure TElIdFTPIOHandlerSocket.HandleIOHandlerCertificateNeeded(Sender : TObject;
  CertificateBuffer: pointer; var CertificateSize: LongInt; PrivateKeyBuffer: pointer;
  var PrivateKeySize: LongInt; CertificateType: TClientCertificateType);
begin
  if Assigned(FOnCertificateNeeded) then
    FOnCertificateNeeded(Self, CertificateBuffer, CertificateSize,
    PrivateKeyBuffer, PrivateKeySize, CertificateType);
end;

procedure TElIdFTPIOHandlerSocket.HandleIOHandlerCertificateNeededEx(Sender :
  TObject; var Certificate : TElX509Certificate);
begin
  if Assigned(FOnCertificateNeededEx) then
    FOnCertificateNeededEx(Self, Certificate);
end;

function TElIdFTPIOHandlerSocket.GetCertStorage : TElCustomCertStorage;
begin
  Result := FSecureClient.CertStorage;
end;

procedure TElIdFTPIOHandlerSocket.SetCertStorage(Value : TElCustomCertStorage);
begin
  FSecureClient.CertStorage := Value;
  FDataIOHandler.CertStorage := Value;
end;

procedure TElIdFTPIOHandlerSocket.InternalValidate(var Validity : TSBCertificateValidity;
  var Reason : TSBCertificateValidityReason);
begin
  Validity := FValidity;
  Reason := FReason;
end;

function TElIdFTPIOHandlerSocket.GetCipherSuites(Index : TSBCipherSuite) : boolean;
begin
  Result := FSecureClient.CipherSuites[Index];
end;

procedure TElIdFTPIOHandlerSocket.SetCipherSuites(Index : TSBCipherSuite; Value : boolean);
begin
  FSecureClient.CipherSuites[Index] := Value;
end;

function TElIdFTPIOHandlerSocket.GetVersions : TSBVersions;
begin
  Result := FSecureClient.Versions;
end;

procedure TElIdFTPIOHandlerSocket.SetVersions(Value : TSBVersions);
begin
  FSecureClient.Versions := Value;
end;

function TElIdFTPIOHandlerSocket.GetCipherSuite : TSBCipherSuite;
begin
  Result := FSecureClient.CipherSuite;
end;

function TElIdFTPIOHandlerSocket.GetOnCiphersNegotiated: TNotifyEvent;
begin
  Result := FSecureClient.OnCiphersNegotiated;
end;

function TElIdFTPIOHandlerSocket.GetOnError: TSBErrorEvent;
begin
  Result := FSecureClient.OnError;
end;

function TElIdFTPIOHandlerSocket.GetVersion : TSBVersion;
begin
  Result := FSecureClient.CurrentVersion;
end;

procedure TElIdFTPIOHandlerSocket.RenegotiateCiphers;
begin
  FSecureClient.RenegotiateCiphers;
end;

procedure TElIdFTPIOHandlerSocket.SetOnCiphersNegotiated(Value: TNotifyEvent);
begin
  FSecureClient.OnCiphersNegotiated := Value;
end;

procedure TElIdFTPIOHandlerSocket.SetOnError(Value: TSBErrorEvent);
begin
  FSecureClient.OnError := Value;
end;

////////////////////////////////////////////////////////////////////////////////
// TElIdFTP

constructor TElIdFTP.Create(AOwner : TComponent);
begin
  inherited;
end;

destructor TElIdFTP.Destroy;
begin
  inherited;
end;

procedure TElIdFTP.IntGet(const ACommand: string; ADest: TStream; AResume: Boolean = false);
var
  LIP: string;
  LPort: Integer;
  LResponse: Integer;
begin
  DoStatus(ftpTransfer, [RSFTPStatusStartTransfer]); try
    if FPassive then begin
      SendPassive(LIP, LPort);
      FDataChannel := TIdTCPClient.Create(nil); try
      if (Self.ClassType = TElIdFTP) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
        (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
      begin
        // II 19042003
        if TElIdFTPIOHandlerSocket(Self.IOHandler).FEncryptDataChannel then
          FDataChannel.IOHandler := TElIdFTPIOHandlerSocket(IOHandler).FDataIOHandler
      end;
        with (FDataChannel as TIdTCPClient) do begin
          if (IOHandler is TIdIOHandlerSocket) and (Self.IOHandler is TIdIOHandlerSocket) then begin
            TIdIOHandlerSocket(IOHandler).SocksInfo.Assign(TIdIOHandlerSocket(Self.IOHandler).SocksInfo);
          end;
          InitDataChannel;
          Host := LIP;
          Port := LPort;
          if (Self.ClassType = TIdFTP) or (not (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket)) or
            (not TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
            Connect;
          try
            if AResume then begin
              Self.SendCmd('REST ' + IntToStr(ADest.Position), [350]);   {Do not tranlsate}
            end;
            Self.WriteLn(ACommand);
            if (Self.ClassType = TElIdFTP) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
              (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
              Connect;
            if (Self.ClassType = TIdFTP) or (not (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket)) or
              (not (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL)) then
            begin
              Self.GetResponse([125, 150, 154]);
              ReadStream(ADest, -1, True);
            end
            else if (Self.ClassType = TElIdFTP) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
              (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
            begin
              ReadStream(ADest, -1, True);
              Self.GetResponse([125, 150, 154]); //APR: Ericsson Switch FTP
            end;
          finally
            Disconnect;
          end;
        end;
      finally FreeAndNil(FDataChannel); end;
    end else begin
       FDataChannel := TIdSimpleServer.Create(nil); try
       with TIdSimpleServer(FDataChannel) do begin
         InitDataChannel;
         BoundIP := (Self.IOHandler as TIdIOHandlerSocket).Binding.IP;
       end;
       if (Self.ClassType = TElIdFtp) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
         (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
       begin
         TIdSimpleServer(FDataChannel).CreateBinding;
         if TElIdFTPIOHandlerSocket(Self.IOHandler).FEncryptDataChannel then
           TIdSimpleServer(FDataChannel).IOHandler := TElIdFTPIOHandlerSocket(IOHandler).FDataIOHandler;
         TIdSimpleServer(FDataChannel).IOHandler.Open;
       end;
       with TIdSimpleServer(FDataChannel) do begin
          BeginListen;
          SendPort(Binding);
          if AResume then begin
            Self.SendCmd('REST ' + IntToStr(ADest.Position), [350]);  {Do not translate}
          end;
          Self.SendCmd(ACommand, [125, 150, 154]); //APR: Ericsson Switch FTP
        end;
        with TIdSimpleServer(FDataChannel) do
        begin
          Listen;
          if (Self.ClassType = TElIdFtp) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
            (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
            IOHandler.AfterAccept;
          ReadStream(ADest, -1, True);
        end;
      finally
        FreeAndNil(FDataChannel);
      end;
    end;
  finally
    DoStatus(ftpReady, [RSFTPStatusDoneTransfer]);
  end;
  // ToDo: Change that to properly handle response code (not just success or except)
  // 226 = download successful, 225 = Abort successful}
  LResponse := GetResponse([225, 226, 250, 426, 450]);
  if (LResponse = 426) or (LResponse = 450) then begin
    GetResponse([226, 225]);
    DoStatus(ftpAborted, [RSFTPStatusAbortTransfer]);
  end;
end;

{$ifdef INDY9013}
procedure TElIdFTP.IntPut(const ACommand: string; ASource: TStream; AFromBeginning: Boolean = true);
{$else}
procedure TElIdFTP.IntPut(const ACommand: string; ASource: TStream);
{$endif}
var
  LIP: string;
  LPort: Integer;
  LResponse: Integer;
begin
  DoStatus(ftpTransfer, [RSFTPStatusStartTransfer]); try
    if FPassive then begin
      SendPassive(LIP, LPort);
      WriteLn(ACommand);
      FDataChannel := TIdTCPClient.Create(nil);
      if (Self.ClassType = TElIdFtp) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
        (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
      begin
        if TElIdFTPIOHandlerSocket(Self.IOHandler).FEncryptDataChannel then
          FDataChannel.IOHandler := TElIdFTPIOHandlerSocket(IOHandler).FDataIOHandler;
      end;
      with TIdTCPClient(FDataChannel) do try
        InitDataChannel;
        Host := LIP;
        Port := LPort;
        if (IOHandler is TIdIOHandlerSocket) and (Self.IOHandler is TIdIOHandlerSocket) then begin
          TIdIOHandlerSocket(IOHandler).SocksInfo.Assign(TIdIOHandlerSocket(Self.IOHandler).SocksInfo);
        end;
        Connect;
        try
          Self.GetResponse([110, 125, 150]);
          try
            WriteStream(ASource, false);
          except
            on E: EIdSocketError do begin
              // If 10038 - abort was called. Server will return 225
              if E.LastError <> 10038 then begin
                raise;
              end;
            end;
          end;
        finally Disconnect; end;
      finally FreeAndNil(FDataChannel); end;
    end else begin
      FDataChannel := TIdSimpleServer.Create(nil); try
        with TIdSimpleServer(FDataChannel) do begin
          InitDataChannel;
          BoundIP := (Self.IOHandler as TIdIOHandlerSocket).Binding.IP;
        end;
        if (Self.ClassType = TElIdFtp) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
          (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
        begin
          TIdSimpleServer(FDataChannel).CreateBinding;
          if TElIdFTPIOHandlerSocket(Self.IOHandler).FEncryptDataChannel then
            TIdSimpleServer(FDataChannel).IOHandler := TElIdFTPIOHandlerSocket(IOHandler).FDataIOHandler;
          TIdSimpleServer(FDataChannel).IOHandler.Open;
        end;
        with TIdSimpleServer(FDataChannel) do begin
          BeginListen;
          SendPort(Binding);
          Self.SendCmd(ACommand, [125, 150]);
          Listen;
          if (Self.ClassType = TElIdFtp) and (Self.IOHandler.ClassType = TElIdFTPIOHandlerSocket) and
            (TElIdFTPIOHandlerSocket(Self.IOHandler).UseSSL) then
            IOHandler.AfterAccept;
          WriteStream(ASource);
        end;
      finally FreeAndNil(FDataChannel); end;
    end;
  finally
    DoStatus(ftpReady, [RSFTPStatusDoneTransfer]);
  end;
  // 226 = download successful, 225 = Abort successful}
  LResponse := GetResponse([225, 226, 250, 426, 450]);
  if (LResponse = 426) or (LResponse = 450) then begin
    // some servers respond with 226 on ABOR
    GetResponse([226, 225]);
    DoStatus(ftpAborted, [RSFTPStatusAbortTransfer]);
  end;
end;

{$ifdef Linux}
function VirtualProtect(lpAddress : pointer; dwSize : Cardinal; flNewProtect : Cardinal;
  var lpflOldProtect : cardinal) : boolean;
begin
  if (lpflOldProtect > 0) then lpflOldProtect := 0;
  lpAddress := pointer((cardinal(lpAddress) shr 12) shl 12);
  if (mprotect(caddr_t(lpAddress), Cardinal(dwSize), integer(flNewProtect)) = -1) then
    Result := false
  else
    Result := TRUE;
end;
{$endif}

var GetProc,
    RealProcRef,
    RealPutProcRef,
    pp : Pointer;
    OldProt,
    Prot2  : Cardinal;

initialization

  if (lowercase(ExtractFileName(ParamStr(0))) <> 'delphi32.exe') and
     (lowercase(ExtractFileName(ParamStr(0))) <> 'delphi') then
  begin
    GetProc := @TElIdFTP.InternalGet;
    if not VirtualProtect(GetProc, 16, {$ifdef Linux}PROT_READ or PROT_WRITE{$else}PAGE_READWRITE{$endif}, {$ifdef Linux}OldProt{$else}@OldProt{$endif}) then
      raise Exception.Create('VirtualProtect error');
    RealProcRef := @TElIdFTP.IntGet;
    pp := @RealProcRef;
    asm
      push edx
      push ebx
      mov ebx, GetProc
      mov word ptr [ebx], $25FF
      inc ebx
      inc ebx
      mov edx, pp
      mov dword ptr [ebx], edx
      pop ebx
      pop edx
    end;
    VirtualProtect(GetProc, 16, {$ifdef Linux}PROT_READ or PROT_EXEC{$else}PAGE_EXECUTE_READ{$endif}, {$ifdef Linux}Prot2{$else}@Prot2{$endif});

    GetProc := @TElIdFTP.InternalPut;
    if not VirtualProtect(GetProc, 16, {$ifdef Linux}PROT_READ or PROT_WRITE{$else}PAGE_READWRITE{$endif}, {$ifdef Linux}OldProt{$else}@OldProt{$endif}) then
      raise Exception.Create('VirtualProtect error');
    RealPutProcRef := @TElIdFTP.IntPut;
    pp := @RealPutProcRef;
    asm
      push edx
      push ebx
      mov ebx, GetProc
      mov word ptr [ebx], $25FF
      inc ebx
      inc ebx
      mov edx, pp
      mov dword ptr [ebx], edx
      pop ebx
      pop edx
    end;
    VirtualProtect(GetProc, 16, {$ifdef Linux}PROT_READ or PROT_EXEC{$else}PAGE_EXECUTE_READ{$endif}, Prot2);
  end;
end.