VBS to AU3

[darkleton]

I found a nice little vbs script that polls a remote machine, gets all the software installed and returns it in a csv/txt file.

I've tried going through the vbs and altering it to au3 as some instructions from other posts (things like change Set to Dim, etc)

I've done as much as I can in the script but can't seem to figure out the last few bits (or if most of it is correct!)

I've attached both vbs and au3 (trimmed down from the vbs). If anybody could give any pointers on whats left to do.

The script should bring up a message box, ask for machine name or ip, then go off to read the specified keys, work through the list and return only keys that have an uninstall string listed. it should then write them to a file as comma separated values.

thanks in advance

Mike

expandcollapse popup

Option Explicit

Dim sTitle
sTitle = "InstalledPrograms.vbs by Bill James"
Dim StrComputer
strComputer = InputBox("Enter I.P. or name of computer to check for " & _
                       "installed software (leave blank to check " & _
                       "local system)." & vbcrlf & vbcrlf & "Remote " & _
                       "checking only from NT type OS to NT type OS " & _
                       "with same Admin level UID & PW", sTitle)
If IsEmpty(strComputer) Then WScript.Quit
strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."

'Wscript.Echo GetAddRemove(strComputer)

Dim sCompName : sCompName = GetProbedID(StrComputer)

Dim sFileName
sFileName = sCompName & "_Software_" & GetDTFileName & ".csv"

Dim s : s = GetAddRemove(strComputer)

If WriteFile(s, sFileName) Then
  'optional prompt for display
MsgBox "Finished Processing" & vbcrlf & vbcrlf & "Results saved to " & sFileName

End If


Function GetAddRemove(sComp)
  'Function credit to Torgeir Bakken
  Dim cnt, oReg, sBaseKey, iRC, aSubKeys
  Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
  Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
              sComp & "/root/default:StdRegProv")
  sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
  iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)

  Dim sKey, sValue, sTmp, sUninstall, sDateValue, sYr, sMth, sDay

  For Each sKey In aSubKeys
    iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
    If iRC <> 0 Then
      oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
    End If
    If sValue <> "" Then
      iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
                                "UninstallString", sUninstall)
      If sUninstall > "" Then
        sValue = sValue & "," & "Uninstall String: " & sUninstall
      End If

      sTmp = sTmp & sValue & vbcrlf
    cnt = cnt + 1
    End If
  Next
  sTmp = BubbleSort(sTmp)
GetAddRemove = "INSTALLED SOFTWARE" & "," & "UNINSTALL STRING" & vbcrlf & vbcrlf & sTmp

End Function

Function BubbleSort(sTmp)
  'cheapo bubble sort
  Dim aTmp, i, j, temp
  aTmp = Split(sTmp, vbcrlf)
  For i = UBound(aTmp) - 1 To 0 Step -1
    For j = 0 to i - 1
      If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
        temp = aTmp(j + 1)
        aTmp(j + 1) = aTmp(j)
        aTmp(j) = temp
      End if
    Next
  Next
  BubbleSort = Join(aTmp, vbcrlf)
End Function

Function GetProbedID(sComp)
  Dim objWMIService, colItems, objItem
  Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select SystemName from " & _
                                         "Win32_NetworkAdapter",,48)
  For Each objItem in colItems
    GetProbedID = objItem.SystemName
  Next
End Function

Function GetDTFileName()
  dim sNow, sMth, sDay, sYr, sHr, sMin, sSec
  sNow = Now
  sMth = Right("0" & Month(sNow), 2)
  sDay = Right("0" & Day(sNow), 2)
  sYr = Right("00" & Year(sNow), 4)
  sHr = Right("0" & Hour(sNow), 2)
  sMin = Right("0" & Minute(sNow), 2)
  sSec = Right("0" & Second(sNow), 2)
  GetDTFileName = sDay & "-" & sMth & "-" & sYr & "_" & sHr & "-" & SMin
End Function

