Attribute VB_Name = "WindowsAPI"
Option Explicit

'<Constant>---------------------------------------------
'---- no selection of a ListBox, or ComboBox

Public Const lbNoSelection          As Integer = -1

'---- API constants
Public Const SW_SHOW                As Long = 5
Public Const CB_ERR                 As Integer = (-1)
Public Const CB_FINDSTRING         As Long = &H14C
Public Const WM_USER = &H400
Public Const CB_SHOWDROPDOWN = WM_USER + 15
Public Const CB_GETDROPPEDSTATE = (WM_USER + 23)
Global Const SWP_NOMOVE = 2
Global Const SWP_NOSIZE = 1
Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2

'---- drawing
Public Const WM_SETREDRAW           As Long = &HB
Public Const REDRAWOFF              As Long = 0
Public Const REDRAWON               As Long = 1

Public Const RDW_UPDATENOW = &H100

'---- network
Public Const DRIVE_CDROM            As Long = 5
Public Const DRIVE_FIXED            As Long = 3
Public Const DRIVE_RAMDISK          As Long = 6
Public Const DRIVE_REMOTE           As Long = 4
Public Const DRIVE_REMOVABLE        As Long = 2
Public Const DRIVE_UNIDENTIFIED     As Long = -1

Public Const ERROR_SUCCESS          As Long = 0&
Public Const RESOURCETYPE_DISK      As Long = &H1

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const SYNCHRONIZE = &H100000

Enum TopStatus
  AlwaysOnTop = True
  Default = False
End Enum



'</Constant>--------------------------------------------

'<Type>-------------------------------------------------
Type RECT
    rLeft   As Long
    rTop    As Long
    rRight  As Long
    rBottom As Long
End Type

Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * 260
End Type

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

'</Type>------------------------------------------------

'<Public>-----------------------------------------------
Public ReturnCode              As Long
'</Public>----------------------------------------------

'<Declaration>------------------------------------------
'---- Win APIs



 
' zunächst die benötigten API-Deklarationen
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
  
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Declare Function GetActiveWindow Lib "user32" () As Integer
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex As Long)
Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function OSGetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function VerInstallFile Lib "version.dll" Alias "VerInstallFileA" (ByVal FLAGS&, ByVal SrcName$, ByVal DestName$, ByVal SrcDir$, ByVal DestDir$, ByVal CurrDir As Any, ByVal TmpName$, lpTmpFileLen&) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal sDrive As String) As Long
Public Declare Function WNetGetUser Lib "mpr" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpusername As String, lpnLength As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As Long) As Long
Public Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function ShellExecuteEx Lib "shell32.dll" Alias "ShellExecuteExA" (lpExecInfo As SHELLEXECUTEINFO) As Long


Public Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal _
    lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    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
    
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Public Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long

