I have a small script that I want to find the computers name, and create a text file in the flash drive the script will run from named after the PC's name.
So far I can pull the name into a variable, and create a text file with a string literal argument. but If I try to pass the name into GetFileName and GetAbsolutePathName calls it either gives me an error or gives the file a blank name.
Edit: I have updated the code to the full code. The program is intended to get the Windows license keys on all the computers in the labs I manage for easy reference. I apologize if the issue is simple, this is my first script I have written, and I feel like it is something I just seem to be missing.
The code in question:
Set WshShell = CreateObject("WScript.Shell")
ConvertToKey(WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"))
Set wshShell = CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
Function ConvertToKey(Key)
Const KeyOffset = 52
i = 28
Chars = "BCDFGHJKMPQRTVWXY2346789"
Do
Cur = 0
x = 14
Do
Cur = Cur * 256
Cur = Key(x + KeyOffset) + Cur
Key(x + KeyOffset) = (Cur \ 24) And 255
Cur = Cur Mod 24
x = x - 1
Loop While x >= 0
i = i - 1
KeyOutput = Mid(Chars, Cur + 1, 1) & KeyOutput
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i - 1
KeyOutput = "-" & KeyOutput
End If
Loop While i >= 0
ConvertToKey = KeyOutput
Dim filesys, filetxt, getname, path
Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.CreateTextFile("I:\"& strComputerName & ".txt", True)
path = filesys.GetAbsolutePathName("I:\"& strComputerName & ".txt")
getname = filesys.GetFileName(path)
filetxt.WriteLine(KeyOutPut)
filetxt.Close
End Function
The result is a text file named ".txt" in the correct location.
You must pass strComputerName into the function, and preface the call with the Call keyword.
Related
I'm trying to get the date from an attribute called 'accountExpires' of a computer object in Active Directory. If the object haven't been set it just says 'never' and if you look it just have a many numbers. I made this and it working for the attribute 'lastlogon', but not for 'accountExpires'. Maybe someone can help me out.
I'm using VBscript because our company is using this in our loginscript.
On Error Resume Next
Dim ADSysInfo, objComputer, lobjDate, laccountExpiresDate, WSHShell
Set WSHShell = CreateObject("WScript.Shell")
Set ADSysInfo = CreateObject("ADSystemInfo")
Set objComputer = GetObject("LDAP://" & ADSysInfo.ComputerName)
msgbox objComputer
Set lobjDate = objComputer.get("lastLogon") ' <----- Working ----->
' Set lobjDate = objComputer.get("accountExpires") ' <----- Not Working ----->
msgbox err.number
if IsNull(lobjDate) then
msgbox "No Date"
else
laccountExpiresDate = Integer8Date(lobjDate, getLocaltimeZoneBias)
msgbox laccountExpiresDate
end if
Function Integer8Date(objDate, lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for bug in IADslargeInteger property methods.
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow) / 600000000 - lngAdjust) / 1440
Integer8Date = CDate(lngDate)
End Function
' Obtain local time zone bias from machine registry.
Function getLocaltimeZoneBias
Dim lngBiasKey, lngBias
lngBiasKey = WSHShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
getLocaltimeZoneBias = lngBias
End Function 'getLocaltimeZoneBias
how can I write UTF-8 encoded strings to a textfile from VBScript? I have tried some variations but no success. So I need the text file saved in UTF-8 format. thanks in advance for your all help.
Output :
CN=™ser1 D˜,OU=TEST,OU=TEST,OU=Users,OU=contoso,DC=contoso,DC=local;10.01.2012 01:00:00
CN=Gšbson ¦LU,OU=TEST,OU=TEST,OU=Users,OU=contoso,DC=contoso,DC=local;20.12.2016 18:55:51
CN=™ZL €ET˜,OU=TEST,OU=TEST,OU=Users,OU=contoso,DC=contoso,DC=local;27.08.2013
type ExpReport.txt (as you can see no special characters)
CN=ser1 D,OU=TEST,OU=TEST,OU=Users,OU=contoso,DC=contoso,DC=local;10.01.2012 01:00:00
CN=Gbson LU,OU=TEST,OU=TEST,OU=Users,OU=contoso,DC=contoso,DC=local;20.12.2016 18:55:51
CN=ZL ET,OU=TEST,OU=TEST,OU=Users,OU=contoso,DC=contoso,DC=local;27.08.2013
cscript //nologo AcctsExpire.vbs > ExpReport.txt
Here is my code :
Option Explicit
Dim adoConnection, adoCommand
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset
Dim strDN, objShell, lngBiasKey, lngBias
Dim lngDate, objDate, dtmAcctExp, k
' Obtain local time zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
' Filter to retrieve all user objects with accounts
' that expire.
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(!accountExpires=0)(!accountExpires=9223372036854775807))"
strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
& ";distinguishedName,accountExpires;subtree"
' Run the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
' Enumerate the recordset.
Do Until adoRecordset.EOF
strDN = adoRecordset.Fields("distinguishedName").Value
lngDate = adoRecordset.Fields("accountExpires")
Set objDate = lngDate
dtmAcctExp = Integer8Date(objDate, lngBias)
Wscript.Echo strDN & ";" & dtmAcctExp
adoRecordset.MoveNext
Loop
adoRecordset.Close
' Clean up.
adoConnection.Close
Function Integer8Date(ByVal objDate, ByVal lngBias)
' Function to convert Integer8 (64-bit) value to a date, adjusted for
' local time zone bias.
Dim lngAdjust, lngDate, lngHigh, lngLow
lngAdjust = lngBias
lngHigh = objDate.HighPart
lngLow = objdate.LowPart
' Account for bug in IADslargeInteger property methods.
If (lngLow < 0) Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0) Then
lngAdjust = 0
End If
lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow) / 600000000 - lngAdjust) / 1440
Integer8Date = CDate(lngDate)
End Function
Last Update :
Issue is resolved.
cscript //nologo AcctsExpire.vbs //U > ExpReport.txt
Also WSCRIPT AcctsExpire.vbs displays correct output.
I am looking to delete folder on multiple usb driver at the same time.
sDeleteFolder = "\Test"
Set oFS = CreateObject("Scripting.FileSystemObject")
Set dUSBKeys = ScanForUSBKeys()
For Each oUSBKey in dUSBKeys.Keys
If Left(oUSBKey, 1) = "\" Then
sKey = oUSBKey
Else
sKey = oUSBKey & "\"
End If
oFS.DeleteFolder sdeleteFolder, sKey
Next
Set dUSBKeys = Nothing
Set oFS = Nothing
MsgBox "Done Del all the folder from USB Drivs", vbOKOnly+VBINformation+VBSystemModal, "DONE"
Function ScanForUSBKeys()
Set oWMI = GetObject("winmgmts:\\.\root\cimv2")
Set dTemp = CreateObject("Scripting.Dictionary")
Set cDisks = oWMI.ExecQuery("Select InterfaceType,MediaType,PNPDeviceID,DeviceID,Size from Win32_DiskDrive")
For Each oDisk in cDisks
If InStr(LCase(oDisk.InterfaceType),"usb") > 0 AND InStr(LCase(oDisk.MediaType),"removable") > 0 _
AND InStr(LCase(oDisk.PNPDeviceID),"blackberry") = 0 AND InStr(LCase(oDisk.PNPDeviceID),"ipod") = 0 _
AND NOT oDisk.PNPDeviceID = "" Then
Set cDrivePartitions = oWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID='" & _
oDisk.DeviceID & "'} WHERE AssocClass = Win32_DiskDriveToDiskPartition" )
For Each oDrivePartition in cDrivePartitions
Set cDriveLetters = oWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID='" & _
oDrivePartition.DeviceID & "'} WHERE AssocClass = Win32_LogicalDiskToPartition")
For Each oDriveLetter in cDriveLetters
dTemp.Add oDriveLetter.DeviceID, 1
Next
Set cDriveLetters = Nothing
Next
Set cDrivePartitions = Nothing
End If
Next
Set cDisks = Nothing
Set ScanForUSBKeys = dTemp
Set dTemp = Nothing
Set oWMI = Nothing
End Function
I keep getting a error :
Type mismatch: 'oFs.DeleteFolder'
Line 12 Char 5
Study the docs for .DeleteFolder
Make sure you pass the full path (not just "\test") and the appropriate boolean (not a string like oUSBKey) when you call the Sub
Use .BuildPath to build that full path
Use the good features of VBScript. E.g.: Option Explicit, declare sPath as Const
Don't use Set x = Nothing in vain
Try this code
sDeleteFolder = "\Test"
For Each oUSBKey in dUSBKeys.Keys
sKey = oUSBKey & sDeleteFolder
oFS.DeleteFolder sKey
Next
I am trying to pass folder location as variable to a VBScript which has array to consume the location as a parameter. I don't know how to pass it, could some one please help me?
I am trying to pass following location as a variable "C:\New","C:\New1" to the below code, the script is working fine when I directly give the location, but when I tired to pass it as variable it is not working.
Code given below:
Set oParameters = WScript.Arguments
folderlocation = oParameters(0)
Dim folderarray
Dim WshShell, oExec
Dim wow()
Set objShell = CreateObject("WScript.Shell")
Dim oAPI, oBag
Dim fso, folder, file
Dim searchFileName, renameFileTo, day
Dim i
folderarray = Array(folderlocation)
ii = 0
day = WeekDay(Now())
If day = 3 Then
aa = UBound(folderarray)
f = 0
j = 0
x = 0
Y = 0
For i = 0 To aa
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderarray(i))
For Each file In folder.Files
If InStr(file.Name, name) = 1 Then
ii = 1
strid = file.Name
Set re = New RegExp
re.Pattern = ".*myfile.*"
If re.Test( strid ) Then
'msgbox "File exist and the file name is """ & strid & """"
x = x+1
Else
'msgbox "file not found"
End If
Set re = Nothing
End If
Next
If x = 0 Then
ReDim Preserve wow(f)
wow(f) = folderarray(i)
f = f+1
j = j+1
Else
x = 0
End If
Next
End If
If J > 0 Then
ReDim Preserve wow(f-1)
value = Join(wow, ",")
MsgBox "Files not found in the following location(s) :" & value
Else
MsgBox "fine"
End If
To fill an array from a list of arguments you'd call the script like this:
your.vbs "C:\New" "C:\New1"
and fill the array in your.vbs like this:
size = WScript.Arguments.Unnamed.Count - 1
ReDim folderarray(size)
For i = 0 To size
folderarray(i) = WScript.Arguments.Unnamed.Item(i)
Next
If for some reason you must pass the folder list as a single argument you'd call the script like this:
your.vbs "C:\New,C:\New1"
and populate the array in your.vbs like this:
folderarray = Split(WScript.Arguments.Unnamed.Item(0), ",")
I am trying to build on this previous post that works to convert a number to the specified base.
In my case I have a vbs script that is looking up a serial number and is outputting the alphanumeric character (base 36) to a txt file.
I would like to add to the txt file the base 10 value of the serial number. So I get an output like this:
Serial Number: ABC1234
Service Code: 22453156048
This is my starting point. This script runs and gives me a txt file with the Serial Number.
On Error Resume Next
' Initialize WSH objects
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Shell = WScript.CreateObject("WScript.Shell")
Set WNetwork = WScript.CreateObject("WScript.Network")
' Initialize WMI
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
' Find client machine name
Set ComputerInfo = WMI.ExecQuery("Select * from Win32_ComputerSystem")
For Each temp In Computerinfo
WorkstationName = WNetwork.ComputerName
Next
Set Bios = WMI.ExecQuery("Select * from Win32_BIOS")
For Each temp In Bios
SerN = temp.SerialNumber
Next
' Create Logfiles
Dim sDateTimeStamp
sDateTimeStamp = cStr(Year(now())) & _
Pad(cStr(Month(now())),2) & _
Pad(cStr(Day(now())),2) & _
Pad(cStr(Hour(now())),2) & _
Pad(cStr(Minute(now())),2) & _
Pad(cStr(Second(now())),2)
Function Pad(CStr2Pad, ReqStrLen)
Dim Num2Pad
Pad = CStr2Pad
If Len(CStr2Pad) < ReqStrLen Then
Num2Pad = String((ReqStrlen - Len(CStr2Pad)), "0")
Pad = Num2Pad & CStr2Pad
End If
End Function
Set LogFile = FSO.CreateTextFile("c:\logs\" & WorkstationName & "_" & sDateTimeStamp & ".txt")
Set EnviromentVariables = Shell.Environment("PROCESS")
LogFile.Writeline("Serial Number:" & space(2) & SerN)
But when I try to add the script from the linked post I do not get any output file.
On Error Resume Next
' Initialize WSH objects
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Shell = WScript.CreateObject("WScript.Shell")
Set WNetwork = WScript.CreateObject("WScript.Network")
' Initialize WMI
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
' Find client machine name
Set ComputerInfo = WMI.ExecQuery("Select * from Win32_ComputerSystem")
For Each temp In Computerinfo
WorkstationName = WNetwork.ComputerName
Next
Set Bios = WMI.ExecQuery("Select * from Win32_BIOS")
For Each temp In Bios
SerN = temp.SerialNumber
Function ToBase(ByVal n, b)
b = 10
n = SerN
If b < 2 Or b > 36 Then Exit Function
Const SYMBOLS = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Do
ToBase = Mid(SYMBOLS, n Mod b + 1, 1) & ToBase
n = Int(n / b)
Loop While n > 0
End Function
SrvCode = ToBase(SerN,10)
Next
' Create Logfiles
Dim sDateTimeStamp
sDateTimeStamp = cStr(Year(now())) & _
Pad(cStr(Month(now())),2) & _
Pad(cStr(Day(now())),2) & _
Pad(cStr(Hour(now())),2) & _
Pad(cStr(Minute(now())),2) & _
Pad(cStr(Second(now())),2)
Function Pad(CStr2Pad, ReqStrLen)
Dim Num2Pad
Pad = CStr2Pad
If Len(CStr2Pad) < ReqStrLen Then
Num2Pad = String((ReqStrlen - Len(CStr2Pad)), "0")
Pad = Num2Pad & CStr2Pad
End If
End Function
Set LogFile = FSO.CreateTextFile("c:\logs\" & WorkstationName & "_" & sDateTimeStamp & ".txt")
Set EnviromentVariables = Shell.Environment("PROCESS")
LogFile.Writeline("Serial Number:" & space(2) & SerN)
LogFile.Writeline("Service Code:" & space(3) & SrvCode)
Nested function definitions aren't allowed in VBScript. This should be raising a syntax error, despite the global On Error Resume Next (which you shouldn't be using in the first place).
Put the function definition somewhere in the global scope (outside the loop), e.g. by changing this:
Set Bios = WMI.ExecQuery("Select * from Win32_BIOS")
For Each temp In Bios
SerN = temp.SerialNumber
Function ToBase(ByVal n, b)
b = 10
n = SerN
If b < 2 Or b > 36 Then Exit Function
Const SYMBOLS = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Do
ToBase = Mid(SYMBOLS, n Mod b + 1, 1) & ToBase
n = Int(n / b)
Loop While n > 0
End Function
SrvCode = ToBase(SerN,10)
Next
into this:
Function ToBase(ByVal n, b)
If b < 2 Or b > 36 Then Exit Function
Const SYMBOLS = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Do
ToBase = Mid(SYMBOLS, n Mod b + 1, 1) & ToBase
n = Int(n / b)
Loop While n > 0
End Function
Set Bios = WMI.ExecQuery("Select * from Win32_BIOS")
For Each temp In Bios
SerN = temp.SerialNumber
SrvCode = ToBase(SerN,10)
Next
Make sure to remove the lines b = 10 and n = SerN. They're messing up the values passed to the parameters b and n.
Credit >> https://web.archive.org/web/20190717135154/http://www.4guysfromrolla.com:80/webtech/032400-1.shtml
I was unable to get the calculation to run using the ToBase Function. But with some more googling I found the above link and I was able to use the referenced function to get the desired output. This now allows me add to a existing script to get the express service code when doing a remote lookup of a Dell computers Service Tag.
So here is the final working script that gives the expected output.
' Initialize WSH objects
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Shell = WScript.CreateObject("WScript.Shell")
Set WNetwork = WScript.CreateObject("WScript.Network")
' Initialize WMI
Set WMI = GetObject("winmgmts:\\.\root\cimv2")
' Find client machine name
Set ComputerInfo = WMI.ExecQuery("Select * from Win32_ComputerSystem")
For Each temp In Computerinfo
WorkstationName = WNetwork.ComputerName
Next
Function baseN2dec(value, inBase)
'Converts any base to base 10
Dim strValue, i, x, y
strValue = StrReverse(CStr(UCase(value)))
For i = 0 To Len(strValue)-1
x = Mid(strValue, i+1, 1)
If Not isNumeric(x) Then
y = y + ((Asc(x) - 65) + 10) * (inBase ^ i)
Else
y = y + ((inBase ^ i) * CInt(x))
End If
Next
baseN2dec = y
End Function
Set Bios = WMI.ExecQuery("Select * from Win32_BIOS")
For Each temp In Bios
SerN = temp.SerialNumber
SrvCd = baseN2dec(SerN, 36)
Next
' Create Logfiles
Dim sDateTimeStamp
sDateTimeStamp = cStr(Year(now())) & _
Pad(cStr(Month(now())),2) & _
Pad(cStr(Day(now())),2) & _
Pad(cStr(Hour(now())),2) & _
Pad(cStr(Minute(now())),2) & _
Pad(cStr(Second(now())),2)
Function Pad(CStr2Pad, ReqStrLen)
Dim Num2Pad
Pad = CStr2Pad
If Len(CStr2Pad) < ReqStrLen Then
Num2Pad = String((ReqStrlen - Len(CStr2Pad)), "0")
Pad = Num2Pad & CStr2Pad
End If
End Function
Set LogFile = FSO.CreateTextFile("c:\logs\" & WorkstationName & "_" & sDateTimeStamp & ".txt")
Set EnviromentVariables = Shell.Environment("PROCESS")
LogFile.Writeline("Serial Number:" & space(2) & SerN)
LogFile.Writeline("Service Code:" & space(3) & SrvCd)