Function WriteFile(sData, sFileName)
  Dim fso, OutFile, bWrite
  bWrite = True
  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  Set OutFile = fso.OpenTextFile(sFileName, 2, True)
  'Possibly need a prompt to close the file and one recursion attempt.
  If Err = 70 Then
    Wscript.Echo "Could not write to file " & sFileName & ", results " & _
                 "not saved." & vbcrlf & vbcrlf & "This is probably " & _
                 "because the file is already open."
    bWrite = False
  ElseIf Err Then
    WScript.Echo err & vbcrlf & err.description
    bWrite = False
  End If
  On Error GoTo 0
  If bWrite Then
    OutFile.WriteLine(sData)
    OutFile.Close
  End If
  Set fso = Nothing
  Set OutFile = Nothing
  WriteFile = bWrite
End Function

expandcollapse popup

Dim $StrComputer
Dim $sCompName
Dim $sFileName
Dim $s
Dim $sKey, $sValue, $sTmp, $sUninstall, $sDateValue, $sYr, $sMth, $sDay
Dim $cnt, $oReg, $sBaseKey, $iRC, $aSubKeys
Dim $aTmp, $i, $j, $temp
Dim $GetDTFileName
$strComputer = InputBox("Welcome","Enter I.P. or name of computer to check")

If $strComputer = "" Then
    $strComputer = "."
EndIf

$sCompName = GetID($StrComputer)
$sFileName = $sCompName & "_Software_" & $GetDTFileName & ".csv"
$s = GetAddRemove($strComputer)

GetAddRemove($strComputer)
FileWrite($sFileName, $s)
MsgBox (0,"","Finished Processing" & @crlf & @crlf & "Results saved to " & $sFileName)


Func GetAddRemove($sComp)

    Const $HKLM = 'HKEY_LOCAL_MACHINE'
    $oReg = ObjGet("winmgmts:{impersonationLevel=impersonate}!\\" & $sComp & "/root/default:StdRegProv")
    $sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    $iRC = $oReg.EnumKey($HKLM, $sBaseKey, $aSubKeys)

  For $sKey In $aSubKeys
        $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "DisplayName", $sValue)
        If $iRC <> 0 Then
        $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "QuietDisplayName", $sValue)
    EndIf
    If $sValue <> "" Then
        $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "UninstallString", $sUninstall)
        If $sUninstall <> "" Then
        $sValue = $sValue & "," & "Uninstall String: " & $sUninstall
    EndIf

      $sTmp = $sTmp & $sValue & @crlf
    $cnt = $cnt + 1
    EndIf
  Next
  $sTmp = BubbleSort($sTmp)
$GetAddRemove = "INSTALLED SOFTWARE" & "," & "UNINSTALL STRING" & @crlf & @crlf & $sTmp
EndFunc

Func BubbleSort($sTmp)

  $aTmp = Split($sTmp, @crlf)
  For $i = UBound($aTmp) - 1 To 0 Step -1
    For $j = 0 to $i - 1
      If LCase($aTmp($j)) > LCase($aTmp($j+1)) Then
        $temp = $aTmp($j + 1)
        $aTmp($j + 1) = $aTmp($j)
        $aTmp($j) = $temp
      Endif
    Next
  Next
$BubbleSort = Join($aTmp, @crlf)
EndFunc

Func GetID($sComp)
  Dim $objWMIService, $colItems, $objItem
  Dim $objWMIService = ObjGet("winmgmts:\\" & $sComp & "\root\cimv2")
  Dim $colItems = $objWMIService.ExecQuery("Select SystemName from Win32_NetworkAdapter",,48)
  For $objItem in $colItems
    $GetID = $objItem.SystemName
  Next
EndFunc

