elmimeviewer_certdetails.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 344 行

// File Version: 2004-02-23
unit ElMimeViewer_CertDetails;
{$hints off}

interface

uses
  {$IFDEF DELPHI_NET}
  System.Text,
  System.Collections,
  System.ComponentModel,
  {$ENDIF}
  Windows, Messages, SysUtils, {$IFDEF D_6_UP}Variants,{$ENDIF} Classes, Graphics, Controls, Forms,
  // ConvertUTF8String:
  {$IFNDEF DELPHI_NET}
  SBChSConv,
  {$ENDIF}
  SBMIMEUtils,
  // BlackBox:
  SBRDN, SBUtils, SBWinCertStorage, SBCustomCertStorage, SBX509, SBX509Ext,
  // VCL units:
  Dialogs, StdCtrls, Grids, ExtCtrls, ComCtrls;

type
  TfraSMIMEViewCert = class(TFrame)
    pages: TPageControl;
    sheetBasic: TTabSheet;
    labelGeneralVerdict: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    labelPrivateKey: TLabel;
    ElPanel1: TPanel;
    ElLabel1: TLabel;
    ElHTMLLabel1: TLabel;
    ElHTMLLabel2: TLabel;
    ElLabel2: TLabel;
    ElLabel3: TLabel;
    ElLabel4: TLabel;
    ElLabel5: TLabel;
    ElLabel6: TLabel;
    ElLabel7: TLabel;
    ElLabel8: TLabel;
    ElLabel10: TLabel;
    ElLabel11: TLabel;
    ElPanel2: TPanel;
    labelSubjectCN: TLabel;
    labelSubjectOrg: TLabel;
    labelSubjectOU: TLabel;
    labelSubjectSN: TLabel;
    labelIssuerCN: TLabel;
    labelIssuerOrg: TLabel;
    labelIssuerOU: TLabel;
    labelValidTo: TLabel;
    labelValidFrom: TLabel;
    eLabel6: TLabel;
    labelEMAIL: TLabel;
  private
    { Private declarations }
    FCert : TElX509Certificate;

    procedure ValidateCertificate(Certificate : TElX509Certificate; var Validity :
        TSBCertificateValidity; var Reason : TSBCertificateValidityReason);
    function GetCertAlgName: string;
    function GetPublicKeyName: string;
    function GetPublicKey: string;
  {$IFNDEF DELPHI_NET}
  private
    Conv: TPlConverter;
  {$ENDIF}
  protected
    function ConvertUTF8String(const Source : AnsiString) : WideString;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetCertificate(
      Certificate : TElX509Certificate;
      Validated : boolean = False;
      Validity : TSBCertificateValidity = cvOK;
      Reason : TSBCertificateValidityReason = []);
    function GetCertificateIssuedToCN( Cert : TElX509Certificate ): WideString;
    function GetCertificateIssuedToE( Cert : TElX509Certificate ): WideString;
  end;

var
  fraSMIMEViewCert: TfraSMIMEViewCert;
resourcestring

  sCertificateContainsPrivateKey = 'Certificate contains private key (also known as Digital ID)';
  sCertificateNotContainsPrivateKey = 'Certificate does NOT contain private key';
  sCertificateValid = 'Certificate is valid';
  sCertificateNotValid = 'Certificate is NOT valid';
  sCertificateFailedToValidate = 'Certificate could not be validated';
  sUnknownCAForCert = 'Certificate was signed by unknown certificate authority';
  sCertificateRevoked = 'Certificate has been revoked';
  sCertificateBadData = 'Certificate contains invalid data';
  sInvalidCertSignature = 'Certificate signature doesn''t correspond to certificate contents';
  sCertNotYetValid = 'Certificate was issued for a later starting date';
  sCertExpired  = 'Certificate has already expired';
  sBit = ' bits';
  sUnknownAlgorithm = 'Unknown algorithm';

implementation

{$R *.dfm}

{ TfraSMIMEViewCert }

