2013-07-04

根據 Software List 產生的 .csv 檔搜尋特定軟體

本 VBScript 程式可對基於 Software List 產生的 .csv 檔進行軟體關鍵字搜尋
產生軟體安裝狀態報表

Find.csv
    以軟體為單位顯示

Find-OneRow.csv
    以電腦為單位顯示

2013.07.26 增加 "排除關鍵字"
2014.10.03 修正關鍵字多打分號 (;) 產生空值造成沒有結果的問題
                    欄位分隔符號由逗號 (,) 改為 vbTab, Excel 可以直接開啟不用選分隔符號
2014.11.24 請改用 取得電腦安裝軟體清單及基本資訊 Software List V2

===== 程式開始 =====

' CSV 檔案所在路徑, 最好把檔案 Copy 到 Local 某資料夾再來用, 避免從網路資料夾讀取比較好
' 不設定時, 將搜尋與 VBS 相同路徑
TargetPath=""

' 要找軟體的關鍵字, 以分號 (;) 分隔
Find=""

' 排除的關鍵字, 以分號 (;) 分隔
FilterKeyword=""

'-------------------------------------------------------------------------------------------------

Set fso=CreateObject("Scripting.FileSystemObject")

if (TargetPath="") then
 TargetPath =  left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))
end if

ReturnString = FoundKeywordFromCSV(TargetPath,Find,FilterKeyword)

NowPath=left(Wscript.ScriptFullName,len(Wscript.ScriptFullName)-len(Wscript.ScriptName))

OutputFileName=NowPath&"!_Find.csv"
Set ResultFile = fso.OpenTextFile(OutputFileName, 2, true, -1)
ResultFile.write ReturnString(0)
ResultFile.close

OutputFileName=NowPath&"!_Find-OneRow.csv"
Set ResultFile = fso.OpenTextFile(OutputFileName, 2, true, -1)
ResultFile.write ReturnString(1)
ResultFile.close

Function FoundKeywordFromCSV(TargetPath,Find,FilterKeyword)

 Set fsoFolder = fso.getFolder(TargetPath)

 Set LoadCSVLineSplit = Nothing
 ReturnValue = "ComputerName,UserName,Publisher,DisplayVersion,DisplayName" & vbcrlf
 ReturnValueOneRow = "ComputerName,UserName,Publisher / DisplayVersion / DisplayName" & vbcrlf

 FindObject=split(Find&";",";")
 FindCount=ubound(FindObject)

 FilterKeywordObject=split(FilterKeyword&";",";")
 FilterKeywordCount=ubound(FilterKeywordObject)

 Dim ReturnValueFound()

 For Each File In fsoFolder.Files

  Set LoadCSV = fso.OpenTextFile(File.path,1,False,-1)
  ReturnValueComputer = ""
  ReturnValueUserName = ""
  FoundHit = 0
  ReturnValueFoundOneRow = ""
  ReturnValueFoundIndex=0


   while not LoadCSV.AtEndOfStream
    ReDim LoadCSVLineSplit(6)
    LoadCSVLine = LoadCSV.ReadLine
    LoadCSVLineSplit = split(LoadCSVLine,vbTab)
    if ubound(LoadCSVLineSplit) > 0 then

     if (LoadCSVLineSplit(0) = "ComputerName") then
      ReturnValueComputer = LoadCSVLineSplit(1)
     elseif (LoadCSVLineSplit(0) = "UserName") then
      ReturnValueUserName = LoadCSVLineSplit(1)
     end if
    end if

    if ubound(LoadCSVLineSplit) > 4 then
     for i=0 to FindCount-1
if (FindObject(i) <> "") then
      FoundMatch=0
      if (InStr(UCase(LoadCSVLineSplit(1)),UCase(FindObject(i)))<>0) then
       FilterHit=0
       for j=0 to FilterKeywordCount-1
  if (FilterKeywordObject(j) <> "") then
        if (InStr(UCase(LoadCSVLineSplit(1)),UCase(FilterKeywordObject(j)))<>0) then
         FilterHit=1
        end if
end if
       next

       if (FilterHit=0) then
        FoundHit = 1
        FoundString=LoadCSVLineSplit(3) & vbtab & LoadCSVLineSplit(2) & vbtab & LoadCSVLineSplit(1)
        FoundStringOneRow=LoadCSVLineSplit(3) & " / " & LoadCSVLineSplit(2) & " / " & LoadCSVLineSplit(1)
        if (ReturnValueFoundIndex > 0 ) then
         for k=0 to ReturnValueFoundIndex-1
          if ReturnValueFound(k) = FoundString then
           FoundMatch=1
          end if
         next
        end if
        if (FoundMatch=0) then
         ReDim Preserve ReturnValueFound(ReturnValueFoundIndex)
         ReturnValueFound(ReturnValueFoundIndex) = FoundString
         if (ReturnValueFoundOneRow <> "") then
          ReturnValueFoundOneRow = ReturnValueFoundOneRow & vbcrlf
         end if
         ReturnValueFoundOneRow = ReturnValueFoundOneRow & FoundStringOneRow
         ReturnValueFoundIndex = ReturnValueFoundIndex +1
        end if
       end if
      end if
end if
     next
    end if

   wend

   if (FoundHit = 1) then
    ReturnValueComputer = ReturnValueComputer
    ReturnValueUserName = ReturnValueUserName
 
    for i=0 to ReturnValueFoundIndex-1
     ReturnValue = ReturnValue & ReturnValueComputer & vbtab & ReturnValueUserName & vbtab & ReturnValueFound(i) & vbcrlf
    next
 
    ReturnValueOneRow = ReturnValueOneRow & ReturnValueComputer & vbtab & ReturnValueUserName & vbtab & """" & ReturnValueFoundOneRow & """" & vbcrlf
   end if
  LoadCSV.close
 Next

 Dim ReturnArray(1)
 ReturnArray(0)=ReturnValue
 ReturnArray(1)=ReturnValueOneRow

 FoundKeywordFromCSV=ReturnArray

End Function

沒有留言: