Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen Download
Dateidownload

IsExeRunning (VB->FB)

Uploader:MitgliedSiedlerchr
Datum/Zeit:30.01.2008 19:52:42

'Is Exe Running:
'Versuch einer Protierung nach FB von VB
'Original Code VB: http://www.vbarchiv.net/archiv/tipp_details.php?pid=572


' zunächst die benötigten API-Deklarationen
 Declare Function CreateToolhelpSnapshot Lib _
  "Kernel32" Alias "CreateToolhelp32Snapshot" ( _
  ByVal lFlgas As Long, ByVal lProcessID As Long) _
  As Long

  Function ProcessFirst Lib "Kernel32" _
     Alias "Process32First" (ByVal hSnapshot As Long, _
  uProcess As PROCESSENTRY32) As Long


 Function ProcessNext Lib "Kernel32" _
  Alias "Process32Next" (ByVal hSnapshot As Long, _
  uProcess As PROCESSENTRY32) As Long

 Declare Sub CloseHandle Lib "Kernel32" ( _
  ByVal hPass As Long)

 Const TH32CS_SNAPPROCESS As Long = 2&
 Const MAX_PATH As Long = 260

 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 * MAX_PATH
End Type

' Prüft, ob eine EXE-Datei bereits ausgeführt wird
 Function IsEXERunning(ByVal sFilename As String) As Long

  Dim lSnapshot As Long
  Dim uProcess As PROCESSENTRY32
  Dim nResult As Long

  ' "Snapshot" des aktuellen Prozess ermitteln
  lSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
  If lSnapshot <> 0 Then
    uProcess.dwSize = Len(uProcess)

    ' Ersten Prozess ermitteln
    nResult = ProcessFirst(lSnapshot, uProcess)

    Do Until nResult = 0
      ' Prozessliste durchlaufen
      If InStr(LCase$(uProcess.szexeFile), LCase$(sFilename)) > 0 Then
        ' Jepp - EXE gefunden
        IsEXERunning = True
        Exit Do
      End If

      ' nächster Prozess
      nResult = ProcessNext(lSnapshot, uProcess)
    Loop

    ' Handle schliessen
    CloseHandle lSnapshot
  End If
End Function