Func GetDTFileName()
  dim $sNow, $sMth, $sDay, $sYr, $sHr, $sMin, $sSec
  $sNow = Now
  $sMth = Right("0" & Month(sNow), 2)
  $sDay = Right("0" & Day(sNow), 2)
  $sYr = Right("00" & Year(sNow), 4)
  $sHr = Right("0" & Hour(sNow), 2)
  $sMin = Right("0" & Minute(sNow), 2)
  $sSec = Right("0" & Second(sNow), 2)
  $GetDTFileName = $sDay & "-" & $sMth & "-" & $sYr & "_" & $sHr & "-" & $SMin
EndFunc

Func WriteFile($sData, $sFileName)
  Dim $fso, $OutFile, $bWrite
  $bWrite = True
  Dim $fso = ObjCreate("Scripting.FileSystemObject")
  On Error Resume Next
  Dim $OutFile = fso.OpenTextFile($sFileName, 2, True)

  If $bWrite Then
    $OutFile.WriteLine($sData)
    $OutFile.Close
  EndIf
  Dim $fso = Nothing
  Dim $OutFile = Nothing
  $WriteFile = bWrite
EndFunc

[wakillon]

Try like this :

expandcollapse popup

Dim $StrComputer
Dim $sCompName
Dim $sFileName
Dim $s
Dim $sKey, $sValue, $sTmp, $sUninstall, $sDateValue, $sYr, $sMth, $sDay
Dim $cnt, $oReg, $sBaseKey, $iRC, $aSubKeys
Dim $aTmp, $i, $j, $temp
Dim $GetDTFileName
$strComputer = InputBox("Welcome","Enter I.P. or name of computer to check")

If $strComputer = "" Then
    $strComputer = "."
EndIf

$sCompName = GetID($StrComputer)
$sFileName = $sCompName & "_Software_" & $GetDTFileName & ".csv"
$s = GetAddRemove($strComputer)
GetAddRemove($strComputer)
FileWrite($sFileName, $s)
MsgBox (0,"","Finished Processing" & @crlf & @crlf & "Results saved to " & $sFileName)

Func GetAddRemove($sComp)
    Const $HKLM = 'HKEY_LOCAL_MACHINE'
    $oReg = ObjGet("winmgmts:{impersonationLevel=impersonate}!\\" & $sComp & "/root/default:StdRegProv")
    $sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    $iRC = $oReg.EnumKey($HKLM, $sBaseKey, $aSubKeys)
    For $sKey In $aSubKeys
        $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "DisplayName", $sValue)
        If $iRC <> 0 Then
        $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "QuietDisplayName", $sValue)
    EndIf
    If $sValue <> "" Then
        $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "UninstallString", $sUninstall)
        If $sUninstall <> "" Then
            $sValue = $sValue & "," & "Uninstall String: " & $sUninstall
        EndIf
        $sTmp = $sTmp & $sValue & @crlf
        $cnt = $cnt + 1
    EndIf
    Next
    $sTmp = BubbleSort($sTmp)
    $GetAddRemove = "INSTALLED SOFTWARE" & "," & "UNINSTALL STRING" & @crlf & @crlf & $sTmp
EndFunc

Func BubbleSort($sTmp)
    $aTmp = StringSplit($sTmp, @crlf)
    For $i = UBound($aTmp) - 1 To 0 Step -1
        For $j = 0 to $i - 1
            If StringLower ($aTmp[$j]) > StringLower($aTmp[$j+1]) Then
                $temp = $aTmp[$j + 1]
                $aTmp[$j + 1] = $aTmp[$j]
                $aTmp[$j] = $temp
            Endif
        Next
    Next
    $BubbleSort = $aTmp & @crlf
EndFunc

Func GetID($sComp)
    Dim $objWMIService, $colItems, $objItem
    Dim $objWMIService = ObjGet("winmgmts:\\" & $sComp & "\root\cimv2")
    Dim $colItems = $objWMIService.ExecQuery("Select SystemName from Win32_NetworkAdapter", '',48 )
    For $objItem in $colItems
       $GetID = $objItem.SystemName
    Next
EndFunc

