Is it possible in VBScript to determine the name of the function currently executing?
In .NET, you could do:
MethodBase method = MethodBase.GetCurrentMethod();
Console.WriteLine(method.Name);
In the past, I build a callstack viewer to see the performance of each function that is called. This needs one extra line of VBS code per function/sub and some overhead during runtime of course because of the extra code.
bottom - up:
Function DoSomething(a, b, c)
dim registerFunctionObj : Set registerFunctionObj = [new RegisterFunction]("DoSomething")
' other code
End Function
Whenever the function is called, it creates a new instance of the RegisterFunction object. When the function exits, the registerFunctionObj variable goes out of scope automatically, calling the Class_Terminate sub of the instance.
[new RegisterFunction] is just a function that return a registerFunction instance:
Function [new RegisterFunction](funcName)
Set [new RegisterFunction] = new cls_RegisterFunction
[new RegisterFunction].FunctionName = funcName
Set [new RegisterFunction].CallStackViewer = CallStackViewer
End function
Class cls_RegisterFunction
Private functionName_, startTime_, callStackViewer_, endTime_
Private Sub Class_Initialize
startTime_ = now
callStackViewer_.LogInitialize me
End Sub
Public Property Let FunctionName(fName)
functionName_ = fName
End Property
Public Property Set CallStackViewer(byRef csv)
Set callStackViewer_ = csv
End Property
Private Sub Class_Terminate
endTime_ = now
callStackViewer_.LogTerminate me
End Sub
End Class
The CallStackViewer instance is a singleton instance of the a CallStackViewer class, but you can make it a part of your project, so you retrieve it through you global project class:
Private PRIV_callStackViewer
Public Function CallStackViewer()
If not IsObject(PRIV_callStackViewer) Then
Set PRIV_callStackViewer = new cls_CallStackViewer
End If
Set CallStackViewer = PRIV_callStackViewer
End Function
Class cls_CallStackViewer
Public Sub Class_Initialize
' Here you can retrieve all function libraries (as text file) extract the
' function name, the file they are in and the linenumber
' Put them in a dictionary or a custom object
End Sub
Public Sub LogInitialize(byref registerFunction)
' Here you can push the function on a stack (use a standard dotnet list>stack for it),
' log the starttime to a log object or handle custom breakpoints
End Sub
Public Sub LogTerminate(byref registerFunction)
' Here you can pop the function from a stack, log the endtime to a log
' object or handle custom breakpoints
End Sub
End Class
Disclaimer: The code in here is pure demo code created on the fly. It lacks functionality and is only here to explain the concept. It could contain errors and is not complete.
The only thing you need is one line of code per function and your own imagination to expand it.
No, but you can easily implement it
dim module_name
sub sub1
module_name = "sub1"
wscript.echo "i'm " & module_name
'do something
end sub
function function1
module_name = "function1"
wscript.echo "i'm " & module_name
function1 = "something"
end function
In case of recursion you could also remember the level you'r in so that you can get out if getting too deep.
Related
Thanks for reading.
I have built a VB6 DLL (VB_InterFace just for a name) that talks to a C# DLL (C#_Driver just for a name) that talks to a Bluetooth Device.
The Demo VB6 test app (VB_Demo just for a name) I created as stage one works fine, does what it is supposed to. It calls the VB_Interface and Opens and Closes the BTDevice. Additional functions also work fine.
However on placing the operational code from VB_Interface into another DLL that is the live operations DLL, Open works fine, but Close is throwing an error. "Variable not defined" when returning from the C#_Driver.
I just can't see why, the code is the same, the process is only marginally different. By this I mean ;
In the VB_Demo I have two buttons "Open" "Close" and when I click on these I get the feedback that I expect from the BTDevice.
Private Sub btnOpenPort_Click()
'MsgBox steps(0)
ReDim steps(5)
Dim rc As HF4000_ResultCodes
'rc = driver.OpenSerial(cmbPorts.Text)
If driver.OpenSerial(cmbPorts.Text) = True Then
Private Sub btnClosePort_Click()
Dim rc As HF4000_ResultCodes
If driver.CloseSerial("COM4") = True Then
However in the live DLL it just executes the same functions internally without being initiated by a button click.
' See IScanDevice documentation.
' #see IScanDevice#OpenDevice
Private Function IScanDevice_OpenDevice() As Scanning.Scan_ResultCodes
(truncated slightly)
50 If driver.OpenSerial("COM4") = True Then
rc = READY
MsgBox "Connected to the device successfully."
' See IScanDevice documentation.
' #see IScanDevice#CloseDevice
Private Function IScanDevice_CloseDevice() As Scanning.Scan_ResultCodes
(truncated slightly)
50 If driver.CloseSerial("COM4") = True Then
60 rc = READY
70 IScanDevice_CloseDevice = Scan_Success
clsDriver.cls
Public Event OnStateChanged(newState As String)
Public Event OnDataUpdated()
Dim WithEvents CSharpInteropServiceEvents As CSharpInteropService.LibraryInvoke
Dim load As New LibraryInvoke
Private Sub Class_Initialize()
Set CSharpInteropServiceEvents = load
End Sub
Private Sub CSharpInteropServiceEvents_MessageEvent(ByVal newState As String)
If newState = "OpenForm1" Then
' FormDummy2.Show ' Not required
End If
If State <> newState Then
State = newState
RaiseEvent OnStateChanged(State)
GetDriverData
End If
End Sub
Private Function BluetoothTestInvoke(load, functionName, param)
BluetoothTestInvoke = load.GenericInvoke("BluetoothTest.dll", "BluetoothTest.Class1", functionName, param)
End Function
Function OpenSerial(portNumber) ' "COM4"
Dim param(0) As Variant
Dim retorno As Variant
param(0) = portNumber
retorno = BluetoothTestInvoke(load, "OpenSerial", param)
OpenSerial = retorno(0) <<<<<<< Works fine returns TRUE
End Function
Function CloseSerial(portNumber) ' "COM4"
Dim param(0) As Variant
Dim retorno As Variant
param(0) = portNumber
retorno = BluetoothTestInvoke(load, "CloseSerial", param)
CloseSerial = retorno(0) <<<<<<<<< "Error Subscript Out of Range"
End Function
What I have discovered is this - and I guess this is the reason why the Close is not working. The question is why is this situation occurring ...
When driver.OpenSerial executes, it hits > Function OpenSerial
Within Function OpenSerial it executes BluetoothTestInvoke where "load" is "CSharpInteropService.LibraryInvoke"
From there it moves to - Sub CSharpInteropServiceEvents_MessageEvent
.. and everything is fine.
However when I then execute driver.CloseSerial after that, it hits > Function CloseSerial
Within Function OpenSerial it executes BluetoothTestInvoke where "load" is "CSharpInteropService.LibraryInvoke"
Now here it "should" move to - Sub CSharpInteropServiceEvents_MessageEvent
However No, it just drops to the next line which is CloseSerial = retorno(0)
and this is where I get the "Subscript out of range" error for retorno(0)
For some reason in the CloseSerial it is not invoking "load"
BluetoothTestInvoke(load, "CloseSerial", param)
Thoughts and suggestions much appreciated.
UPDATE
Quite right, one should never assume anything.
On the tips I started digging deeper into the C# Library. It turns out the "param" value that is the Bluetooth port is passed into the CloseSerial call, and from there is is passed around within the external C# library dll. At one stage it is reset so the port number that should be handled is lost, thus it doesn't close but specifically the "expected" data was not returned to the calling app.
param(0) = portNumber
retorno = BluetoothTestInvoke(load, "CloseSerial", param) << param was being reset in the external library.
I need to pass an object and its operation in a function so that each time I can call the function only and save me to write same steps for all the objects like validating the object before performing an operation. Similar way to a Register User Function in QTP/UFT.
However, Testcomplete doesn't have this feature (atleast under my knowledge, would be happy to know if there is)
This is my code that I am trying but unable to:
Call OpenPageorTab("Aliases.Admin.wndMain.toolStrip", ".Visible")
Function OpenPageorTab(obj, method)
'if obj.Exists then
execute a = obj&method
delay(1000)
OpenPageorTab = True
'Else
log.Error "Unable to find the object"
OpenPageorTab = False
'End if
using if condition as i was passing object earlier instead of string
It fails at "execute" statement and gives me VbScript runtime error when executing this statement.
my question is two fold -
How do I pass objects and its operation in a function and execute it
Also is it possible to pass an object it self instead of string for ex:
obtoolbar = "Aliases.Admin.wndMain.toolStrip"
Call OpenPageorTab(obtoolbar, ".Visible")
Appreciate any help or direction on this issue
EDIT 1
I am somewhere close to an answer however not accurately. I am able to pass the object as string - Check the code below
Call OpenPageorTab("Aliases.Admin.wndMain.toolStrip", ".Click")
Function OpenPageorTab(obj, method)
' if obj.Exists then
eobj = "" & obj & method
execute (eobj)
delay(1000)
OpenPageorTab = True
' Else
log.Error "Unable to find the object"
OpenPageorTab = False
' End if
End Function
However I still need to pass the object something like
Set oToolStrip = Aliases.Admin.wndMain.toolStrip
Call OpenPageorTab(oToolStrip, ".Click")
This is something that I'm unable to do.
EDIT 2
I have already got the answer to this problem and have posted the solution. That being said, is there any way that Function can be utilized as a method ?
Here an example of how to reference a function and pass parameteers to it, including objects.
Const forReading = 1, forWriting = 2, forAppending = 8, CreateFile = True
Set my_obj = CreateObject("Scripting.FileSystemObject").OpenTextFile("c:\temp\test.txt", forWriting, CreateFile)
Function my_function(my_obj, method, text)
command = "my_obj." & method & " """ & text & """"
ExecuteGlobal command
End Function
'make a reference to our function
Set proc = GetRef("my_function")
'and call it with parameters, the first being the method invoked
Call proc(my_obj, "WriteLine", "testing")
'cleanup'
my_obj.Close
Set my_obj = Nothing
I was able to finally formulate the solution the below function can work as makeshift register function in TestComplete
Sub test
'Set the Object
Set pToolStrip = Aliases.Admin.wndMain.toolStrip.Button("User Admin")
Call GenericOperationFunc(pToolStrip, ".Click", "N")
'if you want to perform an operation which return a value
b = GenericOperationFunc(Aliases.Admin.wndPopup.Child(2), ".Caption", "Y")
End Sub
Public Function GenericOperationFunc(obj, method, Return)
GenericOperationFunc = False
on error resume next
if obj.Exists then
if Ret = "Y" then
eobj = "NewText="&"obj" & method
execute (eobj)
GenericOperationFunc = NewText
Delay(500)
Else
eobj = "obj" & method
execute (eobj)
delay(1000)
GenericOperationFunc = True
End if
Else
log.Error "Unable to find the object"
GenericOperationFunc = False
End if
End Function
'log.error, delay, aliases, ptoolstrip(object) are testcomplete specific
I am playing with Windows Script Host VBScript and I am curious if VBScript is capable of adding/removing properties like JScript can.
For example:
var global = this;
var test = function() {
if ('greeting' in global) {
WScript.echo (
'global has property named greeting with value: ' +
global.greeting +
'.'
);
} else {
WScript.echo('global has no property named greeting.');
}
};
test();
global.greeting = 'Hello, World!';
test();
delete global.greeting;
test();
This code determines the global scope (JScript has no initial access to global scope such as window in browsers or global in Node.js, so I have to find it myself).
The test() function checks if the global object has a key named "greeting", and reports its current state as output.
The code does an initial test to show that global object has no greeting key, then sets the greeting property, then does a second test to show that the greeting key has been added to the global object. After this, the greeting property is deleted and a third test is run to show that the key is no longer a part of the global object.
Is this possible to replicate in VBScript?
I know VBScript has Scripting.Dictionary object that can be used to store such information, but I am curious if there is a way to hook existing objects with new properties and delete such properties in VBScript, or if VBScript has no parallel to JScript's {} construct other than Scripting.Dictionary or Classes (whose properties are immutable).
Your specific example could be emulated with something like this:
Set global = CreateObject("Scripting.Dictionary")
Sub test
If global.Exists("greeting") Then
WScript.Echo "global has property named greeting with value: " & _
global("greeting") & "."
Else
WScript.Echo "global has no property named greeting."
End If
End Sub
test
global("greeting") = "Hello, World!"
test
global.Remove("greeting")
test
but in general patching objects, or even regular inheritance, is not supported in VBScript. The best you could do to extend a class is wrap it in a class of your own:
Class MyClass
Private nested_
Public Sub Class_Initialize
Set nested_ = CreateObject("Some.Other.Class")
End Sub
Public Function Foo(val) 'wrapped method
Foo = nested_.Foo(val)
End Sub
Public Function Bar(val) 'patched method
x = nested_.Bar(val)
Bar = x * 42
End Sub
End Class
I have attempted to use an autoit object WinGetPos to handle a popup within a thread in a vb project, I would like WinGetPos function to return the x and y coordiantes of the specified popup and have used the below code, having first imported the AutoItX3.PowerShell.dll reference to my project. I am unable to generate any array could anyone suggest where I might be going wrong?
Imports AutoIt
Imports AutoItX3Lib
Private Declare Auto Function WinGetPos Lib "AutoItX3.PowerShell.dll" (ByVal mywindowtitle As String) As Array
Public Sub Main()
Dim PopUpThread As Thread = New Thread(AddressOf PopUpHandler)
With PopUpThread 'thread is looking for PopUp and press OK
.IsBackground = True
.Start()
End With
End Sub
Private Sub PopUpHandler()
Dim Ret As Integer
Dim myarray As Array
Do
Ret = FindWindow(vbNullString, "Choose File to Upload")
If Ret <> 0 Then
myarray = WinGetPos("Choose File to Upload")
MsgBox(UBound(myarray))
End If
Loop
End Sub
AutoItX is a well known and documented Programm. So why don't just look into the help file. There you will find how to use and WinGetPosX, WinGetPosY, WinGetPosHeight and WinGetPosWidth, but no WinGetPos. That may be the reason for your problem.
A question about scope was raised today and it got me thinking.
I've always understood VBScript scope and how to declare Globally and Locally. It occurred to me though that I never use Public variables but tend to use Dim instead when declaring Globally.
As far as I understood it Dim is the same as Public, but if that's the case why have both of them? Is there a difference between the two and is it good practice to use one over the other?
Update:
This question is aimed purely at VBScript, not VBA and especially in the context of Classic ASP.
Key Differences Between Visual Basic for Applications and VBScript
Access restrictions make sense in modular or object-orientated languages. As Basic started as a simple procedural language, the later addition of such features make strict rules for using Dim, Public, and Private difficult.
Everything below is about VBScript (not VBA, not ASP, not VB.NET)
Facts:
In out of Sub/Function/Class code, Dim, Public, and Private are equivalent: All declarations apply to the global scope
In Subs/Functions/Methods you can use Dim only. The declarations apply to the Func/Sub/Method-local scope
In class definitions, Dim and Public declare variables that are accessible for out-of-classe code; Private creates variables that can be accessed from class-code only. Private methods are callable from class-code only, Public methods (default) can be called from 'outer space'.
Ruleset I:
Use Dim for top-level declarations, because Public/Private have no discernible effect
Use Dim in Subs/Functions/Method, because you must
Use Public or Private (but not Dim) for member variable declarations, because the access permissions are important
Use Private for private methods, but don't bother with Public, because it's the default
Sample code:
Option Explicit
Dim gsDim : gsDim = "gsDim"
Public gsPub : gsPub = "gsPub"
Private gsPriv : gsPriv = "gsPriv"
Class cX
Dim m_sDim
Public m_sPub
Private m_sPriv
Private Sub Class_Initialize()
m_sDim = "m_sDim"
m_sPub = "m_sPub"
m_sPriv = "m_sPriv"
End Sub
Function ToString()
' Public Whatever => syntax error
' Private Whatever => syntax error
Dim Whatever ' => no problem to use Dim for local declaration
ToString = ToStringPriv()
End Function
Private Function ToStringPriv()
ToStringPriv = Join(Array(m_sDim, m_sPub, m_sPriv))
End Function
End Class
Function main()
' Public Whatever => syntax error
' Private Whatever => syntax error
Dim Whatever ' => no problem to use Dim for local declaration
main = 0
WScript.Echo "in func main():", Join(Array(gsDim, gsPub, gsPriv))
Execute "WScript.Echo ""via Execute:"", Join(Array(gsDim, gsPub, gsPriv))"
Dim oX : Set oX = New cX
WScript.Echo "oX.ToString():", oX.ToString()
Dim s
On Error Resume Next
s = oX.ToStringPriv()
WScript.Echo Err.Description
s = oX.m_sPriv
WScript.Echo Err.Description
On Error GoTo 0
End Function
WScript.Echo "top level code:", Join(Array(gsDim, gsPub, gsPriv))
WScript.Quit main()
output:
cscript dimpubpriv.vbs
top level code: gsDim gsPub gsPriv
in func main(): gsDim gsPub gsPriv
via Execute: gsDim gsPub gsPriv
oX.ToString(): m_sDim m_sPub m_sPriv
Object doesn't support this property or method
Object doesn't support this property or method
Update wrt Kul-Tigin's comment:
Ruleset II (when writing code for a host that supports modules):
Treat modules as classes, i.e. apply I.3 and I.4 to your top-level variable rsp. Sub/Function declarations (because now access rights matter/are enforced)
Code:
Option Explicit
Public gsPub : gsPub = "gsPub"
Private gsPriv : gsPriv = "gsPriv"
Class AContext
Public CodeObject
End Class
With (New AContext)
Set .CodeObject = Me
WScript.Echo .CodeObject.gsPub
WScript.Echo .CodeObject.gsPriv
End With
Evidence:
cscript dimpubpriv.vbs
gsPub
... Microsoft VBScript runtime error: Object doesn't support this property or method: 'CodeObject.gsPriv''