I think i have a timing issue. It perplexes me why.
On the trigger of an event I call a function to update a value:
Private Sub t0_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles t0.Click
Input.ppProperty = "blank"
UpdateRecord("Hey", Input.ppProperty)
MsgBox(Input.ppProperty)
End Sub
UpdateRecord() should update the property Input.ppProperty to the value "Hey". It does update it, but not until UpdateRecord() has finished. The code:
Sub UpdateRecord(ByVal updateValue As String, ByRef recordToUpdate As String)
If recordToUpdate <> Nothing Then
MsgBox(updateValue & " " & recordToUpdate & " " & Input.ppProperty)
End If
recordToUpdate = updateValue
If recordToUpdate <> Nothing Then
MsgBox(updateValue & " " & recordToUpdate & " " & Input.ppProperty)
End If
End Sub
Output:
Hey Blank Blank 'initial values
Hey Hey Blank 'values at the end of the function
Hey 'value of property when function is finished
What it seems like it should be is:
Desired Output:
Hey Blank Blank 'initial values
Hey Hey Hey 'values at the end of the function
Hey 'value of property when function is finished
Notice the difference, the property does not update until the function is completely finished.
Why?
EDIT:
Also, how would I go about fixing this so it updates within the function?
When you pass a property ByRef, the equivalent of the following happens:
Dim temporaryValue As String = Input.ppProperty
UpdateRecord("Hey", temporaryValue)
Input.ppProperty = temporaryValue
There’s no direct way around this. A potential solution is to rewrite the UpdateRecord method so that you can pass the whole object (Input) into it and manipulate the property value directly. Only then will the change be reflected directly.
I would imagine that it has something to do with Strings in .Net being an immutable type.
You get a temporary string that is passed in ByRef and then Returned out causing the Input.ppProperty to be set afterwards.
Something like this:
Dim tempInput As String = Input.ppProperty
UpdateRecord("Hey", tempInput)
Input.ppProperty = tempInput
Since it seems that Input is in Scope in both cases why not do this as so.
Sub UpdateRecord(ByVal updateValue As String)
Input.ppProperty = updateValue
End Sub
However if this actually isn't the case I'll need to think about this a little more.
Related
For some reason invoking delegates to update to UI doesn't work for one of my threads but using different delegates to update the same controls in a slightly different way does work.
Here's the broken code, I've commented around the lines that are broken to explain
Private Sub RunBtn_Click(sender As Object, e As EventArgs) Handles RunBtn.Click
Dim transferThread As New System.Threading.Thread(AddressOf RunTransfer)
StartContinuousProg()
UpdateStatus("Running Transfer...")
StartTime = Date.Now
incrementProgMethod = New incrementProgDelegate(AddressOf incrementProg)
finishProgMethod = New finishProgDelegate(AddressOf finishProg)
updateStatusMethod = New updateStatusDelegate(AddressOf UpdateStatus)
writeErrorMethod = New writeErrorDelegate(AddressOf WriteError)
writeWarningMethod = New writeWarningDelegate(AddressOf WriteWarning)
writeAlertMethod = New writeAlertDelegate(AddressOf WriteAlert)
EndTransferMethod = New EndTransferDelegate(AddressOf endTransfer)
transferThread.Start()
End Sub
Private Sub RunTransfer()
'(...Some work...)
For catRow = 0 To CATImportArr.Length - 1
Dim currentCATSerial, currentCATAsset As String
currentCATSerial = LCase(CATImportArr(catRow).getSerialNumber)
currentCATAsset = LCase(CATImportArr(catRow).getAssetNumber)
'This line produces this error: Unable to cast object of type 'System.String' to type 'System.Delegate'.
Invoke(updateStatusMethod("Searching " & currentCATSerial & ", " & currentCATAsset & "..."))
'This line doesn't crash but the UI label doesn't change
updateStatusMethod.Invoke("Searching " & currentCATSerial & ", " & currentCATAsset & "...")
'This line doesn't crash but the UI progress bar doesn't change
Invoke(finishProgMethod)
These are the methods being called through the delegates
Public Function UpdateStatus(ByRef text As String)
ParentForm.StatusLbl.Text = text
Return text
End Function
Public Sub finishProg()
ParentForm.StatusProg.Value = 100
End Sub
A Delegate is simply a class holding a reference to a method. You cannot pass parameters to the Delegate itself.
To pass parameters to the method you want to invoke you have to use the Control.Invoke(Delegate, Object()) overload where you pass the parameter(s) to the Invoke() method, after you've specified the delegate:
Invoke(updateStatusMethod, "Searching " & currentCATSerial & ", " & currentCATAsset & "...")
Since the second parameter of Control.Invoke(Delegate, Object()) is declared ParamArray you may keep on specifying parameters if you need to by just separating them with a comma:
Invoke(updateStatusMethod, [param1], [param2], [param3], ...)
I was wondering how I canspecify a Optional Parameter with a non-constant value?
Liek this for example:
Private Sub Foo(Optional ByVal Name as String = Application.ExecutablePath)
MsgBox("name: " & Name)
End Sub
is there a workarround?
So I can use a not constant value in the parameter as optional?
is there a workarround?
Yes:
Private Sub Foo(Optional ByVal Name As String = Nothing)
If Name Is Nothing Then
Name = Application.ExecutablePath
End If
MsgBox("name: " & Name)
End Sub
The most common way would be to avoid the Optional statement alltogether and use function overloading instead. This means you define a function with the same name multiple times with different declaration like so:
Private Sub Foo()
Foo(Application.ExecutablePath)
End Sub
Private Sub Foo(ByVal Name as String)
MsgBox("name: " & Name)
End Sub
That way, you can either supply a name or not when you call the function. The correct function is used depending on the declaration you use.
This approach seems more complicated, and in this simple case it probably is. However when your declaration gets more complicated, with more optional parameters in different orders mixed with non-optional parameters you will quickly learn to appreciate the possibilities of Overloading, I guarantee.
Expanding on Tim's correct answer
This code can be made more concise by using the If operator. This gives a one line setting of the alternate value if the parameter is Nothing
Private Sub Foo(Optional ByVal Name As String = Nothing)
Name = If(Name, Application.ExecutablePath)
MsgBox("name: " & Name)
End Sub
The If operator was introduced in 2010 IIRC so this code won't work in older versions of Visual Studio
You have to set it to an unused/reserved constant and then check for that in the method.
Private Sub(Optional ByVal Name as String = Nothing)
If Name Is Nothing Then Name = Application.ExecutablePath
MsgBox("name: " & Name)
End Sub
For some extra niceties, you can use xml comments and attributes to indicate via intellisense what the real "default" value is.
Just a very quick question: I want to create a function with an optional parameter because I can't find a need for a parameter in the function. As a result I have coded the following function in visual basic:
Sub characterListLength(ByVal Optional)
Dim rowCount As Integer
Dim endOfArray As Boolean
While endOfArray = False
If dataArray(0, rowCount) And dataArray(1, rowCount) = "" Then
arrayLength = rowCount
endOfArray = True
Else
rowCount += 1
End If
End While
End Sub
However on the first line:
Sub characterListLength(ByVal Optional)
There is an error where an identifier is expected where the code says (ByVal Optional). I am not sure how to fix this error and have the optional parameter. If anyone could explain what else I need to do to fix it, that would be very useful.
You need an actual variable, something like:
Sub characterListLength(Optional ByVal optionalNumber As Integer = 0)
If you said:
because I can't find a need for a parameter in the function
Then use method without parameters:
Sub characterListLength()
'Here your code
End Sub
You need to give the parameter a name and switch the order of the keywords
Sub characterListLength(Optional ByVal p = Nothing)
A better "dot-nettier" alternative to optional parameters is to use overloaded methods. Consider following:
Overloads Sub ShowMessage()
ShowMessage("This is the default alter message")
End Sub
Overloads Sub ShowMessage(ByVal Message As String)
Console.WriteLine(Message)
End Sub
Written like this you can call the above method both ways:
ShowMessage() 'will display default message
ShowMessage("This is custom message") 'will display method from the parameter
Demo: http://dotnetfiddle.net/OOi26i
How can my VB6 form POST 2 vars, pull the results from a URL and then assign a VB6 var to the results?
I need someone to show me VERY basic VB6 sample code or point me in the right direction. This is the simplest form - in the final product, the PHP vars will write to MySQL, but that's not what i need help with.
I have a simple PHP page that accepts 2 parameters:
test.php?var1=secret&var2=pass
Here's my really simple PHP code
<?php
$var1 = $_GET['var1'];
$var2 = $_GET['var2'];
$varAcc = "ACCEPTED";
$varDen = "DENIED";
if ($var1 === "secret" && $var2 === "pass")
{
echo $varAcc;
}
else
{
echo $varDen;
}
?>
The logic behind this is gonna be VB6 login with "userName", "passWord" and "hardWareID", and send a hash. The hash will be checked against MySQL to see whether it exists, and returns YES or NO for access, how many days left on their account, and some other details, like FULL NAME, ACCOUNT INFO, etc.
( NO.. I do not want to use XML, just thought i would put that out there.. Just POST & Receive to vars)
Thank You...
VB forms don't have any built-in mechanism for sending HTTP requests. Some may suggest you use the Internet Transfer Control. However, the VB UserControl has a mechanism for HTTP that you can use without the need for third party controls, assuming you use the GET method, and use the query string to pass your parameters. If you have to use POST, you must use the Internet Transfer Control.
Create a VB project with a reference to "Microsoft Scripting Runtime" (see the menu Project=>References). Add a UserControl. Call it "HttpService". Set InvisibleAtRuntime=True. Add the following code to the UserControl:
Option Explicit
Private Const m_ksProperty_Default As String = ""
Private m_sHost As String
Private m_nPort As Long
Private m_sPath As String
Private m_dctQueryStringParameters As Scripting.Dictionary
Private m_sOutput As String
' Ensure that all parts of the query string are deleted.
Public Sub ClearQueryString()
Set m_dctQueryStringParameters = New Scripting.Dictionary
End Sub
' Executes "GET" method for URL.
Public Function Get_() As String
' Read in data from URL. UserControl_AsyncReadComplete will fire when finished.
UserControl.AsyncRead "http://" & m_sHost & ":" & CStr(m_nPort) & "" & m_sPath & "?" & GetQueryString(), vbAsyncTypeByteArray, m_ksProperty_Default, vbAsyncReadSynchronousDownload
' Return the contents of the buffer.
Get_ = m_sOutput
' Clear down state.
m_sOutput = vbNullString
End Function
' Returns query string based on dictionary.
Private Function GetQueryString() As String
Dim vName As Variant
Dim sQueryString As String
For Each vName In m_dctQueryStringParameters
sQueryString = sQueryString & CStr(vName) & "=" & m_dctQueryStringParameters.Item(vName) & "&"
Next vName
GetQueryString = Left$(sQueryString, Len(sQueryString) - 1)
End Function
' Sets the remote host.
Public Property Let Host(ByVal the_sValue As String)
m_sHost = the_sValue
End Property
' Sets the directory and filename part of the URL.
Public Property Let Path(ByVal the_sValue As String)
m_sPath = the_sValue
End Property
' Sets the port number for this request.
Public Property Let Port(ByVal the_nValue As Long)
m_nPort = the_nValue
End Property
' Sets a name/value pair in the query string. Supports duplicate names.
Public Property Let QueryStringParameter(ByVal the_sName As String, ByVal the_sValue As String)
m_dctQueryStringParameters.Item(the_sName) = the_sValue
End Property
' Fired when the download is complete.
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
' Gets the data from the internet transfer.
m_sOutput = StrConv(AsyncProp.Value, vbUnicode)
End Sub
Private Sub UserControl_Initialize()
' Initialises the scripting dictionary.
Set m_dctQueryStringParameters = New Scripting.Dictionary
End Sub
To use this UserControl, add it to your form. Call it "HttpService". Add a TextBox called "txtOutput" to test the following code on the form:
HttpService.Host = "localhost"
HttpService.Port = 80
HttpService.Path = "/test.php"
HttpService.QueryStringParameter("var1") = "secret"
HttpService.QueryStringParameter("var2") = "pass"
txtOutput.Text = HttpService.Get_
If you must use POST, then you will have to use the Internet Transfer Control. In the VB6 IDE, press CTL-T, and select "Microsoft Internet Transfer Control 6.0". Press Ok.
Add an instance of the control to the form. Call it "Inet". Add a CommandButton called "cmdPost" to the form. Add a reference to "Microsoft Scripting Runtime" (see the menu Project=>References).
Add the following code to your form:
Option Explicit
Private Declare Function InternetCanonicalizeUrl Lib "Wininet.dll" Alias "InternetCanonicalizeUrlW" ( _
ByVal lpszUrl As Long, _
ByVal lpszBuffer As Long, _
ByRef lpdwBufferLength As Long, _
ByVal dwFlags As Long _
) As Long
Private m_sData As String
Private m_nDataReceived As Long
Private m_bPostActive As Boolean
Private m_bDataReceived As Boolean
Private m_bError As Boolean ' For error handling.
Private m_bDisconnected As Boolean
Private Sub cmdPost_Click()
Dim dctParameters As Scripting.Dictionary
txtOutput.Text = vbNullString
m_sData = vbNullString
Set dctParameters = New Scripting.Dictionary
dctParameters.Add "var1", "secret"
dctParameters.Add "var2", "pass"
txtOutput.Text = Post("http://localhost:80/test.php", dctParameters)
End Sub
' Returns post data string based on dictionary.
Private Function GetPostDataString(ByRef the_dctParameters As Scripting.Dictionary) As String
Dim vName As Variant
Dim sPostDataString As String
For Each vName In the_dctParameters
sPostDataString = sPostDataString & UrlEncode(CStr(vName)) & "=" & UrlEncode(CStr(the_dctParameters.Item(vName))) & "&"
Next vName
GetPostDataString = Left$(sPostDataString, Len(sPostDataString) - 1)
End Function
Private Sub Inet_StateChanged(ByVal State As Integer)
' Ignore state change if we are outside the Post function.
If m_bPostActive Then
Select Case State
Case StateConstants.icResponseReceived
ReceiveData False
Case StateConstants.icResponseCompleted
ReceiveData True
Case StateConstants.icDisconnected
m_bDisconnected = True
Case StateConstants.icError
m_bError = True
End Select
End If
End Sub
' Synchronous Post function.
Private Function Post(ByRef the_sURL As String, ByRef the_dctParameters As Scripting.Dictionary)
Dim sPostData As String
Dim sHeaders As String
' Flag that we are in the middle of this function.
m_bPostActive = True
' Create a string containing the POST parameters.
sPostData = GetPostDataString(the_dctParameters)
' Create a headers string to allow POST.
sHeaders = _
"Content-Type: application/x-www-form-urlencoded" & vbNewLine & _
"Content-Length: " & CStr(Len(sPostData)) & vbNewLine & _
"Connection: Keep-Alive" & vbNewLine & _
"Cache-Control: no-cache" & vbNewLine
Inet.Execute the_sURL, "POST", GetPostDataString(the_dctParameters), sHeaders
' Allow Inet events to fire.
Do
DoEvents
Loop Until m_bDataReceived Or m_bDisconnected
If m_bDataReceived Then
Post = m_sData
End If
' Clear all state flags to defaults.
m_bDataReceived = False
m_bDisconnected = False
m_bError = False
m_sData = vbNullString
m_nDataReceived = 0
' Flag that we have exited this function.
m_bPostActive = False
End Function
' Receive as much data as we can.
' <the_bCompleted> should be True if the response is completed i.e. all data is available.
Private Sub ReceiveData(ByVal the_bCompleted As Boolean)
Const knBufferSize As Long = 1024
Dim nContentLength As Long
Dim sContentType As String
Dim sChunk As String
Dim nChunkSize As Long
' If we haven't yet created our buffer, do so now, based on the size of the incoming data.
If m_nDataReceived = 0 Then
nContentLength = CLng(Inet.GetHeader("Content-length"))
m_sData = Space$(nContentLength)
' You might want to do a check on the content type here, and if it is wrong, cancel the request with Inet.Cancel .
sContentType = Inet.GetHeader("Content-type")
End If
' Retrieve data until we have all the data.
Do Until m_nDataReceived = Len(m_sData)
' If called when not all data has been received, then exit function if it is currently executing.
If Not the_bCompleted Then
If Inet.StillExecuting Then
Debug.Print "Exiting"
Exit Sub
End If
End If
' Get a chunk, copy it into the output buffer, and increment the amount of data received.
sChunk = Inet.GetChunk(knBufferSize, DataTypeConstants.icString)
nChunkSize = Len(sChunk)
Mid$(m_sData, m_nDataReceived + 1, nChunkSize) = sChunk
m_nDataReceived = m_nDataReceived + nChunkSize
Loop
' Flag that all data has been retrieved.
m_bDataReceived = True
End Sub
' Encode the URL data.
Private Function UrlEncode(ByVal the_sURLData As String) As String
Dim nBufferLen As Long
Dim sBuffer As String
' Only exception - encode spaces as "+".
the_sURLData = Replace$(the_sURLData, " ", "+")
' Try to #-encode the string.
' Reserve a buffer. Maximum size is 3 chars for every 1 char in the input string.
nBufferLen = Len(the_sURLData) * 3
sBuffer = Space$(nBufferLen)
If InternetCanonicalizeUrl(StrPtr(the_sURLData), StrPtr(sBuffer), nBufferLen, 0&) Then
UrlEncode = Left$(sBuffer, nBufferLen)
Else
UrlEncode = the_sURLData
End If
End Function
I have the following sub
Public Static Sub Varib()
Device_ = Sheet1.DeviceType_.Text
Model_ = Sheet1.Model_.Text
Security_ = Sheet1.SecurityGroup_.Text
Catagory_ = Application.Index(Worksheets("Temp_for_varible_lists").Range("b:b"), Application.Match(x, Worksheets("Temp_for_varible_lists").Range("A:A"), 0))
End Sub
It in fact carries on and in total produces a whole bunch of vaules of various datatypes based on the users input.
So the user choses from a few check boxes, list boxes, fills in some text boxes and hits a submit button and this sub populates a number of varibles from that, that are then uterlised by other funcation and sub in the application.
Now I could make all the varibles Global and access them in that fassion. But I was hoping for something more like what I have seen with c# and VB.net
where you can get the value by using
sub.varible name
example for the code above.
Sub Main()
x = Varib.Device_
msgbox(x)
end sub
is there a simmular way to do this in VBA?
Cheers
aaron
What you're asking cannot be done. The solution is not to make your variables global either (generally a bad idea, with some exceptions, this case not being one of them).
One possibility is to create a user-defined type:
Type Varib
Device_ As String
Model_ As String
Security_ As String
Category_ As String
End Type
and a sub to populate it from your sheet:
Sub LoadVaribFromSheet(v As Varib)
With v
.Device_ = Sheet1.DeviceType_.Text
.Model_ = Sheet1.Model_.Text
.Security_ = Sheet1.SecurityGroup_.Text
.Category_ = _
Application.Index(Worksheets("Temp_for_varible_lists").Range("b:b"), _
Application.Match(x, _
Worksheets("Temp_for_varible_lists").Range("A:A"), 0))
End With
End Sub
You can then use this as follows:
Sub Main()
Dim myVarib As Varib
LoadVaribFromSheet myVarib
' Now do stuff with myVarib ...
MsgBox myVarib.Device_
End Sub
you can use encapsulation for this
Private value As String
Private value1 As String
Public Function setValue(val As String)
value = val
End Function
Public Function setValue1(val As String)
value1 = val
End Function
Public Function getValue() As String
getValue = value
End Function
Public Function getValue1() As String
getValue1 = value1
End Function
-------------------------------------------------------------------------
Sub test()
MsgBox getValue & vbCrLf & getValue1
setValue "myValue"
setValue1 "myValue1"
MsgBox getValue & vbCrLf & getValue1
End Sub