regsvr32 wsh
Dim objShell Set objShell = CreateObject("WScript.Shell") objShell.Run "regsvr32.exe c:\windows\system32\whatever.dll"
Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world (or not, you can keep them private!)
Dim objShell Set objShell = CreateObject("WScript.Shell") objShell.Run "regsvr32.exe c:\windows\system32\whatever.dll"
Function RunOutput(cProgram, nWindowType) '-- Obtain a Temporary File Name Dim oFS Set oFS = CreateObject("Scripting.FileSystemObject") Dim cFile cFile = oFS.GetSpecialFolder(2).Path & "\" & oFS.GetTempName '-- Execute the command and redirect the output to the file Dim oShell Set oShell = CreateObject("WScript.Shell") oShell.Run cProgram & " >" & cFile, nWindowType, True Set oShell = Nothing '-- Read output file and return Dim oFile Set oFile = oFS.OpenTextFile(cFile, 1, True) RunOutput = oFile.ReadAll() oFile.Close '-- Delete Temporary File oFS.DeleteFile cFile Set oFS = Nothing Set cFile = Nothing End Function
Option Explicit
Option Base 0
'code by JoshT
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
(ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
lpOverlapped As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, _
phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long) As Long
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const STARTF_USESTDHANDLES As Long = &H100&
Private Const STARTF_USESHOWWINDOW As Long = &H1&
Private Const SW_HIDE As Long = 0&
Private Const INFINITE As Long = &HFFFF&
Public Function RunCommand(CommandLine As String) As String
Dim si As STARTUPINFO 'used to send info the CreateProcess
Dim pi As PROCESS_INFORMATION 'used to receive info about the created process
Dim retval As Long 'return value
Dim hRead As Long 'the handle to the read end of the pipe
Dim hWrite As Long 'the handle to the write end of the pipe
Dim sBuffer(0 To 63) As Byte 'the buffer to store data as we read it from the pipe
Dim lgSize As Long 'returned number of bytes read by readfile
Dim sa As SECURITY_ATTRIBUTES
Dim strResult As String 'returned results of the command line
'set up security attributes structure
With sa
.nLength = Len(sa)
.bInheritHandle = 1& 'inherit, needed for this to work
.lpSecurityDescriptor = 0&
End With
'create our anonymous pipe an check for success
' note we use the default buffer size
' this could cause problems if the process tries to write more than this buffer size
' retval = CreatePipe(hRead, hWrite, sa, 0&)
'
' If retval = 0 Then
'
' Debug.Print "CreatePipe Failed"
'
' RunCommand = ""
'
' Exit Function
'
' End If
'set up startup info
With si
.cb = Len(si)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW 'tell it to use (not ignore) the values below
.wShowWindow = SW_HIDE
' .hStdInput = GetStdHandle(STD_INPUT_HANDLE)
.hStdOutput = hWrite 'pass the write end of the pipe as the processes standard output
' .hStdError = GetStdHandle(STD_ERROR_HANDLE)
End With
'run the command line and check for success
retval = CreateProcess(vbNullString, _
CommandLine & vbNullChar, _
sa, _
sa, _
1&, _
NORMAL_PRIORITY_CLASS, _
ByVal 0&, _
vbNullString, _
si, _
pi)
If retval Then
'wait until the command line finishes
' trouble if the app doesn't end, or waits for user input, etc
WaitForSingleObject pi.hProcess, INFINITE
' MsgBox "CreateProcess ok" & vbCrLf
'read from the pipe until there's no more (bytes actually read is less than what we told it to)
Do While ReadFile(hRead, sBuffer(0), 64, lgSize, ByVal 0&)
'convert byte array to string and append to our result
strResult = strResult & StrConv(sBuffer(), vbUnicode)
'TODO = what's in the tail end of the byte array when lgSize is less than 64???
Erase sBuffer()
If lgSize <> 64 Then Exit Do
Loop
'close the handles of the process
CloseHandle pi.hProcess
CloseHandle pi.hThread
Else
' Debug.Print "CreateProcess Failed" & vbCrLf
' strResult = ""
' MsgBox "CreateProcess Failed" & vbCrLf
End If
'close pipe handles
CloseHandle hRead
CloseHandle hWrite
'return the command line output
RunCommand = Replace(strResult, vbNullChar, "")
End Function
project MainApp: on the form place controls as follows: place a frame on form, set the caption to frame1 = Communicate to Receiver insert in frame1 a Text box, leave default name(Text1), set index to 0 place another frame on form, set the caption to frame2 = Send This Message insert in frame2 a Text Box, Change default name to Text1, set index to 1 insert a Label under Text Box, leave default name(Label1), set Alignment to center place a Command button on form, leave default name, set command1 caption = Send Message 'MainApp Form1 code ######################################## Option Explicit DefLng A-Z Private Sub Command1_Click() On Error GoTo EHmess If SendMessageToAppReceiver(Me.Text1(0).Text, Me.Text1(1).Text) Then Me.Label1.Caption = "Message has been sent." Else Me.Label1.Caption = "Error sending Message." End If Exit Sub EHmess: MsgBox Err.Description, vbExclamation, "Error: &H" & Hex(Err.Number) End Sub Private Sub Form_Load() Me.Text1(0).Text = GUIDappreceiver Me.Label1.Caption = "Please enter Message to send!" End Sub Private Sub Text1_GotFocus(Index As Integer) With Me.Text1(Index) .SelStart = 0 .SelLength = Len(.Text) End With End Sub ' End MainApp Form1 code #################################### add a Module to project, name the Module = modSendMessage ' modSendMessage code ##################################### Option Explicit DefLng A-Z Private Declare Function FindWindowEx _ Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _ ByVal hWnd2 As Long, _ ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long Private Declare Function SendMessageTimeout _ Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ lParam As Any, _ ByVal fuFlags As Long, _ ByVal uTimeout As Long, _ lpdwResult As Long) As Long Public Const GUIDappreceiver = "{7DE2A166-C107-4FC6-9A09-67672C3D6AAB}" Private Const WM_SETTEXT = &HC Private Function TBHandle(sWindowTitle As String) As Long Dim lWndHandle As Long 'Make sure we are working with a VB Form hWnd 'use WinClass 'This only works on VB RunTime 6 Forms "ThunderFormRT6DC" ' look for form lWndHandle = FindWindowEx(0, 0, "ThunderRT6FormDC", sWindowTitle) If lWndHandle Then 'This only works on VB RunTime 6 Forms "ThunderRT6TextBox" ' once found, look for its TextBox TBHandle = FindWindowEx(lWndHandle, 0, "ThunderRT6TextBox", vbNullString) Else 'This only works on VB RunTime Form "ThunderFormDC" ' if form not found, look for interpreted form lWndHandle = FindWindowEx(0, 0, "ThunderFormDC", sWindowTitle) If lWndHandle Then 'This only works on VB RunTime Form "ThunderTextBox" ' if found, search for its child TextBox TBHandle = FindWindowEx(lWndHandle, 0, "ThunderTextBox", vbNullString) End If End If ' raise error if its not found If lWndHandle = 0 Then Err.Raise vbObjectError + 1, "modSendMessage:TBHandle", sWindowTitle & " App Receiver not found." ElseIf TBHandle = 0 Then Err.Raise vbObjectError + 2, "modSendMessage:TBHandle", sWindowTitle & " App Receiver Text1 not found." End If End Function Public Function SendMessageToAppReceiver(sWindowTitle As String, sText As String) As Boolean Dim lhWndTextBox As Long Dim lRtn As Long lhWndTextBox = TBHandle(sWindowTitle) If lhWndTextBox > 0 Then If SendMessageTimeout(lhWndTextBox, WM_SETTEXT, 0, ByVal sText, 0, 1000, lRtn) Then If lRtn <> 0 Then SendMessageToAppReceiver = True End If End If End If End Function ' End modSendMessage code ################################## run MainApp, then build MainApp.exe create a new seperate exe project, name it AppReceiver on the form place controls as follows: place a Label on form, Remove the caption to Label1 insert in a Text box under Label1, leave default name(Text1) place a Timer on the form, leave default(Timer1) set the name to Form1 = AppReceiver set the caption to Form1 = {7DE2A166-C107-4FC6-9A09-67672C3D6AAB} ' AppReceiver Form1 code ################################### Option Explicit DefLng A-Z Private Sub MessageReceived(sText As String) Select Case sText Case "abc" Case "xyz" End Select End Sub Private Sub Form_Load() Me.Label1.Caption = "Listening for Messages..." End Sub Private Sub Timer1_Timer() Me.Timer1.Interval = 0 Me.Text1.Text = "" End Sub Private Sub Text1_Change() Me.Timer1.Interval = 10000 MessageReceived Me.Text1.Text Me.Label1.Caption = "Message Received" If Me.Text1.Text = "" Then Me.Label1.Caption = "Listening for Messages..." End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = vbFormControlMenu Then Unload frmReceiver End If End Sub ' End AppReceiver Form1 code ################################ add a Module to project, name the Module = modAppReceiver ' modAppReceiver code #################################### Option Explicit DefLng A-Z Public Sub Main() If App.PrevInstance Then Exit Sub Load frmReceiver frmReceiver.Show End Sub ' End modAppReceiver code ################################# right click AppReceiver Project, select AppReceiver Properties, select Startup Object = Sub Main run AppReceiver, then build AppReceiver.exe How to use: start AppMain.exe & AppReceiver.exe type a message in AppMain window "Send This Message" Text Box then press Send Message Button, this will send the message to and display in AppReceiver Window.