۰۲-اسفند-۱۳۸۷, ۰۹:۵۲:۵۷
این کد ماژولهای هر پروسه ای رو همراه با ورژن اون نشون می ده :
کد:
#Compile Exe
#Dim All
#Register None
#Include "Win32Api.Inc"
Global hDlg As Long, hFont As Dword
%TH32CS_SNAPPROCESS = &H2& ' dwFlags for
%TH32CS_SNAPMODULE = &H8& ' CreateToolhelp32Snapshot
%MAX_MODULE_NAME32 = 255
Type PROCESSENTRY32
dwSize As Dword
cntUsage As Dword
th32ProcessID As Dword ' This process
th32DefaultHeapID As Long Ptr
th32ModuleID As Dword ' Associated exe
cntThreads As Dword
th32ParentProcessID As Dword ' This process's parent process
pcPriClassBase As Long ' Base priority of process threads
dwFlags As Dword
szExeFile As Asciiz * %MAX_PATH ' Path
End Type
Type MODULEENTRY32
dwSize As Dword
th32ModuleID As Dword ' This module
th32ProcessID As Dword ' Owning process
GlblcntUsage As Dword ' Global usage count on the module
ProccntUsage As Dword ' Module usage count in th32ProcessID's context
modBaseAddr As Byte Ptr ' Base address of module in th32ProcessID's context
modBaseSize As Dword ' Size in bytes of module starting at modBaseAddr
hModule As Dword ' The hModule of this module in th32ProcessID's context
szModule As Asciiz * (%MAX_MODULE_NAME32 + 1)
szExePath As Asciiz * %MAX_PATH
End Type
Declare Function CreateToolhelp32Snapshot (ByVal dwFlags As Dword, ByVal th32ProcessID As Dword) As Long
Declare Function Process32First (ByVal hSnapshot As Dword, pe As PROCESSENTRY32) As Long
Declare Function Process32Next (ByVal hSnapshot As Dword, pe As PROCESSENTRY32) As Long
Declare Function Module32First (ByVal hSnapshot As Dword, Me As MODULEENTRY32) As Long
Declare Function Module32Next (ByVal hSnapshot As Dword, Me As MODULEENTRY32) As Long
Declare Function EnumProcesses (idProcess As Dword, ByVal cb As Dword, cbNeeded As Dword) As Long
Declare Function GetModuleFileNameEx (ByVal hProcess As Dword, ByVal hModule As Dword, ModuleName As Asciiz, ByVal nSize As Dword) As Dword
Declare Function EnumProcessModules (ByVal hProcess As Dword, hModule As Dword, ByVal cb As Dword, cbNeeded As Dword) As Long
Declare Function GetVersionStringInfo (ByVal Fname As String) As String
Declare Function MakeFontEx(ByVal FontName As String, ByVal PointSize As Long, ByVal fBold As Long, _
ByVal fItalic As Long, ByVal fUnderline As Long) As Long
%ID_LISTBOX = 1001
Sub EnumModules
Dim hKernel32 As Local Dword
Dim hCreateToolhelp32Snapshot As Local Dword
Dim hProcess32Next As Local Dword
Dim hProcess32First As Local Dword
Dim hModule32First As Local Dword
Dim hModule32Next As Local Dword
Dim hPsApiDll As Local Dword
Dim hEnumProcesses As Local Dword
Dim hGetModuleFileNameEx As Local Dword
Dim hEnumProcessModules As Local Dword
Dim os As Local OSVERSIONINFO
Dim pe As Local PROCESSENTRY32
Dim mee As Local MODULEENTRY32
Dim hProcessSnap As Local Dword
Dim hModuleSnap As Local Dword
Dim nModules As Local Dword
Dim nProcesses As Local Dword
Dim hProcess As Local Dword
Dim lResult1 As Local Long
Dim lResult2 As Local Long
Dim cb As Local Dword
Dim cbNeeded As Local Dword
Dim i As Local Dword
Dim j As Local Dword
os.dwOSVersionInfoSize = SizeOf(os)
GetVersionEx ByVal VarPtr(os)
ListBox Reset hDlg, %ID_LISTBOX
If IsFalse(os.dwPlatformId = %VER_PLATFORM_WIN32_NT) Then ' Windows 95/98
hKernel32 = GetModuleHandle("kernel32.dll")
hCreateToolhelp32Snapshot = GetProcAddress(hKernel32, "CreateToolhelp32Snapshot")
hProcess32Next = GetProcAddress(hKernel32, "Process32Next")
hProcess32First = GetProcAddress(hKernel32, "Process32First")
hModule32First = GetProcAddress(hKernel32, "Module32First")
hModule32Next = GetProcAddress(hKernel32, "Module32Next")
Call Dword hCreateToolhelp32Snapshot Using CreateToolhelp32Snapshot (%TH32CS_SNAPPROCESS, 0&) To hProcessSnap
If hProcessSnap <> %INVALID_HANDLE_VALUE Then
pe.dwSize = SizeOf(pe)
Call Dword hProcess32First Using Process32First (hProcessSnap, pe) To lResult1
While lResult1
ListBox Add hDlg, %ID_LISTBOX, pe.szExeFile
Call Dword hCreateToolhelp32Snapshot Using CreateToolhelp32Snapshot(%TH32CS_SNAPMODULE, pe.th32ProcessID) To hModuleSnap
If hModuleSnap <> %INVALID_HANDLE_VALUE Then
mee.dwSize = SizeOf(MODULEENTRY32)
Call Dword hModule32First Using Module32First (hModuleSnap, mee) To lResult2
While lResult2
If pe.th32ModuleID <> mee.th32ModuleID Then _
ListBox Add hDlg, %ID_LISTBOX, " " + _
LSet$(GetVersionStringInfo(mee.szExePath),16) + mee.szExePath
Call Dword hModule32Next Using Module32Next (hModuleSnap, mee) To lResult2
Wend
CloseHandle hModuleSnap
ListBox Add hDlg, %ID_LISTBOX, "--------------------------------"
End If
Call Dword hProcess32Next Using Process32Next (hProcessSnap, pe) To Lresult1
Wend
CloseHandle hProcessSnap
End If
Else ' Windows NT
hPsApiDll = GetModuleHandle("psApi.dll"): If hPsApiDll = 0 Then hPsApiDll = LoadLibrary("psApi.dll")
hEnumProcesses = GetProcAddress(hPsApiDll, "EnumProcesses")
hGetModuleFileNameEx = GetProcAddress(hPsApiDll, "GetModuleFileNameExA")
hEnumProcessModules = GetProcAddress(hPsApiDll, "EnumProcessModules")
cb = 100
Do
ReDim ProcessIDs(1 To cb \ 4) As Dword
Call Dword hEnumProcesses Using EnumProcesses (ProcessIDs(1), cb, cbNeeded) To lResult1
If cb > cbNeeded Then Exit Do
cb = cb + cb
Loop
nProcesses = cbNeeded \ 4
For i = 1 To nProcesses
hProcess = OpenProcess(%PROCESS_QUERY_INFORMATION Or %PROCESS_VM_READ, %False, ProcessIDs(i))
If hProcess Then
cb = 100
Do
ReDim Modules(1 To cb / 4) As Dword
Call Dword hEnumProcessModules Using EnumProcessModules (hProcess, Modules(1), cb, cbNeeded) To lResult1
If lResult1 = 0 Then cbNeeded = 0: Exit Do
If cb > cbNeeded Then Exit Do Else cb = cb * 2
Loop
nModules = cbNeeded / 4
For j = 1 To nModules
Call Dword hGetModuleFileNameEx Using GetModuleFileNameEx (hProcess, Modules(j), pe.szExeFile, SizeOf(pe.szExeFile)) To lResult1
If lResult1 Then If j = 1 Then ListBox Add hDlg, %ID_LISTBOX, pe.szExeFile Else _
ListBox Add hDlg, %ID_LISTBOX, " " + _
LSet$(GetVersionStringInfo(pe.szExeFile),16)+ _
pe.szExeFile
Next
CloseHandle hProcess
ListBox Add hDlg, %ID_LISTBOX, "--------------------------------"
End If
Next
End If
End Sub
CallBack Function DlgProc
Select Case CbMsg
Case %wm_initdialog
Control Add ListBox, CbHndl, %ID_LISTBOX, , 0, 0, 0, 0, %ws_child Or %ws_vscroll, %ws_ex_clientedge
hFont = MakeFontEx("System", 10,%FW_LIGHT, 0, 0) 'create desired font
Control Send CbHndl, %ID_LISTBOX, %WM_SETFONT, hFont, 0 'tell control to use it
EnumModules
Case %wm_size
Dim rc As RECT
GetClientRect CbHndl, rc
SetWindowPos GetDlgItem(CbHndl, %ID_LISTBOX), 0, _
0.03 * rc.nRight, 0.02 * rc.nBottom, 0.94 * rc.nRight, _
0.96 * rc.nBottom, %SWP_NOACTIVATE Or %SWP_NOZORDER
End Select
End Function
Function PBMain
Dialog New 0, "Processes and modules with version info", , , 400, 200, %ws_sysmenu Or %ws_caption Or %ws_thickframe Or %ds_modalframe To hDlg
Dialog Show Modal hDlg Call DlgProc
DeleteObject hFont
End Function
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Retrieve a system file's version number.. Borrowed from Borje Hagsten
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
Function GetVersionStringInfo(ByVal Fname As String) As String
Local lRes As Long, lZero As Long, sBuf As String, tWFD As WIN32_FIND_DATA
Local zFile As Asciiz * %MAX_PATH, pFI As VS_FIXEDFILEINFO Ptr
zFile = zFile + Fname
lRes = FindFirstFile(zFile, tWFD) 'see if it exists
If lRes = %INVALID_HANDLE_VALUE Then Exit Function
FindClose lRes
lRes = GetFileVersionInfoSize(zFile, lZero) 'can we get any info?
If lRes = 0 Then Exit Function
sBuf = Space$(lRes) 'allocate space
GetFileVersionInfo zFile, lRes, lRes, ByVal StrPtr(sBuf) 'get version info
VerQueryValue ByVal StrPtr(sBuf), "\", pFI, lRes 'get VS_FIXEDFILEINFO info
'build answer
sBuf = Format$(HiWrd(@pFI.dwFileVersionMS), "0") & "." & _ 'Major part
Format$(LoWrd(@pFI.dwFileVersionMS), "00")& "." 'Minor part
If @pFI.dwFileVersionLS Then 'rem out to get version only..
sBuf = sBuf & Format$(HiWrd(@pFI.dwFileVersionLS), "00") & "." & _ 'Major part
Format$(LoWrd(@pFI.dwFileVersionLS), "0") 'Minor part
End If
Function = sBuf
End Function
'==========================================================================
' Routine to Change Font Original code by Dave Navarro & Borje Hagsten
'==========================================================================
Function MakeFontEx(ByVal FontName As String, ByVal PointSize As Long, ByVal fBold As Long, _
ByVal fItalic As Long, ByVal fUnderline As Long) As Long
Local hDC As Dword, CyPixels As Long
hDC = GetDC(%HWND_DESKTOP)
CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
ReleaseDC %HWND_DESKTOP, hDC
PointSize = 0 - (PointSize * CyPixels) \ 72
Function = CreateFont( _
PointSize, 0, _ 'height, width(default=0)
0, 0, _ 'escapement(angle), orientation
fBold, _ 'weight (%FW_DONTCARE = 0, %FW_NORMAL = 400, %FW_BOLD = 700)
fItalic, _ 'Italic
fUnderline, _ 'Underline
%FALSE, _ 'StrikeThru - who needs it?
%ANSI_CHARSET, %OUT_TT_PRECIS, _
%CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _
%FF_MODERN+%FIXED_PITCH , ByCopy FontName)
End Function