Could anyone explain why I get this error on line 12? It is clearly an array. Why can I not obtain the value in index position 0 in this way? Do I really need that extra variable (arr)?
Option Explicit
Dim obj
Set obj = new ClsTest
obj.singleval = "test"
MsgBox obj.singleval ' test
obj.repeatingval = split ("a,b,c", ",")
MsgBox IsArray(obj.repeatingval) ' true
MsgBox UBound(obj.repeatingval) ' 2
MsgBox obj.repeatingval(0) ' Wrong number of arguments or invalid
' property assignment: 'repeatingval'
Dim arr : arr = obj.repeatingval
MsgBox IsArray(arr) ' true
MsgBox UBound(arr) ' 2
MsgBox arr(0) ' a
Class ClsTest
Private m_singleval
Private m_repeatingval
Public Property Get singleval()
singleval = m_singleval
End Property
Public Property Let singleval(w)
m_singleval = w
End Property
Public Property Get repeatingval()
repeatingval = m_repeatingval
End Property
Public Property Let repeatingval(w)
m_repeatingval = w
End Property
End Class
If you want indexed access to the (array) property repeatingval you need to change the property definition to include an index. Beware, though, that getter and setter must be defined alike:
Class ClsTest
...
Public Property Get repeatingval(i)
repeatingval = m_repeatingval(i)
End Property
Public Property Let repeatingval(i, w)
m_repeatingval(i) = w
End Property
End Class
You can't have a property where the setter takes an array and the getter returns an element of that array. To be able to assign an array and retrieve an element of that array, you need 2 different properties:
Class ClsTest
...
Public Property Get repeatingval(i)
repeatingval = m_repeatingval(i)
End Property
Public Property Let repeatingval(i, w)
m_repeatingval(i) = w
End Property
Public Property Get repeatingarr
repeatingval = m_repeatingval
End Property
Public Property Let repeatingarr(w)
m_repeatingval = w
End Property
End Class
Set obj = New ClsTest
obj.repeatingarr = Split("a,b,c", ",")
MsgBox IsArray(obj.repeatingarr)
MsgBox UBound(obj.repeatingarr)
MsgBox obj.repeatingval(0)
Do I really need that extra variable (arr)?
You can do MsgBox obj.repeatingval()(0)
Dim thing
For Each thing in obj.repeatingval
msgbox thing
Next
This will give you access to it.
Related
I'm trying to generate a sorted list in VBscript doing this:
Set GNDcons = CreateObject( "System.Collections.Generic.SortedList<string, integer>" )
however it doesn't work, I get Scode:800a01ad
Is it even possible to use this type in VBscript? I saw there's another SortedList in System.Collections without the possibility of setting the data types but the use was deprecated.
You can use the System.Collections.SortedList type in VBScript; just avoid the System.Collections.Generic types, and constructors requiring parameters.
Here's a simple example:
Dim sl : Set sl = CreateObject("System.Collections.SortedList")
sl.Capacity = 5
sl.Add "Just", 0
sl.Add "One", 1
sl.Add "Of", 2
sl.Add "Many", 3
sl.Add "Examples", 4
Dim i, k, v
For i = 0 To sl.Count-1
k = sl.GetKey(i)
v = sl.Item(k)
WScript.Echo "Item at index " & i & " contains key " & k & " and value " & v
Next
If you want to simulate type constraints for keys and values, then you can create a VBScript wrapper class. For example:
Option Explicit
Class CSortedList
Private sl
Private TKeyVarType
Private TValueVarType
Private Sub Class_Initialize()
TKeyVarType = vbEmpty
TValueVarType = vbEmpty
Set sl = CreateObject("System.Collections.SortedList")
End Sub
Private Sub Class_Terminate()
Set sl = Nothing
End Sub
Public Property Let TKey(ByVal VarType_)
TKeyVarType = VarType_
End Property
Public Property Get TKey()
TKey = TKeyVarType
End Property
Public Property Let TValue(ByVal VarType_)
TValueVarType = VarType_
End Property
Public Property Get TValue()
TValue = TValueVarType
End Property
Public Property Let Capacity(ByVal v_)
sl.Capacity = v_
End Property
Public Property Get Capacity()
Capacity = sl.Capacity
End Property
Public Property Get Count()
Count = sl.Count
End Property
Public Property Get IsFixedSize()
IsFixedSize = sl.IsFixedSize
End Property
Public Property Get IsReadOnly()
IsReadOnly = sl.IsReadOnly
End Property
Public Property Get IsSynchronized()
IsSynchronized = sl.IsSynchronized
End Property
Public Property Let Item(ByVal key, ByVal value)
If VarType(key) <> TKeyVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for key"
ElseIf VarType(value) <> TValueVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for value"
Else
sl.Item(key) = value
End If
End Property
Public Property Get Item(ByVal key)
If VarType(key) <> TKeyVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for key"
ElseIf vbObject = VarType(sl.Item(key)) Then
Set Item = sl.Item(key)
Else
Item = sl.Item(key)
End If
End Property
Public Property Get Keys()
Set Keys = sl.Keys
End Property
Public Property Get SyncRoot()
Set SyncRoot = sl.SyncRoot
End Property
Public Property Get Values()
Set Values = sl.Values
End Property
Public Sub Add(ByVal key, ByVal value)
If VarType(key) <> TKeyVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for key"
ElseIf VarType(value) <> TValueVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for value"
Else
sl.Add key, value
End If
End Sub
Public Sub Clear()
sl.Clear
End Sub
Public Function Clone()
Set Clone = sl.Clone()
End Function
Public Function Contains(ByVal key)
If VarType(key) <> TKeyVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for key"
Else
Contains = sl.Contains(key)
End If
End Function
Public Function ContainsKey(ByVal key)
ContainsKey = Contains(key)
End Function
Public Function ContainsValue(ByVal value)
If VarType(value) <> TValueVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for value"
Else
ContainsValue = sl.ContainsValue(value)
End If
End Function
Public Function GetByIndex(ByVal index)
If vbObject = VarType(sl.GetByIndex(index)) Then
Set GetByIndex = sl.GetByIndex(index)
Else
GetByIndex = sl.GetByIndex(index)
End If
End Function
Public Function GetEnumerator()
Set GetEnumerator = sl.GetEnumerator()
End Function
Public Function GetKey(ByVal index)
If vbObject = sl.GetKey(index) Then
Set GetKey = sl.GetKey(index)
Else
GetKey = sl.GetKey(index)
End If
End Function
Public Function GetKeyList()
Set GetKeyList = sl.GetKeyList()
End Function
Public Function GetValueList()
Set GetValueList = sl.GetValueList()
End Function
Public Function IndexOfKey(ByVal key)
If VarType(key) <> TKeyVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for key"
Else
IndexOfKey = sl.IndexOfKey(key)
End If
End Function
Public Function IndexOfValue(ByVal value)
If VarType(value) <> TValueVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for value"
Else
IndexOfValue = sl.IndexOfValue(value)
End If
End Function
Public Sub Remove(ByVal key)
If VarType(key) <> TKeyVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for key"
Else
sl.Remove key
End If
End Sub
Public Sub RemoveAt(ByVal index)
sl.RemoveAt index
End Sub
Public Sub SetByIndex(ByVal index, ByVal value)
If VarType(value) <> TValueVarType Then
WScript.StdErr.WriteLine "Error: Wrong type for value"
Else
sl.SetByIndex index, value
End If
End Sub
Public Sub TrimToSize()
sl.TrimToSize
End Sub
End Class
With New CSortedList
.TKey = vbString
.TValue = vbInteger
.Capacity = 5
.Add "Just", 0
.Add "One", 1
.Add "Of", 2
.Add "Many", 3
.Add "Examples", 4
Dim i, k, v
For i = 0 To .Count-1
k = .GetKey(i)
v = .Item(k)
WScript.Echo "Item at index " & i & " contains key " & k & " and value " & v
Next
End With
Note: The above wrapper class has not been 100% tested, but does restrict keys to Variant string subtypes, and values to Variant integer subtypes. The resulting list is automatically sorted by keys.
Output:
Item at index 0 contains key Examples and value 4
Item at index 1 contains key Just and value 0
Item at index 2 contains key Many and value 3
Item at index 3 contains key Of and value 2
Item at index 4 contains key One and value 1
I am new to vb6 so might be obvious for some of you.I have a collection problem, trying to put items in a collection to then evaluate if the item exists and setting a button to be enabled or not.
The Code:
For Each vBookmark In lstAssign.SelBookmarks
'---------------------------------------
'filtering with agency code and crew code.
sAssignmentValue = lstAssign.columns("AgencyCode").Value & lstAssign.columns("CrewCode").Value
'Show/hide value depending on crew existance.
If Not ExistsStartLocation(colParameters, sValue) Then
bEnableMyButton = True
colParameters.Add (sValue)
Else
bEnableMyButton = False
End If
'----------------------------------------
Next
sAssignmentValue = ""
tbrMain.TbrButtonEnabled "XXX", bEnableMyButton
tbrMain.TbrButtonEnabled "YYY", bEnable
Set colStartLocationParameters = Nothing
Exit Sub
Private Function ExistsStartLocation(col As collection, index As Variant) As Boolean
On Error GoTo ErrHandler
Dim v As Variant
v = col(index)
ExistsStartLocation = True
Exit Function
ErrHandler:
ExistsStartLocation = False
End Function
The problem is at this moment is that I only have colParameters(index) accessible, so I can't access my collection with a value "123-ABC" directly. I do not want to add an integer index, I want to keep simply accessing by item value, but my exists method will always return false. therefore always disabling my button.
How does this works?
At first glance, you should have to do something like this:
Private Function ExistsStartLocation(col As collection, val As String) As Boolean
Dim blnFoundItem As Boolean = False
For index As Integer = 1 To col.Count
If col(index) = val Then
blnFoundItem = True
End If
Next
ExistsStartLocation = blnFoundItem
End Function
Looping the collection works but is not efficient. If you assign the optional Key value in the Add method you can also use that as the Index to the Item method. In your example it appears you are assigning a string to the collection so the Add method would look something like ...
colParameters.Add sValue, sValue
Be aware though that if you are adding duplicate values this won't work. The keys need to be unique.
With the the collection item's key populated you can use a function that leverages the err object. If you try to get a collection item by the key and it exists no error is thrown. If it does not exists err.number 5 is thrown. The new function would be something like this.
Public Function ItemExists(ByVal vCollection As Collection, ByVal vKey As String) As Boolean
Dim varItem As Variant
On Error Resume Next
varItem = vCollection.Item(vKey)
ItemExists = (Err.Number = 0)
End Function
I am new to QTP, just started using it. I have written one class definition in some functional library and also created a test as under:
Class ExcelFileReader
Public default Function Init(pathToExcel)
Dim objFSO
Dim result
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(pathToExcel) Then
Rem File Found
Dim objExcel
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.open(pathToExcel)
Else
REM File not found
result = vbOk
While result <> vbCancel
result = Msgbox ("Unable to Locate the file", 5, "Error")
Wend
ExitAction(1)
End If
End Function
End Class
Test:
Dim objExcelReader : Set objExcelReader = New ExcelFileReader
objExcelReader.Init("D:\mytest.xlsx")
I have associated the functional library with the test but still I am getting an error at line number 2 in test stating class definition not found. Also if I copy complete code in the same file "test" then the things are working as intended.
Thanks in advance :)
Classes have local scope in your library. You have to construct them with a public function to make them publicly available:
Public Function new_ExcelFileReader()
Set new_ExcelFileReader = new ExcelFileReader
End Function
Class ExcelFileReader
Sub Class_Initialize
MsgBox "Present!"
End Sub
End Class
And in your other library:
Dim objExcelReader : Set objExcelReader = New_ExcelFileReader
objExcelReader.Init("D:\mytest.xlsx")
Protip: You can pass initialization parameters into your constructor function.
EDIT
On request: how to pass constructor parameters. Just add them to your constructor function:
Public Function new_ExcelFileReader2(filepath, sheetname)
Set new_ExcelFileReader2 = new ExcelFileReader
new_ExcelFileReader2.Init(filepath, sheetname)
End Function
' And the call:
Set myExcelFileReader = new_ExcelFileReader2("C:\temp\tempExcel.xlsx", "sheet1")
In my implementation I have sometimes the same object, but that gets 'configured' by multiple contructor functions. In your case you could have a new_ExcelFileReader, a new_CSVFileReader and a new_TabDelimitedReader all pointing to the same object but configured differently.
Another way to fancy up your code is to return the object (with the me keyword) by the init function. This will result in code like this:
Class ExcelFileReader
private filepath_
public function Init(filepath)
filepath_ = filepath
Set Init = me
end function
End Class
Set myExcelFileReader = new ExcelFileReader.Init("C:\temp\tmpExcel.xlsx")
With a constructor function you can use it by just returning the object and then calling the Init function.
Public Function new_ExcelFileReader() ' this is the same as the first function
Set new_ExcelFileReader = new ExcelFileReader
End Function
Set myExcelFileReader = new_ExcelFileReader.Init("C:\temp\tmpExcel.xlsx")
In VBScript, some built in objects use an unnamed property. Some Examples:
Set Dict = Server.CreateObject("Scripting.Dictionary")
Set RS = GetEmloyeesRecordSet()
Dict("Beer") = "Tasty" ' Same as Dict.Item("Beer") = "Tasty"
Dict("Crude Oil") = "Gross" ' Same as Dict.Item("Crude Oil") = "Gross"
Response.Write "The First Employee Is: " & RS("Name") ' Same as RS.Fields("Name")
How can I use this same syntax in my own classes?
UPDATE
Here is a working, stand-alone example of how to do this, a simple wrapper for Scripting.Dictionary. Note the use of "Let" to allow the d("key") = "value" syntax. Of course credit goes to Thom for providing the answer.
<%
Class DictWrapper
Private Dict
Private Sub Class_Initialize()
Set Dict = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set Dict = Nothing
End Sub
Public Property Get Count
Count = Dict.Count
End Property
Public Default Property Get Item( Key )
Item = Dict(Key)
End Property
Public Property Let Item( Key, Value )
Dict(Key) = Value
End Property
Public Sub Add( Key, Value )
Dict.Add Key, Value
End Sub
End Class
Dim d : Set d = New DictWrapper
d.Add "Beer", "Good"
Response.Write d("Beer") & "<br>"
d("Beer") = "Bad"
Response.Write d("Beer")
%>
You need to declare a property of the class as the default property. As an example, here's part of a String wrapper class I wrote:
class StringClass
private finished_
private data_
private size_
public function init (val)
finished_ = cStr(val)
set init = me
end function
public default property get value
if (size_ > 0) then
finished_ = finished_ & join(data_, vbNullString)
data_ = empty
size_ = 0
end if
value = finished_
end property
public property let value (val)
data_ = empty
size_ = empty
init(val)
end property
public function add (s)
size_ = size_ + 1
if (isEmpty(data_)) then
redim data_(MIN_ARRAY_SIZE)
elseif (size_ > uBound(data_)) then
redim preserve data_(Float(uBound(data_) * GRANTED_HEAD_ROOM).ceil)
end if
data_(size_ - 1) = cStr(s)
end function
end class
Usage:
dim s: set s = new StringClass
s()= "Hello, world!" ' s.value() = "Hello, world!"
Response.Write s ' Response.Write s.value()
You can also have a parametrized default property:
class ListClass
private size_
private data_
private sub CLASS_INITIALIZE
size_ = 0
data_ = Array()
resize_array MIN_ARRAY_SIZE
end sub
public default property get data (index)
if isObject(data) then
set data_(index) = data
else
data_(index) = data
end if
end property
public property let data (index, value)
data_(index) = value
end property
public property set data (index, value)
set data_(index) = value
end property
public function add(datum)
size_ = size_ + 1
if (size_ > uBound(data_) + 1) then expand_array
assign data_(size_ - 1), datum
add = datum
end function
end class
dim l: set l = new ListClass
l.add("Hello, world!")
l(0) = "Goodbye, world!"
Response.Write l(0)
This second example is probably what you were looking for, using default properties to implement collections, but it's worth checking out the first example, using default properties to implement auto-unboxing of wrapper classes.
I found a way to extend classes in VBScript, but are there any ways to pass in parameters or overload the constructor? I am currently using an Init function to initialize the properties, but would like to be able to do this when I create the object.
This is my sample class:
Class Test
Private strText
Public Property Get Text
Text = strText
End Property
Public Property Let Text(strIn)
strText = strIn
End Property
Private Sub Class_Initialize()
Init
End Sub
Private Sub Class_Terminate()
End Sub
Private Function Init
strText = "Start Text"
End Function
End Class
And I create it
Set objTest = New Test
But would like to do something like this
Set objTest = New Test(strInitText)
Is this possible, or does the object have to be created and initialized in two setps?
Just to alter slightly on svinto's method...
Class Test
Private m_s
Public Default Function Init(s)
m_s = s
Set Init = Me
End Function
Public Function Hello()
Hello = m_s
End Function
End Class
Dim o : Set o = (New Test)("hello world")
Is how I do it. Sadly no overloading though.
[edit]
Though if you really wanted to you could do something like this...
Class Test
Private m_s
Private m_i
Public Default Function Init(parameters)
Select Case UBound(parameters)
Case 0
Set Init = InitOneParam(parameters(0))
Case 1
Set Init = InitTwoParam(parameters(0), parameters(1))
Else Case
Set Init = Me
End Select
End Function
Private Function InitOneParam(parameter1)
If TypeName(parameter1) = "String" Then
m_s = parameter1
Else
m_i = parameter1
End If
Set InitOneParam = Me
End Function
Private Function InitTwoParam(parameter1, parameter2)
m_s = parameter1
m_i = parameter2
Set InitTwoParam = Me
End Function
End Class
Which gives the constructors...
Test()
Test(string)
Test(integer)
Test(string, integer)
which you can call as:
Dim o : Set o = (New Test)(Array())
Dim o : Set o = (New Test)(Array("Hello World"))
Dim o : Set o = (New Test)(Array(1024))
Dim o : Set o = (New Test)(Array("Hello World", 1024))
Bit of a pain though.
You can work around it by having your Init function returning the object itself...
Class Test
Private m_s
Public Function Init(s)
m_s = s
Set Init = Me
End Function
Public Function Hello()
Hello = m_s
End Function
End Class
Dim o
Set o = (New Test).Init("hello world")
Echo o.Hello
You have to do it in two steps. VB Script doesn't support overloading so you can't modify the default constructor with new parameters. Same goes for Vb6
A bit hackish, for sure, but when I need varargs in calls, one of my parameters I pass in as an array, i.e.
Rem printf done poorly
sub printf(fmt, args)
dim fp, vap:
dim outs:
dim fini:
fini = 0:
vap = 0:
while (not fini)
fp = index(fmt,"%"):
if (not(isNull(fp))) then
' do something with %f, %s
select case(fp)
case 'c':
outs = outs & charparse(args(vap)):
case 's':
outs = outs & args(vap):
' and so on. Quite incomplete but you get the idea.
end select
vap = vap + 1
end if
wend
end sub
printf("%s %d\n",array("Hello World", 42)):