sbwsocket.pas

著名的SecureBlackBox控件完整源码

  if Written = 0 then
    FDataLeft := false;
  if Written < 0 then
    Written := 0;
  {$ifdef ICS_V416_OR_ABOVE}
  if (Written = 0) then
    FReceivedOnLastCall := false
  else
    FReceivedOnLastCall := true;
  {$endif}
end;

procedure TElSecureWSocket.OnSecureClientSend(Sender: TObject; Buffer: pointer;
  Size: longint);
const
  WSAEWOULDBLOCK = 10035;
var
  Sent : integer;
  SendPtr : PByte;
  {$ifdef ICS_V515_OR_ABOVE}
  LastError : integer;
  {$endif}
begin
  SendPtr := PByte(Buffer);

  while Size > 0 do
  begin
{$ifdef ICS_V515_OR_ABOVE}
    Sent := inherited RealSend(SendPtr, Size);
    if Sent = -1 then
      LastError := WSocket_WSAGetLastError
    else
      LastError := 0;
{$else}
    Sent := inherited Send(SendPtr, Size);
{$endif}
    //SBDumper.Dumper.WriteString(Format('To send: %d', [Size]));
    // OutputDebugString(PChar(Format('To send: %d', [Size])));

    if (Sent < 0) and (LastError <> WSAEWOULDBLOCK) then
    begin
      FErrorOccured := true;
      break;
    end;
    Dec(Size, Sent);
    Inc(SendPtr, Sent);
    if Size > 0 then
      Sleep(50);
  end;
end;

procedure TElSecureWSocket.ClientMustOpen(Sender: TObject; Error: Word);
begin
  RecvByClient := 0;
  RecvFromSocket := 0;
  if Error = 0 then
  begin
    FDataLeft := true;
    FSocksConnected := true;
    FErrorOccured := false;
    FSecureClient.Open;
    FCallOnData := true;
    while (not FSecureClient.Active) and (not FErrorOccured) and (FDataLeft) do
    begin
      FSecureClient.DataAvailable;
    end;
  end;
end;

type PInteger = ^Integer;

procedure TElSecureWSocket.DataAvailableForClient(Sender: TObject; Error: Word);
begin
  FCallOnData := true;
  {$ifdef ICS_V416_OR_ABOVE}
  repeat
    FReceivedOnLastCall := false;
    FSecureClient.DataAvailable;
  until FReceivedOnLastCall = false;
  if Length(FBuffer) = 0 then
  begin
    PInteger(@LastError)^ := -1;
  end;
  {$else}
  FSecureClient.DataAvailable;
  {$endif}
end;

procedure TElSecureWSocket.ClientConnected(Sender: TObject);
var
  FOldOnData : TDataAvailable; 
begin
  if Assigned(FOldOnSessionConnected) then
  begin
    FOldOnData := FOnDataAvailable;
    FOldOnSessionConnected(Sender, 0);
    if TMethod(FOnDataAvailable).Code <> TMethod(FOldOnData).Code then
    begin
      FOldOnDataAvailable := FOnDataAvailable;
      FOnDataAvailable := FOldOnData;
    end;
  end;
  if FSecureClient.Enabled and FSecureClient.Active then
    DoSSLEstablished();
end;

{$ifdef ICS_V515_OR_ABOVE}
function TElSecureWSocket.RealSend(Data : Pointer; Len : Integer) : Integer;
begin
  if not FSocksConnected then
    Result := inherited RealSend(Data, Len)
  else
  if FSecureClient.Active then
  begin
    FSecureClient.SendData(Data, Len);
    Result := Len;
  end
  else
    result := 0;
end;
{$endif}

function TElSecureWSocket.Send(Data: Pointer; Len: Integer): Integer;
begin
  //if not FSocksConnected then
    Result := inherited Send(Data, Len)
  (*
  else
  if FSecureClient.Active then
  begin
    FSecureClient.SendData(Data, Len);
    Result := Len;
  end
  else
    result := 0;
  *)
end;

function TElSecureWSocket.SendStr({$ifdef ICS_V508_OR_ABOVE}const {$endif}Str : String) : Integer; //!!KAP!!
begin
  Result := Send(@Str[1], Length(Str));
end;

function TElSecureWSocket.Receive(Buffer: Pointer; BufferSize: Integer):
  Integer;
begin
  if not FSocksConnected then
    Result := inherited Receive(Buffer, BufferSize)
  else
  begin
    if Length(FBuffer) > 0 then
    begin
      if BufferSize < Length(FBuffer) then
      begin
        Move(FBuffer[1], Buffer^, BufferSize);
        Delete(FBuffer, 1, BufferSize);
        Result := BufferSize;
      end
      else
      begin
        Result := Length(FBuffer);
        Move(FBuffer[1], Buffer^, Length(FBuffer));
        SetLength(FBuffer, 0);
      end;
    end
    else
    begin
      FDataReceived := False;
      Result := 0;
    end;
  end;
  inc(RecvByClient, Result);
end;

function TElSecureWSocket.ReceiveStr: string;
var
  Len: Integer;
begin
  SetLength(Result, 64000);
  Len := Receive(@Result[1], 64000);
  SetLength(Result, Len);
end;

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

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

destructor TElSecureWSocket.Destroy;
begin
  inherited;
  FreeAndNil(FSecureClient);
end;

function TElSecureWSocket.GetOnCertificateChoose: TSBChooseCertificateEvent;
begin
  Result := FSecureClient.OnCertificateChoose;
end;

function TElSecureWSocket.GetOnCertificateNeeded: TSBCertificateNeededEvent;
begin
  Result := FSecureClient.OnCertificateNeeded;
end;

function TElSecureWSocket.GetOnCertificateValidate: TSBCertificateValidateEvent;
begin
  Result := FSecureClient.OnCertificateValidate;
