Never been to CodeSnippets before?

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!)

regsvr32 wsh

Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.Run "regsvr32.exe c:\windows\system32\whatever.dll" 

wsh shell execute and return output

' MsgBox RunOutput("COMMAND /C DIR C:\", 0)
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

vb6 shellexecute

   
      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


2 exe communicating vb6

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.