'</Declaration>-----------------------------------------
Private Declare Function GetModuleFileName Lib "kernel32" Alias _
        "GetModuleFileNameA" (ByVal hModule As Long, _
        ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const MAX_PATH = 260



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
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
End Type


' SHELLEXECUTEINFO fMask-Konstanten
Private Const SEE_MASK_CLASSKEY = &H3 ' Struktur wird mit dem Handle des Registry-
' Schlüssels für die Klasse gefüllt
Private Const SEE_MASK_CLASSNAME = &H1 ' Struktur wird mit dem Klassennamen oder GUID
' gefüllt der die Datei beschreibt
Private Const SEE_MASK_CONNECTNETDRV = &H80 ' Struktur verbindet den PC mit einem
' Netzlaufwerk falls nötig, lpFile muss der UNC-Pfadname im Netzwerk sein
Private Const SEE_MASK_DOENVSUBST = &H200 ' Struktur wird mit Umgebungsvariablen des
' Programms gefüllt, diese werden in lpDirectory oder lpFile gepackt
Private Const SEE_MASK_FLAG_DDEWAIT = &H100 ' die Funktion wartet, dass die DDE ihre
' Vorgänge abgeschlossen hat und kehrt dann erst zurück
Private Const SEE_MASK_FLAG_NO_UI = &H400 ' die Funktion zeigt keine Fehler-Dialogboxen an
Private Const SEE_MASK_HOTKEY = &H20 ' dwHotkey wird gefüllt
Private Const SEE_MASK_ICON = &H10 ' hIcon wird mit dem Icon Handle des
' Standardicons der Anwendung gefüllt
Private Const SEE_MASK_IDLIST = &H4 ' benutzt die lpIDLIST-Option, um das Programm zu
' starten, das in ihr beschrieben ist
Private Const SEE_MASK_INVOKEIDLIST = &HC ' benutzt die lpIDLIST-Option, um das
' Programm zu starten, das in ihr beschrieben ist
Private Const SEE_MASK_NOCLOSEPROCESS = &H40 ' füllt die Struktur-Option hProcess
' mit dem Process-Handle der gestarteten Anwendung

' SHELLEXECUTEINFO nShow-Konstanten
Private Const SW_HIDE = 0 ' versteckt das Fenster
Private Const SW_MAXIMIZE = 3 ' maximiert das Fenster
Private Const SW_MINIMIZE = 6 ' minimiert das Fenster
Private Const SW_RESTORE = 9 ' stellt das Fenster wieder her

Private Const SW_SHOWMAXIMIZED = 3 ' zeigt das Fenster maximiert an
Private Const SW_SHOWMINIMIZED = 2 ' zeigt das Fenster minimiert an
Private Const SW_SHOWMINNOACTIVE = 7 ' zeigt das Fenster minimiert an aber aktiviert
' es nicht
Private Const SW_SHOWNA = 8 ' zeigt das Fenster an, aber aktiviert es nicht
Private Const SW_SHOWNOACTIVATE = 4 ' zeigt das Fenster in der besten Größe und
' Position an aber aktiviert es nicht
Private Const SW_SHOWNORMAL = 1 ' zeigt das Fenster ganz normal an

' SHELLEXECUTEINFO hInstApp Rückgabe-Konstanten
Public Const SE_ERR_ACCESSDENIED = 5 ' Zugriff verweigert
Private Const SE_ERR_ASSOCINCOMPLETE = 27 ' Dateityp ist nicht ausreichend assoziiert
Private Const SE_ERR_DDEBUSY = 30 ' DDE konnte nicht gestartet werden
Private Const SE_ERR_DDEFAIL = 29 ' DDE ist gescheitert
Private Const SE_ERR_DDETIMEOUT = 28 ' DDE-Zeitlimit wurde ereicht
Private Const SE_ERR_DLLNOTFOUND = 32 ' eine benötigte Dll wurde nicht gefunden
Private Const SE_ERR_FNF = 2 ' Datei wurde nicht gefunden
Private Const SE_ERR_NOASSOC = 31 ' Dateityp ist nicht assoziiert
Private Const SE_ERR_OOM = 8 ' nicht genügend Speicher verfügbar
Private Const SE_ERR_PNF = 3 ' Pfad wurde nicht gefunden
Private Const SE_ERR_SHARE = 26 ' Datei konnte nicht geöffnet werden da sie bereits
' verwendet wird

' SHELLEXECUTEINFO dwHotKey-Konstanten
Private Const HOTKEYF_ALT = &H4 ' benutzt ALT für den Hotkey
Private Const HOTKEYF_CONTROL = &H2 ' benutzt STRG für den Hotkey
Private Const HOTKEYF_EXT = &H8 ' benutzt den Extendend-Key für den Hotkey
Private Const HOTKEYF_SHIFT = &H1 ' benutzt Shift für den Hotkey

' WaitForSingleObject dwMillisekond-Konstante
Private Const INFINITE = &HFFFF ' unendlich warten

' WaitForSingleObject Rückgabe-Konstanten
Private Const WAIT_ABANDONED = &H80 ' der Mutex der in hHanlde angegeben ist wird
' nicht freigegeben, so lange der Eltern-Thread zerstört ist. Der Mutex ist nun
' Bestandteil des aufrufenden Threads und ist nicht mehr im signalisierenden Status
Private Const WAIT_FAILED = &HFFFFFFFF ' die Funktion ist gescheitert
Private Const WAIT_OBJECT_0 = &H0 ' das Objekt, das in hHandle spezifiziert ist,
' ist in einem signalisierendem Status
Private Const WAIT_TIMEOUT = &H102 ' das Zeitlimit für eine Änderung des
' Thread-Status ist abgelaufen


Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

'-----------------------------------------------------------
' <Purpose> finds a string in a ComboBox and highlights it
'-----------------------------------------------------------
Public Function ComboFindString(ByVal FindThis As String, ThisComboBox As ComboBox) As Integer

    '---- preliminary error checking
    If ((ThisComboBox.ListCount = 0) Or (FindThis = "")) Then
        ComboFindString = lbNoSelection
        Exit Function
    End If

    '---- null terminate the string and perform the find
    FindThis = FindThis & Chr(0)
    ReturnCode = SendMessage(ThisComboBox.hwnd, CB_FINDSTRING, -1, FindThis)

    '---- process the return code
    If (ReturnCode = CB_ERR) Then
        ComboFindString = lbNoSelection
    Else
        ComboFindString = CInt(ReturnCode)
    End If
    
End Function


Public Function CreateTheTempDxfFile(ByVal SrcFileName As String) As String
    
    'VerInstallFile under Windows 95 does not handle
    '  long filenames, so we must give it the short versions
    '  (32-bit only).
    Const VIFF_FORCEINSTALL = &H1
    Dim strShortSrcName     As String
    Dim strShortSrcDir      As String
    Dim strShortDestDir     As String
    Dim strShortDestName    As String
    
    CreateTheTempDxfFile = CreateTempFile
    GetShortPathAndFileName SrcFileName, strShortSrcDir, strShortSrcName
    GetShortPathAndFileName CreateTheTempDxfFile, strShortDestDir, strShortDestName
        
    Call VerInstallFile(VIFF_FORCEINSTALL, strShortSrcName, strShortDestName, strShortSrcDir, strShortDestDir, 0&, 0&, 0&)
    
End Function

'-----------------------------------------------------------
' FUNCTION: GetFileName
'
' Return the filename portion of a path
'
'-----------------------------------------------------------
'
Private Function GetShortPathAndFileName(ByVal SrcFileName As String, ByRef strPath As String, ByRef strFileName As String)
    Dim iSep As Integer
    
    strPath = ""
    strFileName = GetShortPathName(SrcFileName)
    iSep = InStr(strFileName, "\")
    Do Until iSep = 0
        strPath = strPath & Left(strFileName, iSep)
        strFileName = Right(strFileName, Len(strFileName) - iSep)
                
        iSep = InStr(strFileName, "\")
    Loop
    
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Name       :  CreateTempFile
' Purpose    :
' Parameters :  NA
' Return val :  NA
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function CreateTempFile() As String
    Const lLen      As Long = 255
    Dim lRet        As Long
    Dim sTmpPath    As String
    Dim sTmpFile    As String
    
    sTmpPath = Space$(lLen)
    sTmpFile = Space$(lLen)
    CreateTempFile = ""
    
    lRet = GetTempPath(lLen, sTmpPath)
    If lRet > 0 Then
        sTmpPath = Left(sTmpPath, lRet)
        lRet = GetTempFileName(sTmpPath, "~LP", 0, sTmpFile)    'return: 0-> error
        If lRet > 0 Then
            CreateTempFile = Left(sTmpFile, Len(Trim(sTmpFile)) - 1)
        End If
    End If
End Function


 '-----------------------------------------------------------
 ' FUNCTION GetShortPathName
 '
 ' Retrieve the short pathname version of a path possibly
 '   containing long subdirectory and/or file names
 '-----------------------------------------------------------
 Function GetShortPathName(ByVal strLongPath As String) As String
     Const cchBuffer = 300
     Dim strShortPath As String
     Dim lResult As Long

     On Error GoTo 0
     strShortPath = String(cchBuffer, Chr$(0))
     lResult = OSGetShortPathName(strLongPath, strShortPath, cchBuffer)
     If lResult = 0 Then
         Error 53 ' File not found
     Else
         GetShortPathName = StripTerminator(strShortPath)
     End If
 End Function
 
'-----------------------------------------------------------
' FUNCTION: StripTerminator
'
' Returns a string without any zero terminator.  Typically,
' this was a string returned by a Windows API call.
'
' IN: [strString] - String to remove terminator from
'
' Returns: The value of the string passed in minus any
'          terminating zero.
'-----------------------------------------------------------
Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Integer

    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function


Public Sub SetOnTop(frm As Form, OnTop As TopStatus)
If OnTop = AlwaysOnTop Then
    Call SetWindowPos(frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
    Call SetWindowPos(frm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End If
End Sub



Public Sub ExecuteAndWait(strFile As String, strParameters As String, Optional hwnd As Long = 0, Optional nSHow As Long = SW_SHOW, Optional blnWait As Boolean = True, Optional ByRef ProzessID As Long)
  Dim Retval As Long, ShExInfo As SHELLEXECUTEINFO

  ' Startoptionen festlegen
  With ShExInfo
    .cbSize = Len(ShExInfo)
    .fMask = SEE_MASK_NOCLOSEPROCESS ' SEE_MASK_FLAG_NO_UI Or SEE_MASK_CLASSNAME Or SEE_MASK_NOCLOSEPROCESS
    .hwnd = hwnd
    .lpVerb = "open"
    .lpFile = strFile
    .lpParameters = strParameters
    .lpDirectory = "c:\"
    .nSHow = nSHow
  End With

  ' Programm ausführen
  Retval = ShellExecuteEx(ShExInfo)
  If Retval = 0 Then

    ' bei Fehler Text ausgeben
    Select Case ShExInfo.hInstApp
    Case SE_ERR_ACCESSDENIED
      Err.Raise 5, "ShellExecuteEx", "Zugriff verweigert"
    Case SE_ERR_FNF
      Err.Raise 5, "ShellExecuteEx", "Datei nicht gefunden"
    Case SE_ERR_NOASSOC
      Err.Raise 5, "ShellExecuteEx", "Datei ist mit keinem Programm verknüpft"
    End Select
  Else

    ' andernfalls Programmdaten ausgeben
    Debug.Print "Datei gestartet: " & ShExInfo.lpFile
    Debug.Print "Dateiklasse: " & ShExInfo.lpClass
    Debug.Print "Prozess Handle: " & ShExInfo.hProcess
    Debug.Print "Instanz Handle:" & ShExInfo.hInstApp
  End If

    If blnWait Then
       ' warten, bis die Anwendung beendet wird
       Do
         DoEvents
       Loop Until WaitForSingleObject(ShExInfo.hProcess, 0) <> WAIT_TIMEOUT
    End If
    ProzessID = ShExInfo.hProcess
End Sub




Public Function WinSysDir() As String
   Dim strLen As String
   Dim sDirBuf As String * 255
   strLen = GetSystemDirectory(sDirBuf, 255)
   WinSysDir = Left$(sDirBuf, strLen)
End Function



Public Function KillProcessByName(NameProcess As String, blnJustCount As Boolean) As Integer

    Const PROCESS_ALL_ACCESS = &H1F0FFF
    Const TH32CS_SNAPPROCESS As Long = 2&
    
    Dim uProcess  As PROCESSENTRY32
    Dim RProcessFound As Long
    Dim hSnapshot As Long
    Dim SzExename As String
    Dim ExitCode As Long
    Dim MyProcess As Long
    Dim AppKill As Boolean
    Dim AppCount As Integer
    Dim i As Integer
    Dim WinDirEnv As String
        

    AppCount = 0

    uProcess.dwSize = Len(uProcess)
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    RProcessFound = ProcessFirst(hSnapshot, uProcess)
    
      Do
        
        i = InStr(1, uProcess.szexeFile, Chr(0))
        SzExename = LCase$(Left$(uProcess.szexeFile, i - 1))
        WinDirEnv = Environ("Windir") + "\"
        WinDirEnv = LCase$(WinDirEnv)
    
        Debug.Print uProcess.th32ProcessID & "=" & SzExename
        
        If Right$(LCase(SzExename), Len(NameProcess)) = LCase$(NameProcess) Then
           AppCount = AppCount + 1
           If blnJustCount = False Then
                MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
                AppKill = TerminateProcess(MyProcess, ExitCode)
                Call CloseHandle(MyProcess)
            End If
        End If
        
        RProcessFound = ProcessNext(hSnapshot, uProcess)
   
       KillProcessByName = AppCount

      Loop While RProcessFound
      Call CloseHandle(hSnapshot)

End Function


Public Function IsInIDE() As Boolean
  Dim strPath As String
  Dim lRet    As Long
   
  IsInIDE = False
  strPath = Space$(MAX_PATH)
  lRet = GetModuleFileName(App.hInstance, strPath, Len(strPath))
  If lRet <> 0 Then
    If LCase$(Mid$(strPath, lRet - 6, 7)) = "vb6.exe" Then
      IsInIDE = True
    End If
  End If
End Function

Public Sub SetWindowTopMost(hwnd As Long)
    'Set the window position to topmost
    SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End Sub


Public Function WaitShell(Cmdline As String, Optional Mode As Long = vbNormalFocus, _
  Optional Timeout As Long = INFINITE, Optional Terminate As Boolean = True)
 
Dim pid As Long, pHnd As Long, ret As Long, Merk As Date
Dim uProc As PROCESS_INFORMATION
Dim uStart As STARTUPINFO
 
  ' Initialize data
  uStart.cb = Len(uStart)
  uStart.wShowWindow = Mode
  uStart.dwFlags = 1
 
' Start the shelled application:
  pid = CreateProcess(0&, Cmdline, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, uStart, uProc)
  g_ProcessId = uProc.hProcess
  
'  If pid <> 0 Then
''   Wait for the shelled application to finish:
'    Merk = Now + Timeout / 86400 ' seconds
'    Do While True
'      Ret = WaitForSingleObject(uProc.hProcess, 0)
'    If Ret <> WAIT_TIMEOUT Then Exit Do
'    If Timeout <> INFINITE And Merk < Now Then Exit Do
'      DoEvents
'    Loop
'    If Ret = 0 Then
'      WaitShell = True
'    Else
'      If Terminate Then Ret = TerminateProcess(uProc.hProcess, 0&)
'      WaitShell = Ret
'    End If
'    Ret = CloseHandle(pHnd)
'  Else
'    WaitShell = Ret
'  End If
 
End Function



' Screenshot erstellen und ggf. als Bitmap speichern
Public Sub DoSnapshot(Optional ByVal bActiveWindow As Boolean = False, _
  Optional ByVal sFile As String = "")
 
   On Error Resume Next
  ' Der Parameter bActiveWindow legt fest, ob ein Screenshot
  ' für das aktuelle Fenster (True) oder für gesamten
  ' Windows-Desktop (False)erstellt werden soll
 
  ' Wird für "sFile" ein Dateiname angegeben wird der
  ' Screenshot sofort als Bitmap gespeichert
 
  Const KEYEVENTF_KEYUP = &H2
  Const VK_MENU = &H12
  Const VK_SNAPSHOT = &H2C
 
  ' Screenshot erstellen ...
  If bActiveWindow Then keybd_event VK_MENU, 0, 0, 0  ' ALT-Taste
  keybd_event VK_SNAPSHOT, 0, 0, 0                    ' Druck-Taste
  keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
  If bActiveWindow Then keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
  DoEvents
 
  ' ... und als Bild speichern
  If sFile <> "" Then
    SavePicture Clipboard.getData, sFile
  End If
End Sub