HOME > エクセルVBA > サンプル > Process32First

Process32First


【ファイル名】Process32First.xlsm
【バージョン】Ver 1.0.0.1
【作成日】2021年05月05日
【更新日】2021年05月26日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】Process32First.zip
【説明】Windows APIのProcess32Firstを使用したプロセスの一覧のサンプルです。

【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > CreateToolhelp32Snapshot
【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > Process32FirstW
【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > Process32NextW
【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > PROCESSENTRY32W
【外部リンク】Windows > Apps > Win32 > API > Handleapi.h > CloseHandle

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="プロセスの一覧">
          <button id="ShowFormButton" label="フォームを表示(&amp;S)" supertip="フォームを表示します。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

UserForm1
Option Explicit

Private Const MAX_PATH = 260 ' パスの最大文字数(ユニコードは文字数の2倍のバイト数が必要)

' CreateToolhelp32Snapshot dwFlags
Private Const TH32CS_SNAPHEAPLIST = &H1 ' ヒープ
Private Const TH32CS_SNAPPROCESS = &H2  ' プロセス
Private Const TH32CS_SNAPTHREAD = &H4   ' スレッド
Private Const TH32CS_SNAPMODULE = &H8   ' モジュール
Private Const TH32CS_SNAPALL = TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE
Private Const TH32CS_SNAPMODULE32 = &H10  ' Includes all 32-bit modules of the process specified in th32ProcessID in the snapshot when called from a 64-bit process.
Private Const TH32CS_INHERIT = &H80000000 ' ハンドルが継承可能

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/win32/api/tlhelp32/nf-tlhelp32-createtoolhelp32snapshot
  Private Declare PtrSafe Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As LongPtr
  
  ' https://docs.microsoft.com/ja-jp/windows/win32/api/tlhelp32/nf-tlhelp32-process32firstw
  Private Declare PtrSafe Function Process32First Lib "kernel32.dll" Alias "Process32FirstW" (ByVal hSnapshot As LongPtr, ByRef lppe As PROCESSENTRY32) As Long
  
  ' https://docs.microsoft.com/ja-jp/windows/win32/api/tlhelp32/nf-tlhelp32-process32nextw
  Private Declare PtrSafe Function Process32Next Lib "kernel32.dll" Alias "Process32NextW" (ByVal hSnapshot As LongPtr, ByRef lppe As PROCESSENTRY32) As Long
  
  ' https://docs.microsoft.com/en-us/windows/win32/api/handleapi/nf-handleapi-closehandle
  Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long
      
  ' https://docs.microsoft.com/en-us/windows/win32/api/tlhelp32/ns-tlhelp32-processentry32w
  Private Type PROCESSENTRY32 ' tlhelp32.h
    dwSize As Long ' このユーザー定義型のバイト数
    cntUsage As Long               '
    th32ProcessID As Long          ' this process
    th32DefaultHeapID As LongPtr   '
    th32ModuleID As Long           ' associated exe
    cntThreads As Long             ' スレッド数
    th32ParentProcessID As Long    ' this process's parent process
    pcPriClassBase As Long         ' Base priority of process's threads
    dwFlags As Long ' フラグ
    szExeFile(1 To MAX_PATH * 2) As Byte ' 実行ファイル名(ユニコードなので文字数の2倍のバイト数が必要)
  End Type

#Else
  Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
  
  Private Declare Function Process32First Lib "kernel32.dll" Alias "Process32FirstW" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long
  
  Private Declare Function Process32Next Lib "kernel32.dll" Alias "Process32NextW" (ByVal hSnapshot As Long, ByRef lppe As PROCESSENTRY32) As Long
  
  Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
      
  Private Type PROCESSENTRY32 ' tlhelp32.h
    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(1 To MAX_PATH * 2) As Byte
  End Type
#End If

Private Sub PreocessButton_Click() ' プロセスの一覧の作成
  Dim i As Long
#If Win64 Then
  Dim hSnapshot As LongPtr
  Dim rc    As LongPtr
#Else
  Dim hSnapshot As Long
  Dim rc    As Long
#End If
  Dim lppe  As PROCESSENTRY32
  Dim Filename As String
  
  ListView1.ListItems.Clear
  hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
  lppe.dwSize = LenB(lppe)
  rc = Process32First(hSnapshot, lppe)
  Do While rc <> 0
    Filename = lppe.szExeFile
    Filename = Left(Filename, InStr(1, Filename, vbNullChar) - 1)
    With ListView1.ListItems.Add
      .Text = Format(lppe.th32ProcessID, "@@@@@@@@") ' 文字列で比較するため前に空白を付けます。
      .SubItems(1) = Format(lppe.cntThreads, "@@@@@@@@")
      .SubItems(2) = Format(lppe.th32ParentProcessID, "@@@@@@@@")
      .SubItems(3) = Format(lppe.pcPriClassBase, "@@@@@@@@")
      .SubItems(4) = Filename
    End With
    rc = Process32Next(hSnapshot, lppe)
  Loop
  Call CloseHandle(hSnapshot)
End Sub

Private Sub UserForm_Initialize() ' 初期処理
  With ListView1
    .ColumnHeaders.Add , , Text:="Process", Width:=40, Alignment:=lvwColumnLeft
    .ColumnHeaders.Add , , Text:="Threads", Width:=40, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="ParentProcess", Width:=70, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="PriClassBase", Width:=70, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="実行ファイル名", Width:=600, Alignment:=lvwColumnLeft
  End With
  
  PreocessButton_Click
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) ' ヘッダーをクリックでソートする(数値の比較ではなく、文字列で比較)
  With ListView1
    .SortKey = ColumnHeader.Index - 1
    .SortOrder = .SortOrder Xor lvwDescending
    .Sorted = True
  End With
End Sub

Private Sub ExitButton_Click() ' 閉じる
  Unload Me
End Sub
このページの上

Module1
Option Explicit

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  
  Select Case control.ID
    Case "ShowFormButton"
      UserForm1.Show vbModal
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  
  Exit Sub
'-------------------------------------------------------------------------------------------------------------------------
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub
このページの上