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.
Related
I am trying to read the information on the storage drives and would like to output the results as (on 1 line):
1/2 - Samsung Evo - 500GB - 4 partitions - C :, D :, E :, F:
2/2 - USB Transcend - 16GB - 2 partitions - G :, H:
On Error Resume Next
' Create a FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
' Provide file path
Dim result, strComputer, outFile, PropertyArr, ArrayItem
outFile = "C:\Users\MISS\Desktop\ok.txt"
' Sets computer name to the current computer name
strComputer = "."
' Setting up file to write
Set objFile = FSO.CreateTextFile(outFile, True)
' Connect to the WMI Service
Set CIMV2 = GetObject("winmgmts:" & "\\" & strComputer & "\root\CIMV2")
If Err Then
WScript.StdOut.WriteLine "Unable to access WMI Service."
WScript.Quit 32
End If
' Fetch all details from Win32_computersystem
Set Win32_DiskDrive = CIMV2.ExecQuery("Select * from Win32_DiskDrive")
PropertyArr = Array("Model","MediaType")
For Each item_PropertyArr In PropertyArr
ArrayItem = item_PropertyArr
Next
For Each item In Win32_DiskDrive
result = item.ArrayItem
WScript.Echo "Result: " & result
Next
Set FSO = Nothing
It is empty result.
To get the string output in the desired format, I would suggest using a template string and use Replace() to fill in the details.
Because you want the driveletters that are associated with each partition aswell, you need to do more than just query the Win32_DiskDrive, because that query does not return driveletters. See here
The below code should do what you want:
Option Explicit
Const ForAppending = 8
Dim objFso, objFile, objWMIService, colDiskDrives, objDiskDrive
Dim colPartitions, objDiskPartition, colLogicalDisks, objDriveLetters, objLogicalDisk
Dim outFile, strFormat, strResult, numCurrentDrive, strMediaType, strID, strQuery, strComputer
On Error Resume Next
' set up file to write
outFile = "C:\Users\MISS\Desktop\ok.txt"
Set objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(outFile) Then objFso.DeleteFile outFile, True
Set objFile = objFso.OpenTextFile(outFile, ForAppending, True)
strComputer = "."
Set objWMIService = GetObject( "winmgmts:{ impersonationLevel=Impersonate }!//" & strComputer )
Set colDiskDrives = objWMIService.ExecQuery( "Select * FROM Win32_DiskDrive" )
'set up a string as template for the output
strFormat = "{0}/{1} - {2} - {3} - {4} partition(s)"
'create a variable for the current disk count
numCurrentDrive = 1
For Each objDiskDrive In colDiskDrives
'start building the string to output
strMediaType = objDiskDrive.MediaType
If IsNull(strMediaType) Or Len(strMediaType) = 0 Then strMediaType = "Unknown"
strResult = Replace(strFormat, "{0}", numCurrentDrive)
strResult = Replace(strResult, "{1}", colDiskDrives.Count)
strResult = Replace(strResult, "{2}", objDiskDrive.Model)
strResult = Replace(strResult, "{3}", strMediaType)
strResult = Replace(strResult, "{4}", objDiskDrive.Partitions)
'increase the current drive counter
numCurrentDrive = numCurrentDrive + 1
'create an arraylist to capture the drive letters
Set objDriveLetters = CreateObject("System.Collections.ArrayList")
'escape the backslashes in objDiskDrive.DeviceID for the query
strID = Replace( objDiskDrive.DeviceID, "\", "\\", 1, -1, vbTextCompare )
strQuery = "Associators Of {Win32_DiskDrive.DeviceID=""" & strID & """} Where AssocClass = Win32_DiskDriveToDiskPartition"
Set colPartitions = objWMIService.ExecQuery(strQuery)
For Each objDiskPartition In colPartitions
'get the drive letter for each partition
strQuery = "Associators Of {Win32_DiskPartition.DeviceID=""" & objDiskPartition.DeviceID & """} Where AssocClass = Win32_LogicalDiskToPartition"
Set colLogicalDisks = objWMIService.ExecQuery(strQuery)
For Each objLogicalDisk In colLogicalDisks
objDriveLetters.Add objLogicalDisk.DeviceID
'objDriveLetters.Add objLogicalDisk.VolumeName
Next
Set colLogicalDisks = Nothing
Next
'add the driveletters to the output string
strResult = strResult & " - " & Join(objDriveLetters.ToArray(), ", ")
Set objDriveLetters = Nothing
Set colPartitions = Nothing
'output on screen
WScript.Echo strResult
'output to file
objFile.WriteLine strResult
Next
'close the file
objFile.Close
Set objFile = Nothing
Set colDiskDrives = Nothing
Set objWMIService = Nothing
Update
As per your comments, you would like to not use .NET (the ArrayList) in the code. This can be done of course, but with a little bit more effort:
Option Explicit
Const ForAppending = 8
Dim objFso, objFile, objWMIService, colDiskDrives, objDiskDrive
Dim colPartitions, objDiskPartition, colLogicalDisks, objLogicalDisk
Dim outFile, strFormat, strResult, strMediaType, strID, strQuery, strComputer
Dim arrDriveLetters, numCurrentDrive, numDriveLetters
On Error Resume Next
' set up file to write
outFile = "C:\Users\MISS\Desktop\ok.txt"
Set objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FileExists(outFile) Then objFso.DeleteFile outFile, True
Set objFile = objFso.OpenTextFile(outFile, ForAppending, True)
strComputer = "."
Set objWMIService = GetObject( "winmgmts:{ impersonationLevel=Impersonate }!//" & strComputer )
Set colDiskDrives = objWMIService.ExecQuery( "Select * FROM Win32_DiskDrive" )
'set up a string as template for the output
strFormat = "{0}/{1} - {2} - {3} - {4} partition(s)"
'create a variable for the current disk count
numCurrentDrive = 1
For Each objDiskDrive In colDiskDrives
'start building the string to output
strMediaType = objDiskDrive.MediaType
If IsNull(strMediaType) Or Len(strMediaType) = 0 Then strMediaType = "Unknown"
strResult = Replace(strFormat, "{0}", numCurrentDrive)
strResult = Replace(strResult, "{1}", colDiskDrives.Count)
strResult = Replace(strResult, "{2}", objDiskDrive.Model)
strResult = Replace(strResult, "{3}", strMediaType)
strResult = Replace(strResult, "{4}", objDiskDrive.Partitions)
'increase the current drive counter
numCurrentDrive = numCurrentDrive + 1
'reset the dynamic array to capture the drive letters
numDriveLetters = 0
ReDim arrDriveLetters(numDriveLetters)
'escape the backslashes in objDiskDrive.DeviceID for the query
strID = Replace( objDiskDrive.DeviceID, "\", "\\", 1, -1, vbTextCompare )
strQuery = "Associators Of {Win32_DiskDrive.DeviceID=""" & strID & """} Where AssocClass = Win32_DiskDriveToDiskPartition"
Set colPartitions = objWMIService.ExecQuery(strQuery)
For Each objDiskPartition In colPartitions
'get the drive letter for each partition
strQuery = "Associators Of {Win32_DiskPartition.DeviceID=""" & objDiskPartition.DeviceID & """} Where AssocClass = Win32_LogicalDiskToPartition"
Set colLogicalDisks = objWMIService.ExecQuery(strQuery)
For Each objLogicalDisk In colLogicalDisks
ReDim Preserve arrDriveLetters(numDriveLetters)
arrDriveLetters(numDriveLetters) = objLogicalDisk.DeviceID
numDriveLetters = numDriveLetters + 1
Next
Set colLogicalDisks = Nothing
Next
'add the driveletters to the output string
strResult = strResult & " - " & Join(arrDriveLetters, ", ")
Erase arrDriveLetters
Set colPartitions = Nothing
'output on screen
WScript.Echo strResult
'output to file
objFile.WriteLine strResult
Next
'close the file
objFile.Close
Set objFile = Nothing
Set colDiskDrives = Nothing
Set objWMIService = Nothing
The output will be something like
1/4 - Samsung SSD 750 EVO 250GB ATA Device - Fixed hard disk media - 1 partition(s) - C:
2/4 - ST3500418AS ATA Device - Fixed hard disk media - 1 partition(s) - E:
3/4 - WDC WD7501AALS-00J7B0 ATA Device - Fixed hard disk media - 1 partition(s) - D:
4/4 - Generic Ultra HS-SD/MMC USB Device - Unknown - 0 partition(s)
Hope that helps
P.S. Best run using CScript instead of WScript, to avoid having popup messages with one line at a time
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
In VBScript, I would like to update a text file with new data and have it shown in a message box.
Below is what I have so far; what am I doing wrong?
Option Explicit
Dim oFso, Michael, John, Valery, Susane, Katterina
Dim oStream, oFolder, f, myArrayList
Const ForAppending = 8
Const ForReading = 1, ForWriting = 2
Set myArrayList = CreateObject("System.Collections.ArrayList")
myArrayList.Add "Misko, Janko, Vierka,"
'create '
Call WriteLineToFile
Function WriteLineToFile
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.CreateTextFile("D:\TestFile1.txt", 2, True)
f.WriteLine "Misko, Janko, Vierka,"
MsgBox "Subor C:\TestFile.txt bol " & "vytvoreny."
f.Close
Set f = Nothing
Set oFso = Nothing
MsgBox "Uspesne vytvoreny " & TestFile2.txt & "."
End Function
Option Explicit 'explicit declaration of all variables'
Dim oFso, f, sPath, sPath2, i, sTemp 'deklaracia'
Dim arrString
Const ForReading = 1, ForWriting = 2
sPath = "D:\TestFile1.txt" 'cesta ku datam'
sPath2 = "D:\TestFile2.txt"
arrString = Array("Marek", "Tomas") 'pole alebo polia'
ReDim arrString(2)
arrString(0) = "Misko"
arrString(1) = "Janko"
arrString(2) = "Vierka"
sTemp = "" 'empty pole pred runom'
For i = 0 To UBound(arrString) 'ide po upper bound '
If i = UBound(arrString) Then
sTemp = sTemp + arrString(i) 'odstrani ciarku na konci'
Else
sTemp = sTemp + arrString(i) + ", "
End If
Next
MsgBox sTemp
Call WriteLineToFile (sPath, sTemp) 'zavola sub routine'
ReDim Preserve arrString (4)
arrString(3) = "Zuzka"
arrString(4) = "Katka"
sTemp = ""
For i = 0 To UBound(arrString)
If i = UBound(arrString) Then
sTemp = sTemp + arrString(i)
Else
sTemp = sTemp + arrString(i) + ", "
End If
Next
MsgBox sTemp
Call WriteLineToFile (sPath2, sTemp)
Sub WriteLineToFile (sFilePath, sText)
Set oFso = CreateObject("Scripting.FileSystemObject")
Set f = oFso.CreateTextFile(sFilePath, 2, True)
'For i = 0 To UBound(arrString) - 1 'nepotrebne'
f.WriteLine sText
'Next
MsgBox "Subor " & sFilePath & " vytvoreny."
f.Close
Set f = Nothing
Set oFso = Nothing
End Sub
Looking how to create a vbscript to pull the maximum number of days a PSO policy has set. It comes back as a value of ... and I do not know how to get the real value that was set.
This is what I have so far:
Option Explicit
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Dim strFilePath, objFSO, objFile, adoConnection, adoCommand, objCDOConf
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset, objMaxPwdAge
Dim strDN, objShell, lngBiasKey, lngBias, blnPwdExpire, strDept, strAdd
Dim objDate, dtmPwdLastSet, lngFlag, k, address, objAdd, objMessage
' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If
strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Wscript.Quit(1)
End If
On Error GoTo 0
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.
strFilter = "(&(objectClass=msDS-PasswordSettings))"
' Filter to retrieve all computer objects.
strQuery = "<LDAP://CN=PSO-Information Systems,CN=Password Settings Container,CN=System,DC=yrmc,DC=org>;" _
& ";cn,msDS-LockoutDuration,msDS-MaximumPasswordAge,msDS-
PasswordSettingsPrecedence;subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
objFile.WriteLine adoRecordset.Fields("cn").Value
adoRecordset.MoveNext
Loop
adoRecordset.Close
I can get a value for cn and even msDS-PasswordSettingsPrecedence but not for msDS-MaximumPasswordAge. Any help would be appreciated.
This is at best a partial answer but I did some searching and I believe you will need one or more of the following:
DSGet/DSQuery
LDIFDE to manage PSO's.
Quest's "Free PowerShell Commands for Active Directory"
Using Quest's free tools, you might find this link handy
Put square brackets around our Active Directory attribute name:
See the blog post "How can I retrieve the value of an active directory attribute that has a hyphen in its name" for more.
you have to find UsersPSO location in your AD like that
domainLookupString = ""CN=UsersPSO,CN=Password Settings Container,CN=System,DC=COMPAY,DC=ORG";
then run the ldap query
ldapFilterString = "(&(objectClass=msDS-PasswordSettings))";
at the end, get the ldap attribute with the Maximum Password Age of the current PSO policy
"msDS-MaximumPasswordAge"
I'm using data report in VB 6 and trying to display images from database. It retrieves the image but showing the same image for all output
the code i'm using are given below
Dim rs As ADODB.Recordset, rs1 As ADODB.Recordset
Dim a As String
k = 0
i = 0
j = 0
k = 0
Set rs = New ADODB.Recordset
With rs
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.ActiveConnection = conn
.Source = "SELECT patientid FROM Inpatients_Maintenance WHERE (ModDate >= '" & frmDate & "') AND (ModDate <= '" & endDate & "')"
.CursorLocation = adUseClient
.Open
Do Until rs.EOF
If (rs.EOF = False And rs.BOF = False) Then
pid(i) = rs.Fields(0).Value
End If
i = i + 1
rs.MoveNext
Loop
End With
Set rs = Nothing
Set rs1 = New ADODB.Recordset
Dim id As String
With rs1
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.ActiveConnection = conn
For j = 0 To i - 1
id = pid(j)
.Source = "Select photo from patientImage where patientid='" & id & "'"
.CursorLocation = adUseClient
.Open
If (rs1.EOF = False And rs1.BOF = False) Then
p(j) = App.Path + "\patients\" + rs1.Fields(0).Value
a = p(j)
Set RptInpatientMaster.Sections("Section1").Controls("Image2").Picture = LoadPicture(a)
End If
.Close
Next j
End With
Do you only see the last one?
Set RptInpatientMaster.Sections("Section1").Controls("Image2").Picture = LoadPicture(a)
you always refer to same picture inside your report, isn't it?