clcert.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

    end;

    cont := CertGetSubjectCertificateFromStore(hStore,
      PKCS_7_ASN_ENCODING or X509_ASN_ENCODING, ACertificate.Context.pCertInfo);
      
    Result := (cont <> nil);
    
    if Result then
    begin
      CertFreeCertificateContext(cont);
    end;
  finally
    if (hPersistStore <> nil) then
    begin
      CertCloseStore(hPersistStore, 0);
    end;
  end;
end;

function TclCertificateStore.GenerateKey(AContext: HCRYPTPROV; AKeySpec: DWORD): HCRYPTKEY;
var
  flags: DWORD;
begin
  flags := ($400 shl $10) or 1;
  if not CryptGenKey(AContext, AKeySpec, flags, @Result) then
  begin
    raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
  end;
end;

function TclCertificateStore.GenerateSubject(const ASubject: string): TclCryptData;
var
  subjSize: DWORD;
begin
  Result := TclCryptData.Create();
  try
    if not CertStrToName(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
      PChar(ASubject), CERT_X500_NAME_STR, nil, nil, @subjSize, nil) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;
    Result.Allocate(subjSize);

    if not CertStrToName(X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
      PChar(ASubject), CERT_X500_NAME_STR, nil, Result.Data, @subjSize, nil) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;
    Result.Reduce(subjSize);
  except
    Result.Free();
    raise;
  end;
end;

function TclCertificateStore.GenerateCertInfo(ASubject, AIssuer: TclCryptData;
  ASerialNumber: Integer; AValidFrom, AValidTo: TDateTime): TclCertificateInfo;
  function GetCertDate(ADate: TDateTime): TFileTime;
  var
    sDate: TSystemTime;
  begin
    DateTimeToSystemTime(LocalTimeToGlobalTime(ADate), sDate);
    SystemTimeToFileTime(sDate, Result);
  end;
  
begin
  Result := TclCertificateInfo.Create();
  try
    if (ASerialNumber = 0) then
    begin
      ASerialNumber := GetTickCount();
    end;
    Result.Info^.SerialNumber.cbData := SizeOf(ASerialNumber);
    GetMem(Result.Info^.SerialNumber.pbData, Result.Info^.SerialNumber.cbData);
    CopyMemory(Result.Info^.SerialNumber.pbData, @ASerialNumber, Result.Info^.SerialNumber.cbData);

    Result.Info^.NotBefore := GetCertDate(AValidFrom);
    Result.Info^.NotAfter := GetCertDate(AValidTo);

    Result.Info^.Subject.cbData := ASubject.DataSize;
    Result.Info^.Subject.pbData := ASubject.Data;

    Result.Info^.Issuer.cbData := AIssuer.DataSize;
    Result.Info^.Issuer.pbData := AIssuer.Data;
  except
    Result.Free();
    raise;
  end;
end;

function TclCertificateStore.GeneratePublicKeyInfo(AContext: HCRYPTPROV; AKeySpec: DWORD): TclCryptData;
var
  keyInfoSize: DWORD;
begin
  Result := TclCryptData.Create();
  try
    if not CryptExportPublicKeyInfo(AContext, AKeySpec, X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
      nil, @keyInfoSize) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;

    Result.Allocate(keyInfoSize);
    if not CryptExportPublicKeyInfo(AContext, AKeySpec, X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
      PCERT_PUBLIC_KEY_INFO(Result.Data), @keyInfoSize) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;
    Result.Reduce(keyInfoSize);
  except
    Result.Free();
    raise;
  end;
end;

function TclCertificateStore.SignAndEncodeCert(AContext: HCRYPTPROV; AKeySpec: DWORD;
  ACertInfo: TclCertificateInfo): TclCryptData;
var
  encodedSize: DWORD;
begin
  Result := TclCryptData.Create();
  try
    if not CryptSignAndEncodeCertificate(AContext, AKeySpec, X509_ASN_ENCODING, X509_CERT_TO_BE_SIGNED,
      ACertInfo.Info, @ACertInfo.Info^.SignatureAlgorithm, nil, nil, @encodedSize) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;

    Result.Allocate(encodedSize);

    if not CryptSignAndEncodeCertificate(AContext, AKeySpec, X509_ASN_ENCODING, X509_CERT_TO_BE_SIGNED,
      ACertInfo.Info, @ACertInfo.Info^.SignatureAlgorithm, nil, Result.Data, @encodedSize) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;
  except
    Result.Free();
    raise;
  end;
