-
Dec 5th, 2022, 12:41 PM
#1
Thread Starter
New Member
[RESOLVED] vb6 activex.exe commandline Application
To be frank I just cannot get my head around "classes", wrappers" etc...
I need a very simple activeX component that a vb6 main exe can access. The activeX.exe would be run from the command line
e.g: "UPSstatus.exe /n" where n is the status number. There would only be one "instance" of the active component. If the CLI was run again with a new value of "n" that would become the value the component will make available to the client exe
I don't want a form created or even visible.
All I want is that the activeX component "UPSstatus.exe" will make the status value "n" available to the client program running on the same computer.
Can anyone out there put me out of my misery?
Thank you in advance.
-
Dec 5th, 2022, 01:34 PM
#2
Re: vb6 activex.exe commandline Application
For you server start a new Std-EXE project and paste this code in Form1
Code:
'--- server
Option Explicit
Private Declare Function CreateFileMoniker Lib "ole32" (ByVal lpszPathName As Long, pResult As IUnknown) As Long
Private Declare Function GetRunningObjectTable Lib "ole32" (ByVal dwReserved As Long, pResult As IUnknown) As Long
Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
Private Const STR_MONIKER As String = "MySolution.MyServer"
Public MyValue As String
Private Sub Form_Load()
If IsObjectRunning(STR_MONIKER) Then
With GetObject(STR_MONIKER)
.MyValue = Command$
End With
Unload Me
Else
MyValue = Command$
PutObject Me, STR_MONIKER
Visible = False
End If
End Sub
Public Function PutObject(oObj As Object, sPathName As String, Optional ByVal Flags As Long) As Long
Const ROTFLAGS_REGISTRATIONKEEPSALIVE As Long = 1
Const IDX_REGISTER As Long = 3
Dim hResult As Long
Dim pROT As IUnknown
Dim pMoniker As IUnknown
hResult = GetRunningObjectTable(0, pROT)
If hResult < 0 Then
Err.Raise hResult, "GetRunningObjectTable"
End If
hResult = CreateFileMoniker(StrPtr(sPathName), pMoniker)
If hResult < 0 Then
Err.Raise hResult, "CreateFileMoniker"
End If
DispCallByVtbl pROT, IDX_REGISTER, ROTFLAGS_REGISTRATIONKEEPSALIVE Or Flags, ObjPtr(oObj), ObjPtr(pMoniker), VarPtr(PutObject)
End Function
Public Sub RevokeObject(ByVal lCookie As Long)
Const IDX_REVOKE As Long = 4
Dim hResult As Long
Dim pROT As IUnknown
hResult = GetRunningObjectTable(0, pROT)
If hResult < 0 Then
Err.Raise hResult, "GetRunningObjectTable"
End If
DispCallByVtbl pROT, IDX_REVOKE, lCookie
End Sub
Public Function IsObjectRunning(sPathName As String) As Boolean
Const IDX_ISRUNNING As Long = 5
Const S_OK As Long = 0
Dim hResult As Long
Dim pROT As IUnknown
Dim pMoniker As IUnknown
hResult = GetRunningObjectTable(0, pROT)
If hResult < 0 Then
Err.Raise hResult, "GetRunningObjectTable"
End If
hResult = CreateFileMoniker(StrPtr(sPathName), pMoniker)
If hResult < 0 Then
Err.Raise hResult, "CreateFileMoniker"
End If
If DispCallByVtbl(pROT, IDX_ISRUNNING, ObjPtr(pMoniker)) = S_OK Then
'--- success
IsObjectRunning = True
End If
End Function
Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
Const CC_STDCALL As Long = 4
Dim lIdx As Long
Dim vParam() As Variant
Dim vType(0 To 63) As Integer
Dim vPtr(0 To 63) As Long
Dim hResult As Long
vParam = A
For lIdx = 0 To UBound(vParam)
vType(lIdx) = VarType(vParam(lIdx))
vPtr(lIdx) = VarPtr(vParam(lIdx))
Next
hResult = DispCallFunc(ObjPtr(pUnk), lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
If hResult < 0 Then
Err.Raise hResult, "DispCallFunc"
End If
End Function
You client code will be much simpler (literally one line of code). Start a new Std-EXE, place a button on Form1 and paste this code in Form1
Code:
'--- client
Option Explicit
Private Const STR_MONIKER As String = "MySolution.MyServer"
Private Sub Command1_Click()
On Error GoTo EH
MsgBox GetObject(STR_MONIKER).MyValue, vbExclamation
EH:
End Sub
Start your server with server.exe test
Pressing the button on the client will show "test".
Without killing the first server launch a second instance with server.exe second
Now pressing the button on the client will show "second".
cheers,
</wqw>
Last edited by wqweto; Dec 5th, 2022 at 01:37 PM.
-
Dec 5th, 2022, 02:18 PM
#3
Thread Starter
New Member
Re: vb6 activex.exe commandline Application
wqweto,
It seems you have used a server-client solution using standard exe which means I don't have have to make an activeX component at all? If so it also means I wouldn't have to be concerned about registering the "server"?
Thank you for your idea. I will try it out, and let you know if there are any issues.
I tried the solution and it seemed to work, but when I put a new command button in my existing project which already has 2 command buttons and added your code...
Private Sub Command3_Click()
On Error GoTo EH
MsgBox GetObject(STR_MONIKER).MyValue, vbExclamation
End Sub
although the rest of the program runs as normal when i click on the command3 button I get a complle error. GetObject is highlighted
and the error message is "argument not optional"
Can you suggest what is wrong?
Last edited by Cal9; Dec 5th, 2022 at 08:46 PM.
Reason: tried your idea and not entirely working
-
Dec 7th, 2022, 08:45 PM
#4
Thread Starter
New Member
Re: vb6 activex.exe commandline Application
I have figured out the problem. I was using an API (I think that is the right term) call...
"Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, _
ByVal nCount As Long, ByRef lpObject As Any) As Long"
This took predence over the Vb built-in "GetObject()" function.
I have renamed to remove that conflict and now it works as expected.
I have also learned a lesson, that I need to make a note of ALL
Vb built-in functions, not just the ones I happen to be using to avoid this sort of problem in the future.
Thank you for your help VBForums
Goodbye until my next problem which will be sooner than later lol
-
May 15th, 2023, 08:44 AM
#5
Re: [RESOLVED] vb6 activex.exe commandline Application
how to GetRunningObjectTable,list all object by api,without tlb?
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|