end;

procedure TElSecureWSocket.SetOnCertificateChoose(Value:
  TSBChooseCertificateEvent);
begin
  FSecureClient.OnCertificateChoose := Value;
end;

procedure TElSecureWSocket.SetOnCertificateNeeded(Value:
  TSBCertificateNeededEvent);
begin
  FSecureClient.OnCertificateNeeded := Value;
end;

procedure TElSecureWSocket.SetOnCertificateValidate(Value:
  TSBCertificateValidateEvent);
begin
  FSecureClient.OnCertificateValidate := Value;
end;

function TElSecureWSocket.ClientGetCipherSuite(Index: TSBCipherSuite): Boolean;
begin
  Result := FSecureClient.CipherSuites[Index];
end;

procedure TElSecureWSocket.ClientSetCipherSuite(Index: TSBCipherSuite;
  const Value: Boolean);
begin
  FSecureClient.CipherSuites[Index] := Value;
end;

procedure TElSecureWSocket.DoSSLEstablished;
begin
  if Assigned(FOnSSLEstablished) then
    FOnSSLEstablished(Self, FSecureClient.CurrentVersion, FSecureClient.CipherSuite);
end;

function TElSecureWSocket.GetClientVersion: TSBVersion;
begin
  Result := FSecureClient.CurrentVersion;
end;

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

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

procedure TElSecureWSocket.InternalValidate(var Validity:
  TSBCertificateValidity;
  var Reason: TSBCertificateValidityReason);
begin
  FSecureClient.InternalValidate(Validity, Reason);
end;

function TElSecureWSocket.GetSSLEnabled: Boolean;
begin
  Result := FSecureClient.Enabled;
end;

procedure TElSecureWSocket.SetSSLEnabled(Value: Boolean);
var
  Mtd : pointer;
  FOldSendEvent : TSBSendEvent;
begin
  FSecureClient.Enabled := Value;
  // II 080403
  if Value and (FSecureClient.Active) then
  begin

    Mtd := @TElSecureWSocket.ClientMustOpen;
    if Mtd <> TMethod(FOnSessionConnected).Code then
    begin
      FOldOnSessionConnected := OnSessionConnected;
      FOnSessionConnected := ClientMustOpen;
    end;

    Mtd := @TElSecureWSocket.DataAvailableForClient;
    if Mtd <> TMethod(FOnDataAvailable).Code then
    begin
      FOldOnDataAvailable := OnDataAvailable;
      FOnDataAvailable := DataAvailableForClient;
    end;

    FOldSendEvent := FSecureClient.OnSend;
    FSecureClient.OnSend := nil;
    FSecureClient.Close(true);
    FErrorOccured := false;
    FSecureClient.OnSend := FOldSendEvent;
    FSecureClient.Open;
  end
  else if (not Value) and (FSecureClient.Active) then
  begin
    FSecureClient.Close;
  end;
end;

procedure TElSecureWSocket.NegotiateSSL;
var
  Mtd : pointer;
  FOldSendEvent : TSBSendEvent;
begin
  if FSecureClient.Active then
  begin
    FOldSendEvent := FSecureClient.OnSend;
    FSecureClient.OnSend := nil;
    FSecureClient.Close(true);
    FSecureClient.OnSend := FOldSendEvent;
  end;
  FSecureClient.Enabled := true;        // II
  FSocksConnected := true;
  Mtd := @TElSecureWSocket.ClientMustOpen;
  if Mtd <> TMethod(FOnSessionConnected).Code then
  begin
    FOldOnSessionConnected := OnSessionConnected;
    FOnSessionConnected := ClientMustOpen;
  end;
  Mtd := @TElSecureWSocket.DataAvailableForClient;
  if Mtd <> TMethod(FOnDataAvailable).Code then
  begin
    FOldOnDataAvailable := OnDataAvailable;
    FOnDataAvailable := DataAvailableForClient;
  end;
  FErrorOccured := false;
  FSecureClient.Open;
  FCallOnData := true;
  while (not FSecureClient.Active) and (not FErrorOccured) do
    FSecureClient.DataAvailable;
end;

procedure TElSecureWSocket.HandleSecureClientClose(Sender : TObject; CloseReason :
  TSBCloseReason);
begin
  FErrorOccured := true;
end;

function TElSecureWSocket.GetCipherSuite : TSBCipherSuite;
begin
  if Assigned(FSecureClient) then
    Result := FSecureClient.CipherSuite
  else
    Result := 0;
end;

function TElSecureWSocket.GetCompressionAlgorithm: TSBSSLCompressionAlgorithm;
begin
  Result := FSecureClient.CompressionAlgorithm;
end;

function TElSecureWSocket.GetCompressionAlgorithms(Index:
    TSBSSLCompressionAlgorithm): boolean;
begin
  Result := FSecureClient.CompressionAlgorithms[Index];
end;

function TElSecureWSocket.GetOnCertificateNeededEx: TSBCertificateNeededExEvent;
begin
  Result := FSecureClient.OnCertificateNeededEx;
end;

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

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

function TElSecureWSocket.GetSSLActive: Boolean;
begin
  Result := FSecureClient.Active;
end;

procedure TElSecureWSocket.RenegotiateCiphers;
begin
  FSecureClient.RenegotiateCiphers;
end;

procedure TElSecureWSocket.SetOnCertificateNeededEx(Value:
    TSBCertificateNeededExEvent);
begin
  FSecureClient.OnCertificateNeededEx := Value;
end;

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

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

procedure TElSecureWSocket.SetCompressionAlgorithms(Index:
    TSBSSLCompressionAlgorithm; Value: boolean);
begin
  FSecureClient.CompressionAlgorithms[Index] := Value;
end;

end.