Killing Previous Instance of VB6 Application - vb6

I've searched around for the proper way to kill a previous Instance of a VB6 application to no avail. If our main service dies, we need to terminate the previous instance of the running application and then, when the service comes back up only the new instance should be loaded. I am trying to exit this code in the following function:
Private Sub g_cServerInterface_FatalError(Error As enSvrReturns, ErrorString As String)
Dim sMsg As String
Dim result As VbMsgBoxResult
m_bFatalError = True
UnFreeze
If m_cLanguageText Is Nothing Then
GoTo TheEnd 'Form not yet loaded - not yet logged on
End If
' m_NumFatalErrors = m_NumFatalErrors + 1
' If m_NumFatalErrors > 5 Then
' Functions.DevInfo "Unable to restart Manitou.", g_cLangText_General
' End
' End If
If Error <> SVRERR_NOT_CONNECTED Or RunningInDebugger() Then
sMsg = g_cLangText_General.GetText("A system error has occurred")
If ErrorString <> "" Then
sMsg = sMsg & ":" & vbCrLf & vbCrLf & ErrorString & vbCrLf & vbCrLf
Else
sMsg = sMsg & ". "
End If
sMsg = sMsg & g_cLangText_General.GetText("Press OK to attempt to restart or Cancel to quit.")
result = DevAskOkCancel(sMsg, Nothing)
Else
' Since we've been disconnected, attempt immediately to reconnect
result = vbOK
End If
If (result = vbOK) Then
On Local Error Resume Next
If InStr(g_CommandLine, "-U") = 0 Then
g_CommandLine = g_CommandLine & " -U" & g_cUser.id
End If
If InStr(g_CommandLine, "-P") = 0 Then
g_CommandLine = g_CommandLine & " -P" & g_cUser.Password
End If
Shell App.Path & "\" & App.EXEName & " " & g_CommandLine & " -X", vbNormalFocus
DoEvents
End If
TheEnd:
If (Not RunningInDebugger()) Then
' Running as compiled executable
' Specifies the exit code for the process, and for all threads that
' are terminated as a result of this call. Use the GetExitCodeProcess
' function to retrieve the process's exit value. Use the GetExitCodeThread
' function to retrieve a thread's exit value.
CoUninitialize
ExitProcess 0
Else
' Running from the IDE
End
End If
End Sub
Note that I added the CoUninitialize and ExitProcess 0 API calls to this. How can I correctly terminate the previously loaded instance when the service comes back up? thanks Larry

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_CLOSE = &H10
Private Sub Form_Load()
Dim strCap As String
Dim lngHwnd As Long
Dim lngRet As Long
strCap = Me.Caption
Me.Caption = "*" & strCap
lngHwnd = FindWindow(ByVal vbNullString, ByVal strCap)
If lngHwnd <> 0 Then
PostMessage lngHwnd, WM_CLOSE, 0&, 0&
End If
Me.Caption = strCap
End Sub

Related

Get output from command line in VB6

