sbicsserversocket.pas

著名的SecureBlackBox控件完整源码

function TElSecureWSocketServer.GetClientCertStorage: TElCustomCertStorage;
begin
  Result := FClientCertStorage;
end;

function TElSecureWSocketServer.GetSessionPool: TElSessionPool;
begin
  Result := FSessionPool;
end;

procedure TElSecureWSocketServer.HandleCiphersNegotiated(Sender : TObject);
begin
  if Assigned(FOnCiphersNegotiated) then
    FOnCiphersNegotiated(Self);
end;

procedure TElSecureWSocketServer.HandleError(Sender : TObject; ErrorCode:
    integer; Fatal: boolean; Remote : boolean);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorCode, Fatal, Remote);
end;

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

procedure TElSecureWSocketServer.SetVersions(Value: TSBVersions);
begin
  FVersions := Value;
end;

procedure TElSecureWSocketServer.SetCertStorage(Value: TElMemoryCertStorage);
begin
  if Value <> FCertStorage then
  begin
    FCertStorage := Value;
    if Value <> nil then
      Value.FreeNotification(Self)
  end;
end;

procedure TElSecureWSocketServer.SetClientCertStorage(Value:
  TElCustomCertStorage);
begin
  if Value <> FClientCertStorage then
  begin
    FClientCertStorage := Value;
    if Value <> nil then
      Value.FreeNotification(Self)
  end;
end;

procedure TElSecureWSocketServer.SetSessionPool(Value: TElSessionPool);
begin
  if Value <> FSessionPool then
  begin
    FSessionPool := Value;
    if Value <> nil then
      Value.FreeNotification(Self)
  end;
end;

procedure TElSecureWSocketServer.Notification(AComponent: TComponent; operation:
  TOperation);
begin
  inherited;
  if (AComponent = FCertStorage) and (Operation = opRemove) then
    SetCertStorage(nil)
  else
    if (AComponent = FSessionPool) and (Operation = opRemove) then
    SetSessionPool(nil)
  else
    if (AComponent = FClientCertStorage) and (Operation = opRemove) then
    SetClientCertStorage(nil);
end;

////////////////////////////////////////////////////////////////////////////////
// TElSecureWSocketClient

constructor TElSecureWSocketClient.Create(AOwner: TComponent);
begin
  inherited;
  FSecureServer := TElSecureServer.Create(nil);
  FSecureServer.OnReceive := HandleReceive;
  FSecureServer.OnSend := HandleSend;
  FSecureServer.OnData := HandleData;
  FSecureServer.OnOpenConnection := HandleOpenConnection;
  FSecureServer.OnCloseConnection := HandleCloseConnection;
  FSecureServer.OnCertificateValidate := HandleCertificateValidate;
  FSecureServer.OnError := HandleError;
  FSecureServer.OnCiphersNegotiated := HandleCiphersNegotiated;

  FConnected := false;
  FErrorOccured := false;
  FAlreadyClosing := false;
end;

destructor TElSecureWSocketClient.Destroy;
begin
  inherited;
  FSecureServer.Free;
end;

procedure TElSecureWSocketClient.HandleReceive(Sender: TObject; Buffer: pointer;
  MaxSize: longint;
  out Written: longint);
begin
  Written := inherited Receive(Buffer, MaxSize);
  if Written <= 0 then Written := 0;
end;

procedure TElSecureWSocketClient.HandleSend(Sender: TObject; Buffer: pointer;
  Size: longint);
var SendPtr : PByte;
    Sent    : integer;
  {$ifdef ICS_V515_OR_ABOVE}
  LastError : integer;
  {$endif}
begin
  SendPtr := PByte(Buffer);
  while Size > 0 do
  begin
//    Sent := inherited Send(SendPtr, Size);
{$ifdef ICS_V515_OR_ABOVE}
    Sent := inherited RealSend(SendPtr, Size);
    if Sent = -1 then
      LastError := WSocket_WSAGetLastError;
{$else}
    Sent := inherited Send(SendPtr, Size);
{$endif}
    if Sent < 0 then
      break;
    dec(Size, Sent);
    inc(SendPtr, Sent);
    if Size > 0 then
      Sleep(50);
  end;
end;

procedure TElSecureWSocketClient.HandleData(Sender: TObject; Buffer: pointer;
  Size: longint);
