This question already has an answer here:
Reading and writing an INI file
(1 answer)
Closed 2 years ago.
I have .ini file and I need to edit one line of that with user input
## General configuration attempt:
###
[Settings]
AppId = 1843
;.................................................
UnlockAllDLCs = 1
UbiConnection = 0
IsUserConnected = 1
;.................................................
PlayerName = SoulFlyers
Language = en-US
SaveLocation = %standard%
;.................................................
Email = *****#flyers.com
Password = so*****1234
CdKey = AAAA-BBBB-CCCC-DDDD
AccountId = ********
TicketId = SoulFlye*****Lovers
;.................................................
###
## Insert the DLC list that you wish to unlock here:
###
[DLC]
; %appid% = %Name%
In this .ini file I need to change the
PlayerName = SoulFlyers
with user input.
I tried with objOutFile.WriteLine and fileStream.WriteLine like this:
Option Explicit
Const ForAppending = 8
Dim ws,fso,RootFolder,MyFile,firstNameInput,fileStream
Do
firstNameInput = inputbox("Please enter your name")
Loop Until firstNameInput <> ""
Set Ws = CreateObject("Wscript.Shell")
RootFolder = Ws.ExpandEnvironmentStrings("%USERPROFILE%\Desktop")
MyFile = RootFolder & "\Edit.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileStream = fso.OpenTextFile(MyFile,ForAppending,True)
fileStream.WriteLine String(50,"*")
fileStream.WriteLine "First name: " & firstNameInput
fileStream.Close
ws.run DblQuote(MyFile)
'*****************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************
but it adds lines to .ini files.
How can I solve it?
Thanks.
This could be a nice solution for your issue, i found this neat function on a french forum :
NB : I will try to translate the comments as soon as possible in english
Option Explicit
Dim Title,fso,oFile,PlayerName,NewPlayerName
Title = "Read and Write from INI file"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.GetFile("Settings.ini")
PlayerName = WriteReadIni(oFile,"Settings","PlayerName",Null) 'For reading only
MsgBox "The content of this variable PlayerName read from Settings.ini file is : " & vbCrlf &_
"PlayerName = " & PlayerName, vbInformation,Title
NewPlayerName = WriteReadIni(oFile,"Settings","PlayerName","Dariush") ' write the new variable here as example "Dariush"
MsgBox "The New content of this variable PlayerName read from Settings.ini file is : " & vbCrlf &_
"PlayerName = " & PlayerName, vbInformation,Title
Function WriteReadIni(oFile,section,key,value)
' *******************************************************************************************
' omen999 - mars 2018 v 1.1 - http://omen999.developpez.com/
' écrit/lit la clé <key> de section <section> de l'objet fichier oFile avec la valeur <value> si lecture : value = Null
' en écriture si la section et/ou la clé n'existent pas, elles seront créées
' en écriture renvoie faux si le couple clé/valeur existait déjà sinon vrai
' en lecture renvoie soit : la valeur de clé, une chaine vide en cas de clé vide ou Faux si la clé n'existe pas
' ********************************************************************************************
Dim oText,iniText,sectText,newSectText,keyText,reg,regSub
' Initialisation des objets regexp
' peut être déplacé dans le code principal en cas d'appels successifs
Set reg = New RegExp
Set regSub = New RegExp
reg.MultiLine=True 'simplifie le pattern
reg.IgnoreCase = True
regSub.IgnoreCase = True
Set oText = oFile.OpenAsTextStream(1,0)
iniText = oText.ReadAll
oText.Close
reg.Pattern = "^\[" & section & "\]((.|\n[^\[])+)"
regSub.Pattern = "\b" & key & " *= *([^;\f\n\r\t\v]*)"
On Error Resume Next
If IsNull(value) Then ' lecture clé
WriteReadIni = regSub.Execute(reg.Execute(iniText).Item(0).SubMatches(0)).Item(0).SubMatches(0)
If Err.Number = 5 then WriteReadIni = False
Else ' écriture clé
sectText = reg.Execute(iniText).Item(0).SubMatches(0)
If Err.Number = 5 Then ' section inconnue
iniText = iniText & vbCrLf & "[" & section & "]" & vbCrLf & key & "=" & value
Else
newSectText = regSub.Replace(sectText,key & "=" & value)
If newSectText = sectText Then ' pas de remplacement constaté. soit le clé/valeur existe déjà soit c'est une nouvelle clé
If regSub.Test(sectText) Then ' le couple clé/valeur existe déjà -> sortie
WriteReadIni = False
Exit Function
End If
If Right(sectText,1) = vbCr Then keyText = key & "=" & value Else keyText = vbCrLf & key & "=" & value
newSectText = sectText & keyText
End If
iniText = reg.Replace(iniText,"[" & section & "]" & newSectText)
End If
Set oText = oFile.OpenAsTextStream(2,0)
oText.Write iniText
oText.Close
WriteReadIni = True
End If
End Function
thanks from all.
i found the solution for my code.
first ask from user to enter his name then, run the prgrom
Dim fso, objOutFile,PlayerName,fileStream,ws,objShell
Do
PlayerName = inputbox("Please Enter Your Name")
Loop Until PlayerName <> ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutFile = fso.CreateTextFile("D:\Program Files (x86)\Games\game\user.ini",True)
objOutFile.WriteLine "## General configuration attempt:"
objOutFile.WriteLine "###"
objOutFile.WriteLine "[Settings]"
objOutFile.WriteLine "AppId = 1843"
objOutFile.WriteLine ";................................................."
objOutFile.WriteLine "UnlockAllDLCs = 1"
objOutFile.WriteLine "UbiConnection = 0"
objOutFile.WriteLine "IsUserConnected = 1"
objOutFile.WriteLine ";................................................."
objOutFile.WriteLine "PlayerName = " & PlayerName
objOutFile.WriteLine "Language = en-US"
objOutFile.WriteLine "SaveLocation = %standard%"
objOutFile.WriteLine ";................................................."
objOutFile.WriteLine "Email = soul#******m"
objOutFile.WriteLine "Password = so*****rd1234"
objOutFile.WriteLine "CdKey = AAAA-BBB*****D"
objOutFile.WriteLine "AccountId = c******c2c1"
objOutFile.WriteLine "TicketId = SoulFl****vers"
objOutFile.WriteLine ";................................................."
objOutFile.WriteLine "###"
objOutFile.WriteLine "## Insert the DLC list that you wish to unlock here:"
objOutFile.WriteLine "###"
objOutFile.WriteLine "[DLC]"
objOutFile.WriteLine "; %appid% = %Name%"
Set objShell = WScript.CreateObject( "WScript.Shell" )
objShell.Run("""D:\Program Files (x86)\Games\\game.exe""")
This function WriteReadIni can be used easily for reading and writing from an INI file :
Here is the English Version :
Option Explicit
Dim Title,fso,oFile,PlayerName,NewPlayerName
Title = "Read and Write from INI file"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFile = fso.GetFile("Settings.ini")
PlayerName = WriteReadIni(oFile,"Settings","PlayerName",Null) 'For reading only
MsgBox "The content of this variable PlayerName read from Settings.ini file is : " & vbCrlf &_
"PlayerName = " & PlayerName, vbInformation,Title
Do
PlayerName = inputbox("Please enter your name")
Loop Until PlayerName <> ""
NewPlayerName = WriteReadIni(oFile,"Settings","PlayerName",PlayerName) ' Writing the new variable to ini file
NewPlayerName = WriteReadIni(oFile,"Settings","PlayerName",Null) ' Reading the new variable
MsgBox "The New content of this variable PlayerName read from Settings.ini file is : " & vbCrlf &_
"PlayerName = " & NewPlayerName, vbInformation,Title
'-----------------------------------------------------------------------------------------------------------------------
Function WriteReadIni(oFile,section,key,value)
'-----------------------------------------------------------------------------------------------------------------------
' omen999 - mars 2018 v 1.1 - http://omen999.developpez.com/
' writes / reads the <key> of the <section> section of the oFile file object with the value <value> if read: value = Null
' In writing if the section and / or the key do not exist, they will be created
' In writing returns false if the key / value pair already existed if not true
' In read returns either: the key value, an empty string in the case of an empty key or False if the key does not exist
'-----------------------------------------------------------------------------------------------------------------------
Dim oText,iniText,sectText,newSectText,keyText,reg,regSub
' Initialization of regex objects
' Can be moved in the main code in case of successive calls
Set reg = New RegExp
Set regSub = New RegExp
reg.MultiLine=True 'simplifie le pattern
reg.IgnoreCase = True
regSub.IgnoreCase = True
Set oText = oFile.OpenAsTextStream(1,0)
iniText = oText.ReadAll
oText.Close
reg.Pattern = "^\[" & section & "\]((.|\n[^\[])+)"
regSub.Pattern = "\b" & key & " *= *([^;\f\n\r\t\v]*)"
On Error Resume Next
If IsNull(value) Then ' key reading
WriteReadIni = regSub.Execute(reg.Execute(iniText).Item(0).SubMatches(0)).Item(0).SubMatches(0)
If Err.Number = 5 then WriteReadIni = False
Else ' key writing
sectText = reg.Execute(iniText).Item(0).SubMatches(0)
If Err.Number = 5 Then ' Unknown section
iniText = iniText & vbCrLf & "[" & section & "]" & vbCrLf & key & "=" & value
Else
newSectText = regSub.Replace(sectText,key & "=" & value)
If newSectText = sectText Then ' No replacement noted. either the key / value already exists or it is a new key
If regSub.Test(sectText) Then ' The key / value pair already exists -> Exit Function
WriteReadIni = False
Exit Function
End If
If Right(sectText,1) = vbCr Then keyText = key & "=" & value Else keyText = vbCrLf & key & "=" & value
newSectText = sectText & keyText
End If
iniText = reg.Replace(iniText,"[" & section & "]" & newSectText)
End If
Set oText = oFile.OpenAsTextStream(2,0)
oText.Write iniText
oText.Close
WriteReadIni = True
End If
End Function
'-----------------------------------------------------------------------------------------------------------------------
Related
I have a VB script which scans the mentioned log file for errors and sends a notification through an email.
How can I scan the latest log file in the folder? For example, Filename1.070615 (Filename1.mmddyy) is a log file. After a certain size, the logfile switches to new file with the same name but different date: Filename1.070615.
cdoSendUsingPort = 2, _
Const ForReading = 1
Dim intStartAtLine, strFileCreateddate, i, strResults, strTextToScanFor, bStartFromScratch
Dim strLastCheckedFor, strArrayToString, strSubject, strMailFrom, strMailTo
strMailto = "<Emailaddress>"
strMailFrom = "<FromAddress>"
strSubject = "Log scanner"
strSMTPServer = "x.x.x.x"
FileToRead = "D:\LOG\filename1.mmddyy"
arrTextToScanFor = Array("error","another thing")
Set WshShell = WScript.CreateObject("WScript.Shell")
searchkey = replace(replace(filetoread,":",""),"\","_")
On Error Resume Next
strLastFileCheckedCreateDate = WshShell.RegRead("HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\CreateDate")
strLastFileLastLineChecked = WshShell.RegRead("HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\LastLineChecked")
strLastCheckedFor = WshSHell.RegRead("HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\CheckForString")
iLastCheckedLine = WshSHell.RegRead("HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\LastLineChecked")
On Error GoTo 0
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set varFile = objFSO.GetFile(FileToRead)
arrLastCheckedForText = split(strLastCheckedFor,",")
strFileCreateDate = varfile.datecreated
strFileModifiedDate = varfile.datelastmodified
sStatus = "<li>Using mail server: " & strSMTPServer & "</li><li>Running from: " & wscript.scriptfullname & "</li>"
Set objTextFile = objFSO.OpenTextFile(FileToRead, ForReading)
objTextFile.ReadAll
iLineCount = objTextFile.Line
objTextFile.close
If strLastCheckedFor = "" Then
bStartFromScratch = true
sStatus = sStatus & "<li>First run of script against string search</li>" & vbcrlf
ElseIf ubound(arrTextToScanFor) <> ubound(arrLastCheckedForText) Then
bStartFromScratch = true
sStatus = sStatus & "<li>Count of string search criteria has changed</li>" & vbcrlf
Else
For each strItem in arrTextToScanFor
Else
bStartFromScratch = true
'MsgBox strResults
End If
If bStartFromScratch = true Then
sStatus = sStatus & "<li>String search criteria does not match prior search</li>" & vbcrlf
End If
Next
End If
If cint(iLineCount) < cint(iLastCheckedLine) Then
bStartFromScratch = true
sStatus = sStatus & "<li>Last line checked (" & iLastCheckedLine & ") is greater than total line count (" & iLineCount & ") in file</li>"
End If
If CStr(strFileCreateDate) = CStr(strLastFileCheckedCreateDate) and bStartFromScratch <> true Then
intStartAtLine = strLastFileLastLineChecked
If bStartFromScratch <> true then
sStatus = sStatus & "<li>Continuing search from line " & intStartAtLine & "</li>" & vbcrlf
End If
ElseIf strFileCreateDate <> strLastFileCheckedCreateDate or bStartFromScratch = true Then
intStartAtLine = 0
If bStartFromScratch <> true then
sStatus = sStatus & "<li>File created date has changed, starting search from line 0</li>" & vbcrlf
End If
End If
i = 0
Dim strNextLine
For each strItem in arrTextToScanFor
strArrayToString = strArrayToString & delim & strItem
delim = ","
Next
Set objTextFile = objFSO.OpenTextFile(FileToRead, ForReading)
Do While objTextFile.AtEndOfStream <> True
If i < CInt(intStartAtLine) Then
objTextFile.skipline
Else
'MsgBox i
strNextLine = objTextFile.Readline
For each strItem in arrTextToScanFor
If InStr(LCase(strNextLine),LCase(strItem)) Then
strResults = "<span style='font-family:courier-new;color:#696969'><span style='font-weight:bold;background-color:#BEF3F3'>Line " & i & ":</span> " & replace(lcase(strNextLine),lcase(strItem),"<span style='background-color:#FFFF81'>" & strItem & "</span>") & "</span><br>" & vbcrlf & strResults
bSendMail = true
End If
Next
End If
i = i + 1
Loop
objTextFile.close
Set WshShell = CreateObject("WScript.Shell")
'Let's save our settings for next time.
WshShell.RegWrite "HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\FileChecked", FileToRead, "REG_SZ"
WshShell.RegWrite "HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\CreateDate", strFileCreateDate, "REG_SZ"
WshShell.RegWrite "HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\LastLineChecked", i, "REG_SZ"
WshShell.RegWrite "HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\LastScanned", Now, "REG_SZ"
WshShell.RegWrite "HKCU\Software\RDScripts\CheckTXTFile\" & searchkey & "\CheckForString",strArrayToString, "REG_SZ"
set WshShell = nothing
strFileSummary = "<tr><td style='font-family:calibri;font-weight:bold;color:darkblue;width:200px'>File path:</td><td>" & FileToRead & "</td></tr>"
strFileCreateDateSummary = "<tr><td style='font-family:calibri;font-weight:bold;color:darkblue;width:200px'>Created date:</td><td>" & strFileCreateDate & "</td></tr>"
strFileModifiedDateSummary = "<tr><td style='font-family:calibri;font-weight:bold;color:darkblue;width:200px'>Modified date:</td><td>" & strFileModifiedDate & "</td></tr>"
strArraySummary = "<tr><td style='font-family:calibri;font-weight:bold;color:darkblue;width:200px'>Text string(s):</td><td>" & strArrayToString & "</td></tr>"
strFileLineSummary = "<tr><td style='font-family:calibri;font-weight:bold;color:darkblue;width:200px'>Last line checked:</td><td>" & i & "</td></tr>"
strSummary = strFileSummary & strFileCreateDateSummary & strFileModifiedDateSummary & strArraySummary & strFileLineSummary
strBodyContent = "<table style='font-family:calibri;'>" & strSummary & "</table><br><br><span style='font-size:large;'>Entries:</span><br>" & strResults & "<div style='padding-top:30px;font-size:x-small'><br><div style='font-weight:bold;font-family:calibri;color:black;'>Job Details:<ul style='font-weight:normal;font-family:calibri;color:darkgray;'>" & sStatus & "</ul></div></div>"
on error goto 0
'Send the email if need be.
If bSendMail = true Then Call sendmail(strMailFrom,strMailTo,strSubject,strBodyContent)
'------------------------------------------------------------------------
'Function EmailFile - email the warning file
'------------------------------------------------------------------------
Function SendMail(strFrom,strTo,strSubject,strMessage)
Dim iMsg, iConf, Flds
On Error GoTo 0
'// Create the CDO connections.
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
'// SMTP server configuration.
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
'// Set the SMTP server address here.
.Item(cdoSMTPServer) = strSMTPServer
.Update
End With
'// Set the message properties.
With iMsg
Set .Configuration = iConf
.To = strMailTo
.From = strMailFrom
.Subject = strSubject
.htmlbody = strMessage
End With
'iMsg.HTMLBody = strMessage
'// Send the message.
iMsg.Send ' send the message.
If CStr(err.number) <> 0 Then
Else
End If
End Function
It would be a bit easier if your log files were named filename1.yymmdd.
Nevertheless, we can use a regex to not only verify the filename but also swap the date components to put them in our desired format!
Set re = New RegExp
re.Pattern = "^(filename1\.)(\d{2})(\d{2})(\d{2})$"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each objFile In fso.GetFolder("d:\log").Files
If re.Test(objFile.Name) Then
strCompareName = re.Replace(objFile.Name, "$1$4$2$3")
If strCompareName > strLatest Then strLatest = strCompareName
End If
Next
' Switch the name back...
strLatest = re.Replace(strLatest, "$1$3$4$2")
WScript.Echo "The latest file is: " & strLatest
This line:
strCompareName = re.Replace(objFile.Name, "$1$4$2$3")
changes the format from mmddyy to yymmdd and saves it in a string for comparison.
Once we've finished our comparisons, we just need to take the latest file we found and reverse the process:
strLatest = re.Replace(strLatest, "$1$3$4$2")
to get the original filename back!
I need help in finding installed software version, license etc.
the below script works fine but it lists out all the installed softwares.
But am trying to find out a particular software.It gives nice output, can you help me here.
==================================================
'This script outputs to a .tsv file a list of applications installed on the computer
'Output file is software.tsv
'Usage: cscript applications.vbs
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("C:\WINDOWS\system32\temp\software.tsv", True)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product")
objTextFile.WriteLine "Caption" & vbtab & _
"Description" & vbtab & "Identifying Number" & vbtab & _
"Install Date" & vbtab & "Install Location" & vbtab & _
"Install State" & vbtab & "Name" & vbtab & _
"Package Cache" & vbtab & "SKU Number" & vbtab & "Vendor" & vbtab _
& "Version"
For Each objSoftware in colSoftware
objTextFile.WriteLine objSoftware.Caption & vbtab & _
objSoftware.Description & vbtab & _
objSoftware.IdentifyingNumber & vbtab & _
objSoftware.InstallDate2 & vbtab & _
objSoftware.InstallLocation & vbtab & _
objSoftware.InstallState & vbtab & _
objSoftware.Name & vbtab & _
objSoftware.PackageCache & vbtab & _
objSoftware.SKUNumber & vbtab & _
objSoftware.Vendor & vbtab & _
objSoftware.Version
Next
objTextFile.Close
======================================================
i just looking for details of C:\Program Files\HP\hponcfg\hponcfg.exe and i do not bother about other installed softwares, by default the above script gives the details of all the softwares, but i just do not need that.
where do i insert this line in the script.??
regards,
Dharanesh,
Check this modification, i tried it with name Google, so check it if retruns for you what do you expect or not ?
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("WScript.Shell")
LogFile = "software.tsv"
if objFSO.FileExists(LogFile) Then
objFSO.DeleteFile(LogFile)
End if
Set objTextFile = objFSO.OpenTextFile(LogFile,8,True)
MySoftware = "Google"
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product where Name Like " & CommandLineLike(MySoftware))
objTextFile.WriteLine "Caption" & vbtab & _
"Description" & vbtab & "Identifying Number" & vbtab & _
"Install Date" & vbtab & "Install Location" & vbtab & _
"Install State" & vbtab & "Name" & vbtab & _
"Package Cache" & vbtab & "SKU Number" & vbtab & "Vendor" & vbtab _
& "Version"
For Each objSoftware in colSoftware
objTextFile.WriteLine objSoftware.Caption & vbtab & _
objSoftware.Description & vbtab & _
objSoftware.IdentifyingNumber & vbtab & _
objSoftware.InstallDate2 & vbtab & _
objSoftware.InstallLocation & vbtab & _
objSoftware.InstallState & vbtab & _
objSoftware.Name & vbtab & _
objSoftware.PackageCache & vbtab & _
objSoftware.SKUNumber & vbtab & _
objSoftware.Vendor & vbtab & _
objSoftware.Version
Next
objTextFile.Close
ws.run "Notepad software.tsv"
'**************************************************************************
Function CommandLineLike(MySoftware)
MySoftware = Replace(MySoftware, "\", "\\")
CommandLineLike = "'%" & MySoftware & "%'"
End Function
'**************************************************************************
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
'***********************************************************************************************
I need to develop a script which compares the size of a folder from its previous size which is saved in text file. If the folder size has increased it should prompt folder size increased.
Monitoring directory with VBScript
Option Explicit
Dim fso,Message,Message2,Msg,intInterval,strDrive,strFolder,strComputer,objWMIService,strQuery
Dim colEvents,objEvent,objTargetInst,objPrevInst,objProperty,ws,LOG_FILE_PATH,LogFile,Chemin,MonTableau
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
strComputer = "."
Chemin = Parcourir_Dossier()
MonTableau = Split(Chemin,"\")
LogFile = MonTableau(UBound(MonTableau)) & ".log"
LOG_FILE_Path = ws.ExpandEnvironmentStrings("%AppData%") & "\" & LogFile
intInterval = "2"
'****************************************************************************************************
Function Parcourir_Dossier()
Dim ws,objFolder,Copyright
Copyright = "[ © Hackoo © 2014 ]"
Set ws = CreateObject("Shell.Application")
Set objFolder = ws.BrowseForFolder(0,"Choose the folder to watch for "_
& Copyright,1,"c:\Programs")
If objFolder Is Nothing Then
Wscript.Quit
End If
Parcourir_Dossier = objFolder.self.path
end Function
'****************************************************************************************************
Chemin = Split(fso.GetAbsolutePathName(Chemin),":")
strDrive = Chemin(0) & ":"
strFolder = Replace(Chemin(1), "\", "\\")
If Right(strFolder, 2) <> "\\" Then strFolder = strFolder & "\\"
'Connexion au WMI
Set objWMIService = GetObject( "winmgmts:" &_
"{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\cimv2" )
'La chaîne de la requête
strQuery = _
"Select * From __InstanceOperationEvent" _
& " Within " & intInterval _
& " Where Targetinstance Isa 'CIM_DataFile'" _
& " And TargetInstance.Drive='" & strDrive & "'"_
& " And TargetInstance.path='" & strFolder & "'"
'Exécutez la requête
Set colEvents = _
objWMIService.ExecNotificationQuery(strQuery)
Do
Set objEvent = colEvents.NextEvent()
Set objTargetInst = objEvent.TargetInstance
Select Case objEvent.path_.Class
'Si c'est le cas de la création de fichier ou d'un événement de suppression et afficher
'juste le nom du fichier
Case "__InstanceCreationEvent"
Message = DblQuote(objTargetInst.Name) & " is created !"
Message2 = String(10,"*") & Now & String(10,"*") & vbCrLf & Message & vbCrLf & String(70,"*")
Call Log(LOG_FILE_Path,Message2)
MsgBox Message,VbInformation,Message
Case "__InstanceDeletionEvent"
Message = DblQuote(objTargetInst.Name) & " is deleted !"
Message2 = String(10,"*") & Now & String(10,"*") & vbCrLf & Message & vbCrLf & String(70,"*")
Call Log(LOG_FILE_Path,Message2)
MsgBox Message,VbInformation,Message
'Si c'est le cas de la modification du fichier,comparer les valeurs de propriété de la cible et de l'instance précédente
'et afficher les propriétés qui ont été changé comme la taille et LastModified
Case "__InstanceModificationEvent"
Set objPrevInst = objEvent.PreviousInstance
For Each objProperty In objTargetInst.Properties_
If objProperty.Value <> _
objPrevInst.Properties_(objProperty.Name) Then
Message = "modified file : " & vbCrLf &_
objTargetInst.Name & vbCrLf &_
"Property : "_
& objProperty.Name & vbCrLf &_
"Last Value : "_
& objPrevInst.Properties_(objProperty.Name) & vbCrLf &_
"New value : " _
& objProperty.Value
Message2 = String(10,"*") & Now & String(10,"*") & vbCrLf & Message & vbCrLf & String(70,"*")
Call Log(LOG_FILE_Path,Message2)
MsgBox Message,64,DblQuote(objTargetInst.Name)
End If
Next
End Select
Loop
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Log(strLogFileChemin,strLogContent)
Const APPEND = 8
Dim objFso,objLogFile
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FileExists(strLogFileChemin) Then objFso.CreateTextFile(strLogFileChemin, True).Close
Set objLogFile = objFso.OpenTextFile(strLogFileChemin,APPEND)
objLogFile.WriteLine strLogContent
objLogFile.Close
End Sub
'**********************************************************************************************
Try like this :
Folder = "c:\your\path\tata"
File = "c:\your\file\containing\the\value.txt"
set objFSO = CreateObject("Scripting.FileSystemObject")
set fileRead = objfso.OpenTextFile(file, 1)
content = fileRead.Readline
FileRead.close
set objFolder = objFSO.GetFolder(Folder)
if objFolder.Size > Clng(content) Then Wscript.Echo "The Folder size [" & ObjFolder.size & "] is bigger then [" & content & "]"
If you need to update the value in your text file.
Folder = "c:\your\path\tata"
File = "c:\your\file\containing\the\value.txt"
set objFSO = CreateObject("Scripting.FileSystemObject")
set fileRead = objfso.OpenTextFile(file, 1)
content = fileRead.Readline
FileRead.close
set objFolder = objFSO.GetFolder(Folder)
set fileWrite = objfso.OpenTextFile(file, 2)
FileWrite.writeline(ObjFolder.size)
FileWrite.close
if objFolder.Size > Clng(content) Then Wscript.Echo "The Folder size [" & ObjFolder.size & "] is bigger then [" & content & "]"
I have this piece of code from the ScriptIT guys.
Set objSysInfo = CreateObject("ADSystemInfo")
strComputer = objSysInfo.ComputerName
Set objComputer = GetObject("LDAP://" & strComputer)
arrOUs = Split(objComputer.Parent, ",")
arrMainOU = Split(arrOUs(0), "=")
wscript.echo arrMainOU(1)
The problem I'm having is that arrMainOU(1) echoes the OU twice. I tried setting up a simple test, but it fails. I don't see this issue covered here or on google.
If arrMainOU(1) = "myOU" Then
wcript.echo "true"
End If
I need to compare 1 value within arrMainOU(1) to an array that contains OU strings. I need a case statement that performs actions depending on whether it's OU1 or OU2 and so on.
I'm getting stuck at evaluating arrMainOU(1) though. If I output the value to a file, then it only writes one value.
Any help would be appreciated - Thank you
Try this code snippet to understand the 'SPLIT' function:
Set objSysInfo = CreateObject("ADSystemInfo")
strComputer = objSysInfo.ComputerName
Set objComputer = GetObject("LDAP://" & strComputer)
arrOUs = Split(objComputer.Parent, ",")
retstring = ""
For ii = LBound( arrOUs) To UBound( arrOUs)
arrMainOU = Split(arrOUs(ii), "=")
For jj = LBound( arrMainOU) To UBound( arrMainOU)
retstring = retstring & "arrOUs(" & CSTR( ii) & ") = " & arrOUs(ii) & vbTab
retstring = retstring & "arrMainOU(" & CSTR( jj) & ") = " & arrMainOU(jj) & vbNewLine
Next
retstring = retstring & vbNewLine
Next
Wscript.Echo retstring
i am getting a error
The VB file reads col1 and finds the matching image name in the directory and the renames that file to col2 it produces a report to show what images haven't been renamed and placed the ones that have in a folder called rename
i have attached the code so you can see
strDocMap = "C:\img\DocMap.xlsx"
strInputFolder = "C:\img\"
strOutputFolder = "C:\img\renamed\"
strLogFile = "C:\img\RenamingLog.txt"
strPattern = "\d{5}"
Set regExpression = New RegExp
With regExpression
.Global = True
.IgnoreCase = True
.Pattern = strPattern
End With
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Const xlUp = -4162
Const xlFormulas = -4123
Const xlPart = 2
Const xlByRows = 1
Const xlNext = 1
Set objWB = objExcel.Workbooks.Open(strDocMap, False, True)
Set objSheet = objWB.Sheets(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Right(strInputFolder, 1) <> "\" Then strInputFolder = strInputFolder & "\"
If Right(strOutputFolder, 1) <> "\" Then strOutputFolder = strOutputFolder & "\"
If objFSO.FolderExists(strOutputFolder) = False Then objFSO.CreateFolder strOutputFolder
Set objLog = objFSO.CreateTextFile(strLogFile, True)
objLog.WriteLine "Script started " & Now
objLog.WriteLine "Enumerating files in folder: " & strInputFolder
objLog.WriteLine "Renaming files to folder: " & strOutputFolder
objLog.WriteLine String(80, "=")
For Each objFile In objFSO.GetFolder(strInputFolder).Files
Set colMatches = regExpression.Execute(objFile.Name)
If colMatches.Count > 0 Then
If colMatches.Count = 1 Then
For Each objMatch In colMatches
strOldNum = objMatch.Value
Set objCell = objSheet.Cells.Find(strOldNum, objSheet.Range("A1"), xlFormulas, xlPart, xlByRows, xlNext, False, False)
If Not objCell Is Nothing Then
strNewNum = objCell.Offset(0, 1).Value
If strNewNum <> "" Then
strNewPath = strOutputFolder & strNewNum & "." & objFSO.GetExtensionName(objFile.Path)
' Check if a file already exists without the appended letter
blnValid = True
If objFSO.FileExists(strNewPath) = True Then
blnValid = False
' Start at "a"
intLetter = 97
strNewPath = strOutputFolder & strNewNum & Chr(intLetter) & "." & objFSO.GetExtensionName(objFile.Path)
Do While objFSO.FileExists(strNewPath) = True
intLetter = intLetter + 1
strNewPath = strOutputFolder & strNewNum & Chr(intLetter) & "." & objFSO.GetExtensionName(objFile.Path)
If intLetter > 122 Then Exit Do
Loop
If intLetter <= 122 Then blnValid = True
End If
If blnValid = True Then
objLog.WriteLine "Renaming " & objFile.Name & " to " & Mid(strNewPath, InStrRev(strNewPath, "\") + 1)
objFSO.MoveFile objFile.Path, strNewPath
Else
objLog.WriteLine "Unable to rename " & objFile.Name & ". Letters exhausted."
End If
End If
End If
Next
Else
objLog.WriteLine objFile.Name & " contains " & colMatches.Count & " matches. Manual adjustment required."
End If
End If
Next
objLog.WriteLine String(80, "=")
objLog.WriteLine "Script finished " & Now
objWB.Close False
objExcel.Quit
objLog.Close
MsgBox "Done"
Thanks
Jack
If line 68
objLog.WriteLine objFile.Name & " contains " & colMatches.Count & " matches. Manual adjustment required."
is really the culprit, I would argue:
The objects objLog, objFile, and colMatches were used before -
acquittal
The methods .WriteLine, .Name, and .Count look good - acquittal
Concatenation (&) should work on string literals and not
null/empty/nothing elements - acquittal
By elimination: objFile.Name contains a funny letter (not
convertable to 'ASCII'). Easy check: Replace "objFile.Name" with a
string literal.
Evidence
Dim s
For Each s In Array(Empty, Null, ChrW(1234))
On Error Resume Next
goFS.CreateTextFile("tmp.txt", True).WriteLine s
WScript.Echo Err.Description
On Error GoTo 0
Next
output:
====================================
Type mismatch
Invalid procedure call or argument
====================================