Ver Mensaje Individual
  #32  
Antiguo 04-10-2023
isnagil isnagil is offline
Miembro
 
Registrado: jun 2010
Posts: 39
Reputación: 0
isnagil Va por buen camino
La función CertOpenStore está declarada así:

Código Delphi [-]
function CertOpenStore(lpszStoreProvider: LPCSTR; dwEncodingType: DWORD;
  hCryptProv: HCRYPTPROV; dwFlags: DWORD; pvPara: Pointer): HCERTSTORE; stdcall; external Crypt32 name 'CertOpenStoreW' delayed;
{$EXTERNALSYM CertOpenStore}

En la unidad System.Net.HttpClient.Win

Al final modificado GetCertStore queda así:

Código Delphi [-]
class function TWinHttpLib.GetCertStore: HCERTSTORE;
procedure AddPFX(path, pass: string);
  const
    CERT_STORE_ADD_USE_EXISTING = 2;
    //Pass = 'LaContraseña';
  var
    pTmpStore: HCERTSTORE;
    pCert: PCERT_CONTEXT;
    DataBlob: CRYPT_BIT_BLOB;
    PFX: TBytes;
  begin
    PFX := TFile.ReadAllBytes(path);

    DataBlob.cbData := Length(PFX);
    DataBlob.pbData := @PFX[0];

    // se lee el pfx en un almacen en memoria
    pTmpStore := PFXImportCertStore(DataBlob, PWideChar(Pass), 0);

    // se copian los certificados al almacen que usa el HttpClient
    pCert := CertEnumCertificatesInStore(pTmpStore, nil);
    while pCert <> nil do
    begin
      if not CertAddCertificateContextToStore(FStore, pCert, CERT_STORE_ADD_USE_EXISTING, nil) then
        RaiseLastOSError;

      pCert := CertEnumCertificatesInStore(pTmpStore, pCert);
    end;

    CertCloseStore(pTmpStore, 0);
  end;

begin
  FLock.Enter;
  try
    if FStore = nil then
    begin
      // almacen temporal en memoria para el HttpClient
      // FStore := CertOpenStore(SZ_CERT_STORE_PROV_MEMORY, 0, 0, 0, nil);
      FStore := CertOpenStore('Memory', 0, 0, 0, nil);

      AddPFX('XXXXXX.pfx', 'XXXXXXX');
      AddPFX('XXXXXX.pfx', 'XXXXX');
    end;

    Result := FStore;
  finally
    FLock.Leave;
  end;
end;

He cambiado DataBlob: CRYPT_DATA_BLOB; por DataBlob: CRYPT_BIT_BLOB; como la otra vez

Y el error lo da en la instrucción FStore := CertOpenStore('Memory', 0, 0, 0, nil);
Responder Con Cita