function GetOIDValue(NTS : TElRelativeDistinguishedName; S: BufferType): AnsiString;
var SL : {$IFDEF DELPHI_NET}ArrayList{$ELSE}TStringList{$ENDIF};
begin
  SL := {$IFDEF DELPHI_NET}ArrayList{$ELSE}TStringList{$ENDIF}.Create;
  try
    NTS.GetValuesByOID(S, SL);
    if SL.Count >= 1 then
      Result := AnsiString(BufferType(SL[0]))
    else
      SetLength(Result, 0);
  finally
    SL.Free;
  end;
end;

function TfraSMIMEViewCert.GetCertAlgName: string;
begin
  case FCert.SignatureAlgorithm of
    SB_CERT_ALGORITHM_MD2_RSA_ENCRYPTION: Result := 'md2RSA';
    SB_CERT_ALGORITHM_MD5_RSA_ENCRYPTION: Result := 'md5RSA';
    SB_CERT_ALGORITHM_SHA1_RSA_ENCRYPTION: Result := 'sha1RSA';
    SB_CERT_ALGORITHM_ID_DSA_SHA1: Result := 'sha1DSA';
    else
      Result := sUnknownAlgorithm;
  end;
end;

function TfraSMIMEViewCert.GetPublicKey: string;
var
  Modulus : {$IFDEF DELPHI_NET}TBytes{$ELSE}Pointer{$ENDIF};
  ModSize : integer;
begin
  Result := '';
  ModSize := 0;
  {$IFDEF DELPHI_NET}
  Modulus := TBytes(TObject(nil));
  {$ELSE}
  Modulus := nil;
  {$ENDIF}
  FCert.GetPublicKeyBlob(Modulus, ModSize);
  {$IFDEF DELPHI_NET}
  SetLength(Modulus, ModSize);
  {$ELSE}
  GetMem(Modulus, ModSize);
  {$ENDIF}
  FCert.GetPublicKeyBlob(Modulus, ModSize);
  Result := BeautifyBinaryString(BinaryToString(Modulus{$IFNDEF DELPHI_NET}, ModSize{$ENDIF}), ' ');
  {$IFNDEF DELPHI_NET}
  FreeMem(Modulus);
  {$ENDIF}
end;

function TfraSMIMEViewCert.GetPublicKeyName: string;
begin
  Result := '';
  case FCert.PublicKeyAlgorithm of
    SB_CERT_ALGORITHM_ID_RSA_ENCRYPTION: Result := 'RSA';
    SB_CERT_ALGORITHM_ID_DSA: Result := 'DSA';
    SB_CERT_ALGORITHM_DH_PUBLIC: Result := 'DH';
  else
    Result := sUnknownAlgorithm;
  end;
  if result <> '' then
    result := Result + #32 + IntToStr(FCert.GetPublicKeySize) + sBit;
end;

procedure TfraSMIMEViewCert.SetCertificate(Certificate: TElX509Certificate;
  Validated: boolean; Validity: TSBCertificateValidity;
  Reason: TSBCertificateValidityReason);
var B : BufferType;
    S: String;
    W : Word;
