以下函数列举WIN98下面进程模块时候死机，而在Win2000下面却没有问题！？？高手救命！(50分)

//查看进程的DLL文件
procedure TMainForm.ModulesView(const ProcessIDWORD);
var
Item : TListItem;
ProcHand : THandle; //进程的句柄
ModHand : array [0..$3FFF - 1] of DWORD; //模块的句柄
ModName : array [0..MAX_PATH] of char; //模块文件名
Count : DWORD;
i,MemSizes : Integer;
ModInfo : TModuleInfo; //模块的信息
begin
//查询方式打开进程
ProcHand := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID);
if ProcHand > 0 then
begin
try
ModuleLists.Clear;
EnumProcessModules(Prochand, @ModHand, sizeof(ModHand), Count);
for i := 0 to (Count div SizeOf(DWORD)) - 1 do
begin
if (GetModuleFileNameEx(ProcHand, ModHand, ModName,
SizeOf(ModName)) > 0) and GetModuleInformation(ProcHand,
ModHand, @ModInfo, SizeOf(ModInfo)) then
begin
//以下获得该进程调用的dll文件及其相关信息
with ModInfo do
begin
if string(ModName)<>ProcessLists.Selected.Caption then
begin
Item:=ModuleLists.Items.Add;
Item.Caption:=ModName;
//调用dll文件的基地址
Item.SubItems.Add(IntToHex(DWord(lpBaseOfDll),8));
//调用dll文件的入口地址
Item.SubItems.Add(IntToHex(DWord(EntryPoint),8));
//占用内存容量
MemSizes:=DWord(SizeOfImage) div 1024;
//将1234输出为1,234
Item.SubItems.Add(Format(' %8.0n KB',[MemSizes*1.0]));
end;
end;
end;
end;
finally
CloseHandle(ProcHand);
end;
end;
end;

关注

Win 98 使用 ToolHelp Api (CreateToolHelp32Snapshot) 对进程进行操作，Win NT使用
PSAPI (EnumProcesses)，当然不一样，搜索一下吧，这里有一堆一堆的源码

我是说以上代码有什么问题？

gz

你的代码用的是pspapi
9x不支持的

up.....

o!你们有改进代码吗？：）

很简单，都用ToolHelp API就行了， 98与2000都支持它
如果你要使NT4也能用，只好加PSAPI模块了
也就是说，判断一下，如果是9X，则调用ToolHelp API否则调用PSAPI
至于说代码， 两个在论坛上都找得到
因为我都贴过不止一遍了， ：）

unit FindProc;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,tlhelp32,shellApi;

type
TProcessInfo = class(TObject)
private
public
cntUsage,
ProcessID,
DefaultHeapID,
ModuleID,
cntThreads,
ParentProcessID: DWORD;
PriClassBase : LongInt;
dwFlags : DWORD;
ExePath : String;
PriString : String[12];
BinType : String[12];
hIco : HIcon;
end;

TModuleInfo = class(TObject)
private
public
ModuleID,
ProcessID,
GlblcntUsage,
ProccntUsage: DWORD;
modBaseAddr: PByte;
modBaseSize: DWORD;
hModule : HMODULE;
szExePath : string;
hIco : HIcon;
end;

TProcList = class(TComponent)
private
fProcessList,
fModuleList : TStringList;
fAbout : String;

protected
procedure FuAbout(value :String);
function GetPrioStr(prioWORD):String;
function GetBTypStr(btypWORD):String;
public
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;

procedure GetProcessInfo;
function GetP_CountUsage(idx : Integer)WORD;
function GetP_ID(idx : Integer): DWORD;
function GetP_defHeap(idx : Integer): DWORD;
function GetP_ModuleID(idx : Integer): DWORD;
function GetP_CountThreads(idx : Integer): DWORD;
function GetP_ParentPID(idx : Integer): DWORD;
function GetP_Priority(idx : Integer): LongInt;
function GetP_dwFlags(idx : Integer): DWORD;
function GetP_IconHandle(Idx : Integer): HIcon;
function GetP_PrioStr(idx : Integer): String;
function GetP_BinTyp(idx : Integer): String;
function GetP_ExePath(idx : Integer): String;

