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

Module32First


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

【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > CreateToolhelp32Snapshot
【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > Module32FirstW
【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > Module32NextW
【外部リンク】Windows > Apps > Win32 > API > Tool Help Library > Tlhelp32.h > MODULEENTRY32W
【外部リンク】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倍のバイト数が必要)
Private Const MAX_MODULE_NAME32_1 = 256 ' 255+1 モジュール名の最大文字数(ユニコードは文字数の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
  ' tlhelp32.h
  ' https://docs.microsoft.com/en-us/windows/win32/api/tlhelp32/ns-tlhelp32-moduleentry32w
  Private Type MODULEENTRY32W
    dwSize As Long ' このユーザー定義型のバイト数
    th32ModuleID As Long    ' モジュールID
    th32ProcessID As Long   ' プロセスID
    GlblcntUsage As Long    ' Global usage count on the module
    ProccntUsage As Long    ' Module usage count in th32ProcessID's context
    modBaseAddr  As LongPtr ' Base address of module in th32ProcessID's context
    modBaseSize  As Long    ' Size in bytes of module starting at modBaseAddr
    hModule      As LongPtr ' The hModule of this module in th32ProcessID's context
    szModule(1 To MAX_MODULE_NAME32_1 * 2) As Byte ' モジュール名
    szExePath(1 To MAX_PATH * 2) As Byte           ' 実行ファイル名
  End Type

  ' 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/en-us/windows/win32/api/tlhelp32/nf-tlhelp32-module32nextw
  Private Declare PtrSafe Function Module32First Lib "kernel32.dll" Alias "Module32FirstW" (ByVal hSnapshot As LongPtr, ByRef lppe As MODULEENTRY32W) As Long
  
  '
  Private Declare PtrSafe Function Module32Next Lib "kernel32.dll" Alias "Module32NextW" (ByVal hSnapshot As LongPtr, ByRef lppe As MODULEENTRY32W) 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
#Else
  
  Private Type MODULEENTRY32W
    dwSize As Long
    th32ModuleID As Long
    th32ProcessID As Long
    GlblcntUsage As Long
    ProccntUsage As Long
    modBaseAddr  As Long 'BYTE*
    modBaseSize  As Long
    hModule      As Long
    szModule(1 To MAX_MODULE_NAME32_1 * 2) As Byte
    szExePath(1 To MAX_PATH * 2) As Byte
  End Type

  Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
  Private Declare Function Module32First Lib "kernel32.dll" Alias "Module32FirstW" (ByVal hSnapshot As Long, ByRef lppe As MODULEENTRY32W) As Long
  Private Declare Function Module32Next Lib "kernel32.dll" Alias "Module32NextW" (ByVal hSnapshot As Long, ByRef lppe As MODULEENTRY32W) As Long
  Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
#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 MODULEENTRY32W
  Dim FileName As String
  
  ListView1.ListItems.Clear
  hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, 0)
  lppe.dwSize = LenB(lppe)
  rc = Module32First(hSnapshot, lppe)
  Do While rc <> 0
    With ListView1.ListItems.Add
      .Text = Format(lppe.th32ModuleID, "@@@@@@@@@") ' 文字列で比較するため前に空白を付けます。
      .SubItems(1) = Format(lppe.th32ProcessID, "@@@@@@@@@")
      .SubItems(2) = Format(lppe.GlblcntUsage, "@@@@@@@@@")
      .SubItems(3) = Format(lppe.ProccntUsage, "@@@@@@@@@")
      .SubItems(4) = Format(lppe.modBaseSize, "@@@@@@@@@@")
      .SubItems(5) = Format(lppe.hModule, "@@@@@@@@@@@")
      FileName = lppe.szModule
      FileName = Left(FileName, InStr(1, FileName, vbNullChar) - 1)
      .SubItems(6) = FileName
      FileName = lppe.szExePath
      FileName = Left(FileName, InStr(1, FileName, vbNullChar) - 1)
      .SubItems(7) = FileName
    End With
    rc = Module32Next(hSnapshot, lppe)
  Loop
  Call CloseHandle(hSnapshot)
End Sub

Private Sub UserForm_Initialize() ' 初期処理
  With ListView1
    .ColumnHeaders.Add , , Text:="th32ModuleID", Width:=70, Alignment:=lvwColumnLeft
    .ColumnHeaders.Add , , Text:="th32ProcessID", Width:=70, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="GlblcntUsage", Width:=70, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="ProccntUsage", Width:=70, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="modBaseSize", Width:=70, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="hModule", Width:=70, Alignment:=lvwColumnRight
    .ColumnHeaders.Add , , Text:="szModule", Width:=150, Alignment:=lvwColumnLeft
    .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
このページの上