How to get the extended information of a file ?
For example this vbscript can get the extended information of Firefox.exe :
Option Explicit
Dim fso,ws,RootFolder,LogFile,stFolder,stFile,oShell,oFolder,oFile,i
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
LogFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "txt"
If fso.FileExists(LogFile) Then
fso.DeleteFile(LogFile)
End If
stFolder = Ws.ExpandEnvironmentStrings("%PROGRAMFILES%\Mozilla Firefox")
stFile ="firefox.exe"
Set oShell = CreateObject("Shell.Application")
Set oFolder = oShell.Namespace(stFolder)
Set oFile = oFolder.Items.Item(stFile)
'Displays extended file properties
For i = 0 to 34
WriteLog("[" & i & "] " & oFolder.GetDetailsOf(oFolder.Items, i ) & " : " & oFolder.GetDetailsOf(oFile, i))
Next
ws.run DblQuote(LogFile)
'*********************************************************************************************************************
Sub WriteLog(strText)
Dim fs,ts,LogFile
Const ForAppending = 8
LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(LogFile,ForAppending,True)
ts.WriteLine strText
ts.Close
End Sub
'*********************************************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************************************
Or if you want to check the version of Firefox installed and if it is uptodate or not try this vbscript :
Option Explicit
Const ForWriting = 2
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Dim RC , sPath, sNames, iTypes, sValue, objRegistry
Dim ROOT, i, j , msg, sKey, RC1, sKeyNames, fso, Fich
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fich = fso.OpenTextFile("Version.txt", ForWriting, true)
Dim shell : Set shell = CreateObject("WScript.Shell")
sPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
ROOT = HKEY_LOCAL_MACHINE
Dim OK
OK = False
Set objRegistry = GetObject("WinMgmts:root\default:StdRegProv")
RC1 = objRegistry.EnumKey(ROOT, sPath, sKeyNames)
If (RC1 = 0) And (Err.Number = 0) And Not IsEmpty(sKeyNames) Then
For j = LBound(sKeyNames) To UBound(sKeyNames)
RC = objRegistry.EnumValues(ROOT, sPath & sKeyNames(j), sNames, iTypes)
If (RC = 0) And (Err.Number = 0) And IsArray(sNames) Then
If VerifTypes(ROOT, sPath & sKeyNames(j), iTypes) And OK Then Fich.WriteLine vbNewLine & sKeyNames(j) & " : "
For i = LBound(iTypes) To UBound(iTypes)
If iTypes(i) = REG_SZ Then
RC = objRegistry.GetStringValue(ROOT , sPath & sKeyNames(J), sNames(i), sValue)
If (LCase(sNames(i)) = "displayname" And sValue <> "") Or (LCase(sNames(i)) = "displayversion" And sValue <> "") Then
If InStr(1,LCase(sValue),"firefox") > 0 Then
msg = msg & sNames(i) & " = " & sValue
OK = True
MsgBox sValue & VbcrLf & "La version installée du soft Firefox est : "& ExtractVersion(sValue),64,"La Version installée du Soft Firefox"
Dim MyVer,NetVersion,URL,ws
MyVer = ExtractVersion(sValue)
URL = "http://www.mozilla.org/fr/firefox/new/"
NetVersion = GetFirefoxMajorVersion(URL)
msgbox NetVersion
If CompareVersions(MyVer,NetVersion) = -1 Then
MsgBox "La dernière version de Firefox est : " & NetVersion & VbCrlf &_
"Il y a une mise à jour en ligne !",48,"Il y a une mise à jour en ligne ! "
set ws = CreateObject("WScript.Shell")
ws.run URL
Else
MsgBox "Firefox est à jour !",64,"Firefox est à jour !"
end if
Fich.Write msg & vbNewLine & "La version installée du soft Firefox est : "& ExtractVersion(sValue) & vbNewLine
End If
End If
OK = False
End If
msg = ""
Next ' pour i
'MsgBox msg
Else
'Msgbox "L'erreur suivante est survenue : " & Err.Description
End If
Next ' pour J
Fich.Close
End If
Shell.run "version.txt"
'******************************************************************************************************************
Function Lsh(ByVal N, ByVal Bits)
Lsh = N * (2 ^ Bits)
End Function
'***************************************************************************************
Function VerifTypes(ROOT, strPath, Types)
' Cette fonction vérifie si la clé (strPath) contient des valeurs
' "DisplayVersion" ou "DisplayName" et qui ne sont pas être vides
' pour ne pas retourner celles qui n'en contiennent pas.
Dim Ret, strNames, Verif, ind
Verif = False
Ret = objRegistry.EnumValues(ROOT, strPath,strNames, Types)
If (Ret = 0) And (Err.Number = 0) And IsArray(strNames) Then
For ind = LBound(strNames) To UBound(strNames)
If LCase(strNames(ind)) = "displayname" Or LCase(strNames(ind)) = "displayversion" Then
Verif = True
Exit For
ELse
Verif = False
End If
Next
End If
VerifTypes = Verif
End Function
'***************************************************************************************
Function ExtractVersion(Data)
Dim objRegex,Match,Matches
Set objRegex = new RegExp
objRegex.Pattern = "\d{2}\.\d"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
ExtractVersion = Match.Value
Next
End Function
'***************************************************************************************
Function GetVersionStringAsArray(ByVal Version)
Dim VersionAll, VersionParts, N
VersionAll = Array(0, 0, 0, 0)
VersionParts = Split(Version, ".")
For N = 0 To UBound(VersionParts)
VersionAll(N) = CLng(VersionParts(N))
Next
Dim Hi, Lo
Hi = Lsh(VersionAll(0), 16) + VersionAll(1)
Lo = Lsh(VersionAll(2), 16) + VersionAll(3)
GetVersionStringAsArray = Array(Hi, Lo)
End Function
'***************************************************************************************
' Compares two versions "a.b.c.d". If Version1 < Version2,
' returns -1. If Version1 = Version2, returns 0.
' If Version1 > Version2, returns 1.
Function CompareVersions(ByVal Version1, ByVal Version2)
Dim Ver1, Ver2, Result
Ver1 = GetVersionStringAsArray(Version1)
Ver2 = GetVersionStringAsArray(Version2)
If Ver1(0) < Ver2(0) Then
Result = -1
ElseIf Ver1(0) = Ver2(0) Then
If Ver1(1) < Ver2(1) Then
Result = -1
ElseIf Ver1(1) = Ver2(1) Then
Result = 0
Else
Result = 1
End If
Else
Result = 1
End If
CompareVersions = Result
End Function
'***************************************************************************************
Function GetFirefoxMajorVersion(URL)
Dim Titre,ie,objFSO,Data,OutPut,objRegex,Match,Matches
Titre = "La dernière version de Firefox"
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate(URL)
ie.Visible=False
DO WHILE ie.busy
Wscript.Sleep 100
Loop
Data = ie.document.documentElement.innerHTML
Set objRegex = new RegExp
objRegex.Pattern = "\d{2}\.\d"
objRegex.Global = True
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
GetFirefoxMajorVersion = Match.Value
Next
ie.Quit
Set ie = Nothing
End Function
'***************************************************************************************
Here is another way to get FileVersion of Firefox.exe using Powershell and Vbscript
GetFileDetailsFirefox.vbs
Option Explicit
Dim MyCmd,Ws,Ret,ByPassPSFile,PSFile,PathFile,OutPut
Set Ws = CreateObject("wscript.Shell")
PathFile = Ws.ExpandEnvironmentStrings("%ProgramFiles%") & "\Mozilla Firefox\Firefox.exe"
OutPut = Ws.ExpandEnvironmentStrings("%Temp%") & "\firefox_version.txt"
PSFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
ByPassPSFile = "cmd /c PowerShell.exe -ExecutionPolicy bypass -noprofile -file "
MyCmd = "Get-ChildItem "& DblQuote(PathFile) &" | Get-ItemProperty | Select VersionInfo | Format-List > " & OutPut &""
Call WriteLog(MyCmd)
Ret = Ws.run(ByPassPSFile & PSFile,0,True)
ws.run DblQuote(OutPut)
'**********************************************************************************************
Sub WriteLog(strText)
Dim fs,ts,PSFile
Const ForWriting = 2
PSFile = Left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(PSFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'***********************************************************************************************