procedure GetModuleInfo(ProcID : DWORD);
function GetM_ModuleID(idx : Integer) WORD;
function GetM_ProcessID(idx : Integer) WORD;
function GetM_GlblcntUsage(idx : Integer)WORD;
function GetM_ProccntUsage(idx : Integer)WORD;
function GetM_modBaseAddr(idx : Integer) WORD;
function GetM_IconHandle(Idx : Integer) :HIcon;
function GetM_modBaseSize(idx : Integer) WORD;
function GetM_hModule(idx : Integer):HMODULE;
function GetM_szExePath(idx : Integer):string;

published
Property About : String read FAbout write FuAbout;
Property ModuleList : TStringList read fModuleList write fModuleList;
Property ProcessList: TStringList read fProcessList write fProcessList;
end;

procedure Register;

implementation


Constructor TProcList.Create(AOwner : TComponent);
Begin
inherited Create(AOwner);
fModuleList := TStringList.Create;
fModuleList.sorted := True;
fProcessList := TStringList.Create;
fProcessList.sorted := True;
End;

Destructor TProcList.Destroy;
var i:Integer;
Begin

for i := 0 to fModuleList.Count-1 do
fModuleList.Objects.Free;
fModuleList.Clear;
fModuleList.Free;

for i := 0 to fProcessList.Count-1 do
fProcessList.Objects.Free;
fProcessList.Clear;
fProcessList.Free;

inherited Destroy;
End;

procedure TProcList.GetModuleInfo(ProcID : DWORD);

procedure AddModule(me32:TMODULEENTRY32);
var
tw : Word;
ts : array[0..MAX_PATH] of char;
MObj : TModuleInfo;

begin
StrCopy(ts,me32.szExePath);
tw := 0;

MObj := TModuleInfo.Create;
MObj.hIco := ExtractIcon(hInstance,me32.szExePath,0);
if MObj.hIco=0 then
MObj.hIco := ExtractAssociatedIcon(hInstance,ts,tw);
MObj.ModuleId := me32.th32ModuleID;
MObj.ProcessID := me32.th32ProcessID;
MObj.GlblcntUsage:= me32.GlblcntUsage;
MObj.ProccntUsage:= me32.ProccntUsage;
MObj.modBaseAddr := me32.modBaseAddr;
MObj.modBaseSize := me32.modBaseSize;
Mobj.hModule := me32.hModule;
MObj.szExePath := String(me32.szExePath);
fModuleList.AddObject(String(me32.szModule), MObj);
end;

var
i:Integer;
snap : THandle;
me32 : TMODULEENTRY32;
begin
snap := 0;
for i := 0 to fModuleList.Count-1 do
fModuleList.Objects.Free;
fModuleList.Clear;
try
snap := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,ProcID);
if snap <> 0 then begin
me32.dwSize := SizeOf(TMODULEENTRY32);
if Module32First(snap, me32) then begin
AddModule(me32);
while Module32Next(snap, me32) do
AddModule(me32);
end;
end;
finally
CloseHandle(snap);
end;
end;

procedure TProcList.GetProcessInfo;
var
Fi : TSHFileInfo;
tw : Word;
ts : array[0..MAX_PATH] of char;
PObj : TProcessInfo;
procedure AddProcess(pe32:TPROCESSENTRY32);
begin
tw := 0;
StrCopy(ts,pe32.szExeFile);
PObj := TProcessInfo.Create;
PObj.hIco := ExtractIcon(hInstance,pe32.szExeFile,0);
if PObj.hIco=0 then
PObj.hIco := ExtractAssociatedIcon(hInstance,ts,tw);
PObj.cntUsage := pe32.cntUsage;
PObj.ProcessID := pe32.th32ProcessID;
PObj.DefaultHeapID := pe32.th32DefaultHeapID;
PObj.ModuleID := pe32.th32ModuleID;
PObj.cntThreads := pe32.cntThreads;
PObj.ParentProcessID:= pe32.th32ParentProcessID;
PObj.PriClassBase := pe32.pcPriClassBase;
Pobj.dwFlags := pe32.dwFlags;
PObj.ExePath := String(pe32.szExeFile);
PObj.PriString := GetPrioStr(pe32.pcPriClassBase);
PObj.BinType := GetBTypStr(SHGetFileInfo(pe32.szExeFile,0,FI,SizeOf(FI),SHGFI_EXETYPE));
fProcessList.AddObject(ExtractFileName(pe32.szExeFile),PObj);
end;
var
i:Integer;
snap : THandle;
pe32 : TPROCESSENTRY32;
begin
snap := 0;
for i := 0 to fProcessList.Count-1 do
fProcessList.Objects.Free;
fProcessList.Clear;
try
snap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if snap <> 0 then begin
pe32.dwSize := SizeOf(TPROCESSENTRY32);
if Process32First(snap, pe32) then begin
AddProcess(pe32);
while Process32Next(snap, pe32) do
AddProcess(pe32);
end;
end;
finally
CloseHandle(snap);
end;
End;

