添加/删除程序列表的重复数据删除和过滤 (VBScript)

Question

该脚本可以工作并告诉我程序文件中安装了哪些内容。

两个问题

重复行

，即

AVG 2011 Ver: 10.0.1204

AVG 2011 Ver: 10.0.1204 Installed: 27/01/2011

并且

我不想包含具有关键字“Update”、“Hotfix”、“Java”的行任何 VB 专家都可以帮助解决此脚本中需要的额外内容吗？

Option Explicit

Dim sTitle
sTitle = "Installed Programs on your PC -"
Dim StrComputer

strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."

'Wscript.Echo GetAddRemove(strComputer)

Dim sCompName : sCompName = GetProbedID(StrComputer)

Dim sFileName
sFileName = sCompName & "_" & GetDTFileName() & "_Software.txt"

Dim s : s = GetAddRemove(strComputer)

If WriteFile(s, sFileName) Then
  'optional prompt for display
  If MsgBox("Finished processing.  Results saved to " & sFileName & _
            vbcrlf & vbcrlf & "Do you want to view the results now?", _
            4 + 32, sTitle) = 6 Then
    WScript.CreateObject("WScript.Shell").Run sFileName, 9
  End If
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, sVersion, 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, _
                                "DisplayVersion", sVersion)
      If sVersion <> "" Then
        sValue = sValue & vbTab & "Ver: " & sVersion
      Else
        sValue = sValue & vbTab 
      End If
      iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
                                "InstallDate", sDateValue)
      If sDateValue <> "" Then
        sYr =  Left(sDateValue, 4)
        sMth = Mid(sDateValue, 5, 2)
        sDay = Right(sDateValue, 2)
        'some Registry entries have improper date format
        On Error Resume Next 
        sDateValue = DateSerial(sYr, sMth, sDay)
        On Error GoTo 0
        If sdateValue <> "" Then
          sValue = sValue & vbTab & "Installed: " & sDateValue
        End If
      End If
      sTmp = sTmp & sValue & vbcrlf
    cnt = cnt + 1
    End If
  Next
  sTmp = BubbleSort(sTmp)
  GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _
                 " - " & Now() & 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 = sMth & sDay & sYr & "_" & sHr & sMin & sSec
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

Answer 1

@icecurtain：你问题的第二部分可以按照@Oliver的建议使用InStr来解决，重写以适合你的脚本，它看起来像——

If sValue <> "" _
    AND (InStr(1, sValue, "Hotfix", 1)) = 0 _
    AND (InStr(1, sValue, "Update", 1)) = 0 _
    AND (InStr(1, sValue, "Java", 1)) = 0) Then

第一部分也不会那么棘手，除了事实上，您包含版本和安装日期（如果找到）（某些重复项仅包含部分或根本不包含）。如果未包含额外的数据位，您可以循环遍历所有行并将它们添加到 Scripting.Dictory 对象中，并使用 .Exists 检查以防止重复被添加。

Answer 2

好吧，即使我不是绝地大师（或者没有自尊;-)），这也可以帮助您：

If InStr(1, sValue, "hotfix", vbTextCompare) = 0 Then
    Print "This is NOT a hotfix"
End If

有关更多信息，请查看 InStr() 的 MSDN 页面。

Answer 3

我不认为硬编码字符串检查是可行的方法，如果其中任何一个为真，卸载条目就是更新：

• 它有一个名为 SystemComponent 的双字值，它是 <> 0
• 名为 ParentKeyName 的字符串值
• 注册表子项以“KB”或“Q”+ 6 个数字开头 (KB######,Q######)