📄 enumstuff.pas
字号:
unit EnumStuff;
// Delphi 4,5 enumeration implementation of several win32 APIs
// Dragon PC
interface
uses windows;
type TACardinal = array [0..maxInt shr 2-1] of cardinal;
TPACardinal = ^TACardinal;
TDACardinal = array of cardinal;
type TOperatingSystem = (osUnknown, osWin311, osWin95, osWin95osr2, osWin98, osWinNT3, osWinNT4, osWinNT4SP4, osWinNT5);
function GetOperatingSystem : TOperatingSystem;
// Tests which system is running...
type TExeType = (etUnknown, etDos, etWin16, etConsole, etWin32);
function GetExeType(exefile: string) : TExeType;
// Determines the type of the executable.
type TWindowList = array of record
pid : cardinal;
tid : cardinal;
window : cardinal;
parent : cardinal;
owner : cardinal;
visible : boolean;
enabled : boolean;
inTaskbar : boolean;
rect : TRect;
title : string;
className : string;
end;
TThreadList = array of record
pid : cardinal;
tid : cardinal;
windows : TWindowList;
end;
TProcessList = array of record
pid : cardinal;
name : string;
exeType : TExeType;
threads : TThreadList;
end;
TDesktopList = array of record
name : string;
windows : TWindowList;
end;
TWindowStationList = array of record
name : string;
desktops : TDesktopList;
end;
TCachedPasswordList = array of record
resource : string;
password : string;
resType : byte;
end;
function GetProcessList (threadsToo: boolean = false; windowsToo: boolean = false) : TProcessList;
// Lists the currently running processes.
function GetThreadList (pid: cardinal = 0; windowsToo: boolean = false) : TThreadList;
// Lists the currently running threads of the process "pid" or of all processes.
function GetWindowList (pid: cardinal = 0; tid: cardinal = 0; onlyThoseInTaskbar: boolean = false) : TWindowList;
// Lists the currently existing top level windows of the process "pid" or of all
// processes and of the thread "tid" or of all threads.
function GetChildWindowList (window: cardinal) : TWindowList;
// Lists the the child windows of "window".
function GetWindowStationList (desktopsToo: boolean = false; windowsToo: boolean = false) : TWindowStationList;
// Lists the currently existing window stations. (works only under winNT)
function GetDesktopList (ws: cardinal = 0; windowsToo: boolean = false) : TDesktopList;
// Lists the currently existing desktops. (works only under winNT)
function GetDesktopWindowList (dt: cardinal = 0) : TWindowList;
// Lists the currently existing windows of the current desktop. (works only under winNT)
function GetCachedPasswords : TCachedPasswordList;
// Lists all cached passwords of the currently logged in user. (works only under win95/98)
implementation
uses ShellAPI, sysUtils;
type TPThreadList = ^TThreadList;
TPProcessList = ^TProcessList;
var OS : TOperatingSystem;
OSReady : boolean = false;
function GetOperatingSystem : TOperatingSystem;
var os1 : TOSVersionInfo;
begin
if not OSReady then begin
OSReady:=true;
os1.dwOSVersionInfoSize:=sizeOf(os1); GetVersionEx(os1);
case os1.dwPlatformID of
VER_PLATFORM_WIN32s : OS:=osWin311;
VER_PLATFORM_WIN32_WINDOWS : if (os1.dwMajorVersion=4) and (os1.dwMinorVersion=0) then begin
if os1.dwBuildNumber>1000 then OS:=osWin95osr2 else OS:=osWin95;
end else if (os1.dwMajorVersion=4) and (os1.dwMinorVersion=10) then
OS:=osWin98
else OS:=osUnknown;
VER_PLATFORM_WIN32_NT : case os1.dwMajorVersion of
0..3 : OS:=osWinNT3;
4 : if string(os1.szCSDVersion)='Service Pack 4' then OS:=osWinNT4SP4
else OS:=osWinNT4;
5 : OS:=osWinNT5;
end;
else OS:=osUnknown;
end;
end;
result:=OS;
end;
const MAX_MODULE_NAME32 = 255;
type
TProcessEntry32 = record
dwSize : DWORD;
cntUsage : DWORD;
th32ProcessID : DWORD; // this process
th32DefaultHeapID : DWORD;
th32ModuleID : DWORD; // associated exe
cntThreads : DWORD;
th32ParentProcessID : DWORD; // this process's parent process
pcPriClassBase : integer; // Base priority of process's threads
dwFlags : DWORD;
szExeFile : array [0..MAX_PATH-1] of char; // Path
end;
TThreadEntry32 = record
dwSize : DWORD;
cntUsage : DWORD;
th32ThreadID : DWORD; // this thread
th32OwnerProcessID : DWORD; // Process this thread is associated with
tpBasePri : integer;
tpDeltaPri : integer;
dwFlags : DWORD;
end;
TModuleEntry32 = record
dwSize : DWORD;
th32ModuleID : DWORD; // This module
th32ProcessID : DWORD; // owning process
GlblcntUsage : DWORD; // Global usage count on the module
ProccntUsage : DWORD; // Module usage count in th32ProcessID's context
modBaseAddr : pointer; // Base address of module in th32ProcessID's context
modBaseSize : DWORD; // Size in bytes of module starting at modBaseAddr
hModule : HMODULE; // The hModule of this module in th32ProcessID's context
szModule : array [0..MAX_MODULE_NAME32] of char;
szExePath : array [0..MAX_PATH-1] of char;
end;
const TH32CS_SnapProcess = 2;
TH32CS_SnapThread = 4;
TH32CS_SnapModule = 8;
var //PsApiHandle : cardinal = 0;
CreateToolhelp32Snapshot :
function (dwFlags,th32ProcessID: cardinal) : cardinal; stdcall
= nil;
Process32First :
function (hSnapshot: cardinal; var lppe: TProcessEntry32) : bool; stdcall
= nil;
Process32Next :
function (hSnapshot: cardinal; var lppe: TProcessEntry32) : bool; stdcall
= nil;
Thread32First :
function (hSnapshot: cardinal; var lpte: TThreadEntry32) : bool; stdcall
= nil;
Thread32Next :
function (hSnapshot: cardinal; var lpte: TThreadEntry32) : bool; stdcall
= nil;
Module32First :
function (hSnapshot: cardinal; var lpme: TModuleEntry32) : bool; stdcall
= nil;
Module32Next :
function (hSnapshot: cardinal; var lpme: TModuleEntry32) : bool; stdcall
= nil;
EnumProcesses :
function (idProcess: TPACardinal; cb: cardinal; var cbNeeded: cardinal) : bool; stdcall
= nil;
EnumProcessModules :
function (hProcess: cardinal; var hModule: cardinal; cb: cardinal; var cbNeeded: cardinal) : bool; stdcall
= nil;
GetModuleFileNameEx :
function (hProcess,hModule: cardinal; fileName: PChar; nSize: cardinal) : cardinal; stdcall
= nil;
function TestToolhelpFunctions : boolean;
var c1 : cardinal;
begin
c1:=GetModuleHandle('kernel32');
@CreateToolhelp32Snapshot:=GetProcAddress(c1,'CreateToolhelp32Snapshot');
@Process32First :=GetProcAddress(c1,'Process32First' );
@Process32Next :=GetProcAddress(c1,'Process32Next' );
@Thread32First :=GetProcAddress(c1,'Thread32First' );
@Thread32Next :=GetProcAddress(c1,'Thread32Next' );
@Module32First :=GetProcAddress(c1,'Module32First' );
@Module32Next :=GetProcAddress(c1,'Module32Next' );
result:=(@CreateToolhelp32Snapshot<>nil) and
(@Process32First<>nil) and (@Process32Next<>nil) and
(@Thread32First<>nil) and (@Thread32Next<>nil) and
(@Module32First<>nil) and (@Module32Next<>nil);
end;
{function TestPsApi : boolean;
begin
if PsApiHandle=0 then begin
PsApiHandle:=LoadLibrary('psapi');
result:=PsApiHandle<>0;
if result then begin
@EnumProcesses :=GetProcAddress(PsApiHandle,'EnumProcesses' );
@EnumProcessModules :=GetProcAddress(PsApiHandle,'EnumProcessModules' );
@GetModuleFileNameEx:=GetProcAddress(PsApiHandle,'GetModuleFileNameExA');
result:=(@EnumProcesses<>nil) and (@EnumProcessModules<>nil) and (@GetModuleFileNameEx<>nil);
end;
end else result:=true;
end;}
function GetExeType(exefile: string) : TExeType;
var c1 : cardinal;
sfi : TSHFileInfo;
s1 : string;
begin
c1:=SHGetFileInfo(pchar(exefile),0,sfi,SizeOf(sfi),SHGFI_EXETYPE);
s1:=chr(c1 and $ff)+chr((c1 and $ff00) shr 8);
if s1='MZ' then result:=etDos
else if s1='NE' then result:=etWin16
else if (s1='PE') and (hiWord(c1)=0) then result:=etConsole
else if (s1='PE') and (hiWord(c1)>0) then result:=etWin32
else if CompareText(AnsiUpperCase(ExtractFileName(exefile)),AnsiUpperCase('winoa386.mod'))=0 then result:=etDos
else result:=etUnknown;
end;
function NT4_EnumProcessesAndThreads(pl: TPProcessList; tl: TPThreadList; windowsToo: boolean) : boolean;
type TPerfDataBlock = packed record
signature : array [0..3] of wchar;
littleEndian : cardinal;
version : cardinal;
revision : cardinal;
totalByteLength : cardinal;
headerLength : cardinal;
numObjectTypes : cardinal;
defaultObject : cardinal;
systemTime : TSystemTime;
perfTime : comp;
perfFreq : comp;
perfTime100nSec : comp;
systemNameLength : cardinal;
systemnameOffset : cardinal;
end;
TPPerfDataBlock = ^TPerfDataBlock;
TPerfObjectType = packed record
totalByteLength : cardinal;
definitionLength : cardinal;
headerLength : cardinal;
objectNameTitleIndex : cardinal;
objectNameTitle : PWideChar;
objectHelpTitleIndex : cardinal;
objectHelpTitle : PWideChar;
detailLevel : cardinal;
numCounters : cardinal;
defaultCounter : integer;
numInstances : integer;
codePage : cardinal;
perfTime : comp;
perfFreq : comp;
end;
TPPerfObjectType = ^TPerfObjectType;
TPerfCounterDefinition = packed record
byteLength : cardinal;
counterNameTitleIndex : cardinal;
counterNameTitle : PWideChar;
counterHelpTitleIndex : cardinal;
counterHelpTitle : PWideChar;
defaultScale : integer;
defaultLevel : cardinal;
counterType : cardinal;
counterSize : cardinal;
counterOffset : cardinal;
end;
TPPerfCounterDefinition = ^TPerfCounterDefinition;
TPerfInstanceDefinition = packed record
byteLength : cardinal;
parentObjectTitleIndex : cardinal;
parentObjectInstance : cardinal;
uniqueID : integer;
nameOffset : cardinal;
nameLength : cardinal;
end;
TPPerfInstanceDefinition = ^TPerfInstanceDefinition;
TAPChar = array [0..maxInt div 4-1] of pchar;
TPCardinal = ^cardinal;
var i1,i2,i3,i4 : integer;
b1,b2,b3,b4 : boolean;
bt,bp : boolean;
c1 : cardinal;
pCard : TPCardinal;
perfDataBlock : TPPerfDataBlock;
perfObjectType : TPPerfObjectType;
perfCounterDef : TPPerfCounterDefinition;
perfInstanceDef : TPPerfInstanceDefinition;
begin
result:=false;
bt:=tl=nil; if not bt then tl^:=nil; bp:=pl=nil; if not bp then pl^:=nil;
if bt and bp then exit;
perfDataBlock:=nil;
try
i1:=$10000;
repeat
ReallocMem(perfDataBlock,i1); i2:=i1;
i4:=RegQueryValueEx(HKEY_PERFORMANCE_DATA,'230 232',nil,@i3,pointer(perfDataBlock),@i2);
if i4=ERROR_MORE_DATA then i1:=i1*2;
until (i4<>ERROR_MORE_DATA);
if i4<>ERROR_SUCCESS then exit;
perfObjectType:=pointer(cardinal(perfDataBlock)+perfDataBlock^.headerLength);
for i1:=0 to integer(perfDataBlock^.numObjectTypes)-1 do begin
b1:= (pl<>nil) and (perfObjectType^.objectNameTitleIndex=230); // 230 -> "Process"
b2:=(not b1) and (tl<>nil) and (perfObjectType^.objectNameTitleIndex=232); // 232 -> "Thread"
if b1 or b2 then begin
perfCounterDef:=pointer(cardinal(perfObjectType)+perfObjectType^.headerLength);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -