source: trunk/bin/SubOperation/enum_process64/enum_process64.abp@ 364

#include "enum_process64.idx"

#include <api_shlwapi.sbp>
#include <api_psapi.sbp>
#include <api_tlhelp32.sbp>

' ↓ ここからプログラムが実行されます


' EnumWindowsProcコールバック関数
Function FindWindowProc(hwnd As HWND, lParam As LPARAM) As BOOL
    SetPointer(lParam As VoidPtr, hwnd As VoidPtr)
    FindWindowProc = FALSE  '列挙を中断
End Function

Sub main(lpszCmdLine As LPTSTR)
    Dim temporary[MAX_PATH] As TCHAR, temp2[1024] As TCHAR

    Dim lpszBuffer As LPTSTR
    lpszBuffer=calloc(SizeOf (TCHAR))

    Dim szAppPath[MAX_PATH] As TCHAR
    GetModuleFileName(GetModuleHandle(0), szAppPath, MAX_PATH)

    Dim pdwProcessId As *DWord
    pdwProcessId=malloc(8192*SizeOf(DWord))

    'プロセスを列挙
    Dim cbNeeded As DWord
    EnumProcesses(pdwProcessId,8192*sizeof(DWORD),cbNeeded)

    Dim i As Long
    For i=0 To ELM(cbNeeded/SizeOf(DWord))

        'プロセスIDを元にハンドルを取得
        Dim hProcess = OpenProcess(PROCESS_ALL_ACCESS,0,pdwProcessId[i])
        If hProcess=0 Then Continue

        'そのプロセスにおける実行モジュールのインスタンスハンドルを取得
        Dim hModule As HINSTANCE
        Dim cbReturned As DWord
        If EnumProcessModules(hProcess, VarPtr(hModule), sizeof(HINSTANCE), cbReturned )=0 Then Continue

        '実行ファイル名を取得
        GetModuleFileNameEx(hProcess,hModule,temporary,MAX_PATH)

        Dim bWow64 As BOOL
        Dim lpszPlatform As LPSTR
        IsWow64Process(hProcess,bWow64)
        If bWow64 Then
            lpszPlatform="Win32"
        Else
            lpszPlatform="Win64"
        End If


        '------------------------------
        ' ウィンドウタイトルを取得
        '------------------------------

        'スナップショットを取得
        Dim hSnapshot As HANDLE
        hSnapshot=CreateToolhelp32Snapshot(TH32CS_SNAPALL,0)

        Dim te As THREADENTRY32
        FillMemory(VarPtr(te),SizeOf(THREADENTRY32),0)
        te.dwSize=SizeOf(THREADENTRY32)
        If Thread32First(hSnapshot,te) Then
            Do
                If te.th32OwnerProcessID=pdwProcessId[i] Then
                    Exit Do
                End If
            Loop While Thread32Next(hSnapshot,te)
        End If

        Dim hwnd = 0 As HWND
        EnumThreadWindows(te.th32ThreadID,AddressOf(FindWindowProc),VarPtr(hwnd) As LPARAM)

        While GetParent(hwnd)
            hwnd=GetParent(hwnd)
        Wend

        Dim szWndTitle[1024] As TCHAR
        szWndTitle[0]=0
        If hwnd Then GetWindowText(hwnd,szWndTitle,1024)

        CloseHandle(hSnapshot)


        CloseHandle(hProcess)


        '自分自身は無視
        If lstrcmpi(temporary,szAppPath)=0 Then
            Continue
        End If



        '--------------------
        ' バッファへ追加
        '--------------------

        wsprintf(temp2,ToTCStr(Ex"\q%s\q,%d,%s,%s\r\n"),temporary,pdwProcessId[i],lpszPlatform,szWndTitle)

        lpszBuffer=realloc(lpszBuffer,lstrlen(lpszBuffer)+lstrlen(temp2)+1)
        lstrcat(lpszBuffer,temp2)
    Next

    free(pdwProcessId)


    '-----------------------
    ' ファイルへ保存
    '-----------------------

    _splitpath(szAppPath,temporary,temp2,NULL,NULL)
    lstrcat(temporary,temp2)
    lstrcat(temporary,ToTCStr("list.dat"))

    Dim hFile = CreateFile(temporary,GENERIC_WRITE,0,ByVal 0,CREATE_ALWAYS,0,0)

    Dim dwAccBytes As DWord
    WriteFile(hFile,lpszBuffer,lstrlen(lpszBuffer),VarPtr(dwAccBytes),ByVal 0)

    CloseHandle(hFile)

    free(lpszBuffer)
End Sub

main(PathGetArgs(GetCommandLine()))