strComputer = "." Set objFSO = CreateObject("Scripting.FileSystemObject") Dim ClsVI, VI, sVersionString, ValueName Set ClsVI = New CVersionInfo ' create main class. if strComputer <> "." then file_array = array ( _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\Office\winproj.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\Office10\msaccess.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\Visio11\visio.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE11\excel.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE11\outlook.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE11\msaccess.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE11\powerpnt.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE11\winproj.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE11\winword.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE12\excel.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE12\outlook.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE12\powerpnt.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE12\visio.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE12\winword.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE14\excel.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE14\outlook.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE14\powerpnt.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE14\visio.exe", _ "\\" & strComputer & "\c$\Program Files\Microsoft Office\OFFICE14\winword.exe") else file_array = array ( _ "C:\Program Files\Microsoft Office\Office\winproj.exe", _ "C:\Program Files\Microsoft Office\Office10\msaccess.exe", _ "C:\Program Files\Microsoft Office\Visio11\visio.exe", _ "c:\Program Files\Microsoft Office\OFFICE11\excel.exe", _ "c:\Program Files\Microsoft Office\OFFICE11\outlook.exe", _ "c:\Program Files\Microsoft Office\OFFICE11\msaccess.exe", _ "c:\Program Files\Microsoft Office\OFFICE11\powerpnt.exe", _ "c:\Program Files\Microsoft Office\OFFICE11\winproj.exe", _ "c:\Program Files\Microsoft Office\OFFICE11\winword.exe", _ "c:\Program Files\Microsoft Office\OFFICE12\excel.exe", _ "c:\Program Files\Microsoft Office\OFFICE12\outlook.exe", _ "c:\Program Files\Microsoft Office\OFFICE12\powerpnt.exe", _ "c:\Program Files\Microsoft Office\OFFICE12\visio.exe", _ "c:\Program Files\Microsoft Office\OFFICE12\winword.exe", _ "c:\Program Files\Microsoft Office\OFFICE14\excel.exe", _ "c:\Program Files\Microsoft Office\OFFICE14\outlook.exe", _ "c:\Program Files\Microsoft Office\OFFICE14\powerpnt.exe", _ "c:\Program Files\Microsoft Office\OFFICE14\visio.exe", _ "c:\Program Files\Microsoft Office\OFFICE14\winword.exe", _ "c:\Program Files\Adobe\Reader 8.0\Reader\Acrord32.exe") end if for i = 0 to ubound(file_array) If objFSO.FileExists(file_array(i)) Then Set objFile = objFSO.GetFile(file_array(i)) Set VI = ClsVI.GetFileVersionInfo(file_array(i)) ' return a VersionInfo class for path. If VI.State = 0 Then '-- test to make sure info, was returned. wscript.echo "InternalName: " & VI.Value("InternalName") wscript.echo "ProductName: " & VI.Value("ProductName") wscript.echo "ProductVersion: " & VI.Value("ProductVersion") End If Wscript.Echo "Date last accessed: " & objFile.DateLastAccessed wscript.echo wscript.echo Else ' Wscript.Echo "File does not exist." End If next Class CVersionInfo Private FSOcvi, TScvi, ANumscvi, VIcvi Private Sub Class_Initialize() On Error Resume Next Set FSOcvi = CreateObject("Scripting.FileSystemObject") End Sub Private Sub Class_Terminate() On Error Resume Next Set TScvi = Nothing Set FSOcvi = Nothing Set VIcvi = Nothing End Sub Public Function GetFileVersionInfo(sFilePath) Dim ARetcvi, s1cvi, Pt1cvi, sRes, sBcvi, A1cvi, A4cvi(3), A2cvi(1), LocRes, VLocRes, SizeRes, iOffSet, Boocvi, sVerString, sMarker Dim iNum1cvi, iNum2cvi, iReadPt, iNum3cvi, LocAspack, VLocAspack, VIOffset, ReadOffset, BooAspack On Error Resume Next Set VIcvi = Nothing Set VIcvi = New VSInfo If (FSOcvi.FileExists(sFilePath) = False) Then VIcvi.Init "", 1 Set GetFileVersionInfo = VIcvi 'bad path. Exit Function End If sRes = ".rsrc" sVerString = "VS_VER" BooAspack = False Set TScvi = FSOcvi.OpenTextFile(sFilePath, 1) s1cvi = TScvi.Read(2048) TScvi.Close Set TScvi = Nothing A1cvi = GetArray(Mid(s1cvi, 61, 2)) iNum1cvi = (GetNumFromBytes(A1cvi) + 1) sBcvi = GetByteString(s1cvi, False) sMarker = Mid(sBcvi, iNum1cvi, 4) If (sMarker <> "PE**") Then If Left(sMarker, 2) = "NE" Then VIcvi.Init "", 5 Set GetFileVersionInfo = VIcvi Else VIcvi.Init "", 4 Set GetFileVersionInfo = VIcvi End If Exit Function End If Pt1cvi = InStr(1, sBcvi, sRes) If (Pt1cvi = 0) Then VIcvi.Init "", 2 Set GetFileVersionInfo = VIcvi Exit Function End If Pt1cvi = Pt1cvi + 12 A1cvi = GetArray(Mid(s1cvi, Pt1cvi, 12)) For iOffSet = 0 to 3 A4cvi(iOffSet) = A1cvi(iOffSet) Next VLocRes = GetNumFromBytes(A4cvi) For iOffSet = 0 to 3 A4cvi(iOffSet) = A1cvi(iOffSet + 4) Next SizeRes = GetNumFromBytes(A4cvi) For iOffSet = 0 to 3 A4cvi(iOffSet) = A1cvi(iOffSet + 8) Next LocRes = GetNumFromBytes(A4cvi) Pt1cvi = InStr(1, sBcvi, ".aspack") If (Pt1cvi > 0) Then BooAspack = True Pt1cvi = Pt1cvi + 12 A1cvi = GetArray(Mid(s1cvi, Pt1cvi, 12)) For iOffSet = 0 to 3 A4cvi(iOffSet) = A1cvi(iOffSet) Next VLocAspack = GetNumFromBytes(A4cvi) For iOffSet = 0 to 3 A4cvi(iOffSet) = A1cvi(iOffSet + 8) Next LocAspack = GetNumFromBytes(A4cvi) End If Boocvi = False Set TScvi = FSOcvi.OpenTextFile(sFilePath, 1) TScvi.Skip LocRes + 12 s1cvi = TScvi.Read(2) iNum1cvi = Asc(s1cvi) s1cvi = TScvi.Read(2) iNum2cvi = Asc(s1cvi) If (iNum2cvi = 0) Then TScvi.Close Set TScvi = Nothing VIcvi.Init "", 3 Set GetFileVersionInfo = VIcvi Exit Function End If If (iNum1cvi > 0) Then TScvi.Skip (iNum1cvi * 8) iReadPt = LocRes + 16 + (iNum1cvi * 8) Boocvi = False For iOffSet = 1 to iNum2cvi s1cvi = TScvi.Read(8) iReadPt = iReadPt + 8 If (Asc(s1cvi) = 16) Then Boocvi = True Exit For End If Next If (Boocvi = False) Then TScvi.Close Set TScvi = Nothing VIcvi.Init "", 3 Set GetFileVersionInfo = VIcvi Exit Function End If A1cvi = GetArray(s1cvi) iOffSet = 0 iNum3cvi = 1 Do For iNum1cvi = 0 to 2 A4cvi(iNum1cvi) = A1cvi(iNum1cvi + 4) Next A4cvi(3) = 0 iNum2cvi = GetNumFromBytes(A4cvi) If (A1cvi(7) > 127) Then iNum2cvi = LocRes + iNum2cvi + 16 TScvi.Skip (iNum2cvi - iReadPt) '- 1) s1cvi = TScvi.Read(8) iReadPt = iReadPt + ((iNum2cvi - iReadPt) + 8) A1cvi = GetArray(s1cvi) Else iOffSet = (iNum2cvi + LocRes) Exit Do End If iNum3cvi = iNum3cvi + 1 If (iNum3cvi > 10) Then Exit Do Loop If (iOffSet = 0) Then TScvi.Close Set TScvi = Nothing VIcvi.Init "", 3 Set GetFileVersionInfo = VIcvi Exit Function End If TScvi.Skip (iOffSet - iReadPt) s1cvi = TScvi.Read(8) iReadPt = iReadPt + ((iOffSet - iReadPt) + 8) A1cvi = GetArray(s1cvi) For iNum1cvi = 0 to 3 A4cvi(iNum1cvi) = A1cvi(iNum1cvi) Next VIOffset = GetNumFromBytes(A4cvi) ReadOffset = ((VIOffset - VLocRes) + LocRes) For iNum1cvi = 0 to 3 A4cvi(iNum1cvi) = A1cvi(iNum1cvi + 4) Next SizeRes = GetNumFromBytes(A4cvi) TScvi.Skip (ReadOffset - iReadPt) s1cvi = TScvi.Read(SizeRes) TScvi.Close Set TScvi = Nothing sBcvi = GetByteString(s1cvi, True) Pt1cvi = InStr(1, sBcvi, sVerString) If (Pt1cvi > 0) Then VIcvi.Init sBcvi, 0 Set GetFileVersionInfo = VIcvi ' ok ElseIf (BooAspack = True) Then ReadOffset = ((VIOffset - VLocAspack) + LocAspack) Set TScvi = FSOcvi.OpenTextFile(sFilePath, 1) TScvi.Skip ReadOffset s1cvi = TScvi.Read(SizeRes) TScvi.Close Set TScvi = Nothing sBcvi = GetByteString(s1cvi, True) Pt1cvi = InStr(1, sBcvi, sVerString) If (Pt1cvi > 0) Then VIcvi.Init sBcvi, 0 Set GetFileVersionInfo = VIcvi Else VIcvi.Init "", 3 Set GetFileVersionInfo = VIcvi End If Else VIcvi.Init "", 3 Set GetFileVersionInfo = VIcvi End If End Function Private Function GetByteString(sStr, SnipUnicode) Dim sRet, iLen, iA, iLen2, A2cvi() On Error Resume Next iLen2 = 0 If (SnipUnicode = False) Then ReDim A2cvi(len(sStr) - 1) For iLen = 1 to Len(sStr) iA = Asc(Mid(sStr, iLen, 1)) If iA = 0 Then iA = 42 A2cvi(iLen - 1) = Chr(iA) Next Else ReDim A2cvi((len(sStr) \ 2) - 1) For iLen = 1 to Len(sStr) step 2 iA = Asc(Mid(sStr, iLen, 1)) If iA = 0 Then iA = 42 ' A2cvi(iLen2) = Chr(iA) iLen2 = iLen2 + 1 Next End If GetByteString = Join(A2cvi, "") End Function Private Function GetArray(sStr) Dim iA, Len1, Len2, AStr() On Error Resume Next Len1 = Len(sStr) ReDim AStr(Len1 - 1) For iA = 1 to Len1 AStr(iA - 1) = Asc(Mid(sStr, iA, 1)) Next GetArray = AStr End Function Private Function GetNumFromBytes(ABytes) Dim Num1 Err.Clear On Error Resume Next GetNumFromBytes = -1 Num1 = ABytes(0) + (ABytes(1) * 256) If (UBound(ABytes) = 3) Then Num1 = Num1 + (ABytes(2) * 65536) + (ABytes(3) * 16777216) End If If (Err.number = 0) Then GetNumFromBytes = Num1 End Function End Class Class VSInfo Private sFVI, iErr, Char1 Private Sub Class_Initialize() Char1 = Chr(1) End Sub Public Sub Init(sVInfo, iErrCode) sFVI = sVInfo iErr = iErrCode End Sub Public Property Get State() State = iErr End Property Public Property Get Value(sValName) On Error Resume Next Value = "" If iErr <> 0 Then Exit Property Value = GetInfo(sValName) End Property Private Function GetInfo(sVal) Dim Pta, Ptb, LenVal, s4 On Error Resume Next GetInfo = "" LenVal = Len(sVal) + 1 Pta = InStr(1, sFVI, sVal, 1) If (Pta > 0) Then Pta = Pta + LenVal Ptb = InStr((Pta + 1), sFVI, "*") If Ptb > (Pta + 2) Then s4 = Mid(sFVI, Pta, (Ptb - Pta)) s4 = Replace(s4, "*", "") If InStr(1, s4, Char1, 0) = 0 Then GetInfo = s4 End If End If End Function End Class