What is the scope of the Randomize(seed) function? The way this code is written will the random number generator be seeded with a value of 20 when generate is called from myfunction? Does the randomize function change a global variable or some local variable?
Thanks for any help!
Function myfunction()
Call seed()
Call generate()
End Function
Function seed()
Randomize (20)
End Function
Function generate()
Dim X As Integer
X = CInt(100*Rnd)
End Function
If you call Randomize with explicit value or do not call Randomize at all you will get the same sequence by every start of the program. Try:
Dim i As Long
Dim sText As String
sText = ""
For i = 1 To 10
sText = sText & CInt(100 * Rnd(10)) & vbCrLf
Next i
MsgBox sText
But of course sometimes it could be wanted result...
Related
I'm experimenting with bitmaps in VBScript, writing them to file and opening them with the default application. See https://github.com/antonig/vbs/tree/master/VBScript_graphics
The slowest part is in writing the pixels from an array to a byte string then to the file. I'm presently using this classic snippet to convert long values to 4 byte strings:
function long2str(byval k)
Dim s
for i=1 to 4
s= chr(k and &hff)
k=k\&h100
next
End function
I wondered if I could make the conversion faster using just two chrw() in the place of the four chr(). To my dismay i learned chrw takes a signed short integer. Why so??. So the code has to deal with the highest bits separately. This is what I tried but it does'nt work:
function long2wstr(byval x)
dim k,s
k=((x and &h7fff) or (&H8000 * ((x and &h8000) <>0 )))
s=chrw(k)
k=((x and &h7fff0000)\&h10000 or(&H8000 * (x<0)))
s=s & chrw(k)
long2wstr=s
end function
'test code
for i=0 to &hffffff
x=long2wstr(i)
y=ascw(mid(x,1,1))+&h10000*ascw(mid(x,2,1))
if i<>y then wscript.echo hex(i),hex(y)
next
wscript.echo "ok" 'if the conversion is correct the program should print only ok
Can you help me?
Today I can answer my own question. To write binary data to a file two bytes at a time is possible. The bad news is the increase of speed is just marginal. Here is a demo code, the solution was about adding some & sufixes to the hex values in my original code.
fn=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2)& "\testwchr.bmp"
Function long2wstr( x) 'falta muy poco!!!
Dim k1,k2,x1
k1=((x And &h7fff) Or (&H8000& And ((X And &h8000&)<>0)))
k2=((X And &h7fffffff&) \ &h10000&) Or (&H8000& And ((X And &h80000000&) <>0 ))
long2wstr=chrw(k1) & chrw(k2)
End Function
Function wstr2long(s)
x1=AscW(mid(s,1,1))
xx1=x1-(65536 *(x1<0))
x2=AscW(mid(s,2,1))
wstr2long=x2*65536+xx1
End Function
Function rndlong() rndlong=CLng(4294967296* rnd()-2147483648+256*rnd) :End Function
Dim a(1000)
With CreateObject("ADODB.Stream")
.Charset = "UTF-16LE" 'o "UTF16-BE"
.Type = 2' adTypeText
.open
Randomize timer
For I=0 To 1000
a(i)=rndlong
.writetext long2wstr(a(i))
Next
.savetofile fn,2
.close
'now read the file to see if ADODB has changed anything
.open
.loadfromfile fn
.position=2 'skip bom
cnt=0
For I=0 To 1000
j= wstr2long(.readtext (2))
If j<>a(i) Then WScript.Echo a(i),j:cnt=cnt+1
Next
WScript.Echo cnt 'should print 0
.close
End With
I cant understand about the difference between Function and Sub procedures in VB.NET.
The one with Function :
Private Function remainder (intno1 As Integer, intno2 As _ Integer) As Integer
Dim intresult As Integer
intresult = intno1 Mod intno2
remainder = intresult
End Function
and then by this way i call it :
Private Sub cmdrem _Click()
Dim intm As Integer, intn As Integer
Dim intmod As Integer
intm = Val (txtno1.Text)
intn = Val (txtno2.Text)
intmod = remainder (intm, intn)
lblres.text = "Answer Is = " + Str(intmod)
End Sub
would you please help me ?
some main differences between procedure and function in vb are that the function returns a value but sub procedure never returns value.
the return type must be defined in function declaration.
A function always is declared with keyword Function and a sub procedure is declared with keyword Sub.
Function ends with the keyword end function
and procedure ends with keyword end sub.
I'm trying to put together tests in HP Unified Functional Testing
the way a programmer would.
For those unaware, the tool uses VBScript as its driver.
Because I want to use data from the same DataTable across multiple UFT actions
-- and because the Global table already has a different set of data on it
-- I want to retrieve data from an external file.
UFT happily supports this function.
My current plan is that, depending on which test I'm running,
I will iterate through only a range of rows in that table.
This is the script I've come up with:
' targets the local sheet, but
' not the same value as dtLocalSheet
Const sheetNum = 2
dim sheetRowCount
DataTable.ImportSheet "PersonFile.xlsx", 1, sheetNum
sheetRowCount = DataTable.GetSheet(sheetNum).GetRowCount
dim firstRow, lastRow
firstRow = Parameter("FirstPersonIndex")
lastRow = Parameter("LastPersonIndex")
If sheetRowCount < lastRow Then
lastRow = sheetRowCount
End If
If sheetRowCount >= firstRow Then
Dim i
For i = firstRow To lastRow
DataTable.SetCurrentRow i
' begin payload
MsgBox(DataTable.Value("LastName", dtLocalSheet))
' end payload
Next
End if
I don't want to have to repeat all this boilerplate
every time I want to use this pattern.
I'd really like to have something like:
In a Function Library:
sub LoopThroughSheetAnd(sheetFile, doThis)
' targets the local sheet, but
' not the same value as dtLocalSheet
Const sheetNum = 2
dim sheetRowCount
DataTable.ImportSheet sheetFile, 1, sheetNum
sheetRowCount = DataTable.GetSheet(sheetNum).GetRowCount
dim firstRow, lastRow
firstRow = Parameter("FirstRow")
lastRow = Parameter("LastRow")
If sheetRowCount < lastRow Then
lastRow = sheetRowCount
End If
If sheetRowCount >= firstRow Then
Dim i
For i = firstRow To lastRow
DataTable.SetCurrentRow i
call doThis()
Next
End if
end sub
In the original action...
sub Payload1()
MsgBox(DataTable.Value("LastName", dtLocalSheet))
end sub
LoopThroughSheetAnd "PersonFile.xlsx", Payload1
In a separate action, 3 or 4 steps later...
sub Payload2()
' compare the data against another data source
end sub
LoopThroughSheetAnd "PersonFile.xlsx", Payload2
The above code doesn't work in VBScript.
A type mismatch error is thrown
as soon as we try to pass Payload1 as a parameter.
How could one reasonably pull this off in VBScript?
Bonus points if the answer also works in UFT.
You can pass functions as parameters with the GetRef() function. Here's a utility map function, like you'd find in JavaScript that accepts an array and calls a function for each element of the array:
Sub Map(a, f)
Dim i
For i = 0 To UBound(a)
' Call a function on each element and replace its value with the function return value
a(i) = f(a(i))
Next
End Sub
Map MyArray, GetRef("SomeFunc")
Now you could write SomeFunc so that it operates on a value and returns an updated value:
Function SomeFunc(i)
SomeFunc = i + 1
End Function
This works fine. map calls SomeFunc using the function "pointer" we passed to it.
You could do something similar with your LoopThroughStreetAnd function:
LoopThroughStreetAnd "PersonFile.xlsx", GetRef("Payload2")
The standard way of callbacks in VBScript uses GetRef, as in this demo.
When using objects, you can wrap a call to a method in an object, and then you can pass the object. (This is approximately what happens in other languages already, you just have to do it manually in VBScript.)
The only issue is that any method called this way has to be Public.
I would use a naming scheme of something like "Func1", "Func2", "Action1", "Action2", etc., depending on the arity of the functions and whether they return values or not.
Dim s : Set s = New Something : s.Run
Class Something
Public Sub HowToPassMe(pValue)
WScript.Echo pValue
End Sub
Public Sub Run
Dim action : Set action = New Action1Wrapper
Set action.Target = Me
Dim se : Set se = New SomethingElse
se.DoSomethingElse action
End Sub
End Class
Class SomethingElse
Public Sub DoSomethingElse(pAction1)
pAction1.Action1("something")
End Sub
End Class
Class Action1Wrapper
Private mTarget
Public Property Set Target(value) : Set mTarget = value : End Property
Public Sub Action1(p1)
mTarget.HowToPassMe(p1)
End Sub
End Class
Using Execute, Action1Wrapper can also be written something like the following. You can also write a factory class for easier use.
Class Action1Wrapper
Private mTarget
Public Property Set Target(value) : Set mTarget = value : End Property
Private mName
Public Property Let Name(value) : mName = value : End Property
Public Sub Action1(p1)
Execute "mTarget." & mName & "(p1)"
End Sub
End Class
Class Action1Factory_
Public Function Create(pTarget, pName)
Dim a1 : Set a1 = New Action1Wrapper
Set a1.Target = pTarget
a1.Name = pName
Set Create = a1
End Function
End Class
Dim Action1Factory : Set Action1Factory = New Action1Factory_
Used as:
Dim action : Set action = Action1Factory.Create(Me, "HowToPassMe")
Dim se : Set se = New SomethingElse
se.DoSomethingElse action
And as I write the question, my memory gets jogged,
and I begin researching a "feature" I once discovered.
This fails to work in the context of HP UFT,
but if you're running cscript, or working with Classic ASP,
you can either declare a function late, or replace a previous declaration,
to change how it works.
VBScript lets you declare the same function or subroutine
multiple times in a program.
It treats the last declaration as the correct one.
You can get around this in cscript and ASP by physically separating
the different versions of the function,
so that one doesn't get clobbered by the other.
You'll have to be careful not to put the two anywhere near each other,
or you(r successor) might have an aneurysm trying to debug the outcome.
Honestly, you're probably better served refactoring your code some other way.
Now, with the disclaimers out of the way,
the following example is for use with cscript or wscript.
Code
Since this won't work in UFT anyway, I'll write from scratch.
In WrapperSub.vbs:
' Sub WrapperSub_Payload doesn't exist in this file.
' It must be declared by the calling file or the program will crash.
Sub WrapperSub()
wscript.echo("This begins the wrapper.")
WrapperSub_Payload
wscript.echo("This ends the wrapper.")
End Sub
In WrapperSubUseA.vbs:
With CreateObject("Scripting.FileSystemObject")
call ExecuteGlobal(.openTextFile("WrapperSub.vbs").readAll())
End With
Sub WrapperSub_Payload
wscript.echo("This is payload A.")
End Sub
WrapperSub
In WrapperSubUseB.vbs:
With CreateObject("Scripting.FileSystemObject")
call ExecuteGlobal(.openTextFile("WrapperSub.vbs").readAll())
End With
Sub WrapperSub_Payload
wscript.echo("This is payload B.")
End Sub
WrapperSub
Output
>cscript wrappersubusea.vbs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.
This begins the wrapper.
This is payload A.
This ends the wrapper.
>cscript wrappersubuseb.vbs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.
This begins the wrapper.
This is payload B.
This ends the wrapper.
Note that if a placeholder for WrapperSub_Payload
were declared in the source file,
that placeholder would always execute instead of the intended subroutine.
This is probably due to ExecuteGlobal
executing after the current file is parsed,
causing the placeholder to load after the local declaration.
When you try this in UFT --
placing the contents of WrapperSub.vbs in a function library --
the function library rightfully ignores the caller's scope.
It will then fail because WrapperSub_Payload doesn't exist in scope.
The range of input values possible is quite huge in my case. So a select-case methodology will not work.
So based on my input say flowers.. doffodil,lily,rose,etc, my function name to call would be flowerdoffodil(), flowerlily(), flowerrose(), etc. Ech of these functions are already defined.
Only which one to call will need to be determined at runtime based on my input.
Is there a way to do this in vb script?
Note: I am a rookie programmer and am using QTP for automation.
Use GetRef() as in:
Option Explicit
Function flowerdoffodil()
flowerdoffodil = "my name is daffodil!"
End Function
Function flowerlily()
flowerlily = "my name is lily!"
End Function
Function flowerrose()
flowerrose = "my name is rose!"
End Function
Dim aInp : aInp = Split("doffodil lily rose")
Dim sFnc
For Each sFnc In aInp
Dim fncX : Set fncX = GetRef("flower" & sFnc)
Dim sRes : sRes = fncX()
WScript.Echo sFnc, TypeName(fncX), sRes
Next
output:
cscript 30161364.vbs
doffodil Object my name is daffodil!
lily Object my name is lily!
rose Object my name is rose!
Further food for thought: You can use a Dictionary:
Dim dicFncs : Set dicFncs = CreateObject("Scripting.Dictionary")
Set dicFncs("doffodil") = GetRef("flowerdoffodil")
Set dicFncs("lily") = GetRef("flowerlily")
Set dicFncs("rose") = GetRef("flowerrose")
and call the function(s) like:
Dim sRes : sRes = dicFncs(sFnc)()
(See also: 1, 2, 3)
I'm trying to store an array value so that I can reuse when Sub is called more than once.
I would like to prevent from reassigning values to the array if value exist.
My code is something like this.
Dim views()
Sub runit()
For i=0 To 3
test()
Next
End Sub
Sub test()
ReDim Preserve views(0)= "test"
' - other codes that I want to run-
End Sub
I get " Type mismatch :'choseviews'" error.
If I move "Dim views()" inside "Sub test", I don't get the error.
How do I declare global array in VBScript?
If it's not possible, is there any ways to prevent reassigning array when Sub is called?
This following code does not work but you may get an idea what I'm trying to do .
Dim views()
Sub runit()
For i=0 To 3
test()
Next
End Sub
Function IsArrayDimmed(arr)
IsArrayDimmed = False
If IsArray(arr) Then
On Error Resume Next
Dim ub : ub = UBound(arr)
If (Err.Number = 0) And (ub >= 0) Then IsArrayDimmed = True
End If
End Function
Sub test()
If IsArrayDimmed(views) Then
Else
ReDim Preserve views(0)= "test"
End If
' - other codes that I want to run-
End Sub
Thank you for your help.
If I understand correctly, it seems like you want to declare a global array variable, and then add items to that array, without being limited to a static number of elements. In other words, you need to dynamically increase the size of the array by re-allocating it.
The global declaration is correct and belongs where you have it:
Dim views()
What you wrote here is incorrect syntax, you cannot assign a value and ReDim at the same time.:
ReDim Preserve views(0)= "test"
Additionally, that would ReDim the array to size 0, which is the opposite of what you want.
If you wish to "push" values on that array you should use a function like this which handles the redim to increase the size of the array before adding the value to the tail of the array:
Function Push(ByRef arrTarget, ByVal varValue)
Dim intCounter
Dim intElementCount
ReDim Preserve arrTarget(UBound(arrTarget) + 1)
If (isObject(varValue)) Then
Set arrTarget(UBound(arrTarget)) = varValue
Else
arrTarget(UBound(arrTarget)) = varValue
End If
Push = arrTarget
End Function
Use it like this:
Call Push(views,"test")
Any variable instantiated in the global scope will be a "global" variable. However, you should pass that variable explicitly into other scopes "by reference" if you want to have any changes persist in the original scope. You can do that using the ByRef keword in your Function or Sub declaration.
Sub test(ByRef viewsArray)
Now within test you will reference viewsArray which acts as a pointer to views.