md %TEMP%\reg
REG EXPORT HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall %TEMP%\reg\uninstall32.reg /y /reg:32
REG EXPORT HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall %TEMP%\reg\uninstall.reg /y /reg:64
REG EXPORT HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products %TEMP%\reg\product32.reg /y /reg:32
REG EXPORT HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products %TEMP%\reg\product.reg /y /reg:64
REG EXPORT HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName %TEMP%\reg\compname.reg /y
cscript.exe appdetect.vbs %TEMP%\reg
call %TEMP%\reg\start2.cmd
pause

Option Explicit
Dim ReportUrl, ReportData, RemoveCmd
Dim AppName, AppNeedVer
AppName="КриптоПро CSP"
AppNeedVer="5.0"
RemoveCmd="rem msiexec.exe /uninstall %GUID%"
'ReportUrl="http://localhost/appscan.php"
ReportData="comp=%COMP%&ver=%VER%&guid=%GUID%&dt=%DT%&code=%CODE%&product=%PROD%"

' ==============
Dim FSO, CDir, CmdFile, CompName
Sub ReportWWW(Product,Ver,Guid,Dt,Code)
Dim S, S2
  If ReportUrl<>"" Then
      S=ReportUrl
      S2=ReportData
      S=Replace(S,"%GUID%",Guid)
      S=Replace(S,"%COMP%",Compname)
      S=Replace(S,"%VER%",Ver)
      S=Replace(S,"%DT%",Dt)
      S=Replace(S,"%CODE%",Code)
      S=Replace(S,"%PROD%",Product)
'
      S2=Replace(S2,"%GUID%",Guid)
      S2=Replace(S2,"%COMP%",Compname)
      S2=Replace(S2,"%VER%",Ver)
      S2=Replace(S2,"%DT%",Dt)
      S2=Replace(S2,"%CODE%",Code)
      S2=Replace(S2,"%PROD%",Product)
'
      WScript.Echo S2
  End If
End Sub
Sub ReportApp(Product,Ver,Guid,Dt,Code)
Dim S
  If Instr(1,Product,AppName)>0 Then
    WScript.Echo Product+" "+Ver+chr(13)+chr(10)+Guid+chr(13)+chr(10)+Compname+" "+Dt+chr(13)+chr(10)+Code
    If RemoveCmd<>"" Then
      S=RemoveCmd
      S=Replace(S,"%GUID%",Guid)
      S=Replace(S,"%COMP%",Compname)
      S=Replace(S,"%VER%",Ver)
      S=Replace(S,"%DT%",Dt)
      S=Replace(S,"%CODE%",Code)
      S=Replace(S,"%PROD%",Product)
      If Instr(1,Ver,AppNeedVer)=0 And Code="" Then
        CmdFile.WriteLine S
      End If
    End If
    ReportWWW Product, Ver, Guid, Dt, Code
  End If ' Detected Appname
