CA autoenrollment

On Error Resume Next
Dim currentDirectory,Certreq
Certreq = "certreq.exe"
currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
''' Don't change belows this line unless you know what you doing
''' =============================================================================
'''CAPICOM_KEY_LOCATION Enumeration
Const CAPICOM_CURRENT_USER_KEY  = 0   'The key is a user key.
Const CAPICOM_LOCAL_MACHINE_KEY = 1   'The key is a machine key.
Const HKEY_CLASSES_ROOT = &H80000000
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

OS = Get_OS(objWMIService)
OS_Type = Get_OS_TYPE(objWMIService)
If ( instr(UCase(OS),UCase("Windows 7")) <> 0 ) and (OS_Type="x64")Then
  Script_Engine_Arch = Wscript_Engine
  If (Script_Engine_Arch = "x86") or (ElevationCheck = False) Then
     Set objShell = CreateObject( "WScript.Shell" )
      WINDIR=objShell.ExpandEnvironmentStrings("%windir%")
      colScriptBase_Engine = Split(Wscript.FullName,"\")
      objScriptEngine = colScriptBase_Engine(UBound(colScriptBase_Engine))
      x64ScriptEngine = WINDIR & "\SysWOW64\" & objScriptEngine
     Set objelevate = CreateObject("Shell.Application")
      objelevate.ShellExecute x64ScriptEngine , Chr(34) & Wscript.ScriptFullName & Chr(34) ,"","runas",1
  Else
     Main
  End If
End If


Sub Main()
  UserInfo=Inputbox("Please enter windows AD account for generating CA configuration file!","CA conf generator")
  If len(UserInfo) <> 6 Then
    Msgbox "Invalid Windows AD ccount",vbCritical+vbOkOnly,"Critical Error"
    Wscript.Quit
  Else
    GetUserInfo UserInfo
  End If
  SetupConf Config, "[Version]"
  SetupConf Config, "Signature=""$Windows NT$"""
  SetupConf Config, ""
  SetupConf Config, "[NewRequest]"
  SetupConf Config, "Subject=""" & UserInfo & """"
  SetupConf Config, "ProviderName=""Microsoft Enhanced RSA and AES Cryptographic Provider"""
  SetupConf Config, "ProviderType=24"
  SetupConf Config, "KeyLength=1024"
  SetupConf Config, "Exportable=True"
  'SetupConf Config, "Exportable=False"
  SetupConf Config, "KeySpec=1"
  SetupConf Config, "KeyUsage=0xf0 "
  'SetupConf Config, "MachineKeySet=False"
  SetupConf Config, "MachineKeySet=True"
  SetupConf Config, "SMIME=True"
  SetupConf Config, "RequestType=CMC"
  SetupConf Config, ""
  SetupConf Config, "[EnhancedKeyUsageExtension]"
  SetupConf Config, "OID=1.3.6.1.5.5.7.3.2"
  SetupConf Config, ""
  SetupConf Config, "[RequestAttributes]"
  ExportConfigFile Config
  SubmitCAREQ
End Sub

Sub GetUserInfo (ByRef rtnString)
  On Error Resume Next
  Set WshShell = CreateObject("Wscript.Shell")
  Set WshSysEnv = WshShell.Environment("PROCESS")
  'sUserName=WshSysEnv("USERNAME")
  sUserName=rtnString
  Set rootDSE = GetObject("LDAP://RootDSE")
  DomainContainer = rootDSE.Get("defaultNamingContext")
  Set conn = CreateObject("ADODB.Connection")
  conn.Provider = "ADSDSOObject"
  conn.Open "ADs Provider"
  ldapStr = ";(&(objectCategory=person)(objectClass=user)(sAMAccountName=" & sUserName & "));cn,mail,department,physicalDeliveryOfficeName;subtree"
  Set rs = conn.Execute(ldapStr)
    If rs.RecordCount <> 1 Then
      Msgbox "System Error,cannot find user info on AD system",vbCritical + vbYesOnly,"System error"
    Wscript.Quit 1
  End If
  Company = "XXXXXX"
  If Trim("Santa Clara") = Trim(rs.Fields("physicalDeliveryOfficeName")) Then
    Company = "XXXXXXX"
  End If
  Select Case UCase(rs.Fields("physicalDeliveryOfficeName"))
   Case UCase("TX")
     Company = "TX"
     State = "TX"
   Case UCase("VT")
     Company = "VT"
     State = "VT"
   Case UCase("US")
     Company = "US"
     State = "CA"
  End Select
rtnString =  "E=" & rs.Fields("mail") &_
             ",CN=" & rs.Fields("cn") &_
             ",OU=" & rs.Fields("department") &_
             ",O=" & Company &_
             ",L=" & rs.Fields("physicalDeliveryOfficeName") &_
             ",S=" & State &_
             ",C=US"
End Sub
Sub SetupConf (ByRef Configuration, Value)
  Configuration = Configuration & Value & vbCrLf
End Sub
Sub ExportConfigFile(Content)
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  ScriptPath = Left(WScript.ScriptFullName,Len(WScript.ScriptFullName) - Len(WScript.ScriptName))
  Config_Name = "MyCA.inf"
  Set objTextOutStream = objFSO.CreateTextFile(ScriptPath & Config_Name)
  objTextOutStream.Write Content
  objTextOutStream.Close
End Sub
Sub SubmitCAREQ()
  On Error Resume Next
  Set WshShell = CreateObject("Wscript.Shell")
  CertSVR = "FQDN_OF_CA_SERVER\CANAME"
  WshShell.Exec("%ComSpec% /c certreq -New -f " & chr(34) & currentDirectory & "MyCA.inf" & chr(34) & " " & chr(34) & currentDirectory & "MyCA.req" & chr(34)).StdOut.ReadAll
  rtnValue = WshShell.Exec("%ComSpec% /c certreq -Submit -f -config " & CertSVR & " " & chr(34) & currentDirectory & "MyCA.req" &chr(34)).StdOut.ReadAll
  RequestId = Split(rtnValue,vbCrLf)
  If UBound(RequestId) > 2 Then
    DeleteUnusedFiles
    Msgbox "CA request has been sent to Server" & vbCrLf &_
                 "Your Request ID is [" & Trim(Replace(RequestId(1),"RequestId:","")) & "]", vbYesOnly+vbInformation, "NAP-VPN CA apply assistant" 
  Else
    Msgbox "Fail to submit CA request to server" & vbCrLf & "Error info: " & Err.Description,vbYesOnly+vbCritical, "NAP-VPN CA apply assistant"
    Wscript.Quit 1
  End If
End Sub
Sub DeleteUnusedFiles()
  On Error Resume Next
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Config_Name = "MyCA.inf"
  REQ_Name = "MyCA.req"
  objFSO.DeleteFile currentDirectory  & Config_Name
  objFSO.DeleteFile currentDirectory  & REQ_Name
End Sub

Function Get_OS(ByRef objWMIService)
  Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
  For Each objItem in colItems
    Get_OS = objItem.Caption
  Next
  Set colItems = Nothing
End Function
Function Get_OS_TYPE(ByRef objWMIService)
  Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
  For Each objItem in colItems
    If instr( objItem.SystemType,"64") <> 0 Then
      Get_OS_TYPE = "x64"
    Else
      Get_OS_TYPE = "x86"
    End If
  Next
  Set colItems = Nothing
End Function
Function Wscript_Engine()
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set SystemDirectory = objFSO.GetSpecialFolder(1)
  If Instr(UCase(Wscript.FullName),UCase(SystemDirectory)) <> 0 Then
    Wscript_Engine = "x86"
  Else
    Wscript_Engine = "x64"
  End If
End Function
Function ElevationCheck 'test whether user has elevated token 
  Dim oShell, oExecWhoami, oWhoamiOutput, strWhoamiOutput, boolHasElevatedToken
  Set oShell = CreateObject("WScript.Shell")
  Set oExecWhoami = oShell.Exec("whoami /groups")
  Set oWhoamiOutput = oExecWhoami.StdOut
  strWhoamiOutput = oWhoamiOutput.ReadAll
  If InStr(1, strWhoamiOutput, "S-1-16-12288", vbTextCompare) Then boolHasElevatedToken = True
  If boolHasElevatedToken Then
    ElevationCheck = True
  Else
    ElevationCheck = False
  End If
End Function


-----------------------------------------------------------------------------------------------------------------------------export

'Option Explicit
'On Error Resume next
'Dim SubjectName
Dim Store, Certificates, Certificate, SavePath, SaveExt, CertNumCounter, PrivateKeyPassword, PK, Uflag, RequestID
Dim objCertStore, objCert, currentDirectory, fso, folder, files, fileIdx, Answer1, Answer2, LatestCertificate
UFlag=false
'''CAPICOM_STORE_LOCATION Enumeration
Const CAPICOM_MEMORY_STORE                = 0   'The store is a memory store. Any changes in the contents of the store are not persisted.
Const CAPICOM_LOCAL_MACHINE_STORE         = 1   'The store is a local machine store.
Const CAPICOM_CURRENT_USER_STORE          = 2   'The store is a current user store.
Const CAPICOM_ACTIVE_DIRECTORY_USER_STORE = 3   'The store is an Active Directory store.
Const CAPICOM_SMART_CARD_USER_STORE       = 4   'Stores support smart cardased certificate stores.
'''CAPICOM_CERTIFICATE_FIND_TYPE Enumeration
Const CAPICOM_CERTIFICATE_FIND_SHA1_HASH    = 0   'Returns certificates matching a specified SHA1 hash.
Const CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME = 1   'Returns certificates whose subject name exactly or partially matches.      
Const CAPICOM_CERTIFICATE_FIND_ISSUER_NAME  = 2   'Returns certificates whose issuer name exactly or partially matches.
Const CAPICOM_CERTIFICATE_FIND_ROOT_NAME    = 3   'Returns certificates whose root subject name exactly or partially matches.
'''CAPICOM_STORE_OPEN_MODE Enumeration
Const CAPICOM_STORE_OPEN_READ_ONLY        = 0   'Open the store in read-only mode.
Const CAPICOM_STORE_OPEN_READ_WRITE       = 1   'Open the store in read/write mode.
Const CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED  = 2   'Open the store in read/write mode if the user has read/write permissions.
Const CAPICOM_STORE_OPEN_EXISTING_ONLY    = 128 'Open existing stores only; do not create a new store. Introduced by CAPICOM 2.0.
Const CAPICOM_STORE_OPEN_INCLUDE_ARCHIVED = 256 'Include archived certificates when using the store. Introduced by CAPICOM 2.0.
'''CAPICOM_CERTIFICATE_SAVE_AS_TYPE Enumeration
Const CAPICOM_CERTIFICATE_SAVE_AS_PFX = 0   'The output file will be formatted as a PFX (PKCS 12) file and any associated private keys.
Const CAPICOM_CERTIFICATE_SAVE_AS_CER = 1   'The output file will be formatted as a CER file with no private keys saved.
'''CAPICOM_CERTIFICATE_INCLUDE_OPTION Enumeration
Const CAPICOM_CERTIFICATE_INCLUDE_CHAIN_EXCEPT_ROOT = 0   'Saves all certificates in the chain with the exception of the root entity.
Const CAPICOM_CERTIFICATE_INCLUDE_WHOLE_CHAIN       = 1   'Saves the complete certificate chain.
Const CAPICOM_CERTIFICATE_INCLUDE_END_ENTITY_ONLY   = 2   'Saves only the end entity certificate.
'''CAPICOM_KEY_STORAGE_FLAG Enumeration
Const CAPICOM_KEY_STORAGE_DEFAULT        = 0   'Default key storage.
Const CAPICOM_KEY_STORAGE_EXPORTABLE     = 1   'The key is exportable.
Const CAPICOM_KEY_STORAGE_USER_PROTECTED = 2   'The key is user protected.
'''CAPICOM_KEY_LOCATION Enumeration
Const CAPICOM_CURRENT_USER_KEY  = 0   'The key is a user key.
Const CAPICOM_LOCAL_MACHINE_KEY = 1   'The key is a machine key.
Const HKEY_CLASSES_ROOT = &H80000000
Const ConfigStr = "FQDN_OF_CA\CANAME"
Const CertReq = "certreq.exe"
currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
OS = Get_OS(objWMIService)
OS_Type = Get_OS_TYPE(objWMIService)
If ( instr(UCase(OS),UCase("Windows 7")) <> 0 ) and (OS_Type="x64")Then
  Script_Engine_Arch = Wscript_Engine
  If (Script_Engine_Arch = "x86") or (ElevationCheck = False) Then
     Set objShell = CreateObject( "WScript.Shell" )
      WINDIR=objShell.ExpandEnvironmentStrings("%windir%")
      colScriptBase_Engine = Split(Wscript.FullName,"\")
      objScriptEngine = colScriptBase_Engine(UBound(colScriptBase_Engine))
      x64ScriptEngine = WINDIR & "\SysWOW64\" & objScriptEngine
     Set objelevate = CreateObject("Shell.Application")
      objelevate.ShellExecute x64ScriptEngine , Chr(34) & Wscript.ScriptFullName & Chr(34) ,"","runas",1
  Else
     Main
  End If
End If

'''\\\\\\\ Sub Functions \\\\\\\\\
'''
Sub Main
RequestID = InputBox("Enter your Certificate RequestID:", "Cert Export & Import for NAP-VPN")
  If RequestID="" Then
    Wscript.Quit
  End If
  If isnumeric(RequestID) <> True Then
    Msgbox "RequestID must be numeric",vbOkOnly + vbCritical, "rtn Code"
    Wscript.Quit 1
  End If
  'SavePath = "ntcusa"
  SaveExt  = ".pfx"
  PK = "Private"
  CertNumCounter = 0
  PackageCheck
  Retrieve_CER
  Install_CER
  PrivateKeyPassword = "ntcusa"
  '''''RegisterCapicom
  ExportCert
  'InsertCert
End Sub
Sub PackageCheck()
  On Error Resume Next
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  If objFSO.FileExists(objFSO.GetSpecialFolder(1) & "\" & Certreq) = False Then
    objFSO.CopyFile currentDirectory  & CertReq ,  objFSO.GetSpecialFolder(1) & "\"
  End If
  If err.number <> 0 Then
    Msgbox "Fail to install certreq to system!",vbOkOnly + vbCritical, "Certreq error code"
    Wscript.Quit 1
  End If
  Set objFSO = nothing
End Sub
Sub Retrieve_CER
  On Error Resume Next
  Set WshShell = CreateObject("Wscript.Shell")
  rtnValue = WshShell.Exec("%ComSpec% /c certreq -f -config " & ConfigStr & " -retrieve " & RequestID & " " & chr(34) & currentDirectory & PK & ".cer" & chr(34)).StdOut.ReadAll
  If instr(rtnValue ,"pending") <> 0 Then
    Msgbox "Please call system admin to issue the certificate for you!",vbOkOnly + vbCritical, "Certificate retrieve info"
    Wscript.Quit 1
  End If
 
  If instr(rtnValue ,"Issued") = 0 Then
    Msgbox "Fail to retrieve certificate",vbOkOnly + vbCritical, "Certificate retrieve info"
    Wscript.Quit 1
  End If
  Set WshShell = nothing
End Sub
Sub Install_CER
  On Error Resume Next
  Set WshShell = CreateObject("Wscript.Shell")
  rtnValue = WshShell.Exec("%ComSpec% /c certreq -accept " & chr(34) & currentDirectory & PK & ".cer" & chr(34)).StdOut.ReadAll
  DeleteUnusedFiles (currentDirectory & PK & ".cer")
  If instr(rtnValue , "Cannot find object or property.") Then
    Msgbox "Private key cannot match this certificate." & vbCrLf & "Please resubmit your CA request again.",vbCritical + vbOkOnly,"Certificate import result"
    Wscript.Quit 1
  End If
  Set WshShell = nothing
End Sub

'''\\\\\\\\ This subfunction is for certificate export \\\\\\\\\''
Sub ExportCert
  On Error Resume Next
    Set Store = CreateObject("CAPICOM.Store")
    '''Test Capicom.dll exist of not base on vb error handling
    If err.number = 0 Then
      'OK, Capicom.dll was registered; do nothing here...
    ElseIf err.number = 429 Then
      'WScript.Echo "Capicom was registered, but CAPICOM.store object still cannot be created..."
      MsgBox("CAPICOM.DLL was registered, but CAPICOM.store object" & VbCrLf & "still cannot be created..." & VbCrLf & "Please contact your local admin")
      err.Clear
      WScript.Quit 1
    Else
      'wscript.echo "Unknown error. Error#: " & err.number
      MsgBox("Unknown error.  Error#: " & err.number & VbCrLf & "Please contact your local admin")
      err.clear
      WScript.Quit 1   'Terminate script when unknown error occurs...
    End If
    If isNull(Store) Then
      'WScript.Echo "Store object cannot be created; error#: " & err.number
      MsgBox("Store object cannot be created.  error#: " & err.number & VbCrLf & "Please contact your local admin")
      WScript.Quit 1
    End If
    Store.Open CAPICOM_LOCAL_MACHINE_STORE, "MY" , CAPICOM_STORE_OPEN_READ_WRITE 'CAPICOM_STORE_OPEN_READ_ONLY
    'Set Certificates = Store.Certificates.Find(CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME, SubjectName, false)
    Set Certificates = Store.Certificates.Find(CAPICOM_CERTIFICATE_FIND_ISSUER_NAME, "us-NTCSJNT35-CA", false)
 If Certificates.Count > 0 Then
          For Each Certificate in Certificates
            If DateDiff("s",now,Certificate.ValidToDate)<0 Then ' remove expired certificate
              Store.remove Certificate
            Else
              If Certificate.HasPrivateKey Then ' Private Key
                If Certificate.PrivateKey.IsExportable Then
                  If ExtractCertInfo(Certificate) = True Then
                    Set LatestCertificate = Certificate
                    UFlag = True
                    Exit For
                  End If
                Else 'non-exportable key
                  'Store.remove Certificate
                End If
              Else 'non-private key
                Store.remove Certificate
              End If
            End If
          Next
 Else
          MsgBox("No applied certificates could be found on your system")
          WScript.Quit 1
 End If
        If UFlag Then
          colSubject=Split(LatestCertificate.SubjectName,",")
          State = Split(colSubject(5),"=")(1)
          AppliedUser=Split(colSubject(1),"=")(1)
          LatestCertificate.Save currentDirectory & State & " - " & AppliedUser & SaveExt, PrivateKeyPassword, CAPICOM_CERTIFICATE_SAVE_AS_PFX, CAPICOM_CERTIFICATE_INCLUDE_CHAIN_EXCEPT_ROOT
          Store.remove LatestCertificate
          'Remove Key here
        Else
          MsgBox("Warnning!! No valid certificate could be found." & VbCrLf & "Please re-enroll with and check the check box 'Mark keys as exportable'.")
        End If
  Set Certificates = Nothing
  Set Store = Nothing
  Wscript.Echo "Done"
End Sub
Function ExtractCertInfo(Certificate)
'Wscript.Echo Certificate.SubjectName & vbCrLf & "Valid From : [" & Certificate.ValidFromDate & "]    Valid To : [" & Certificate.ValidToDate & "]"
colSubject=Split(Certificate.SubjectName,",")
msg = msg & "Do you want to export this certificate!" & vbCrLf & vbCrLf
msg = msg & "Valid From : [" & Certificate.ValidFromDate & "]" & vbCrLf
msg = msg & "Valid To : [" & Certificate.ValidToDate & "]" & vbCrLf
msg = msg & vbCrLf
msg = msg & Replace(Trim(colSubject(0)),"E=","Email Address : ") & vbCrLf
msg = msg & Replace(Trim(colSubject(1)),"CN=","User Name : ") & vbCrLf
msg = msg & Replace(Trim(colSubject(2)),"OU=","Department : ") & vbCrLf
msg = msg & Replace(Trim(colSubject(3)),"O=","Organization : ") & vbCrLf
msg = msg & Replace(Trim(colSubject(4)),"L=","City : ") & vbCrLf
msg = msg & Replace(Trim(colSubject(5)),"S=","State :") & vbCrLf
msg = msg & Replace(Trim(colSubject(6)),"C=","Country : ") & vbCrLf
rtnValue =Msgbox(msg , vbInformation + vbYesNo, "Certificate Information")
 If rtnValue = vbYes Then
   ExtractCertInfo = True
 Else
   ExtractCertInfo = False
 End If
End Function
'''\\\\\\\\ This sub function is for certificate import action\\\\\\\\\''
Sub InsertCert
  On Error Resume next
  set objCertStore = CreateObject ("CAPICOM.Store")
  set objCert = CreateObject ("CAPICOM.Certificate")
  currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
  objCertStore.Open CAPICOM_LOCAL_MACHINE_STORE, "My", CAPICOM_STORE_OPEN_READ_WRITE
  objCert.Load currentDirectory & PK & SaveExt, PrivateKeyPassword, CAPICOM_KEY_STORAGE_DEFAULT, CAPICOM_LOCAL_MACHINE_KEY
  objCertStore.Add objCert
  If err.number = 0 Then
    DeleteUnusedFiles PK & SaveExt
    MSgbox "Complete to install NAPVPN certificate on your Machine",vbOkOnly + vbInformation,"Certificate import result"
  Else
    MSgbox "Fail to install NAPVPN certificate on your Machine" & vbCrLf & "Please contact your local admin!",vbOkOnly + vbCritical,"Certificate import result"
    Wscript.Quit 1
  End If 
  objCertStore.close
  If Uflag Then
    objCertStore.open CAPICOM_CURRENT_USER_STORE, "MY" , CAPICOM_STORE_OPEN_READ_WRITE 'CAPICOM_STORE_OPEN_READ_ONLY
    objCertStore.Remove LatestCertificate
    objCertStore.close
  End If
  Set objCertStore = Nothing
  Set objCert = Nothing
  Set fso = Nothing
End Sub
Sub DeleteUnusedFiles(FileName)
  On Error Resume Next
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  objFSO.DeleteFile FileName
  Set objFSO = nothing
End Sub
Function Get_OS(ByRef objWMIService)
  Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
  For Each objItem in colItems
    Get_OS = objItem.Caption
  Next
  Set colItems = Nothing
End Function
Function Get_OS_TYPE(ByRef objWMIService)
  Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
  For Each objItem in colItems
    If instr( objItem.SystemType,"64") <> 0 Then
      Get_OS_TYPE = "x64"
    Else
      Get_OS_TYPE = "x86"
    End If
  Next
  Set colItems = Nothing
End Function
Function Wscript_Engine()
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set SystemDirectory = objFSO.GetSpecialFolder(1)
  If Instr(UCase(Wscript.FullName),UCase(SystemDirectory)) <> 0 Then
    Wscript_Engine = "x86"
  Else
    Wscript_Engine = "x64"
  End If
End Function
Function ElevationCheck 'test whether user has elevated token 
  Dim oShell, oExecWhoami, oWhoamiOutput, strWhoamiOutput, boolHasElevatedToken
  Set oShell = CreateObject("WScript.Shell")
  Set oExecWhoami = oShell.Exec("whoami /groups")
  Set oWhoamiOutput = oExecWhoami.StdOut
  strWhoamiOutput = oWhoamiOutput.ReadAll
  If InStr(1, strWhoamiOutput, "S-1-16-12288", vbTextCompare) Then boolHasElevatedToken = True
  If boolHasElevatedToken Then
    ElevationCheck = True
  Else
    ElevationCheck = False
  End If
End Function
------------------------------------------------------------------------------------------------------------------------------env check
On Error Resume Next
Const HKEY_CLASSES_ROOT = &H80000000
Const CAPICOM_LOCAL_MACHINE_STORE         = 1   'The store is a local machine store.
Const CAPICOM_STORE_OPEN_READ_WRITE       = 1   'Open the store in read/write mode.
Const CertReq = "certreq.exe"
currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

OS = Get_OS(objWMIService)
OS_Type = Get_OS_TYPE(objWMIService)
If ( instr(UCase(OS),UCase("Windows 7")) <> 0 ) and (OS_Type="x64")Then
  Script_Engine_Arch = Wscript_Engine
  If (Script_Engine_Arch = "x86") or (ElevationCheck = False) Then
     Set objShell = CreateObject( "WScript.Shell" )
      WINDIR=objShell.ExpandEnvironmentStrings("%windir%")
      colScriptBase_Engine = Split(Wscript.FullName,"\")
      objScriptEngine = colScriptBase_Engine(UBound(colScriptBase_Engine))
      x64ScriptEngine = WINDIR & "\SysWOW64\" & objScriptEngine
     Set objelevate = CreateObject("Shell.Application")
      objelevate.ShellExecute x64ScriptEngine , Chr(34) & Wscript.ScriptFullName & Chr(34) ,"","runas",1
  Else
     Main
  End If
End If
Sub Main
  PackageCheck
  RegisterCapicom
  InstallMainCA
End Sub
Sub InstallMainCA()
  On Error Resume Next
  set oCertStore = CreateObject ("CAPICOM.Store")
  set oCert = CreateObject ("CAPICOM.Certificate")
  Certificate = currentDirectory & "certnew.cer"
  oCertStore.Open 1, "ROOT", 2
  oCert.Load Certificate, , 1, 1
  oCertStore.Add oCert
  If Err.Number <> 0 Then
    Msgbox Err.Description,vbYesonly +  vbCritical, "Root Certificate Import Result"
    Wscript.Quit 1
  Else
    Msgbox "Root Certificate has been installed on this computer Successfully.",vbYesonly +  vbInformation, "Root Certificate Import Result"
  End If
End Sub
Function Get_OS(ByRef objWMIService)
  Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
  For Each objItem in colItems
    Get_OS = objItem.Caption
  Next
  Set colItems = Nothing
End Function
Function Get_OS_TYPE(ByRef objWMIService)
  Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
  For Each objItem in colItems
    If instr( objItem.SystemType,"64") <> 0 Then
      Get_OS_TYPE = "x64"
    Else
      Get_OS_TYPE = "x86"
    End If
  Next
  Set colItems = Nothing
End Function
Function Wscript_Engine()
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set SystemDirectory = objFSO.GetSpecialFolder(1)
  If Instr(UCase(Wscript.FullName),UCase(SystemDirectory)) <> 0 Then
    Wscript_Engine = "x86"
  Else
    Wscript_Engine = "x64"
  End If
End Function
Sub PackageCheck()
  On Error Resume Next
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  If objFSO.FileExists(objFSO.GetSpecialFolder(1) & "\" & Certreq) = False Then
    objFSO.CopyFile currentDirectory  & CertReq ,  objFSO.GetSpecialFolder(1) & "\"
  End If
  If err.number <> 0 Then
    Msgbox "Fail to install certreq to system!",vbOkOnly + vbCritical, "Certreq error code"
    Wscript.Quit 1
  End If
  Set objFSO = nothing
End Sub
'''\\Copy and register Capicom.dll from system32 directory if it is missing in client system\\
Sub RegisterCapicom
  Dim SystemDirectory, FileSystemObj, ShellObj
  WScript.Echo "Check local system for capicom registration...."
  If CapicomRegged Then
    'WScript.Echo "Capicom was registered before the launch of this script!!"
    MsgBox("CAPICOM.DLL was registered!!")
    Exit Sub
  Else
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set SystemDirectory = objFSO.GetSpecialFolder(1) 'get system32 folder
    If objFSO.FileExists( SystemDirectory & "\capicom.dll" ) = False Then
      If objFSO.FileExists ( currentDirectory & "capicom.dll" ) = True Then
        objFSO.CopyFile currentDirectory & "capicom.dll", SystemDirectory & "\"
        '
      Else
        MsgBox("CAPICOM.DLL is missing!  Please ensure CAPICOM.DLL is in the same directory as this program.")
        '    FileSystemObj.CopyFile currentDirectory & "capicom.dll", SystemDirectory & "\"
      End If
    Else
      Set ShellObj = Wscript.CreateObject("Wscript.Shell")
      ShellObj.Run "cmd.exe /c regsvr32.exe /s " & Chr(34) & SystemDirectory & "\capicom.dll" & Chr(34),0,vbTrue
      'WScript.Echo "Capicom.dll v2.1.0.3 is now registered in your" & VbCrLf & "System Directory: " & SystemDirectory & VbCrLf & "Please rerun this script..."
      MsgBox("Capicom.dll v2.1.0.3 is now registered!")
      Set shellobj = Nothing
    End If
    set objFSO = Nothing
  End If
  'Wscript.Quit 0
End Sub
'''\\\Check is Capicom regged or not...
Function CapicomRegged()
 Dim strComputer, objReg, strKeyPath, RegKeyExists, strValueName, returnValue
 strComputer  = "."
 strKeyPath   = "CLSID\"
 strValueName = "{03ACC284-B757-4B8F-9951-86E600D2CD06}"
 Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
 objReg.EnumKey HKEY_CLASSES_ROOT, strKeyPath, returnValue
 CapicomRegged = False
 If Not IsNull(returnValue) Then
  'WScript.Echo "Goto For loop"
  For Each s In returnValue
   'WScript.Echo s
   If lcase(s) = lcase(strValueName) Then
    CapicomRegged = True
    'WScript.Echo RegKeyExists
    Exit Function
   End If
  Next
 End If
End Function
Function ElevationCheck 'test whether user has elevated token 
  Dim oShell, oExecWhoami, oWhoamiOutput, strWhoamiOutput, boolHasElevatedToken
  Set oShell = CreateObject("WScript.Shell")
  Set oExecWhoami = oShell.Exec("whoami /groups")
  Set oWhoamiOutput = oExecWhoami.StdOut
  strWhoamiOutput = oWhoamiOutput.ReadAll
  If InStr(1, strWhoamiOutput, "S-1-16-12288", vbTextCompare) Then boolHasElevatedToken = True
  If boolHasElevatedToken Then
    ElevationCheck = True
  Else
    ElevationCheck = False
  End If
End Function