获取系统进程,并保存到ListView中,程序每次退出都会报内存错,帮忙看看

能写程序-会种庄稼 2009-12-31 10:09:36
程序在Dll中获取系统进程,并保存到ListView中,ListView通过主程序传递给Dll
下面是代码部分

1、DLL代码

library process;

uses
SysUtils,
Windows,
Classes,
ComCtrls,
TLHelp32,
System,
Psapi;


{$R *.res}

function GetProcessList(LV: TListView): Integer; stdcall;
var listView: TListView;
FSnapshotHandle: THandle;
totalProcess: Integer;
IsLoopContinue: BOOL;
FProcessEntry32: TProcessEntry32;
newItem: TListItem;
processHandle: THandle;
modName: Array[0..511] of char;
n: DWORD;
processID: Integer;
hMod: HModule;
begin
totalProcess:= 0;
listView := LV;
listView.Items.BeginUpdate;
listView.Items.Clear;
{读取系统进程,并添加到listview}
FSnapshotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS,0); //创建系统快照
FProcessEntry32.dwSize := SizeOf(FProcessEntry32); //设置结构大小
IsLoopContinue := Process32First(FsnapshotHandle, FProcessEntry32); //得到第一个进程信息
while Integer(IsLoopContinue) <> 0 do
begin
//进程总数加1
totalProcess := totalProcess + 1;
//获取进程ID
processID := FProcessEntry32.th32ProcessID;
//列表添加一行
newItem := listView.Items.Add;
newItem.Caption := IntToStr(processID);//显示进程ID
//列表行增加进程名
newItem.SubItems.Add(ExtractFileName(FProcessEntry32.szExeFile));
//获取进程句柄
processHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
false,
processID);
if processHandle <> 0 then
try
ENumProcessModules(processHandle, @hMod, SizeOf(hMod), n);
if GetModuleFileNameEx(processHandle, hMod, modName, SizeOf(modName)) > 0
then
newItem.SubItems.Add(ExtractFilePath(modName));
CloseHandle(processHandle);
except
MessageBox(0,'获取进程路径出错','出错了',MB_OK);
end;