begin
  FCert := Certificate;

  pages.ActivePageIndex := 0;

  // fill General, Subject
  labelSubjectCN.Caption := ConvertUTF8String(GetOIDValue(FCert.SubjectRDN, SB_CERT_OID_COMMON_NAME));
  labelSubjectOrg.Caption := ConvertUTF8String(GetOIDValue(FCert.SubjectRDN, SB_CERT_OID_ORGANIZATION));
  labelSubjectOU.Caption := ConvertUTF8String(GetOIDValue(FCert.SubjectRDN, SB_CERT_OID_ORGANIZATION_UNIT));
  B := FCert.SerialNumber;
  labelSubjectSN.Caption := BeautifyBinaryString(BinaryToString({$IFDEF DELPHI_NET}B{$ELSE}@B[1], Length(B){$ENDIF}), ' ');
  labelEMAIL.Caption := ConvertUTF8String(GetOIDValue(FCert.SubjectRDN, SB_CERT_OID_EMAIL));


  // fill General, Issuer
  labelIssuerCN.Caption := ConvertUTF8String(GetOIDValue(FCert.IssuerRDN, SB_CERT_OID_COMMON_NAME));
  labelIssuerOrg.Caption := ConvertUTF8String(GetOIDValue(FCert.IssuerRDN, SB_CERT_OID_ORGANIZATION));
  labelIssuerOU.Caption := ConvertUTF8String(GetOIDValue(FCert.IssuerRDN, SB_CERT_OID_ORGANIZATION_UNIT));

  // fill General, Validity
  labelValidFrom.Caption := DateToStr(FCert.ValidFrom);
  labelValidTo.Caption := DateToStr(FCert.ValidTo);

  if FCert.PrivateKeyExists then
    S := sCertificateContainsPrivateKey
  else
    S := sCertificateNotContainsPrivateKey;

  labelPrivateKey.Caption := S;

  // set Validated/Valid label
  if (not Validated) or (Validity = cvSelfSigned) then
    ValidateCertificate(FCert, Validity, Reason);

  if Validity = cvOK then
    S := sCertificateValid
  else
  if Validity = cvInvalid then
  begin
    if vrBadData in Reason then
      S := sCertificateBadData
    else
    if vrInvalidSignature in Reason then
      s := sInvalidCertSignature
    else
    if vrUnknownCA in Reason then
      S := sUnknownCAForCert
    else
    if vrRevoked in Reason then
      S := sCertificateRevoked
    else
    if vrNotYetValid in Reason then
      S := sCertNotYetValid
    else
    if vrExpired in Reason then
      S := sCertExpired
    else
      S := sCertificateNotValid
  end
  else
  if Validity = cvStorageError then
    S := sCertificateFailedToValidate;

  labelGeneralVerdict.Caption := S;

end;

procedure TfraSMIMEViewCert.ValidateCertificate(
  Certificate: TElX509Certificate;
  var Validity: TSBCertificateValidity;
  var Reason: TSBCertificateValidityReason
);
var
  Storage : TElWinCertStorage;
begin
  if Validity <> cvSelfSigned then
  begin
    Storage := TElWinCertStorage.Create(nil);
    with Storage.SystemStores do
    begin
      Add('ROOT');
      Add('CA');
      Add('MY');
      Add('SPC');
    end;

    try
      Validity := Storage.Validate(Certificate, Reason);
    except
      Validity := cvStorageError;
    end;
    Storage.Free;
  end;

  if Validity = cvSelfSigned then
  begin
    Validity := cvOk;
    Reason := [];
    if not Certificate.Validate then
    begin
      Validity := cvInvalid;
      Reason := [vrInvalidSignature];
    end;
    if (Certificate.ValidFrom > Now) then
    begin
      Reason := Reason + [vrNotYetValid];
      Validity := cvInvalid;
    end;
    if (Certificate.ValidTo < Now) then
    begin
      Reason := Reason + [vrExpired];
      Validity := cvInvalid;
    end;
  end;
end;

constructor TfraSMIMEViewCert.Create(AOwner: TComponent);
begin
  inherited;
  {$IFNDEF DELPHI_NET}
  Conv := TPlConverter.Create('utf-8', 'utf-16');
  {$ENDIF}
end;

destructor TfraSMIMEViewCert.Destroy;
begin
  {$IFNDEF DELPHI_NET}
  Conv.Free;
  {$ENDIF}
  inherited;
end;

function TfraSMIMEViewCert.ConvertUTF8String(const Source: AnsiString): WideString;
{$IFDEF DELPHI_NET}
begin
  Result := System.Text.Encoding.UTF8.GetString(TBytes(Source));
end;
{$ELSE}
var
  sDest: String;
begin
  sDest := '';
  if Length(Source) > 0 then
  begin
    Conv.Convert(Source, sDest, []);
    Result := AnsiStringToByteWideString(sDest);
  end
  else
    Result := '';
end;
{$ENDIF}

function TfraSMIMEViewCert.GetCertificateIssuedToCN(Cert: TElX509Certificate): WideString;
begin
  Result := ConvertUTF8String(GetOIDValue(Cert.SubjectRDN, SB_CERT_OID_COMMON_NAME));
end;

function TfraSMIMEViewCert.GetCertificateIssuedToE( Cert : TElX509Certificate ): WideString;
begin
  Result := ConvertUTF8String(GetOIDValue(Cert.SubjectRDN, SB_CERT_OID_EMAIL));
end;

end.