i am using this .Cls file and a command using 7zip to extract specific file from a zip.
my single file gets extracted how ever i need to add if statement to se if my file was found so that i can exit sub it can this piece of code be modifed to add own code
DOSOutputs.cls
Option Explicit
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MsgType, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (ByRef lpMsg As Any) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageW" (ByRef lpMsg As Any) As Long
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type MsgType
hWnd As Long
message As Long
wParam As Long
lParam As Long
Time As Long
pt As POINTAPI
End Type
Private Const PM_NOREMOVE As Long = 0&
Private Const PM_REMOVE As Long = 1&
'
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'The CreatePipe function creates an anonymous pipe,
'and returns handles to the read and write ends of the pipe.
Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
'Used to read the the pipe filled by the process create
'with the CretaProcessA function
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
'Structure used by the CreateProcessA function
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'Structure used by the CreateProcessA function
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
'Structure used by the CreateProcessA function
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
'This function launch the the commend and return the relative process
'into the PRECESS_INFORMATION structure
Private Declare Function CreateProcessA Lib "kernel32" ( _
ByVal lpApplicationName As Long, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
'Close opened handle
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hHandle As Long) As Long
'Consts for the above functions
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private mCommand As String 'Private variable for the CommandLine property
Private mOutputs As String 'Private variable for the ReadOnly Outputs property
'Event that notify the temporary buffer to the object
Public Event ReceiveOutputs(CommandOutputs As String)
'This property set and get the DOS command line
'It's possible to set this property directly from the
'parameter of the ExecuteCommand method
Public Property Let CommandLine(DOSCommand As String)
mCommand = DOSCommand
End Property
Public Property Get CommandLine() As String
CommandLine = mCommand
End Property
'This property ReadOnly get the complete output after
'a command execution
Public Property Get Outputs()
Outputs = mOutputs
End Property
Public Function ExecuteCommand(Optional CommandLine As String) As String
Dim proc As PROCESS_INFORMATION 'Process info filled by CreateProcessA
Dim ret As Long 'long variable for get the return value of the
'API functions
Dim start As STARTUPINFO 'StartUp Info passed to the CreateProceeeA
'function
Dim sa As SECURITY_ATTRIBUTES 'Security Attributes passeed to the
'CreateProcessA function
Dim hReadPipe As Long 'Read Pipe handle created by CreatePipe
Dim hWritePipe As Long 'Write Pite handle created by CreatePipe
Dim lngBytesread As Long 'Amount of byte read from the Read Pipe handle
Dim strBuff As String * 256 'String buffer reading the Pipe
'if the parameter is not empty update the CommandLine property
If Len(CommandLine) > 0 Then
mCommand = CommandLine
End If
'if the command line is empty then exit whit a error message
If Len(mCommand) = 0 Then
MsgBox "Command Line empty", vbCritical
Exit Function
End If
'Create the Pipe
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
'If an error occur during the Pipe creation exit
MsgBox "CreatePipe failed. Error: " & Err.LastDllError, vbCritical
Exit Function
End If
'Launch the command line application
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
'set the StdOutput and the StdError output to the same Write Pipe handle
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
'Execute the command
ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret <> 1 Then
'if the command is not found ....
MsgBox "File or command not found", vbCritical
Exit Function
End If
'Now We can ... must close the hWritePipe
ret = CloseHandle(hWritePipe)
mOutputs = ""
'Read the ReadPipe handle
Do
ret = ReadFile(hReadPipe, strBuff, 256, lngBytesread, 0&)
mOutputs = mOutputs & Left(strBuff, lngBytesread)
'Send data to the object via ReceiveOutputs event
RaiseEvent ReceiveOutputs(Left(strBuff, lngBytesread))
'Pause 0.02
FastDoEvents
Loop While ret <> 0
'Close the opened handles
ret = CloseHandle(proc.hProcess)
ret = CloseHandle(proc.hThread)
ret = CloseHandle(hReadPipe)
'Return the Outputs property with the entire DOS output
ExecuteCommand = mOutputs
End Function
Public Sub FastDoEvents()
Dim uMsg As MsgType
'
Do While PeekMessage(uMsg, 0&, 0&, 0&, PM_REMOVE) ' Reads and deletes message from queue.
TranslateMessage uMsg ' Translates virtual-key messages into character messages.
DispatchMessage uMsg ' Dispatches a message to a window procedure.
Loop
End Sub
form1
Private WithEvents objDOS As DOSOutputs
Private Sub Form_Load()
Set objDOS = New DOSOutputs
End Sub
button command
Private Sub Command22_Click()
On Error Resume Next
On Error GoTo errore
objDOS.CommandLine = text6.text
objDOS.ExecuteCommand
'If objDOS.Outputs = "41_gfx7.rom " Then
'Text1.Text = Text1.Text & objDOS.Outputs & vbNewLine
'End If
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub
text6.text has
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
so now am trying to get the status from output using if statement to se if 41_gfx7.rom was found so that i can exit the scan or sub as there is no need to scan further.
or maybe if you can help add better one it will be great,once the string is found exit sub it
Private Sub Command1_Click()
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(Text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
End Sub
text6 is my command
ok update
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
i need to add list to this command according to https://sevenzip.osdn.jp/chm/cmdline/commands/list.htm so that file names gets displayed in output data
The following Microsoft article describes two methods that read the output of a command: WSH: Running Programs
The simplest uses the StdOut property of the WshExec object:
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 157.59.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If Instr(strText, "Reply") > 0 Then
Wscript.Echo "Reply received."
Exit Do
End If
Loop
You can replace the ping command here with your 7z command and read StdOut to see what your command returned.
Since you are doing this in VB6, you can add a reference (Projects menu > References) to Windows Script Host Object Model library and instantiate the objects with the proper types directly:
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 127.0.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
With this approach you don't need the DOSCommand.cls, you can simply use the WshShell object for all your operations.
Your Command22_Click would look like this:
Private Sub Command22_Click()
On Error GoTo errore
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
' Parse the text your 7z command returned here
If InStr(strText, "41_gfx7.rom") > 0 Then
Text1.Text = Text1.Text & strText & vbCrLf
Exit Do
End If
Loop
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub

Move macro forward when caught/stuck in process

I have written a macro that uses the paping.exe program to cycle through a list of device IP addresses by sending pings and recording their return values. While the macro works as intended for the majority of the time, there are spare moments when the ping command appears to be stuck or caught up and stops moving forward. This causes me to have to manually break the execution and start the process over.
From a more broad perspective, is there a way to handle this runtime error. My thought was to break the list of devices into groupings, and if the program becomes stuck, I could tell the macro to move forward to the next grouping. While just an idle idea, I wanted to reach out to the community for advice, tips and ideas on ways I could more eloquently handle this issue. The list of devices that I am pinging is set to grow in time as well.
Public Sub getPingStatusCode(IPvalue As String, portValue As String)
ret = WshShell.Run("C:\Users\*******\paping.exe " & IPvalue & " -p " & portValue & " -c " & pingCount & " -t " & pingTime, 0, True) 'CHANGEEEEEEE
totalCounter = totalCounter + 1
Select Case ret
Case 0: strResult = "Connected"
Case 1: strResult = "Fail"
Case 11001: strResult = "Buffer too small"
Case 11002: strResult = "Destination net unreachable"
Case 11003: strResult = "Destination host unreachable"
Case 11004: strResult = "Destination protocol unreachable"
Case 11005: strResult = "Destination port unreachable"
Case 11006: strResult = "No resources"
Case 11007: strResult = "Bad option"
Case 11008: strResult = "Hardware error"
Case 11009: strResult = "Packet too big"
Case 11010: strResult = "Request timed out"
Case 11011: strResult = "Bad request"
Case 11012: strResult = "Bad route"
Case 11013: strResult = "TTL expired transit"
Case 11014: strResult = "TTL expired reassembly"
Case 11015: strResult = "Parameter problem"
Case 11016: strResult = "Source quench"
Case 11017: strResult = "Option too big"
Case 11018: strResult = "Bad destination"
Case 11032: strResult = "Negotiating IPSEC"
Case 11050: strResult = "General failure"
Case Else: strResult = "Unknown host"
End Select
'if statement on return value for bolding and font color
'and counters
If ret = 0 Then 'CONNECTED
With pingSheet.Cells(i, 4)
.Value = strResult
End With
totalOn = totalOn + 1
onOff = 1
'set the rawDataSheet value to connected status...assumes that the sheet starts with all rawdata values as "connected"
rawDataSheet.Cells(4, i).Value = strResult
ElseIf ret = 1 Then 'FAILED
With pingSheet.Cells(i, 4)
.Value = strResult
.Font.Color = vbRed
.Font.bold = True
End With
failCounter = failCounter + 1
onOff = 0
'give RawData sheet a "down since" date value
If rawDataSheet.Cells(4, i).Value = "Connected" Then
rawDataSheet.Cells(4, i).Value = Now
End If
''''''''''''''
pdfDeviceDump
Else
With pingSheet.Cells(i, 4)
.Value = strResult
.Font.Color = vbRed
.Font.bold = True
End With
failCounter = failCounter + 1
onOff = 0
End If
End Sub
I could not get paping.exe to run on my machine so I wrote some code using ping.exe instead.
In principle one can shell out and redirect output to file and then pick up the file later when finished. We use Windows API calls to wait for a process to finish.
Option Explicit
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Const INFINITE = &HFFFF
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Sub TestShellAndRedirectPingToFile()
Dim vIPAddresses As Variant
vIPAddresses = Array("bbc.co.uk", "wikipedia.org", "cnn.com")
Dim dicFilesToPickUp As Scripting.Dictionary
Set dicFilesToPickUp = ShellAndRedirectPingToFile(vIPAddresses)
Dim vKeyLoop As Variant
For Each vKeyLoop In dicFilesToPickUp.Keys
Dim lPID As Long
lPID = dicFilesToPickUp.Item(vKeyLoop)
Dim hProc As Long
hProc = OpenProcess(PROCESS_ALL_ACCESS, 0&, lPID)
Debug.Print "Waiting on " & vKeyLoop & " (" & lPID & ")"
WaitForSingleObject hProc, INFINITE
CloseHandle hProc '* be nice and close handles
Next
Debug.Print "Done! Files ready to read."
End Sub
Function ShellAndRedirectPingToFile(ByVal vIPAddresses As Variant) As Scripting.Dictionary
Dim dicFilesToPickUp As Scripting.Dictionary
Set dicFilesToPickUp = New Scripting.Dictionary
Dim sTempFolder As String
sTempFolder = Environ$("TEMP")
If Right$(sTempFolder, 1) <> "\" Then sTempFolder = sTempFolder & "\"
Dim vAddressLoop As Variant
For Each vAddressLoop In vIPAddresses
Dim sTempFile As String
sTempFile = sTempFolder & vAddressLoop & ".txt"
Dim sCmd As String
sCmd = Environ$("comspec") & " /S /C ping.exe " & vAddressLoop & " > " & sTempFile
Dim lPID As Long
lPID = VBA.Shell(sCmd)
dicFilesToPickUp.Add sTempFile, lPID
Next
Set ShellAndRedirectPingToFile = dicFilesToPickUp
End Function

Visual Basic for Applications (VBA) Shell

I'd like to invoke a script on my linux server using VBA in Excel. To do this, I'm using a local copy of Putty that's in the path.
I've successfully written a single command to create a putty session and log in to the server, I'm just unsure how to pass another command after this has been opened in the shell.
Any Ideas?
The below subroutine works, but causes a problem when the second command is attempted.
Cheers
Sub test()
Dim putty As String
Dim strCommand As String
Dim strCommand1 As String
Dim User As String
Dim Pass As String
Dim Host As String
Dim File As String
Dim RemotePath As String
putty = """" & Range("E3").Text & "\Putty.exe"""
User = Range("E8").Text
Pass = Range("E9").Text
Host = Range("E7").Text
'File = """" & Range("E11").Text & """"
RemotePath = Range("E10").Text
strCommand = putty & " -l " & User & " -pw " & Pass & _
" " & File & " " & Host & ":" & RemotePath
'MsgBox strCommand
Shell strCommand, 1 ' vbNormalFocus '
Module2.WaitFor (5)
Shell "ls -l > shell.log", 1
End Sub
use other tool to execute shell command plink
execute this command by this code:
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Sub ShellAndWait(ByVal program_name As String, _
ByVal window_style As VbAppWinStyle)
Dim process_id As Long
Dim process_handle As Long
' Start the program.
On Error GoTo ShellError
process_id = Shell(program_name, window_style)
On Error GoTo 0
DoEvents
' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
Exit Sub
ShellError:
MsgBox Err.Description, vbOKOnly Or vbExclamation, "Error"
End Sub
ShellAndWait "plink -pw password -noagent user#server.com ""rm -f /tmp/file.txt ; gunzip /tmp/file.txt.gz""", vbMaximizedFocus

Get list of installed network card

I want to fill the combo box with all the installed network adapter name using visual basic 6.0. Is there any way to do so? I also want to know how to add, edit and delete the value of registry?
Simplest way would be to shell out to the ipconfig command, redirect the output to a file, and then parse the file. There are many implementations of a function usually called "ShellAndWait()". I've taken one I had squirreled away - it might not be the best, but it works.
Option Explicit
Private Declare Function CloseHandle Lib "Kernel32.dll" ( _
ByVal hHandle As Long _
) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long _
) As Long
Private Declare Function WaitForSingleObject Lib "Kernel32.dll" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long _
) As Long
Private Const INFINITE As Long = -1&
Private Const SYNCHRONIZE As Long = &H100000
Private Sub Form_Load()
Dim oNetworkAdapters As VBA.Collection
Dim vNetworkAdapter As Variant
Set oNetworkAdapters = GetNetworkAdapters()
cmbNICs.Clear
For Each vNetworkAdapter In oNetworkAdapters
cmbNICs.AddItem vNetworkAdapter
Next vNetworkAdapter
End Sub
Public Function GetNetworkAdapters() As VBA.Collection
Dim sTempFileName As String
Dim nFileNo As Integer
Dim sLine As String
Dim oNetworkAdapters As VBA.Collection
Set oNetworkAdapters = New VBA.Collection
sTempFileName = Environ$("TEMP") & "\VBTmp" & Format$(Now, "yyyymmddhhnnss")
If ShellAndWait("cmd.exe /c ipconfig > """ & sTempFileName & """", vbHide) Then
nFileNo = FreeFile
Open sTempFileName For Input As #nFileNo
Do Until EOF(nFileNo)
Line Input #nFileNo, sLine
If Len(sLine) > 0 Then
If sLine Like "*:" Then
If Not sLine Like " *:" Then
oNetworkAdapters.Add sLine
End If
End If
End If
Loop
Close #nFileNo
Kill sTempFileName
End If
Set GetNetworkAdapters = oNetworkAdapters
End Function
' Start the indicated program and wait for it to finish, hiding while we wait.
Public Function ShellAndWait(ByRef in_sProgramName As String, _
ByVal in_enmWindowStyle As VbAppWinStyle) As Boolean
Dim nProcessId As Long
Dim hProcess As Long
' Start the program.
On Error GoTo ShellError
nProcessId = Shell(in_sProgramName, in_enmWindowStyle)
On Error GoTo 0
DoEvents
' Wait for the program to finish.
' Get the process handle.
hProcess = OpenProcess(SYNCHRONIZE, 0, nProcessId)
If hProcess <> 0 Then
WaitForSingleObject hProcess, INFINITE
CloseHandle hProcess
End If
ShellAndWait = True
Exit Function
ShellError:
MsgBox "Error starting task '" & in_sProgramName & "'" & vbCrLf & Err.Description, vbOKOnly Or vbExclamation, "Error"
End Function
Here is the simple code that will detect all Ethernet and wireless adaptors
NetworkInterface slectedNic;
IEnumerable<NetworkInterface> nics = NetworkInterface.GetAllNetworkInterfaces().Where(network => network.OperationalStatus == OperationalStatus.Up && (network.NetworkInterfaceType == NetworkInterfaceType.Ethernet || network.NetworkInterfaceType == NetworkInterfaceType.Wireless80211));
foreach (NetworkInterface item in nics)
{
cmbAdptors.Items.Add(item);
}
but if u want to detect only active wireless adaptor
change
.Where(network => network.OperationalStatus == OperationalStatus.Up && (network.NetworkInterfaceType == NetworkInterfaceType.Ethernet || network.NetworkInterfaceType == NetworkInterfaceType.Wireless80211));
to
.Where(network => network.OperationalStatus == OperationalStatus.Up && network.NetworkInterfaceType == NetworkInterfaceType.Wireless80211)

Process monitor / dispatcher in VB6

I need to write a little application in VB6 to run instances of another VB6 application and keep an eye on the running processes, but I don't have any idea how to get process information in VB6. I can see some of what I need with the tasklist utility but I don't really know how create processes (specifying the process or application name if possible) and fetching information about processes from the operating system.
This application is to run on a Windows XP machine.
Does anyone know of a get-you-started tutorial or helpful web page for this sort of thing?
There are numerous Windows API functions you can use to do this. I'd start with looking at EnumProcesses (VB6 example and declaration here) which can be used to gather information about all running processes. You can also use OpenProcess
to start interrogating Windows about a particular process (another VB6 example).
There is also a fairly nice example on MSDN.
And of course, there is CreateProcess (AllApi link) or ShellExecute (AllApi) for spawning processes - the former gives you more control over the creation of the process, while the latter is a much simpler call.
There was another question posted about this a while back with some example code.
Another possible approach would be to use WMI (some useful snippets to adapt).
Finally, here are some tutorials that show you how to do it (I'd recommend trying it yourself first though :):
Getting Process Information using PSAPI
Another EnumProcesses/OpenProcess implementation
WMI-based demonstration
Here are some related questions although you probably already saw them when you searched this site before posting:
Monitoring processes to see if they've crashed in vb6
How can I execute a .bat file but wait until its done running before moving on?
How To Enumerate Processes From VB 6 on Win 2003?
Since you say the other application is ** also VB6**, it would be easier to make the other application into an ActiveX exe. Then you can get references to objects in the other application direct from your first application. COM solves it all for you.
Here's Microsoft's tutorial on the subject - you can download the code too.
Or here's another answer where I've written about this
You don't need to go spelunking for processes just to get a handle to child processes that you spawn. The VB6 Shell() function returns a Process ID you can use to call OpenProcess with. CreateProcess gives you the handle directly.
Ok, here is a super-stripped-down example of a program in VB6 to spawn and monitor programs. The example is coded to start and repeatedly restart 3 copies of the command shell (trivial sample child program). It is also written to kill any running children when it is terminated, and there are better alternatives to use in most cases. See A Safer Alternative to TerminateProcess().
This demo also reports back the exit code of each process that quits. You could enter exit 1234 or somesuch to see this in action.
To create the demo open a new VB6 Project with a Form. Add a multiline TextBox Text1 and a Timer Timer1 (which is used to poll the children for completion). Paste this code into the Form:
Option Explicit
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const PROCESS_TERMINATE = &H1&
Private Const WAIT_OBJECT_0 = 0
Private Const INVALID_HANDLE = -1
Private Const DEAD_HANDLE = -2
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
ByRef lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Tasks() As String
Private Handles() As Long
Private Sub Form_Load()
Dim I As Integer
'We'll run 3 copies of the command shell as an example.
ReDim Tasks(2)
ReDim Handles(2)
For I = 0 To 2
Tasks(I) = Environ$("COMSPEC") & " /k ""#ECHO I am #" & CStr(I) & """"
Handles(I) = INVALID_HANDLE
Next
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim I As Integer
Timer1.Enabled = False
DoEvents
For I = 0 To UBound(Tasks)
If Handles(I) <> INVALID_HANDLE And Handles(I) <> DEAD_HANDLE Then
TerminateProcess Handles(I), 666
CloseHandle Handles(I)
Handles(I) = DEAD_HANDLE
End If
Next
End Sub
Private Sub Timer1_Timer()
Dim I As Integer
Dim ExitCode As Long
Dim Pid As Long
Timer1.Enabled = False
For I = 0 To UBound(Tasks)
If Handles(I) <> INVALID_HANDLE Then
If WaitForSingleObject(Handles(I), 0) = WAIT_OBJECT_0 Then
If GetExitCodeProcess(Handles(I), ExitCode) <> 0 Then
Text1.SelText = "Task " & CStr(I) & " terminated, " _
& "exit code: " & CStr(ExitCode) _
& ", restarting task." _
& vbNewLine
Else
Text1.SelText = "Task " & CStr(I) & " terminated, " _
& "failed to retrieve exit code, error " _
& CStr(Err.LastDllError) _
& ", restarting task." _
& vbNewLine
End If
CloseHandle Handles(I)
Handles(I) = INVALID_HANDLE
End If
End If
If Handles(I) = INVALID_HANDLE Then
Pid = Shell(Tasks(I), vbNormalFocus)
If Pid <> 0 Then
Handles(I) = OpenProcess(SYNCHRONIZE _
Or PROCESS_QUERY_INFORMATION _
Or PROCESS_TERMINATE, 0, Pid)
If Handles(I) <> 0 Then
Text1.SelText = "Task " & CStr(I) & " started." _
& vbNewLine
Else
Text1.SelText = "Task " & CStr(I) _
& ", failed to open child process." _
& vbNewLine
Handles(I) = DEAD_HANDLE
End If
Else
Text1.SelText = "Task " & CStr(I) _
& ", failed to Shell child process." _
& vbNewLine
Handles(I) = DEAD_HANDLE
End If
End If
Next
Timer1.Enabled = True
End Sub
Hopefully this helps answer the question.
something more simple will use sockets.
Launch you app server and on your client implements the communication against your server. With that you will provide intercommunication.
well i say. because i dont be what you try do
Sorry it only apply if your clients are done in house i you have the option of added changes

Resources