End Sub
Sub DetectInFile(Fname)
Dim F, F2, S, Sect, Ver, k, ParName, ParValue, Product,Dt,Code
  If Not FSO.FileExists(CDir+"\"+Fname) Then Exit Sub
  Set F=FSO.OpenTextFile(CDir+"\"+Fname,1,,-1)
  Sect=""
  Do While Not F.AtEndOfStream
    S=F.ReadLine()
    If S<>"" Then
      If Left(S,1)="[" Then
        ReportApp Product, Ver, Sect, Dt, Code
        S=Trim(Mid(S,2,Len(S)-2))
        Sect=Replace(S,"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\","",vbTextCompare)
        Sect=Replace(Sect,"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall","",vbTextCompare)
        Product=""
        Ver=""
        Dt=""
        Code=""
      ElseIf Sect<>"" Then
        k=Instr(1,S,"=")
        If k>0 Then
          ParName=Replace(Left(S,k-1),"""","")
          ParValue=Mid(S,k+1)
          Do While Right(ParValue,1)="\"
            S=Trim(F.ReadLine())
            ParValue=Left(ParValue,Len(ParValue)-1)+S
          Loop
          ParValue=Replace(ParValue,"""","")
          If ParName="DisplayName" Then
            Product=ParValue
          End If
          If ParName="DisplayVersion" Then
            Ver=ParValue
          End If
          If ParName="InstallDate" Then
            Dt=ParValue
          End If
          '"UninstallString"=hex(2):
          '"VersionMajor"=dword:00000004
          '"VersionMinor"=dword:00000000
        End If ' Equal sign presents
      End If ' Sect not empty
    End If ' S not empty
  Loop
  ReportApp Product, Ver, Sect, Dt, ""
  F.Close
End Sub
Sub DetectProducts(Fname)
Dim F, F2, S, Sect, Ver, k, ParName, ParValue, Product,Dt,Code
  If Not FSO.FileExists(CDir+"\"+Fname) Then Exit Sub
  Set F=FSO.OpenTextFile(CDir+"\"+Fname,1,,-1)
  Sect=""
  Do While Not F.AtEndOfStream
    S=F.ReadLine()
    If S<>"" Then
      If Left(S,1)="[" Then
        ReportApp Product, Ver, Sect, Dt, Code
        S=Trim(Mid(S,2,Len(S)-2))
        Sect=Replace(S,"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\","",vbTextCompare)
        Sect=Replace(Sect,"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products","",vbTextCompare)
        Product=""
        Ver=""
        Dt=""
        Code=""
      ElseIf Instr(1,Sect,"InstallProperties",vbTextCompare)>0 Then
        k=Instr(1,S,"=")
        If k>0 Then
          ParName=Replace(Left(S,k-1),"""","")
          ParValue=Mid(S,k+1)
          Do While Right(ParValue,1)="\"
            S=Trim(F.ReadLine())
            ParValue=Left(ParValue,Len(ParValue)-1)+S
          Loop
          ParValue=Replace(ParValue,"""","")
          If ParName="DisplayName" Then
            Product=ParValue
          End If
          If ParName="DisplayVersion" Then
            Ver=ParValue
          End If
          If ParName="InstallDate" Then
            Dt=ParValue
          End If
          If ParName="ProductID" Then
            Code=ParValue
          End If
          '"UninstallString"=hex(2):
          '"VersionMajor"=dword:00000004
          '"VersionMinor"=dword:00000000
        End If ' Equal sign presents
      End If ' Sect not empty
    End If ' S not empty
  Loop
  ReportApp Product, Ver+"/"+AppNeedVer, "", Dt, Code
  F.Close
End Sub
Sub DetectComp(Fname)
Dim F, F2, S, Sect, k, ParName, ParValue
  Set F=FSO.OpenTextFile(CDir+"\"+Fname,1,,-1)
  Sect=""
  Do While Not F.AtEndOfStream
    S=F.ReadLine()
    If S<>"" Then
      If Left(S,1)="[" Then
        S=Trim(Mid(S,2,Len(S)-2))
        Sect=Replace(S,"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName","A",vbTextCompare)
      ElseIf Sect<>"" Then
        k=Instr(1,S,"=")
        If k>0 Then
          ParName=Replace(Left(S,k-1),"""","")
          ParValue=Mid(S,k+1)
          Do While Right(ParValue,1)="\"
            S=Trim(F.ReadLine())
            ParValue=Left(ParValue,Len(ParValue)-1)+S
          Loop
          ParValue=Replace(ParValue,"""","")
          If ParName="ComputerName" Then
            CompName=ParValue
          End If
        End If ' Equal sign presents
      End If ' Sect not empty
    End If ' S not empty
  Loop
  F.Close
End Sub
  Set FSO=CreateObject("Scripting.FileSystemObject")
  CDir=WScript.Arguments(0)
  If CDir="" Then CDir=FSO.GetFolder(".")
  WScript.Echo CDir
  Set CmdFile=FSO.CreateTextFile(CDir+"\start2.cmd",True)
  CmdFile.WriteLine "chcp 1251"
  DetectComp "compname.reg"
  WScript.Echo ">>SCAN: "+CompName+" "+AppName+" "+AppNeedVer
  DetectInFile "uninstall32.reg"
  DetectInFile "uninstall.reg"
  DetectProducts "product32.reg"
  DetectProducts "product.reg"
  CmdFile.WriteLine ""
  'CmdFile.WriteLine "pause"
  CmdFile.Close

Set FSO=CreateObject("Scripting.FileSystemObject")