end;

procedure TclCertificateStore.SetCertPrivateKey(const AContainer: string; AKeySpec: DWORD;
  ACertificate: TclCertificate);
var
  info: CRYPT_KEY_PROV_INFO;
begin
  info.pwszContainerName := PWideChar(WideString(AContainer));
  info.pwszProvName := MS_DEF_PROV;
  info.dwProvType := PROV_RSA_FULL;
  info.dwFlags := 0;
  info.cProvParam := 0;
  info.rgProvParam := nil;
  info.dwKeySpec := AKeySpec;
  if not CertSetCertificateContextProperty(ACertificate.Context, CERT_KEY_PROV_INFO_PROP_ID,
    0, @info) then
  begin
    raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
  end;
end;

function TclCertificateStore.AddSelfSigned(const ASubject: string;
  ASerialNumber: Integer; AValidFrom, AValidTo: TDateTime): TclCertificate;
var
  context: HCRYPTPROV;
  key: HCRYPTKEY;
  container: string;
  subj, keyInfo, encodedCert: TclCryptData;
  certInfo: TclCertificateInfo;
  keySpec: DWORD;
  //TODO cc: TclCertificate;
begin
  keySpec := AT_KEYEXCHANGE {TODO or AT_SIGNATURE};
  context := 0;
  key := 0;
  subj := nil;
  certInfo := nil;
  keyInfo := nil;
  encodedCert := nil;
  Result := nil;
  try
    container := IntToStr(GetTickCount());
    if not CryptAcquireContext(@context, PChar(container), MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;

    key := GenerateKey(context, keySpec);
    subj := GenerateSubject(ASubject);
    certInfo := GenerateCertInfo(subj, subj, ASerialNumber, AValidFrom, AValidTo);

    {TODO
    cc := CertificateByEmail('[e-mail]');

    certInfo.Info^.Issuer.cbData := cc.Context.pCertInfo.Subject.cbData;
    certInfo.Info^.Issuer.pbData := cc.Context.pCertInfo.Subject.pbData;
    }
    
    keyInfo := GeneratePublicKeyInfo(context, keySpec);
    certInfo.Info^.SubjectPublicKeyInfo := PCERT_PUBLIC_KEY_INFO(keyInfo.Data)^;
    encodedCert := SignAndEncodeCert(context, keySpec, certInfo);

    Result := TclCertificate.CreateFromBinary(encodedCert.Data, encodedCert.DataSize);
    try
      SetCertPrivateKey(container, keySpec, Result);
    except
      Result.Free();
      raise;
    end;
    Add(Result);
  finally
    encodedCert.Free();
    keyInfo.Free();
    certInfo.Free();
    subj.Free();
    if (key <> 0) then
    begin
      CryptDestroyKey(key);
    end;
    if (context <> 0) then
    begin
      CryptReleaseContext(context, 0);
    end;
  end;
end;

procedure TclCertificateStore.ExportToPFX(ACertificate: TclCertificate;
  const AFileName, APassword: string; AExportPrivateKey: Boolean);
var
  i: Integer;
  hStore: HCERTSTORE;
  pfxBlob: CRYPT_DATA_BLOB;
  pfx: TclCryptData;
  psw: PWideChar;
  flags: DWORD;
  stream: TStream;
begin
  hStore := nil;
  pfx := nil;
  stream := nil;
  try
    hStore := CertOpenStore(CERT_STORE_PROV_MEMORY, 0, 0, 0, nil);
    if (hStore = nil) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;

    if (ACertificate <> nil) then
    begin
      if not CertAddCertificateContextToStore(hStore, ACertificate.Context, CERT_STORE_ADD_NEW, nil) then
      begin
        raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
      end;
    end else
    begin
      for i := 0 to Count - 1 do
      begin
        if not CertAddCertificateContextToStore(hStore, Items[i].Context, CERT_STORE_ADD_NEW, nil) then
        begin
          raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
        end;
      end;
    end;

    pfx := TclCryptData.Create();
    stream := TFileStream.Create(AFileName, fmCreate);
      
    flags := 0;
    if AExportPrivateKey then
    begin
      flags := flags or EXPORT_PRIVATE_KEYS;
    end;

    pfxBlob.cbData := 0;
    pfxBlob.pbData := nil;
    psw := PWideChar(WideString(APassword));
    if not PFXExportCertStoreEx(hStore, @pfxBlob, psw, nil, flags) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;

    pfx.Allocate(pfxBlob.cbData);
    pfxBlob.pbData := pfx.Data;
    if not PFXExportCertStoreEx(hStore, @pfxBlob, psw, nil, flags) then
    begin
      raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
    end;
    pfx.Reduce(pfxBlob.cbData);

    stream.Write(pfx.Data^, pfx.DataSize);
  finally
    stream.Free();
    pfx.Free();
    CertCloseStore(hStore, 0);
  end;
end;

function TclCertificateStore.AddFrom(ACertificate: TclCertificate): TclCertificate;
begin
  Result := TclCertificate.Create(ACertificate.Context);
  Add(Result);
end;

procedure TclCertificateStore.Remove(ACertificate: TclCertificate);
begin
  Delete(FList.IndexOf(ACertificate));
end;

function TclCertificateStore.Encrypt(const AData: TclCryptData): TclCryptData;
var
  i: Integer;
  encryptPara: CRYPT_ENCRYPT_MESSAGE_PARA;
  cbEncrypted: DWORD;
  gpRecipientCerts: PCCERT_CONTEXT;
  p: ^PCCERT_CONTEXT;
begin
{$IFDEF LOGGER}try clPutLogMessage(Self, edEnter, 'Encrypt');{$ENDIF}
  Result := TclCryptData.Create();
  try
    ZeroMemory(@encryptPara, SizeOf(encryptPara));
    encryptPara.cbSize := SizeOf(encryptPara);
    encryptPara.dwMsgEncodingType := (X509_ASN_ENCODING or PKCS_7_ASN_ENCODING);
    encryptPara.ContentEncryptionAlgorithm.pszObjId := szOID_RSA_RC2CBC;

    GetMem(gpRecipientCerts, SizeOf(PCCERT_CONTEXT) * Count);
    try
      for i := 0 to Count - 1 do
      begin
        p := Pointer(Integer(gpRecipientCerts) + SizeOf(PCCERT_CONTEXT) * i);
        p^ := Items[i].Context;
      end;

      cbEncrypted := 0;
      if CryptEncryptMessage(@encryptPara, Count, gpRecipientCerts, AData.Data, AData.DataSize, nil, @cbEncrypted) then
      begin
        Result.Allocate(cbEncrypted);
        if CryptEncryptMessage(@encryptPara, Count, gpRecipientCerts, AData.Data, AData.DataSize, Result.Data, @cbEncrypted) then
        begin
          Result.Reduce(cbEncrypted);
          Exit;
        end;
      end;
    finally
      FreeMem(gpRecipientCerts);
    end;

    raise EclCryptError.Create(TclCertificate.GetLastErrorText(), GetLastError());
  except
    Result.Free();
    raise;
  end;
{$IFDEF LOGGER}clPutLogMessage(Self, edLeave, 'Encrypt'); except on E: Exception do begin clPutLogMessage(Self, edLeave, 'Encrypt', E); raise; end; end;{$ENDIF}
end;

{ TclCertificateInfo }

constructor TclCertificateInfo.Create;
begin
  inherited Create();
  FInfo.SerialNumber.pbData := nil;
  FInfo.dwVersion := CERT_V3;
  FInfo.SignatureAlgorithm.pszObjId  := szOID_RSA_SHA1RSA;
  FInfo.SignatureAlgorithm.Parameters.cbData := 0;
  FInfo.cExtension := 0;
  FInfo.rgExtension := nil;
  FInfo.IssuerUniqueId.cbData := 0;
  FInfo.SubjectUniqueId.cbData := 0;
end;

destructor TclCertificateInfo.Destroy;
begin
  FreeMem(FInfo.SerialNumber.pbData);
  inherited Destroy();
end;

function TclCertificateInfo.GetInfo: PCERT_INFO;
begin
  Result := @FInfo;
end;

{ EclCryptError }

constructor EclCryptError.Create(const AErrorMsg: string; AErrorCode: Integer);
begin
  inherited Create(AErrorMsg);
  FErrorCode := AErrorCode;
end;

end.