process.bas

LineWatcher dials your ISP, keeps your connection alive and logs errors. Originally distributed as f

Attribute VB_Name = "Mod_Process"
' RICHARD GOUTORBE ( [e-mail] http://www.reseau.org/rg/ ) holds the copyright to all code in this document.
' You are granted a license to use this code under the following conditions:
' - You are free to modify the code in any way you see fit.
' - You are free to redistribute the code FOR NON-PROFIT PURPOSE provided that
'     1) appropriate credit is given to Richard Goutorbe, and
'     2) you do not charge any kind of fee for the code without the written permission of Richard Goutorbe.
' You are free to redistibute a binary compiled version of the code for any purpose, profit or non-profit.
' If you distribute the code in this form, you must give appropriate credit to Richard Goutorbe.
' PUBLISHING THE CODE ON OTHER WEB SITES, OR POSTING THE CODE ON OTHER WEB SITES FOR PUBLICATION WITHOUT THE WRITTEN PERMISSION OF RICHARD GOUTORBE, IS STRICTLY PROHIBITED.
Option Explicit

Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    ' fields
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type

'The ShellExecuteEx function performs an action on a file. The file can be an executable file or a document
'Return Values:
'If the function succeeds, the return value is nonzero.
'If the function fails, the return value is zero. To get extended error information, call GetLastError
Private Declare Function ShellExecuteEx Lib "shell32.dll" (SEI As SHELLEXECUTEINFO) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long


' Open given document path or url, with the associated application
' Return value: 0=ok, -1=error
' 1f590a8d-4976-4577-b4ac-d731debd6024
Public Function OpenDoc(url_str As String) As Integer
    Dim err_str As String
    err_str = Spawn(url_str)
    If (LenB(err_str) > 0) Then
        MsgBox err_str, vbCritical, App.Title
    End If
    OpenDoc = IIf(Len(err_str) = 0, 0, -1)
End Function


' Run given program and optionaly wait until it terminates
' visible_bool: True=run in normal window, False=run invisible
' Return value: empty string if Ok, or error message
'4729860c-6a92-440c-8a22-0eae80557172
Public Function Spawn( _
    strProgram As String, _
    Optional strParameters As String, _
    Optional visible_bool As Boolean = True, _
    Optional wait_bool As Boolean = False _
    ) As String
    Const SEE_MASK_NOCLOSEPROCESS = &H40
    Const SW_SHOWNORMAL = 1
    Const SW_HIDE = 0
    Const WAIT_TIMEOUT = 258&  ' The time-out interval elapsed, and the object's state is nonsignaled
    Dim sei_struct As SHELLEXECUTEINFO
    
    Debug.Print "Spawn "; strProgram; " "; strParameters
    
    With sei_struct
        .cbSize = Len(sei_struct)
        .fMask = SEE_MASK_NOCLOSEPROCESS
        .hwnd = GetDesktopWindow()
        .lpVerb = "open"
        .lpFile = strProgram
        .lpParameters = strParameters
        .nShow = IIf(visible_bool, SW_SHOWNORMAL, SW_HIDE)
    End With
    If (ShellExecuteEx(sei_struct) <> 0) Then
        If (wait_bool) Then
            ' process launched, wait until it terminates
            While (WaitForSingleObject(sei_struct.hProcess, 100) = WAIT_TIMEOUT)
                DoEvents
            Wend
        End If
        Spawn = ""
    Else
        Spawn = ShellExecErrorDescription(sei_struct.hInstApp)
    End If
End Function





Private Function ShellExecErrorDescription(ByVal Status As Long) As String
    Const SE_ERR_FNF = 2&
    Const SE_ERR_PNF = 3&
    Const SE_ERR_ACCESSDENIED = 5&
    Const SE_ERR_OOM = 8&
    Const SE_ERR_DLLNOTFOUND = 32&
    Const SE_ERR_SHARE = 26&
    Const SE_ERR_ASSOCINCOMPLETE = 27&
    Const SE_ERR_DDETIMEOUT = 28&
    Const SE_ERR_DDEFAIL = 29&
    Const SE_ERR_DDEBUSY = 30&
    Const SE_ERR_NOASSOC = 31&
    Const ERROR_BAD_FORMAT = 11&
    Dim retval_str As String
    
    If (Status <= 32) Then
        Select Case Status
            Case SE_ERR_FNF
                retval_str = "Fichier non trouv