● 動作中のプロセスを取得する ●

Windows 95 ではフルパスが返ったのだが、Windows XP で実行したらファイル名しか返らなかった。時代を感じる。

以下の関数をちょいと改造すれば、プロセスIDからEXEファイル名を取得することもできる。タイマーなど使うことになるが、さらに工夫すれば Shell() 関数から起動したプログラムの監視もできるかもしれない。GetExitCodeProcess() を使うプロセス監視は CPU が 100% になるので使いたくないところである。おっと話がそれた。ではどうぞ。

Private Const TH32CS_SNAPPROCESS = 2&
Private Const MAX_PATH = 260

Private 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

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

'最初のプロセスエントリを取得する
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

'次のプロセスエントリを取得する
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long

'開かれているオブジェクトのハンドルをクローズする
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'---------------------------------------------------------------
' 関数名 : GetSnapShot
' 機  能 : 動作中のプロセスを取得する
' 引  数 : (in)ExeFiles() … 動作中のプロセス
' 返り値 : 動作中のプロセス数
'---------------------------------------------------------------
Public Function GetSnapShot(ByRef ExeFiles() As String) As Long

    Dim hSnapshot As Long
    Dim udtProcess As PROCESSENTRY32
    Dim FuncRet As Long
    Dim ExeFileNum As Long

    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    If hSnapshot = 0 Then Exit Function
    
    udtProcess.dwSize = Len(udtProcess)
    FuncRet = Process32First(hSnapshot, udtProcess)

    '初期化
    ExeFileNum = (-1)
    Do While FuncRet <> 0
        ExeFileNum = ExeFileNum + 1
        ReDim Preserve ExeFiles(ExeFileNum) As String
        ExeFiles(ExeFileNum) = Left$(udtProcess.szExeFile, _
                    InStr(udtProcess.szExeFile, Chr$(0)) - 1)
        FuncRet = Process32Next(hSnapshot, udtProcess)
    Loop

    Call CloseHandle(hSnapshot)

    GetSnapShot = ExeFileNum

End Function

以下はお試しロジック

Private Sub Form_Load()

    Dim FileName() As String
    Dim ProcNum As Long
    Dim i As Long

    ProcNum = GetSnapShot(FileName)
    'For i = 0 To ProcNum ←↓どっちでも良い
    For i = 0 To UBound(FileName)
        Debug.Print FileName(i)
    Next i

End Sub

戻る