Issue with variable set to variable in VBS - vbscript

In a VBS I have which I use in conjunction with SecureCRT to automate some processes on Cisco devices, I have (very much pared down) the following code:
Sub prConnectToHost(strConnectHost)
'If no host is passed into subroutine then we need to prompt for one.
If strConnectHost = "" Then strConnectHost = LCase(crt.Dialog.Prompt("Enter hostname or IP address:", "Connect to a host", strHost, False))
strHost = strConnectHost
'If user hits Cancel or hits Ok with no hostname entered then exit.
If strHost = "" Then
booReconnect = False
Exit Sub
End If
'Write to connection log
Call prWriteToConnectionLog
'Run command capture subroutine.
Call prCommandLoop
Set intWaitString = Nothing: Set strScreenGet = Nothing
Set strLatestScriptVersion = Nothing: Set strConnectHost = Nothing
End Sub
Sub Main has a section like this:
Do While booReconnect = True
Call prConnectToHost("")
Loop
crt.Dialog.Prompt is the same as MsgBox, only it centres on the window and not the screen, so it's a little neater. The variable strHost is the actual hostname string which is global in the script and contains the hostname we want to connect to. It is used in the Prompt line as a default text, the idea being that if you disconnect and the booReconnect flag is set, this Sub is called again, and next time you're prompted for a hostname the old one is there - useful if you spelled it wrong first time, or you're connecting to a bunch of devices with a similar name.
You can see where we call prCommandLoop at the end of this Sub, which is a loop which uses a crt Function called WaitForStrings which puts the script on hold until it finds a particular string sequence. When it does, it fires off some stuff, then loops back around until it sits waiting again.
One of the automation commands detects for the presence of the connection menu (so therefore we have quit the router session) and prompts the user for another hostname to connect to.
The important bit is in the variable clearup at the end - Set strConnectHost = Nothing. If I leave this in and immediately exit prCommandLoop with booReconnect set, as soon as Set strConnectHost = Nothing is applied, strHost dies - if I try to reference it I get an error Object Variable not set. I experimented with putting a MsgBox strHost line right at the end of the Sub, which proved this.
The bizarre thing is that if I choose a different automation command in prCommandLoop first and then quit the session, the Set strConnectHost = Nothing doesn't seem to bother anyone.
Can anyone help me explain why this is a problem, as it is baffling me. I can easily work around it (by not issuing Set strConnectHost = Nothing at the end of the prConnectToHost Sub), but I just want to understand what the problem is.

