I am trying to write a piece of code in VBScript to compute the
SHA512 value for a given file. According to MSFT documentation
the ComputeHash method of the SHA512Managed object requires a
Byte array as input. So I used ADODB to read the input file which
SHA512 value is to be computed (Because, AFAIK, there is no way
to build a Byte array in VBScript). However I get a runtime error 5,
'Invalid procedure call or argument' when calling the method. The
variable bar in the code below is of type Byte() - VBScript says.
Could anyone tell me what is going wrong ?
Code :
Option Explicit
'
'
'
Dim scs, ado
Dim bar, hsh
Set scs = CreateObject("System.Security.Cryptography.SHA512Managed")
Set ado = CreateObject("ADODB.Stream")
ado.type = 1 ' TypeBinary
ado.open
ado.LoadFromFile WScript.ScriptFullName
bar = ado.Read
ado.Close
MsgBox TypeName(bar) & "/" & LenB(bar) & "/" & Len(bar),,"Box 1"
' Displays : "Byte()/876/438"
On Error Resume Next
' Attempt 1
Set hsh = scs.ComputeHash(bar)
MsgBox Hex(Err.Number) & "/" & Err.Description,,"Set hsh = "
' Displays : "5/Invalid procedure call or argument"
' Attempt 2
hsh = scs.ComputeHash(bar)
MsgBox Hex(Err.Number) & "/" & Err.Description,,"hsh = "
' Displays : "5/Invalid procedure call or argument"
MsgBox TypeName(scs),,"scs" ' Displays : "SHA512Managed"
Set ado = Nothing
Set scs = Nothing
WScript.Quit
Use
hsh = scs.ComputeHash_2((bar))
(no set, _2 suffix not to pick the other ComputeHash method, pass by value ())
see here.
Related
I want to change the code below, so that it executes the sas guide project (.egp) and changes the parameter value according to the values of the array. (The idea is to open the project, run to the value of the array (0), close the project; open the project, run to the value array (1); ... until the array (n)).
But it executes only for the first value of the array, not the sequence for the other values. What's the mistake?
I added the line (for t = 0 to UBound (id)) and put (Next) before app.Quit
Dim t
Dim id
id=Array("111111111","22222222","33333333")
'-----------------------------------
' The name and location of the project file that will be opened and run by this script.
prjName = "C:\SAS\EG\Samples\XXXXX.egp" 'Project Name
for t = 0 to UBound(id)
And at the end of the code
Next
app.Quit
The full code
Option Explicit
'----------------------------------------------------------------
'AutomationPrompts.vbs
'This example program demonstrates how to use the 4.2 SAS Enterprise Guide
'automation interface to access and modify the prompts for a project and a stored
'process within that project. The project is opened and the project prompt names
'and values are displayed to the user. Subsequently, the stored processes within
'the project are opened and their prompt names and values are then displayed.
'
'The prompt value for the stored process is changed to 'M' (for male), the project
'is saved then run.
'
'The project is called AutomationwithPrompts.egp and the prjName variable should be
'modified to reflect the location of this proejct on the machine that is running
'this script.
'----------------------------------------------------------------
'--------------
'Declare the variables that will be used in the program
'--------------
Dim app
Dim prjName
Dim prjObject
Dim parmList
Dim parm
Dim spList
Dim sp
Dim spParamList
Dim spParam
Dim spParamName
Dim spParamValue
Dim n
Dim i
Dim t
Dim id
id=Array("111111111","22222222","33333333")
'-----------------------------------
' The name and location of the project file that will be opened and run by this script.
prjName = "C:\SAS\EG\Samples\XXXXX.egp" 'Project Name
for t = 0 to UBound(id)
' Start the app and open the project
Set app = CreateObject("SASEGObjectModel.Application.8.1")
Set prjObject = app.Open(prjName,"")
'---------------------------------
'Begin processing the project
'---------------------------------
' Discover the parameters for the project
Set parmList = prjObject.Parameters
Wscript.Echo "Project has " & parmList.Count & " parameters."
' Get the default value from the first parameter
Set parm = parmList.Item(0)
WScript.Echo parm.Name & " parameter has default value of " & parm.DefaultValue
' Change the value of the parameter to 'M' and display the new value.
parm.Value = id(t)
WScript.Echo parm.Name & " parameter has been set to value of " & parm.Value
'-------------------------------
'Begin processing the stored process
'-------------------------------
Set spList = prjObject.StoredProcessCollection
' Get the number of parameters for the store process
Wscript.Echo "StoredProcess has " & spList.Count & " parameters."
' Cycle through the list of stored processes and the parameters for each of them.
for n=0 to (spList.Count - 1)
Set sp = spList.Item(n)
' Get the list of parameters
Set spParamList = sp.Parameters
' Process each stored process parameter
for i=0 to (spParamList.Count - 1)
Set spParam = spParamList.Item(i)
' Get the name and default value for the parameter
spParamName = spParam.Name
spParamValue = spParam.DefaultValue
' Display the parameter information to the user
WScript.Echo spParamName & " parameter has default value of " & spParamValue
' Change the value of the parameter
spParam.Value = id(t)
' Display the modified value
WScript.Echo spParamName & " parameter has been set to value of " & spParam.Value
' Save the project with the updated stored process
prjObject.Save
Next
Next
' Run the new project
prjObject.Run
' Make sure the project is saved after it has been run.
prjObject.Save
' Close the project and application.
prjObject.Close
Next
app.Quit
I got it, the final code is below.
Option Explicit
'--------------
Dim app
Dim prjName
Dim prjObject
Dim parmList
Dim parm
Dim n
Dim i
Dim t
Dim id
id=Array("111111111","22222222","33333333")
'-----------------------------------
' The name and location of the project file that will be opened and run by this script.
prjName = "C:\SAS\EG\Samples\XXXXX.egp" 'Project Name
' Start the app and open the project
Set app = CreateObject("SASEGObjectModel.Application.8.1")
Set prjObject = app.Open(prjName,"")
'---------------------------------
'Begin processing the project
'---------------------------------
for t = 0 to UBound(id)
' Discover the parameters for the project
Set parmList = prjObject.Parameters
Wscript.Echo "Project has " & parmList.Count & " parameters."
' Get the default value from the first parameter
Set parm = parmList.Item(0)
WScript.Echo parm.Name & " parameter has default value of " & parm.DefaultValue
' Change the value of the parameter and display the new value.
parm.Value = id(t)
WScript.Echo parm.Name & " parameter has been set to value of " & parm.Value
' Run the new project
prjObject.Run
WScript.Sleep 5000
Next
' Make sure the project is saved after it has been run.
prjObject.Save
' Close the project and application.
prjObject.Close
app.Quit
I need to have an Active Directory Shadow Groups (aka Active Directory Dynamic Group), based on several DN's.
I've searched high and low for a simple tool that would allow me to do this, and finally found Dan Holme's excellent script (quoted below) at http://kb.caresys.com.cn/4052785/need-script-add-all-accounts-active-directory-security-group (and a few other places)
I also found several PowerShell scripts, but they all appear to have much harder dependencies and I need a tool that's as stand-alone as possible. They also all have the same problem as I'm faced with here.
The Group_Shadow.vbs script performs exactly what I need with one exception:
I need to be able to specify the AD's Host, port number and credentials (login and password).
The script assumes that "LDAP://" is pointing to the correct AD, and I guess the AD Credentials are derived from the user running the script?
I did find a hint about how to set the host name and password, by changing the "LDAP://" string into "LDAP://LDAP_HOST:LDAP_PORT/".
That seems pretty easy to implement - but there were a few comments stating it didn't work...
I also found a hint about setting the credentials:
Dim LDAP ' As IADsOpenDSObject
Set LDAP = GetObject("LDAP:")
Set obj = LDAP.OpenDSObject("LDAP://", "domain\name", "password", ADS_USE_ENCRYPTION OR ADS_SECURE_AUTHENTICATION)
This appear to be the hard part (being totally novice in both the VBScript and Active Directory world), and I simply can't figure out how to combine to two.
I hope the community can help me out, either by assisting fixing this script or by pointing to a different solution.
Thanks in advance!
The Script:
'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 2007
'
' NAME: Group_Shadow.vbs
'
' AUTHOR: Dan Holme , Intelliem
' DATE : 12/12/2007
'
' USAGE:
' cscript.exe Group_Shadow.vbs
'
' Dynamically updates the membership of a group
' to match the objects returned from an Active Directory query
'
' See the Windows Administration Resource Kit for documentation
'
' Neither Microsoft nor Intelliem guarantee the performance
' of scripts, scripting examples or tools.
'
' See www.intelliem.com/resourcekit for updates to this script
'
' (c) 2007 Intelliem, Inc
'==========================================================================
Option Explicit
Dim sDomainDN
Dim sGroupSAMAccountName
Dim aSearchOUs
Dim sQuery
'==========================================================================
' CONFIGURATION BLOCK
' Domain's DN
sDomainDN = "dc=domain,dc=local"
' sAMAccountName of shadow group
sGroupSAMAccountName = "Security Group"
' An array of one or more OUs to search
aSearchOUs = Array("ou=Something,dc=domain,dc=local")
' LDAP query that will be run in each OU
sQuery = " (&(objectCategory=computer)(name=GA*));distinguishedName;subtree"
'==========================================================================
' Create dictionaries
Dim dResults
Set dResults = CreateObject("Scripting.Dictionary")
dResults.CompareMode = vbTextCompare ' Case INsensitive
Dim dTargetMembership
Set dTargetMembership = CreateObject("Scripting.Dictionary")
dTargetMembership.CompareMode = vbTextCompare ' Case INsensitive
Dim dCurrentMembership
Set dCurrentMembership = CreateObject("Scripting.Dictionary")
dCurrentMembership.CompareMode = vbTextCompare ' Case INsensitive
Dim dMembershipChanges
Set dMembershipChanges = CreateObject("Scripting.Dictionary")
dMembershipChanges.CompareMode = vbTextCompare ' Case INsensitive
' Perform LDAP searches, adding to final list stored in dTargetMembership
Dim sSearchOU
Dim sLDAPQuery
For Each sSearchOU In aSearchOUs
sLDAPQuery = "<LDAP://" & sSearchOU & ">;" & sQuery
Set dResults = AD_Search_Dictionary(sLDAPQuery)
Call DictionaryAppend(dResults, dTargetMembership)
Next
' Locate group
Dim sGroupADsPath
Dim oGroup
sGroupADsPath = ADObject_Find_Generic(sGroupSAMAccountName, sDomainDN)
If sGroupADsPath = "" Then
' Error handling: group not found
WScript.Quit
End If
Set oGroup = GetObject(sGroupADsPath)
' Get members and store in dictionary
Dim aMembers
aMembers = oGroup.GetEx("member")
Set dCurrentMembership = ArrayToDictionary(aMembers)
' Calculate the "delta" between the current and desired state
Set dMembershipChanges = Dictionary_Transform(dCurrentMembership, dTargetMembership)
' Make the membership changes based on the transform dictionary's instructions
Dim sMember
For Each sMember In dMembershipChanges
If UCase(dMembershipChanges.Item(sMember)) = "ADD" Then
oGroup.Add "LDAP://" & sMember
End If
If UCase(dMembershipChanges.Item(sMember)) = "DELETE" Then
oGroup.Remove "LDAP://" & sMember
End If
Next
WScript.Quit
' ======================
' FUNCTIONS FROM LIBRARY
' ======================
' #region Dictionary routines
Function ArrayToDictionary(ByRef aArray)
' Converts a one-dimensional array into a dictionary.
' Assumes elements in array are unique
Dim dDic
Dim aElement
Set dDic = CreateObject("Scripting.Dictionary")
dDic.CompareMode = vbTextCompare ' Case INsensitive
On Error Resume Next ' trap duplicate array elements
For Each aElement In aArray
dDic.Add aElement, 0
Next
On Error GoTo 0
Set ArrayToDictionary = dDic
End Function
Sub DictionaryAppend(ByRef dNewElements, ByRef dDictionary)
' Appends the elements of dNewElements to dDictionary
Dim sKey
On Error Resume Next ' trap duplicate array elements
For Each sKey In dNewElements.keys
dDictionary.Add sKey, dNewElements.Item(sKey)
Next
On Error GoTo 0
End Sub
Function Dictionary_Transform(ByVal dOriginal, ByVal dFinal)
' Retunrs a dictionary with a list of update operations required
' so that dOriginal is transformed to dFinal
Dim dTransform, sKey
Set dTransform = CreateObject("Scripting.Dictionary")
dTransform.CompareMode = vbTextCompare ' Case INsensitive
For Each sKey In dFinal.Keys
If Not dOriginal.Exists(sKey) Then
dTransform.Add sKey, "ADD"
End If
Next
For Each sKey In dOriginal.Keys
If Not dFinal.Exists(sKey) Then
dTransform.Add sKey, "DELETE"
End If
Next
Set Dictionary_Transform = dTransform
End Function
' #endregion
' #region Active Directory object find routines
Function ADObject_Find_Generic(ByVal sObject, ByVal sSearchDN)
' Version 071130
' Takes any input (name, DN, or ADsPath) of a user, computer, or group, and
' returns the ADsPath of the object as a way of validating that the object exists
'
' INPUTS: sObject DN or ADsPath to an object
' sAMAccountName (pre-Windows 2000 logon name) of a user or group
' computer name of a computer
' sSearchDN the DN within which to search (often, the DN of the domain, e.g. dc=contoso, dc=com)
'
' RETURNS: ADObject_Find_Generic ADsPath (LDAP://...) of the object
' blank if object was not found
'
' NOTES: ASSUMPTION: computers, users & groups have unique names. See note inline.
'
' REQUIRES AD_Search_Array routine
' AD_Search_RS routine
' ADObject_Validate routine
Dim aResults, sLDAPQuery
Select Case ADObject_NameType(sObject)
Case ""
ADObject_Find_Generic = ""
Case "adspath"
ADObject_Find_Generic = ADObject_Validate(sObject)
Case "distinguishedname"
ADObject_Find_Generic = ADObject_Validate("LDAP://" & sObject)
Case "name"
' Assumption: No computer has the same name as a user's or group's sAMAccountName
' otherwise, this query will return more than one result
sLDAPQuery = "<LDAP://" & sSearchDN & ">;" & _
"(|(samAccountName=" & sObject & ")(samAccountName=" & sObject & "$));" & _
"aDSPath;subtree"
aResults = AD_Search_Array (sLDAPQuery)
If Ubound(aResults) = -1 Then
ADObject_Find_Generic = ""
Else
ADObject_Find_Generic = aResults(0)
End If
End Select
End Function
Function ADObject_NameType(ByVal sObjectName)
' Version 071204
' Evaluates sObjectName to determine what type of name it is
' Returns ADObject_NameType adspath
' distinguishedname
' name
' blank if sObjectName = ""
Dim sNameType
If Len(sObjectName) = 0 Then
sNameType = ""
ElseIf Len(sObjectName) < 3 Then
' can't be a DN or an ADsPath - must be a name
sNameType = "name"
ElseIf Ucase(Left(sObjectName,3)) = "CN=" Then
' is a DN
sNameType = "distinguishedname"
ElseIf Len(sObjectName) < 8 Then
' too short to be an ADsPath and isn't a DN, so it must be a name
sNameType = "name"
ElseIf UCase(Left(sObjectName, 7)) = "LDAP://" Then
' is already an ADsPath
sNameType = "adspath"
Else
' must be a name
sNameType = "name"
End If
ADObject_NameType = sNameType
End Function
Function ADObject_Validate(ByVal sObjectADsPath)
' Version 071122
' Returns ADsPath of object as a way of validating that the object exists
'
' INPUTS: sObjectADsPath ADsPath of object to test
' RETURNS: ADObject_Validate Path of object (if it exists) or blank
Dim oObject
On Error Resume Next
Set oObject = GetObject(sObjectADsPath)
If Err.Number <> 0 Then
ADObject_Validate = ""
Err
Turns out there are two answers to take note of in regard to "LDAP://" credentials.
First, specifically to the script I posted, I simply had to open my eyes!
Almost the last line of the script there were already options to add the credentials:
oConnection.Open "", vbNullString, vbNullString
Simply had to be correctly populated:
oConnection.Open "", "username", "password"
Second, a more general description was already provided by #Harvey Kwok in this SO answer: Secure LDAP object manipulation with VBscript using alternate credentials
Is there a way to write anonymous functions, pass them to other functions, in which they are invoked, in vbscript?
There are no anonymous functions/subs/methods in VBScript.
You can use GetRef() (see sample1, sample2) to get something like a function pointer that can be passed to functions/subs to be invoked there (callback). But there are no closures in VBScript, so tricks possible in other languages fail in VBScript.
For specific problems that can be solved with higher order functions in functional languages there may be (nearly) equivalent VBScript solutions involving classes/objects; but for discussing that approach you need to describe your/such a problem in detail.
VBScript has the ability to execute arbitatry code.
Execute and Eval just do what they say to a string containing code.
ExecuteGlobal adds code to your program, like a new function, new variables.
Script Control adds vbscript/jscript scripting language to any program including vbscripts. It can have access to the host's data.
If using ExecuteGlobal/Execute/Eval it is best to run through a scriptcontrol first to test for syntax errors (as you can't trap syntax errors, but you can trap the runtime error the script control gives off on a syntax error).
So you can build your program at runtime.
Set Arg = WScript.Arguments
set WshShell = createObject("Wscript.Shell")
Set Inp = WScript.Stdin
Set Outp = Wscript.Stdout
Sub VBSCmd
RawScript = LCase(Arg(1))
'Remove ^ from quoting command line and replace : with vbcrlf so get line number if error
Script = Replace(RawScript, "^", "")
Script = Replace(Script, "'", chr(34))
Script = Replace(Script, ":", vbcrlf)
'Building the script with predefined statements and the user's code
Script = "Dim gU" & vbcrlf & "Dim gdU" & vbcrlf & "Set gdU = CreateObject(" & chr(34) & "Scripting.Dictionary" & chr(34) & ")" & vbcrlf & "Function UF(L, LC)" & vbcrlf & "Set greU = New RegExp" & vbcrlf & "On Error Resume Next" & vbcrlf & Script & vbcrlf & "End Function" & vbcrlf
'Testing the script for syntax errors
On Error Resume Next
set ScriptControl1 = wscript.createObject("MSScriptControl.ScriptControl",SC)
With ScriptControl1
.Language = "VBScript"
.UseSafeSubset = False
.AllowUI = True
.AddCode Script
End With
With ScriptControl1.Error
If .number <> 0 then
Outp.WriteBlankLines(1)
Outp.WriteLine "User function syntax error"
Outp.WriteLine "=========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & .number & " " & .description
Outp.WriteLine "Line " & .line & " " & "Col " & .column
Exit Sub
End If
End With
ExecuteGlobal(Script)
'Remove the first line as the parameters are the first line
'Line=Inp.readline
Do Until Inp.AtEndOfStream
Line=Inp.readline
LineCount = Inp.Line
temp = UF(Line, LineCount)
If err.number <> 0 then
outp.writeline ""
outp.writeline ""
outp.writeline "User function runtime error"
outp.writeline "==========================="
Outp.WriteBlankLines(1)
Outp.Write NumberScript(Script)
Outp.WriteBlankLines(2)
Outp.WriteLine "Error " & err.number & " " & err.description
Outp.WriteLine "Source " & err.source
Outp.WriteLine "Line number and column not available for runtime errors"
wscript.quit
End If
outp.writeline temp
Loop
End Sub
Vbs
filter vbs "text of a vbs script"
filter vb "text of a vbs script"
Use colons to seperate statements and lines. Use single quotes in place of double quotes, if you need a single quote use chr(39). Escape brackets and ampersand with the ^ character. If you need a caret use chr(136).
The function is called UF (for UserFunction). It has two parameters, L which contains the current line and LC which contains the linecount. Set the results of the script to UF. See example.
There are three global objects available. An undeclared global variable gU to maintain state. Use it as an array if you need more than one variable. A Dictionary object gdU for saving and accessing previous lines. And a RegExp object greU ready for use.
Example
This vbs script inserts the line number and sets the line to the function UF which Filter prints.
filter vbs "uf=LC ^& ' ' ^& L"<"%systemroot%\win.ini"
This is how it looks in memory
Dim gU
Set gdU = CreateObject("Scripting.Dictionary")
Set greU = New RegExp
Function UF(L, LC)
---from command line---
uf=LC & " " & L
---end from command line---
End Function
If there is a syntax error Filter will display debugging details.
User function syntax error
==========================
1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC dim & " " & L
7 End Function
Error 1025 Expected end of statement
Line 6 Col 6
User function runtime error
===========================
1 Dim gU
2 Dim gdU
3 Set greU = CreateObject("Scripting.Dictionary")
4 Function UF(L, LC)
5 On Error Resume Next
6 uf=LC/0 & " " & L
7 End Function
Error 11 Division by zero
Source Microsoft VBScript runtime error
Line number and column not available for runtime errors
the funny thing about function objects is that they by definition are a memory leak. This means that once you create a function object, you need to keep the scope it was created in intact, which threw me off.
Class VBCompiler
Public leaks
Public Sub Class_Initialize()
leaks = Array()
End Sub
Public Function Compile(code)
Dim compiler, result
Set compiler = CreateObject("MSScriptControl.ScriptControl")
Set portal = CreateObject("Scripting.Dictionary")
Dim name
compiler.Language = "VBScript"
compiler.AddObject "portal", portal, True
compiler.ExecuteStatement code
name = compiler.Procedures(1).Name
compiler.ExecuteStatement "portal.Add ""result"", GetRef(""" & name & """)"
' save the script control because if we go out of scope...
' our function object goes poof!
' leaks.Push compiler
ReDim Preserve leaks(UBound(leaks) + 1)
Set leaks(UBound(leaks)) = compiler
Set Compile = portal("result")
End Function
End Class
Dim z
Set z = New VBCompiler
Set z2 = z.Compile("Function Foo(s):MsgBox s:Foo = 2:End Function")
z2("Hi!")
z2 "Hello Again!"
Gives the two message boxes as desired
Class VBCompiler
Public Function Compile(code)
Dim compiler, result
Set compiler = CreateObject("MSScriptControl.ScriptControl")
Set portal = CreateObject("Scripting.Dictionary")
Dim name
compiler.Language = "VBScript"
compiler.AddObject "portal", portal, True
compiler.ExecuteStatement code
name = compiler.Procedures(1).Name
compiler.ExecuteStatement "portal.Add ""result"", GetRef(""Foo"") "
Set Compile = portal("result")
End Function
End Class
Dim z
Set z = New VBCompiler
Set z2 = z.Compile("Function Foo():MsgBox ""Well Met!"":Foo = 2:End Function")
z2("Hi!")
z2 "Hello Again!"
The above gives (29, 5) (null): Unspecified error. This error is in essence: your object has committed suicide.
This approach can be improved(in particular, the issue of wasteful one ScriptControl per compilation without any plans to release them).
I am writing a script to write event log information to a csv. My script was working before. But I changed some stuff, which shouldn't have any effect on writing to the csv. I have tried writing to unicode and to ASCII, based on some research I did on the internet about this issue. Neither makes a difference. The odd thing is that I use the same code later in my script to write other logs (I first write system logs, then I write application logs, etc.), and it works perfectly there. The code I am using is temporary, as I have not got around to writing a way to delete carriage returns from messages (which causes issues with importing the CSV to Excel). So it might fix itself once I do that. But it seems like it is a larger issue than that. Here is the script up until it moves on to other logs:
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
strComputer = "."
strType = "Error"
strPath = "T:\IT resources\Event Logs\ErrorLog" & strComputerName & ".csv"
'Script to convert UTC to human readable. From Script Repository.
Function WMIDateStringToDate(dtmInstallDate)
WMIDateStringToDate = CDate(Mid(dtmInstallDate, 5, 2) & "/" & _
Mid(dtmInstallDate, 7, 2) & "/" & Left(dtmInstallDate, 4) _
& " " & Mid (dtmInstallDate, 9, 2) & ":" & _
Mid(dtmInstallDate, 11, 2) & ":" & Mid(dtmInstallDate, _
13, 2))
End Function
'ForWriting is to write to file from start. ForAppending is to write to file from end of file.
constForWriting = 2
constForAppending = 8
constTristate = 0
boolUnicode = False
chrCarriageReturn = chr(13)
chrNewLine = chr(10)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'This is so that cscript won't encounter a runtime error if the file already exists. Also so that it will write to the already existing file.
If objFSO.FileExists(strPath)=False Then
Set objErrLog = objFSO.CreateTextFile(strPath,constForWriting,boolUnicode)
objErrLog.Write "Type,"
objErrLog.Write "Time Generated,"
objErrLog.Write "Source Name,"
objErrLog.Write "Event Code,"
objErrLog.Write "Category,"
objErrLog.Write "Message"
objErrLog.Writeline
strTimeMin = "01/01/1970/0:00:00"
'19700101000000.000000-480
Else Set objErrLog = objFSO.OpenTextFile(strPath,constForAppending,constTristate)
'Only need this if it writes from the line the file ends on, as opposed to starting on a new line (which I expect it will).
objErrLog.WriteLine
End If
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'Querying Event Logs
Set colLoggedEvents = objWMIService.ExecQuery _
("SELECT * FROM Win32_NTLogEvent WHERE Logfile = 'system' AND "_
& "Type = 'Error'")
'Type='Error' instead of "1" because it is a WQL query, I think. I believe that it is searching the entries in a database that reference the Win32_NTLogEvent objects. So I am searching the values in the database as opposed to the properties of the objects they reference. Or perhaps not. WHen I echo the type property of every object in colLoggedEvents, cscript outputs "Error". So maybe the I'm reading the SDK wrong? At least it seems to be working.
'This is a comparison function which tells where string 2 occurs in string 1. Starts at 1.
constStart = 1
constCompareType = 0
'This loop writes the information to a .csv.
For Each objEvent In colLoggedEvents
If objEvent.Timegenerated > strTimeMin Then
strTimeMin = objEvent.TimeGenerated
Else
End If
objErrLog.Write objEvent.Type & ","
objErrLog.Write WMIDateStringToDate(objEvent.TimeGenerated) & ","
objErrLog.Write objEvent.SourceName & ","
objErrLog.Write objEvent.EventCode & ","
constExist=InStr(constStart,objEvent.Message,chrCarriageReturn,constCompareType)+InStr(constStart,objEvent.Message,chrNewLine,constCompareType)
If constExist = 0 Then
objErrLog.Write objEvent.Category & ","
objErrLog.Write objEvent.Message
Else
objErrLog.Write objEvent.Category
End If
objErrLog.WriteLine
Next
Any help would be greatly appreciated.
Loose the misconception that code 'might fix itself'
Give the full error details (number, description, line identified) when asking a question
Assuming that you got a "5 - Invalid procedure call or argument" error on a line starting with "objErrLog.Write" see here for an explanation.
You claim you have tested a variant of your code using Unicode; you didn't, because:
The prototype of .CreateTextFile is
object.CreateTextFile(filename:string[, overwrite:bool[, unicode:bool]])
This clashes with your
objFSO.CreateTextFile(strPath,constForWriting,boolUnicode)
The prototype of .OpenTextFile is
object.OpenTextFile(filename:string[, iomode:enum[, create:bool[, format:enum]]])
This clashes with your
objFSO.OpenTextFile(strPath,constForAppending,constTristate)
So fix these blunders (yourself!), test with the file really opened for Unicode, and hope that assumption (3) holds.
Update wrt comments:
Please reflect upon "Give the full error details (number, description, line identified) when asking a question" in the context of:
I get an invalid procedure error after 68 members of colLoggedEvents
when I have the file in ASCII.
vs
I get the error when I call the OpenTextFile method
The first statement implies that the 68th member contains characters that can't be written in ASCII/ANSI mode. Really/Correctly using Unicode output format will fix the problem, provided the error log does not contain invalid data.
The second statement indicates that the parameters to the .Open/CreateTextfile methods are still not correct. Did you change both invocations to Unicode?
Update II:
The docs define
TristateTrue -1 Opens the file as Unicode.
Your code wrongly uses:
constTristate = 1
Set objErrLog = objFSO.OpenTextFile(strPath,constForAppending,boolCreate,constTristate)
Evidence:
>> Set ts = goFS.OpenTextFile("error5.txt", 8, False, 1)
>>
Error Number: 5
Error Description: Invalid procedure call or argument
>> Set ts = goFS.OpenTextFile("error5.txt", 8, False, -1)
>>
>> <-- no news are good news
Update wrt comment concerning TriStateTrue:
The VBScript doc say:
TristateUseDefault -2 Opens the file using the system default.
TristateTrue -1 Opens the file as Unicode.
TristateFalse 0 Opens the file as ASCII.
The doc #Adam refered to concerns VBA; but I wouldn't trust it without a check.
how o write vb code which can except parameter at runtime
ex. My exe is "readfile.exe" and if i want to give file name rom command line the command to be executed will be
readfile.exe filename
it should take the file name parameter and perform the action
Look at the Command function, that should give you all the parameters that were passed in.
I can't find the VB6 docs for it online, but MSDN have the docs for the VBA version, and that's usually the same so I'd suggest looking here for more info. And it even has a full sample here.
You can do something like this:
Sub Main()
Dim a_strArgs() As String
Dim blnDebug As Boolean
Dim strFilename As String
Dim i As Integer
a_strArgs = Split(Command$, " ")
For i = LBound(a_strArgs) To UBound(a_strArgs)
Select Case LCase(a_strArgs(i))
Case "-d", "/d"
' debug mode
blnDebug = True
Case "-f", "/f"
' filename specified
If i = UBound(a_strArgs) Then
MsgBox "Filename not specified."
Else
i = i + 1
End If
If Left(a_strArgs(i), 1) = "-" Or Left(a_strArgs(i), 1) = "/" Then
MsgBox "Invalid filename."
Else
strFilename = a_strArgs(i)
End If
Case Else
MsgBox "Invalid argument: " & a_strArgs(i)
End Select
Next i
MsgBox "Debug mode: " & blnDebug
MsgBox "Filename: " & strFilename
End Sub