IsLoopContinue := Process32Next(FsnapShotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
listView.Items.EndUpdate;
Result := totalProcess;exit; //return
end;


exports
GetProcessList;

begin
end.



这个是主程序代码:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ComCtrls;

type
TGetProcessList = function(LV: TListView):Integer; stdcall;
TFrmMain = class(TForm)
btnKillProcess: TButton;
GroupBox1: TGroupBox;
MenuBar: TMainMenu;
N1: TMenuItem;
Q1: TMenuItem;
LVProcessList: TListView;
Label1: TLabel;
LblTotalProcess: TLabel;
procedure FormCreate(Sender: TObject);
procedure btnKillProcessClick(Sender: TObject);
procedure Q1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
GetProcessList :TGetProcessList;
FarProc:TFarProc;
totalProcess :Integer;
public
{ Public declarations }
end;

var
FrmMain: TFrmMain;
DLLHandle: Cardinal;
implementation

{$R *.dfm}


{
完成ListView的界面初始化,外部DLL的加载
}
procedure TFrmMain.FormCreate(Sender: TObject);
begin
{ 初始LVProcessList}
with LVProcessList do
begin
try
ViewStyle := vsReport;
RowSelect := true;
Font.Color := clBlack;
Columns.Add;
Column[0].Caption := 'PID';
Column[0].AutoSize := false;
Column[0].Width := 60;
Column[0].Alignment := taLeftJustify;
Columns.Add;
Column[Columns.Count - 1].Caption := '映像名称';
Column[Columns.Count - 1].AutoSize := false;
Column[Columns.Count - 1].Width := 120;
Column[Columns.Count - 1].Alignment := taLeftJustify;
Columns.Add;
Column[Columns.Count - 1].Caption := '程序路径';
Column[Columns.Count - 1].AutoSize := false;
Column[Columns.Count - 1].Width := 310;
Column[Columns.Count - 1].Alignment := taLeftJustify;
except
messagebox(handle,'出错','!',MB_OK);
end;
end;

{ 加载process.dll}
DLLHandle := LoadLibrary('lib\process.dll');
if DLLHandle <> 0 then
begin
{获取外部函数的地址,
该外部函数负责列出系统所有当前的进程,
并显示到ListView控件,传递给的参数是
主Form的LVProcesslist控件}
FarProc := GetProcAddress(DLLHandle, 'GetProcessList');
if Assigned(FarProc) then
begin
GetProcessList := FarProc;
totalProcess := GetProcessList(LVProcessList);{ 开始获取系统进程,并在LVProcessList控件中显示 }
LblTotalProcess.Caption := IntToStr(totalProcess);
end;
end
else
begin
MessageBox(handle,'加载lib\process.dll失败','程序出错了',MB_OK);
Application.Terminate;
end;
end;

procedure TFrmMain.btnKillProcessClick(Sender: TObject);
var userChoice: Integer;
begin
userChoice := MessageBox(handle,'警告:终止进程可能会有不希望的结果发生,确定要结束吗?','确认消息',MB_OKCANCEL);
if userChoice = IDOK then
begin
//
end;
if UserChoice = IDCANCEL then
begin
//
end;
end;

procedure TFrmMain.Q1Click(Sender: TObject);
begin
close;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end;


end.


我觉得可能是资源没清理干净,不过找不出来。希望高手指点一二!
...全文
191 8 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
imho888 2009-12-31
  • 打赏
  • 举报
回复
[Quote=引用 3 楼 bigwatercar 的回复:]
引用 1 楼 imho888 的回复:
建议不要传递控件


那我该如何组织数据,返回给主程序呢?
[/Quote]

如果需要的参数很多,还不如传递窗口的handle
在dll里创建需有的组件
hjkto 2009-12-31
  • 打赏
  • 举报
回复
学习 
金卯刀 2009-12-31
  • 打赏
  • 举报
回复
dll與主程式交互,涉及操作string問題。應該要主程式dpr及dll dpr最前端引用 sharemem
kfcoffe 2009-12-31
  • 打赏
  • 举报
回复
1.LVProcessList.Items.Delete(i);
主要是这句,比如你原来里面有10项,现在删除1项,那么后面的就会前移,这样当你释放第10项的时候就会报错。

2.用TStringList 也可以啊。

  • 打赏
  • 举报
回复
关于内存报错,我已经解决了。

procedure TFrmMain.FormDestroy(Sender: TObject);
var i,j: Integer;
begin
for i := LVProcessList.Items.Count - 1 downto 0 do
begin
for j := LVProcessList.Items.Item[i].SubItems.Count - 1 downto 0 do
begin
LVProcessList.Items.Item[i].SubItems.Delete(j);
end;
LVProcessList.Items.Item[i].SubItems.Free;
{ 使用下面两句会报错 }
//LVProcessList.Items.Delete(i);
//LVProcessList.Items.Free;
end;

if DLLHandle <> 0 then
FreeLibrary(DLLHandle);
end;


主程序中释放subitem。 不过我搞不明白我注释掉的那两行为什么会出错。也是内存错。

另外,如果不传递控件,我用什么数据结构传给主程序。

大家讨论,不是灌水贴的都有分
  • 打赏
  • 举报
回复
[Quote=引用 1 楼 imho888 的回复:]
建议不要传递控件
[/Quote]

那我该如何组织数据,返回给主程序呢?
gyk120 2009-12-31
  • 打赏
  • 举报
回复
控件传递的确不好,另外你也可以根据map文件或者调试,看看到底是哪个地方出错了
imho888 2009-12-31
  • 打赏
  • 举报
回复
建议不要传递控件

1,183

社区成员

发帖
与我相关
我的任务
社区描述
Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