function TProcList.GetPrioStr(prioWORD):String;
begin
Result := '';
case prio of
4 : Result := '[Idle ]';
8 : Result := '[Normal ]';
13: Result := '[High ]';
24: Result := '[RealTime]';
else
Result := '[Unknown]';
end;
end;

function TProcList.GetBTypStr(btypWORD):String;
const
IMAGE_DOS_SIGNATURE = $5A4D;
IMAGE_OS2_SIGNATURE = $454E;
IMAGE_VXD_SIGNATURE = $454C;
IMAGE_NT_SIGNATURE = $0000;
begin
if btyp = 0 then Result:=''
else
case LoWord(btyp) of
IMAGE_DOS_SIGNATURE: Result:='MS-Dos';
IMAGE_VXD_SIGNATURE: Result:='Vxd';
IMAGE_OS2_SIGNATURE,
17744,
IMAGE_NT_SIGNATURE:
begin
case HiWord(btyp) of
1024: Result:='32-Bit';
768,
778: Result:='16-Bit';
else
Result:='hi:'+IntTOStr(hiword(btyp));
end;
end;
else
Result:='lo:'+IntToStr(LoWord(btyp));
end;
end;

procedure TProcList.FuAbout(value:String);
begin

end;

function TProcList.GetP_CountUsage(idx : Integer)WORD;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).cntUsage;
end;
function TProcList.GetP_ID(idx : Integer): DWORD;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).ProcessID;
end;
function TProcList.GetP_defHeap(idx : Integer): DWORD;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).DefaultHeapID;
end;
function TProcList.GetP_ModuleID(idx : Integer): DWORD;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).ModuleID;
end;
function TProcList.GetP_CountThreads(idx : Integer): DWORD;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).cntThreads;
end;
function TProcList.GetP_ParentPID(idx : Integer): DWORD;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).ParentProcessID;
end;
function TProcList.GetP_Priority(idx : Integer): LongInt;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).PriClassBase;
end;
function TProcList.GetP_dwFlags(idx : Integer): DWORD;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).dwFlags;
end;
function TProcList.GetP_ExePath(idx : Integer): String;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).ExePath;
end;
function TProcList.GetP_PrioStr(idx : Integer):String;
begin
Result:= TProcessInfo(fProcessList.Objects[idx]).PriString
end;
function TProcList.GetP_BinTyp(idx : Integer):String;
begin
Result:=TProcessInfo(fProcessList.Objects[idx]).BinType;
end;
function TProcList.GetP_IconHandle(idx : Integer): HIcon;
begin
Result := TProcessInfo(fProcessList.Objects[idx]).hIco;
end;
function TProcList.GetM_ModuleID(idx : Integer)WORD;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).ModuleID;
end;
function TProcList.GetM_ProcessID(idx : Integer)WORD;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).ProcessID;
end;
function TProcList.GetM_GlblcntUsage(idx : Integer)WORD;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).GlblcntUsage;
end;
function TProcList.GetM_ProccntUsage(idx : Integer)WORD;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).ProccntUsage;
end;
function TProcList.GetM_modBaseAddr(idx : Integer)WORD;
begin
Result :=DWORD(TModuleInfo(fModuleList.Objects[idx]).modBaseAddr);
end;
function TProcList.GetM_modBaseSize(idx : Integer)WORD;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).modBaseSize;
end;
function TProcList.GetM_hModule(idx : Integer):HMODULE;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).hModule;
end;
function TProcList.GetM_szExePath(idx : Integer):string;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).szExePath;
end;
function TProcList.GetM_IconHandle(idx : Integer):HIcon;
begin
Result := TModuleInfo(fModuleList.Objects[idx]).hIco;
end;

procedure Register;
begin
RegisterComponents('Process', [TProcList]);
end;
end.

多人接受答案了。