begin
  if Size <= FRecvMaxSize then
  begin
    Move(Buffer^, FRecvBuffer^, Size);
    FRecvWritten := Size;
  end
  else
  begin
    Move(Buffer^, FRecvBuffer^, FRecvMaxSize);
    FRecvWritten := FRecvMaxSize;
    SetLength(FBuffer, Size - FRecvMaxSize);
    Move(PByteArray(Buffer)[FRecvMaxSize], FBuffer[1], Size - FRecvMaxSize);
  end;
  FDataReceived := True;
  
  if Assigned(FOldOnDataAvailable) then
    FOldOnDataAvailable(Self, 0);
end;

procedure TElSecureWSocketClient.HandleOpenConnection(Sender: TObject);
begin
  FConnected := true;
  FAlreadyClosing := false;
  if FSecureServer.Active then
    DoSSLEstablished;
end;

procedure TElSecureWSocketClient.HandleCloseConnection(Sender: TObject;
  CloseDescription: integer);
begin
  FConnected := false;
  FErrorOccured := true;
end;

procedure TElSecureWSocketClient.HandleCertificateValidate(Sender: TObject;
  X509Certificate: TElX509Certificate; var Validate: boolean);
begin
  if Assigned(FOnCertificateValidate) then
    FOnCertificateValidate(Self, X509Certificate, Self, Validate);
end;

procedure TElSecureWSocketClient.StartConnection;
var
  I: integer;
  HandshakeTimeout : integer;
  HandshakeStart : integer;
begin
  FSecureServer.Enabled := TElSecureWSocketServer(FServer).SSLEnabled;
  for I := SB_SUITE_FIRST to SB_SUITE_LAST do
    FSecureServer.CipherSuites[I] :=
      TElSecureWSocketServer(FServer).FCipherSuites[I];
  FSecureServer.Versions := TElSecureWSocketServer(FServer).FVersions;
  FSecureServer.ClientAuthentication :=
    TElSecureWSocketServer(FServer).ClientAuthentication;
  FSecureServer.CertStorage := TElSecureWSocketServer(FServer).FCertStorage;
  FSecureServer.ClientCertStorage :=
    TElSecureWSocketServer(FServer).FClientCertStorage;
  FSecureServer.SessionPool := TElSecureWSocketServer(FServer).FSessionPool;
  HandshakeTimeout := TElSecureWSocketServer(FServer).HandshakeTimeout;
  FOldOnDataAvailable := OnDataAvailable;
  FOnDataAvailable := DataAvailableForServer;
  FSecureServer.Open;
  if FSecureServer.Enabled then
  begin
    HandshakeStart := GetTickCount;
    while (not FSecureServer.Active) and (not FErrorOccured) do
    begin
      FSecureServer.DataAvailable;
      if (HandshakeTimeout <> 0) and (GetTickCount - HandshakeStart > HandshakeTimeout) then
      begin
        HandleError(Self, ERROR_SSL_TIMEOUT, true, false);
        FErrorOccured := true;
      end;
      MessageLoop();
    end;
    if FErrorOccured then
    begin
      inherited Close;
      Exit;
    end;
  end;
  if (FConnected) and
    (Assigned(TElSecureWSocketServer(FServer).FOldClientConnectHandler)) then
    TElSecureWSocketServer(FServer).FOldClientConnectHandler(FServer, Self, 0);
end;

procedure TElSecureWSocketClient.Close;
begin
  if not FAlreadyClosing then
  begin
    FAlreadyClosing := true;
    if FSecureServer <> nil then
      FSecureServer.Close(true);
    FConnected := false;
    inherited;
  end;
end;

{$ifdef ICS_V515_OR_ABOVE}
function TElSecureWSocketClient.RealSend(Data : Pointer; Len : Integer) : Integer;
begin
  if FSecureServer.Active then
  begin
    FSecureServer.SendData(Data, Len);
    Result := Len;
  end
  else
    Result := inherited RealSend(Data, Len);
end;
{$endif}

function TElSecureWSocketClient.Send(Data: Pointer; Len: Integer): Integer;
begin
{$ifdef ICS_V515_OR_ABOVE}
  result := inherited Send(Data, Len);
{$else}
  FSecureServer.SendData(Data, Len);
  Result := Len;
{$endif}
end;