Func GetDTFileName()
     $GetDTFileName = @WDAY & "-" & @MON & "-" & @YEAR & "_" & @HOUR & "-" & @MIN
EndFunc

Func WriteFile($sData, $sFileName)
    Dim $fso, $OutFile, $bWrite
    $bWrite = True
    Dim $fso = ObjCreate("Scripting.FileSystemObject")
    If not @Error Then
        Dim $OutFile = $fso.OpenTextFile($sFileName, 2, True)
        If $bWrite Then
            $OutFile.WriteLine($sData)
            $OutFile.Close
        EndIf
        Dim $fso = ''
        Dim $OutFile = ''
        $WriteFile = $bWrite
    EndIf
EndFunc

[darkleton]

i get the following error when run:

Line 63 - The requested action with this object has failed.:

Dim $colItems = $objWMIService.ExecQuery("Select SystemName from Win32_NetworkAdapter", '',48 )

Dim $colItems = $objWMIService.ExecQuery("Select SystemName from Win32_NetworkAdapter", '',48 )^ ERROR

sorry should have mentioned, this is only when i enter a machine name and press enter

Edited October 2, 2010 by darkleton

[darkleton]

having read around it appears that objWMIService.ExecQuery is a WMI function designed for vbscript. so i'm not sure if there is a way around it, as the other methods for doing what i need with autoit (connecting to remote reg etc) take a lot longer than this way.

[water]

To create WMI queries for AutoIt you could try SvenP's "WMI ScriptOMatic tool for Autoit".

It creates pure AutoIt code.

I think everything that can be done with WMI for VBS can be done for AutoIt as well.

[darkleton]

To create WMI queries for AutoIt you could try SvenP's "WMI ScriptOMatic tool for Autoit".

It creates pure AutoIt code.

I think everything that can be done with WMI for VBS can be done for AutoIt as well.

awesome, thanks water, will check that out now

[wakillon]

i get the following error when run:

Line 63 - The requested action with this object has failed.:

Dim $colItems = $objWMIService.ExecQuery("Select SystemName from Win32_NetworkAdapter", '',48 )

Dim $colItems = $objWMIService.ExecQuery("Select SystemName from Win32_NetworkAdapter", '',48 )^ ERROR

sorry should have mentioned, this is only when i enter a machine name and press enter

Try Dim $colItems = $objWMIService.ExecQuery ( "Select * from Win32_NetworkAdapter", 'WQL', 48 )

[darkleton]

i have a feeling this is going to be a little more complex than i first thought. it now goes past the execquery and stops on the oreg.enumkey :

29) : ==> The requested action with this object has failed.:

$iRC = $oReg.EnumKey($HKLM, $sBaseKey, $aSubKeys)

$iRC = $oReg.EnumKey($HKLM, $sBaseKey, $aSubKeys)^ ERROR

grrrrrr

[Mat]

I would use the Reg* functions instead of the object, you'll get more informative error messages if you do as well.

This is great UDF that might be useful.

[darkleton]

that udf looks great, the only prob i've had is that it wont run the function on the selected reg key. the two examples it gives, the first works great, the second (the HKLM uninstall) just hangs.

[darkleton]

actually, it didn't hang, but took nearly 5 mins to get the strings from the local machine, compared to the 25secs the jscript did. i'll have to try and find another way of getting the info.

thanks

[Mat]

actually, it didn't hang, but took nearly 5 mins to get the strings from the local machine, compared to the 25secs the jscript did. i'll have to try and find another way of getting the info.

thanks

Try this then: http://www.autoitscript.com/forum/index.php?showtopic=70108

Or maybe this: http://www.autoitscript.com/forum/index.php?showtopic=16529

Both will give serious speed improvements...

Ultimately, AutoIt should be able to do it at the same speed as anything else, it may be a it more complex though.

Edited October 4, 2010 by Mat

[darkleton]

sorry for the LONG delay in updating.

the two UDFs look good, but both look as though they only work on the local machine, i still cant get it to run on a remote machine as the VBS script did