Certificate informations (Win only)

Share your advanced PureBasic knowledge/code with the community.
infratec
Always Here
Always Here
Posts: 7620
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Certificate informations (Win only)

Post by infratec »

Hi,

since I helped a bit in Coding questions, I extended the code and made a pbi with a procedure GetChainCert()
Additional I added the informations about not before and not after.

Works with x86 and x64

Save it as GetCertChain.pbi

Code: Select all

;
; GetCertChain by infratec
;
; https://www.purebasic.fr/english/viewtopic.php?f=12&t=71727&p=528937
;
; V0.03
; - works now also with 64 bit
;
; V0.02
; - before and after times are now also with day time
;
; V0.01
; - first release 32 bit only
;


CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf


CompilerIf Not Defined(INTERNET_FLAG_RELOAD, #PB_Constant)
  #INTERNET_FLAG_RELOAD = $80000000
CompilerEndIf

CompilerIf Not Defined(INTERNET_OPTION_SECURITY_FLAGS, #PB_Constant)
  #INTERNET_OPTION_SECURITY_FLAGS = 31
CompilerEndIf

CompilerIf Not Defined(INTERNET_OPTION_SERVER_CERT_CHAIN_CONTEXT, #PB_Constant)
  #INTERNET_OPTION_SERVER_CERT_CHAIN_CONTEXT = 105
CompilerEndIf

CompilerIf Not Defined(SECURITY_FLAG_IGNORE_UNKNOWN_CA, #PB_Constant)
  #SECURITY_FLAG_IGNORE_UNKNOWN_CA = $100
CompilerEndIf

CompilerIf Not Defined(CERT_NAME_SIMPLE_DISPLAY_TYPE, #PB_Constant)
  #CERT_NAME_SIMPLE_DISPLAY_TYPE = 4
CompilerEndIf

CompilerIf Not Defined(CERT_NAME_ISSUER_FLAG, #PB_Constant)
  #CERT_NAME_ISSUER_FLAG = $00000001
CompilerEndIf


CompilerIf Not Defined(CRYPT_ALGORITHM_IDENTIFIER, #PB_Structure)
  Structure CRYPTOAPI_BLOB Align #PB_Structure_AlignC
    cbData.l
    *mut
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CRYPT_ALGORITHM_IDENTIFIER, #PB_Structure)
  Structure CRYPT_ALGORITHM_IDENTIFIER Align #PB_Structure_AlignC
    *pszObjId
    Parameters.CRYPTOAPI_BLOB
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CERT_PUBLIC_KEY_INFO, #PB_Structure)
  Structure CERT_PUBLIC_KEY_INFO Align #PB_Structure_AlignC
    Algorithm.CRYPT_ALGORITHM_IDENTIFIER
    *PublicKey
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CERT_INFO, #PB_Structure)
  Structure CERT_INFO Align #PB_Structure_AlignC
    dwVersion.l
    SerialNumber.CRYPTOAPI_BLOB
    SignatureAlgorithm.CRYPT_ALGORITHM_IDENTIFIER
    Issuer.CRYPTOAPI_BLOB
    NotBefore.FILETIME
    NotAfter.FILETIME
    *Subject
    SubjectPublicKeyInfo.CERT_PUBLIC_KEY_INFO
    *IssuerUniqueId
    *SubjectUniqueId
    cExtension.l
    *rgExtension
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CERT_CONTEXT, #PB_Structure)
  Structure CERT_CONTEXT Align #PB_Structure_AlignC
    dwCertEncodingType.l
    *pbCertEncoded.Byte
    cbCertEncoded.l
    *CertInfo.CERT_INFO
    HCERTSTORE.l
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CERT_TRUST_STATUS, #PB_Structure)
  Structure CERT_TRUST_STATUS Align #PB_Structure_AlignC
    dwErrorStatus.l
    dwInfoStatus.l
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CERT_CHAIN_ELEMENT, #PB_Structure)
  Structure CERT_CHAIN_ELEMENT Align #PB_Structure_AlignC
    cbSize.l
    *CertContext.CERT_CONTEXT
    TrustStatus.CERT_TRUST_STATUS
    *RevocationInfo.CERT_REVOCATION_INFO
    *IssuanceUsage.CERT_ENHKEY_USAGE
    *ApplicationUsage.CERT_ENHKEY_USAGE
    *ExtendedErrorInfo
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CERT_SIMPLE_CHAIN, #PB_Structure)
  Structure CERT_SIMPLE_CHAIN Align #PB_Structure_AlignC
    cbSize.l
    TrustStatus.CERT_TRUST_STATUS
    cElement.l
    *rgpElement.CERT_CHAIN_ELEMENT[0]
    *TrustListInfo.CERT_TRUST_LIST_INFO
    fHasRevocationFreshnessTime.l
    dwRevocationFreshnessTime.l
  EndStructure
CompilerEndIf

CompilerIf Not Defined(CERT_CHAIN_CONTEXT, #PB_Structure)
  Structure CERT_CHAIN_CONTEXT Align #PB_Structure_AlignC
    cbSize.l
    TrustStatus.CERT_TRUST_STATUS
    cChain.l
    *rgpChain.CERT_SIMPLE_CHAIN[0]
    cLowerQualityChainContext.l
    *rgpLowerQualityChainContext.CERT_CHAIN_CONTEXT
    fHasRevocationFreshnessTime.l
    dwRevocationFreshnessTime.l
    dwCreateFlags.l
    ChainId.GUID
  EndStructure
CompilerEndIf


Structure GetCertChain_Structure
  ChainNo.i
  ChainIndex.i
  NotBefore.q
  NotAfter.q
  Certificate$
  Issuer$
EndStructure



CompilerIf Not Defined(CertGetNameString, #PB_Procedure)
  Prototype.l Proto_CertGetNameString(*CertContext.CERT_CONTEXT, dwType.l, dwFlags.l, *pvTypePara, *NameString, cchNameString.l)
  Global CertGetNameString.Proto_CertGetNameString
CompilerEndIf

CompilerIf Not Defined(CertFreeCertificateChain, #PB_Procedure)
  Prototype Proto_CertFreeCertificateChain(*ChainContext.CERT_CHAIN_CONTEXT)
  Global CertFreeCertificateChain.Proto_CertFreeCertificateChain
CompilerEndIf


Procedure.i GetCertChain(URL$, List CertChainList.GetCertChain_Structure())
 
  Protected Result.i
  Protected *CertCtx.CERT_CHAIN_CONTEXT
  Protected *ChainContext.CERT_CHAIN_CONTEXT
  Protected *simpleCertificateChainWithinContext.CERT_SIMPLE_CHAIN
  Protected *CertContext.CERT_CONTEXT
  Protected.i i, simpleCertChainIndex
  Protected.l Bytes, hInet, dwFlags, hConnect, hRequest, dwContext, cbCertSize
  Protected *SimpleChain.CERT_CHAIN_ELEMENT
  Protected *NameString
  Protected SysTime.Systemtime
  Protected Lib.i
  
 
  ClearList(CertChainList())
 
  Result = #True
 
  If CertGetNameString = #Null Or CertFreeCertificateChain = #Null
    Lib = OpenLibrary(#PB_Any, "crypt32.dll")
    If Lib
      CertGetNameString = GetFunction(Lib, "CertGetNameStringW")
      CertFreeCertificateChain = GetFunction(Lib, "CertFreeCertificateChain")
    Else
      Result = #False
    EndIf
  EndIf
 
  If Result
   
    Result = #False
   
    hInet = InternetOpen_("", 0, #Null, #Null, 0)
    If hInet
     
      hConnect = InternetConnect_(hInet, URL$, #INTERNET_DEFAULT_HTTPS_PORT, #Null, #Null, #INTERNET_SERVICE_HTTP, 0,  @dwContext)
      If hConnect
       
        hRequest = HttpOpenRequest_(hConnect, "GET", "/", #Null, #Null, #Null, #INTERNET_FLAG_SECURE, @dwContext)
        If hRequest
         
          If HttpSendRequest_(hRequest, #Null, 0, #Null, 0)
           
            cbCertSize = SizeOf(CERT_CHAIN_CONTEXT)
           
            If InternetQueryOption_(hRequest, #INTERNET_OPTION_SERVER_CERT_CHAIN_CONTEXT , @*CertCtx, @cbCertSize)
             
              *ChainContext = *CertCtx
             
              For i = 0 To *ChainContext\cChain - 1
               
                *simpleCertificateChainWithinContext = PeekL(*ChainContext\rgpChain + i * SizeOf(Integer))
               
                ;                 Debug "ChainElements: " + Str(*simpleCertificateChainWithinContext\cElement)
               
                ; For each certificate chain in this context...
                For simpleCertChainIndex = 0 To *simpleCertificateChainWithinContext\cElement - 1
                 
                  AddElement(CertChainList())
                  CertChainList()\ChainNo = i + 1
                  CertChainList()\ChainIndex = simpleCertChainIndex + 1
                 
                  ; get the CertContext from the Array
                  *SimpleChain = PeekL(*simpleCertificateChainWithinContext\rgpElement + simpleCertChainIndex * SizeOf(Integer))
                  *CertContext = *SimpleChain\CertContext
                  
                  If FileTimeToSystemTime_(*CertContext\CertInfo\NotBefore, @SysTime)
                    CertChainList()\NotBefore = Date(SysTime\wYear, SysTime\wMonth, SysTime\wDay, SysTime\wHour, SysTime\wMinute, SysTime\wSecond)
                  EndIf
                 
                  If FileTimeToSystemTime_(*CertContext\CertInfo\NotAfter, @SysTime)
                    CertChainList()\NotAfter = Date(SysTime\wYear, SysTime\wMonth, SysTime\wDay, SysTime\wHour, SysTime\wMinute, SysTime\wSecond)
                  EndIf
                 
                  ;-------------------------------------------------------------------
                  ; Find And print the name of the subject of the certificate
                  ; just retrieved.
                  *NameString = AllocateMemory(128)
                  If *NameString
                    If CertGetNameString(*CertContext, #CERT_NAME_SIMPLE_DISPLAY_TYPE, 0, #Null, *NameString, 128)
                      CertChainList()\Certificate$ = PeekS(*NameString)
                    Else
                      Debug "CertGetName failed."
                    EndIf
                    FreeMemory(*NameString)
                  EndIf
                 
                  ; Get the issuer now...
                  *NameString = AllocateMemory(128)
                  If *NameString
                    If CertGetNameString(*CertContext, #CERT_NAME_SIMPLE_DISPLAY_TYPE, #CERT_NAME_ISSUER_FLAG, #Null, *NameString, 128)
                      CertChainList()\Issuer$ = PeekS(*NameString)
                    Else
                      Debug "CertGetName failed."
                    EndIf
                    FreeMemory(*NameString)
                  EndIf
                 
                Next simpleCertChainIndex
               
              Next i
             
              CertFreeCertificateChain(*CertCtx)
             
            Else
              Debug "InternetQueryOption Error: " + Str(GetLastError_())
            EndIf
          Else
            Debug "HTTPSendRequest Error: " + Str(GetLastError_())
          EndIf
        Else
          Debug "HttpOpenRequest Error: " + Str(GetLastError_())
        EndIf
      Else
        Debug "InternetConnect Error: " + Str(GetLastError_())
      EndIf
    Else
      Debug "InternetOpen Error: " + Str(GetLastError_())
    EndIf
   
  EndIf
 
  ProcedureReturn ListSize(CertChainList())
 
EndProcedure




CompilerIf #PB_Compiler_IsMainFile
 
  NewList CertChainList.GetCertChain_Structure()
 
  If GetCertChain("www.purebasic.fr", CertChainList())
    ForEach CertChainList()
      Debug "Chain " + Str(CertChainList()\ChainNo) + "." + Str(CertChainList()\ChainIndex)
      Debug CertChainList()\Certificate$
      Debug CertChainList()\Issuer$
      Debug "Valid from " + FormatDate("%dd.%mm.%yyyy %hh:%ii:%ss", CertChainList()\NotBefore) + " To " + FormatDate("%dd.%mm.%yyyy %hh:%ii:%ss", CertChainList()\NotAfter)
      Debug ""
    Next
  EndIf
 
CompilerEndIf
Bernd
Last edited by infratec on Tue Feb 18, 2020 4:22 pm, edited 2 times in total.
infratec
Always Here
Always Here
Posts: 7620
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Certificate informations (Win only)

Post by infratec »

V0.02
before and after times are now also with day time

Now you can replace your certificate at the correct second :mrgreen:
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Certificate informations (Win only)

Post by Kwai chang caine »

Hello INFRATEC :D
I not understand all about this subject (Not only this one anyway, you can say to me :mrgreen: ) :oops:
But apparently, that works W10 x64 / v5.62 x86
Chain 1.1
purebasic.com
Let's Encrypt Authority X3
Valid from 23.09.2018 21:00:34 To 22.12.2018 21:00:34

Chain 1.2
Let's Encrypt Authority X3
DST Root CA X3
Valid from 17.03.2016 16:40:46 To 17.03.2021 16:40:46

Chain 1.3
DST Root CA X3
DST Root CA X3
Valid from 30.09.2000 21:12:19 To 30.09.2021 14:01:15
Thanks a lot for sharing 8)
ImageThe happiness is a road...
Not a destination
infratec
Always Here
Always Here
Posts: 7620
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Certificate informations (Win only)

Post by infratec »

V0.03 works now also with PB x64 :mrgreen:
Post Reply