function
  TElSecureWSocketClient.SendStr({$IFDEF ICS_V508_OR_ABOVE}const{$ENDIF}Str:
  string): Integer;
begin
  FSecureServer.SendText(Str);
  Result := Length(Str);
end;

function TElSecureWSocketClient.Receive(Buffer: Pointer; BufferSize: Integer):
  Integer;
begin

  if (FLineMode and (FLineLength > 0)) or (FRcvdCnt > 0) then
  begin
    result := inherited Receive(Buffer, BufferSize);
    exit;
  end;

  Result := 0;

  // take data from the data buffer if available
  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;

  // try to read more data from the socket, if possible
  if Result < BufferSize then
  begin
    FRecvBuffer := @(PByteArray(Buffer)[Result]);
    FRecvMaxSize := BufferSize - Result;
    FRecvWritten := 0;
    FSecureServer.DataAvailable;
    inc(Result, FRecvWritten);
    FRecvBuffer := nil;
  end;

end;

procedure TElSecureWSocketClient.DataAvailableForServer(Sender: TObject; Error:
  Word);
begin
  FSecureServer.DataAvailable;
end;

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

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

function TElSecureWSocketClient.GetVersions: TSBVersions;
begin
  Result := FSecureServer.Versions;
end;

function TElSecureWSocketClient.GetCipherSuite: TSBCipherSuite;
begin
  Result := FSecureServer.CipherSuite;
end;

function TElSecureWSocketClient.GetVersion: TSBVersion;
begin
  Result := FSecureServer.CurrentVersion;
end;

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

procedure TElSecureWSocketClient.SetVersions(Value: TSBVersions);
begin
  FSecureServer.Versions := Value;
end;

function TElSecureWSocketClient.GetCertStorage: TElMemoryCertStorage;
begin
  Result := FSecureServer.CertStorage;
end;

function TElSecureWSocketClient.GetClientCertStorage: TElCustomCertStorage;
begin
  Result := FSecureServer.ClientCertStorage;
end;

function TElSecureWSocketClient.GetSessionPool: TElSessionPool;
begin
  Result := FSecureServer.SessionPool;
end;

function TElSecureWSocketClient.GetClientAuthentication: boolean;
begin
  Result := FSecureServer.ClientAuthentication;
end;

function TElSecureWSocketClient.GetCompressionAlgorithm:
    TSBSSLCompressionAlgorithm;
begin
  Result := FSecureServer.CompressionAlgorithm;
end;

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

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TElSecureWSocketClient.GetRcvdCount: LongInt;
begin
  result := Length(FBuffer);
  if result = 0 then
    result := inherited GetRcvdCount;
end;

function TElSecureWSocketClient.GetSSLEnabled: Boolean;
begin
  Result := FSecureServer.Enabled;
end;

procedure TElSecureWSocketClient.HandleCiphersNegotiated(Sender : TObject);
begin
  if Assigned(FOnCiphersNegotiated) then
    FOnCiphersNegotiated(Self);
end;

procedure TElSecureWSocketClient.HandleError(Sender : TObject; ErrorCode:
    integer; Fatal: boolean; Remote : boolean);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorCode, Fatal, Remote);
end;

procedure TElSecureWSocketClient.SetCertStorage(Value: TElMemoryCertStorage);
begin
  FSecureServer.CertStorage := Value;
end;

procedure TElSecureWSocketClient.SetClientCertStorage(Value:
  TElCustomCertStorage);
begin
  FSecureServer.ClientCertStorage := Value;
end;

procedure TElSecureWSocketClient.SetSessionPool(Value: TElSessionPool);
begin
  FSecureServer.SessionPool := Value;
end;

procedure TElSecureWSocketClient.SetClientAuthentication(Value: boolean);
begin
  FSecureServer.ClientAuthentication := Value;
end;

procedure TElSecureWSocketClient.InternalValidate(var Validity:
  TSBCertificateValidity;
  var Reason: TSBCertificateValidityReason);
begin
  FSecureServer.InternalValidate(Validity, Reason);
end;

procedure TElSecureWSocketClient.RenegotiateCiphers;
begin
  FSecureServer.RenegotiateCiphers;
end;

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

procedure TElSecureWSocketClient.SetSSLEnabled(Value: Boolean);
begin
  FSecureServer.Enabled := Value;
end;

end.