Set is used to assign objects to variables. Think of Nothing as a very special object
>> WScript.Echo IsObject(Nothing)
>>
-1
which is useful only to indicate the emptiness of the variable. Your
Set strConnectHost = Nothing
assigns this Nothing to strConnectHost. After that, the variable is good for nothing - it holds the empty object that can't be printed or used in computations or asked to do methods.
The type prefix fraud (*str*ConnectHost) should alert you that this is fishy. You work with strings (and numbers?); to clear/reset them use (simple) assignment with Empty:
>> strConnectHost = Empty
>>
>> WScript.Echo IsEmpty(strConnection)
>>
-1
or with a suitable value:
intWaitString = -1 ' or 0 ...
(assuming intWaitString isn't another type prefix fraud).
SECOND ATTEMPT:
I assume you call your sub like this:
strHost = "SomeHost"
prConnectToHost strHost
The relevant digest of your sub is:
Sub prConnectToHost( [ByRef] strConnectHost)
...
Set strConnectHost = Nothing
End Sub
As VBScript uses by reference passing of parameters as default, your modification
changes the caller variable strHost. This happens to non-object variables too:
Dim sVar : sVar = "String 0"
WScript.Echo 0, sVar
changeString sVar
WScript.Echo 1, sVar
Sub changeString( sByRefVar )
sByRefVar = "String 1: changed by changeString( ByRef sByRefVar )"
End Sub
output:
0 String 0
1 String 1: changed by changeString( ByRef sVar )
In your case the modification assigns Nothing to the variable that is called
strConnectHost in the Sub and strHost on the caller level. As I said before,
that makes the variable useless (except of testing for Is Nothing).
I hope that explains the clobbering of strHost.
WRT 'memory management': Except for very special cases, you don't need to
clear/reset/SetToNothing variables in VBScript. Using local variable in your
Subs/Functions is all that is necessary. If you decide to use global variables
and manage their state yourself, you must pay attention to the variable types:
Changing the type from object (including Nothing) <=> non-object and lying
about types by misleading type prefixes is dangerous/a sure way to desaster.
If you think you must clear strHost, assign Empty or "" to strConnectHost.
NEXT ADDITION
All VBScript variables are Variants, but not all Variants are created equal:
>> s0 = "string"
>> s1 = CStr( 12.35 )
>> WScript.Echo TypeName( s0 ), TypeName( s1 )
>>
String String
>> n0 = 1
>> n1 = CByte( n0 )
>> WScript.Echo TypeName( n0 ), TypeName( n1 )
>>
Integer Byte
TypeName() and VarType() show the sub-types and a progammer can use a set of
C[hange/onvertTo]<Type>() functions to enforce them - to a degree, as assignments
may change types 'under the hood'.
>> WScript.Echo TypeName( n0 ), TypeName( n1 )
>>
Integer Byte
>> n0 = 1.1
>> n1 = 2 ^ 20
>> WScript.Echo TypeName( n0 ), TypeName( n1 )
>>
Double Double
There are even Type Mismatch Errors:
>> WScript.Echo Nothing
>>
Error Number: 13
Error Description: Type mismatch
>>
>> WScript.Echo s0 Is Nothing
>>
Error Number: 424
Error Description: Object required
So sub-types matter. Some people think type prefixes are uncool, but others see
them as valuable help in weakly typed languages. If you decide to use them, you
should use them correctly -
Set strWhatEver = objWhatever
objWhatever = intWhatever
intWhatever = objWhatever
If strWhatEver = intWhatever Then
all smell (of not paying attention to types and hard to pin down errors in later code).

Related

vbscript X and Cancel not doing what they should

im writing a code in vbscript where it will ask the user for input and then run certain files according to the input and i have the else so that it will redo the if else sequence when you type something that isnt an option but when i try to press cancel or the red 'X' it acts as if i have put in an invalid input and goes over the else sequence.
Dim sInput
sInput = InputBox("input")
If sInput = "input1" or sInput = "input2" Then
set shell=createobject("wscript.shell")
shell.run "file.bat"
elseif sInput = "exit" or sInput = "Exit" Then
WScript.Quit
else
name=msgbox (" That is not a valid response",0+16,"ERROR")
set shell=createobject("wscript.shell")
shell.run "input.vbs"
end if
Don't try to restart the script.
Use a loop instead. End the loop when the user entered a valid option, or quit the entire program if requested.
Option Explicit
Dim Shell, input, button
Set Shell = CreateObject("WScript.Shell")
Do
input = InputBox("input")
If IsEmpty(input) Or LCase(input) = "exit" Then WScript.Quit
input = LCase(Trim(input))
If input = "input1" Or input = "input2" Then
Shell.Run "file.bat"
Exit Do
Else
button = MsgBox("That is not a valid response.", vbExclamation + vbRetryCancel, "ERROR")
If button = vbCancel Then Exit Do
End If
Loop
Notes:
Option Explicit makes variable declaration mandatory. It's a good idea to always have this enabled.
IsEmpty() is true when the user pressed the Cancel button (or the Esc key) in the InputBox - but this will work only before the response is manipulated in any way, such as LCase or Trim. Supporting the Cancel button is more intuitive than having a special "exit" keyword, so maybe you should get rid of that.
The various constants you can use with MsgBox are described on ss64.com and in more detal in the official VBScript language reference.
You can change what Enter and Esc do in each MsgBox by using the vbDefaultButton1 or vbDefaultButton2 constants.
The Do loop without any conditions (Do/Loop While ... or Do/Loop Until ...) will run forever - be sure not to forget using Exit Do or WScript.Quit(). (If you do, killing the Script with the Task Manager will get you out of it.)

How to add the input from InputBox into MsgBox

I want to add the inputted text from an MsgBox into a Msgbox I got this but it don't work. Can anyone help me?
Dim x
x = MsgBox("Welcome to this software. Are you new with this?", vbYesNo +
vbQuestion, "Welcome!")
Dim f
f = strMessage =Inputbox("First enter your name","The software")
Dim z
z = MsgBox(Welcome strMessage!)
There are a couple of issues with what you have here. I'll go through them one by one.
f = strMessage = InputBox("First enter your name","The software")
I assume you're trying to store the value the user entered into the InputBox into some variable--either f, or strMessage, or maybe both. VBScript does not allow multiple assignments in the way that you've written them. Instead, VBScript is testing whether the value stored in strMessage (which you haven't declared or initialized) is equal to the value the user entered. The value of that test (which will be either True or False) is then stored in f.
If you're trying to store the user's input in just f, this will work:
f = InputBox("First enter your name","The software")
If you want to store it in both f and strMessage, you'll need two assignment statements:
Dim strMessage
f = InputBox("First enter your name","The software")
strMessage = f
Next, there are a couple issues with these lines:
Dim z
z = MsgBox(Welcome strMessage!)
First, MsgBox with only one argument will always return 1, so there's no real use in having variable z.
Next, you haven't put quotes around the first argument to MsgBox. As a result, Welcome strMessage! confuses the interpreter, and throws an error. If you instead add quotes, "Welcome strMessage!", that will resolve the error.
I expect, however, you want to display the user's input back to them. In that case, you can't just put the variable within the quotes--you need to concatenate it on, using &. Thus, you should come to:
MsgBox("Welcome, " & f & "!")
Finally, an important note, the variable names you have (x, f, strMessage, and z) not particularly descriptive. Consider some helpful names, like isUserNew and userName. With those changes, you'd get to:
Dim isUserNew
Dim userName
isUserNew = MsgBox("Welcome to this software. Are you new with this?", vbYesNo, "Welcome!")
userName = Inputbox("First enter your name","The software")
MsgBox("Welcome, " & userName & "!")

How to avoid entering a duplicate entry in a database?

I have a VB6 application where I am trying to avoid inserting a duplicate entry of a PIN number. But my code is always saving the duplicate entry.
Here is my current code:
Public Function IsPIN_NOExists(ByVal TableName As String, _
ByRef EmployeeCode As String, ByVal FieldName As String, ByVal DataToCheck As String, _
Optional ByVal CodeFieldName As String, Optional ByVal CodeFieldValue As String) As Boolean
TableName = UCase$(Trim$(TableName))
EmployeeCode = Trim$(EmployeeCode)
On Error GoTo ErrorHandle
Dim lstrSQL1 As String
Dim lrsTemp1 As ADODB.Recordset
lstrSQL1 = " Select " & FieldName & " from " & TableName & " Where PIN_NO =" & DataToCheck & ""
If Len(Trim$(CodeFieldName)) <> 0 And Len(Trim$(CodeFieldValue)) <> 0 Then
lstrSQL1 = lstrSQL1 & " AND " & CodeFieldName & " <> '" & CodeFieldValue & "'"
End If
Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)
If lrsTemp1 Is Nothing Then
IsPIN_NOExists = False
ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
IsPIN_NOExists = True
lrsTemp1.MoveFirst
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
MsgBox (EmployeeCode)
ElseIf lrsTemp1.RecordCount = 0 Then
IsPIN_NOExists = False
Else
IsPIN_NOExists = False
End If
If lrsTemp1.State = adStateOpen Then lrsTemp1.Close
Set lrsTemp1 = Nothing
Exit Function
ErrorHandle:
IsPIN_NOExists = False
End Function
And here is my calling code for this function:
If Trim$(TxtPINno.text) <> "" And Trim$(TxtPINno.text) <> "-" Then
'If gObjValidation.IsCodeExists(fstrTableName, gEmployerCode, "PIN_NO", Trim$(TxtPINno.text)) = True Then
If gobjValidation.IsDescriptionExists(fstrTableName, gEmployerCode, "PIN_NO", Trim$(TxtPINno.text), "EMPLOYEE_ID", Val(txtEmpCode.Tag)) = True Then
If gobjValidation.IsPIN_NOExists(fstrTableName, gEmployeeCode, "EMPLOYEE_CODE", _
Trim$(TxtPINno.text)) = True Then
MsgBox (gEmployeeCode)
Call MessageBox("This PIN Number is already existing for another employee. Cannot enter duplicate number!", OKOnly, Information, DefaultButton1, Me.Caption)
sstInformationTab.Tab = 0
If TxtPINno.Enabled = True Then TxtPINno.SetFocus
CheckAllValidations = False
Exit Function
End If
End If
End If
How can I fix this code to avoid entering a duplicate entry?
Edit: Adding in ExecuteSQL function code
Public Function ExecuteSQL(ByVal SQLQueryStatement As String) As ADODB.Recordset
On Error GoTo ErrorHandler
Dim lrs As ADODB.Recordset
cintDBHitCtr = cintDBHitCtr + 1
Set lrs = DBConnection.Execute(SQLQueryStatement, , adCmdText)
Set lrs.ActiveConnection = Nothing
Set ExecuteSQL = lrs
Set lrs = Nothing
Exit Function
ErrorHandler:
Set ExecuteSQL = Nothing
Call TrapDatabaseError(SQLQueryStatement, DBConnection.Errors(0), cDBType)
End Function
It looks like you've thrown extra logic into your function to try to fix your problem. This:
If lrsTemp1 Is Nothing Then
IsPIN_NOExists = False
ElseIf Not (lrsTemp1.BOF And lrsTemp1.EOF) Then
IsPIN_NOExists = True
lrsTemp1.MoveFirst
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
MsgBox (EmployeeCode)
ElseIf lrsTemp1.RecordCount = 0 Then
IsPIN_NOExists = False
Else
IsPIN_NOExists = False
End If
Stripped of all extraneous logic, can be replaced with this:
With lrsTemp1
IsPIN_NOExists = Not (.BOF And .EOF)
If IsPIN_NOExists Then
EmployeeCode = lrsTemp1.Fields("EMPLOYEE_CODE")
End If
End With
(Presumably, all your MsgBoxes are to try to troubleshoot what's wrong, so they can be left out.)
Now, the logic in your function, in plain English, is "If the PIN exists in the database, then return true." Looking at your calling code, your logic in plain English is "If the function returns true then tell the user that the PIN already exists." Since this logic is correct, it follows that your error is somewhere else in your code.
Your error is very probably somewhere in the code itself. Disable your error handler (just comment out the "on error" statement) and you will probably find that you get an error on another line. As a general rule, don't put error handlers in your code until you are sure that it works as intended. Error handlers are for users, not developers.
The way that you have your error handler set up, if you get an error your code will keep adding the duplicate error, which is the problem that you describe. So it seems likely that that is your problem. Now, without intending to be offensive, I must also tell you that this is a very bad (terrible, even) error handling design. Your logic in plain English is "if there is an error, tell the calling code that you didn't find a duplicate key." That's not so good, is it? :) For example, if you have an error in your SQL statement, then your code will insert the duplicate PIN.
Also, your function sounds like "PIN doesn't exist", when you are returning true if it does exist. Consider renaming it to something like "PIN_IsDuplicate" or better (that is, more consistent with standard naming conventions) "IsDuplicatePIN".
***** EDIT *****
Ok, I believe I have your solution. If you are too conscientious about "cleaning up" your open object references, you run the risk of dropping them before you are finished using them. In this case, you are attempting to break the active connection to your recordset, because you are under the incorrect impression that the connection is only necessary when you first pull the data from the recordset. While this is true in the .Net world, it is only true in the VB6 world if you specifically set up a "disconnected recordset."
Your problem is with this line of code:
Set lrs.ActiveConnection = Nothing
When you do this, you will get the error (if you disable your error handler) "Operation is not allowed when object is open." This means that you have to maintain your connection to the database as long as the recordset is open, which it is until you close it or until the function ends.
Tracing through your code, if you get an error on this line by trying to destroy the connection, then you call your error handler. The error handler tells the function to return a null object pointer to the calling function. So, in the calling function, this line of code:
Set lrsTemp1 = cObjDBConn.ExecuteSQL(lstrSQL1)
actually sets lrsTemp1 to Nothing. Therefore, the first condition of your If block is satisfied, and your function returns False as instructed. This gives the obscure behavior that you understandably found confusing.
So, here's what to take away from this. First, error handlers are for users, not for developers. They should be the last step in your coding process, because they turn runtime errors into logical errors which are harder to find. If you find that you have errors in code that has error handlers in place, the first step is to disable all error handlers. To do this, go to Tools/Options/General and select Break on All Errors. That will cause the runtime to ignore the error handlers.
Next, don't keep setting things to Nothing. A lot of misguided expertise in earlier versions of VB suggests that you need to do this. In truth, the VB runtime is much better at releasing object references that go out of scope than you are. It does so automatically in all but a few very well defined situations which you are unlikely to encounter. So, get rid of all of your "Set Object = Nothing" statements. You don't need them, and as you are finding out, they can cause errors.
One thing that it is helpful to do, however, is to explicitly close your connection (call the connection object's Close method) when you are done using it. Dropping the Recordset's ActiveConnection property doesn't close the connection, it just says that the recordset doesn't want to use it anymore. Also, if you quit using it by setting the connection variable to nothing, the server won't automatically be notified that the connection is closed. It will get around to figuring it out eventually, but you will save resources by doing it in your code.
Finally, get clearer on the different types of cursors. The default CursorType is adOpenForwardOnly, a cursor which only supports MoveFirst and MoveNext. This is the simplest one, which is appropriate for either selecting a single value (as you are) or iterating through a recordset from top to bottom (for example, when populating a listbox with the contents of the recordset). This cursor must remain connected to the database until you close the recordset, which is why you get an error when you try to drop the active connection.
If you want a recordset that you can still use after disconnecting from the database, you need a client-side recordset, and will need to set the CursorLocation property to adUseClient. This can only have a CursorType of adOpenStatic, which is a fully-traversable (supports moving backwards, forwards, by multiple records, etc.) non-updateable cursor--a "static" or "snapshot" cursor. (If you set the CursorLocation property to adUseClient, the CursorType will be automatically forced to adOpenStatic.)
If you want to do all this, you can't use the Execute method of the Connection object. Instead, you have to use the Recordset's Open method. Here's a bit of code that pulls the authors table from the SQL Server pubs sample database into a disconnected recordset and prints all the last names to the debug window:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=.\SQLEXPRESS;Initial Catalog=pubs;Integrated Security=SSPI;"
Set rs = New ADODB.Recordset
With rs
.CursorLocation = adUseClient
.Open "select * from authors", cn, adOpenStatic
Set .ActiveConnection = Nothing
cn.Close
Do Until .EOF
Debug.Print .Fields("au_lname")
.MoveNext
Loop
.MoveFirst
End With

Win32_NTLogEvent message property FilSystemObject.Write procedure call issue

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 to extract context informationm the equivalent of __LINE__, __FILE__,etc., in VBSCRIPT

I'd like to know how to get the line number of a line in vbscript programmaticly either at the point of the code like __LINE__ or more ideally a way to get the line number of where the current function was called like python's stack module so I can write a reusable debugging function(and the file the code is located in) and no I don't want to know how to turn on line numbers in my editor.
Also I'd like to now any similar useful information that can be extracted such as calling function, variable type as string, etc.
Unfortunatly that doesn't work the way like in Ruby and Python. The next best thing i worked out is putting a call to a errorhandling function everywhere where things could go wrong. The numbers in the parameter of this function are adapted each time i execute a macro in my editor (i use textpad, the \i is autonumbering in a Regular Expression). If your editor doesn't support this you could write a script that does this. So when an error occurs, it is logged with the number the errorhandling function was called and you can easily find it back in the source by looking for #number#.
This is usable for both asp and vbs but for vbs there is an easier way.
Some editors like textpad or sublimle text let you execute a vbs script, show the output in a tab and if an error is produced let you double click the line with the errormessage which opens the script at that line. This is also done by a regular expression. Let me know if you need the one for textpad.
on error resume next
'initialize constants DEBUGLEVEL and LOGFILE
'initialize strHostName
'some code
oConn.execute(sql)
if not LogError("#1#") then
'do the things if successfull, otherwise log error with number
end if
'again some code
if not LogError("#2#") then
'do the things if successfull, otherwise log error with number
end if
'the debug and log functions
function LogError(errornumber)
'LogError\(\"#[0-9]+#\"\) replace by LogError("#\i#")
if err.number <> 0 then
call debug("<name of script>/Logerror","","","Errornumber:" _
& errornumber & " " & err.number & " " & err.description & " " _
& err.source)
LogError = True
err.clear
errors = errors+1
else
LogError = False
end if
end function
function Debug (pagina, lijn, varnaam, varinhoud)
if DEBUGLEVEL > 0 then
const forReading = 1, forWriting = 2, forAppending = 8, CreateFile = True
dim fs,f, var, strHostName
set fs=CreateObject("Scripting.FileSystemObject")
strHostName = fs.GetFileName(WScript.FullName)
if fs.FileExists(LOGFILE) then
set f=fs.OpenTextFile(LOGFILE, forAppending)
else
set f=fs.OpenTextFile(LOGFILE, forWriting,true)
end if
var = now & " " & pagina & ":" & lijn & ":" & varnaam & ":" & varinhoud
f.WriteLine var
if LCase(strHostName) = "cscript.exe" then 'debugging
if DEBUGLEVEL > 1 then
wscript.echo var
end if
end if
f.Close
set f=Nothing
set fs=Nothing
end if
debug = true
end function
VBScript doesn't expose that information, so you can't access it programmatically from within the script (edge cases notwithstanding). You're going to need a debugger for extracting this kind of information. Or you could have another script interpret the first one and keep track of line numbers (like this). I wouldn't recommend the latter for any kind of production environment, though.
As long as it's happening outside of a function, the following works.
Automatic error-handling is turned off at the start of the script by On Error Resume Next, so that the script doesn't just exit before you can do anything. BUT, you can then turn error-handling back on using On Error GoTo 0 and Raise an exception yourself. That will output the line number in addition to any of your debugging messages.
For example:
On Error Resume Next
server = WScript.Arguments(0)
If Err.Number <> 0 Then
WScript.Echo("Need to pass in an argument!")
On Error GoTo 0
Err.Raise(1)
End if
If you run this without any arguments, you get the following output:
Need to pass in an argument!
C:\script.vbs(6, 5) Microsoft VBScript runtime error: Unknown runtime error
The "6" refers to the line number where the exception was raised.
This way you can print custom output, and also you'll know what line the error happened at.
Yes!
There is a way to get the exact error line number, but it's HUGLY, as we are talking about an ancient programming tool....
And yes, it is worth it, especially if your code is going to run in front of many users. That way you can get past isolating and reproducing the bug, right to solving it.
Take a close look at the last variable "Erl" in the line of code below. It is an undocumented global variable the VB script processor holds.
Dim sErrorMsg as String
sErrorMsg = Err.Description & "(" & Err.Number & ")" & vbNewLine & "Source: " & Err.Source & vbNewLine & "At line number: " & Erl
In order to get anything from that global "Erl" variable you need to (manually)** set its value at the beginning of each line of code as shown below. Beware, you set the line number, if you forget to set the number for a specific line, Erl will report the last set value. See the division by zero error line, it reports the line number set above because I did not set a line number value at the beginning of the line that caused the error.
I have not figured out the inbuilt call stack, though I know there is one. Please let me know if you figure that one out, for now I use a module level variable to build the stack.
More tips at the very end, below this code sample
Sub WhatEverSub ()
2 Const iColIdxPageNbr As Integer = 2
3 Const iColIdxDefinition As Integer = 3
5 Dim oDoc_Source As Document
6 Dim oDoc_Target As Document
10 Dim oTable As Table
11 Dim oRange As Range
12 Dim n As Long
13 Dim strAllFound As String
14 Dim Title As String
15 Dim Msg As String
On Error GoTo PrepErrorHandler
Dim xyz As Long
xyz = Rnd(3) / 0
16
17 Title = "Evil Finder - This program is about doing something important for the world"
18
19 'Show msg - stop if user does not click Yes
20 Msg = "This macro finds all evil things consisting of 2 or more " & _
"uppercase letters and extracts the hex representation to a table " & _
"in a new document." & vbNewLine & vbNewLine & _
"Do you want to continue?"
21 If MsgBox(Msg, vbYesNo + vbQuestion, Title) <> vbYes Then
22 Exit Sub
23 End If
(... whatever code ...)
820 Application.ScreenUpdating = True
830 If n = 1 Then
840 Msg = "No evil things were found. Need to find better detection tool"
850 oDoc_Target.Close savechanges:=wdDoNotSaveChanges
860 Else
870 Msg = "Finished extracting " & n - 1 & " evil thing(s) to a new document."
880 End If
PrepErrorResumeLine:
890 MsgBox Msg, vbOKOnly, Title
'Clean up
1000 Set oRange = Nothing
1010 Set oDoc_Source = Nothing
1020 Set oDoc_Target = Nothing
1030 Set oTable = Nothing
Exit Sub
PrepErrorHandler:
Msg = Err.Description & "(" & Err.Number & ")" & vbNewLine & "Source: " & Err.Source & vbNewLine & "At line number: " & Erl
Resume PrepErrorResumeLine
End Sub
**Some more tips:
1)
As for setting the error line number values manually, I wrote a utility (more than a decade ago) to automate the addition or removal or renumbering of all lines in a module by working directly on the VB project files (or standalone .vbs files), but the below will take care of the basic, with a few manual adjustsments remaining...
Set up VB code line #s using MS Excel
a) paste code in column C
b) set column A's first cell value to 10, and second to 20 and drag copy down to auto increment until you reach the last line/row of code in column B
c) in column B paste in the following formula and drag copy down =A1 & REPT(" ", 8 - LEN(A1))
d) copy columns B and C back into the VB code pane et voila!
Strip out the line numbers to do major edits using Word
Paste the code in,
Hit CTRL + H and make sure wildcards is checked (click the "more" button)
Fill in the following settings
FIND
[^13][0-9 ]{4}
REPLACE
^p
Done!
2)
number each line in increments of 10 at least so you can wedge in a few lines at the last minute without having to renumber each line below your change
3) On Error Resume Next is evil and will cost you a lot of debugging hours!
At least 90% of the time, one should use a specific handler, or nothing. If you do not already know how to recover from an error, do not use RESUME NEXT to silence it, instead, log all the details (using Erl) and learn from the run time logs and use GoTo 0 'Zero, not the letter O to let the rest of the errors bubble up the call stack.
On Error GoTo MyErrorHandlerSection
(... write your risky code here ...)
On Error GoTo 0
'the line immediately above disables all error handling in the current function, if any error happens, it will be passed to the calling function
Nothing prevents you from adding another handling section in the same function if you have another chunk of risky code using
On Error GoTo MySecondErrorHandlerSection

Resources