程序退出的时候总会出错，按钮点第二次也会出错，找了一个下午，高手帮忙看看

Question

DLL代码library process;uses
  SysUtils,
  Windows,
  Classes,
  ComCtrls,
  TLHelp32,
  System,
  Psapi;type
  PDetail = record
  PID: Integer;
  PName: Array[0..MAX_PATH] of char;
  PPath: Array[0..MAX_PATH] of char;
end;type
  dynArr = array of Integer;
  lpPDetail = ^PDetail;
  PDArr = array of lpPDetail;
  lpPDArr = ^PDArr;var
  pda: lpPDArr;
  
{$R *.res}////////////////////////////////////////////////////////////////////////////////////////
{ 获取进程ID，并存入数组 }
function GetProcessIdList: dynArr; stdcall;
var
  ppidarr: dynArr;
  i: Integer;
  FSnapshotHandle: THandle;
  IsLoopContinue: BOOL;
  FProcessEntry32: TProcessEntry32;
  processID: Integer;
begin
  i := 0;
  try
  FSnapshotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS,0); //创建系统快照
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32); //设置结构大小
  IsLoopContinue := Process32First(FsnapshotHandle, FProcessEntry32); //得到第一个进程信息
  while Integer(IsLoopContinue) <> 0 do
  begin
    //获取进程ID
    setLength(ppidarr,i+1);
    processID := FProcessEntry32.th32ProcessID;
    ppidarr[i] := processID;
    i := i + 1;
    IsLoopContinue := Process32Next(FsnapShotHandle, FProcessEntry32);
  end;
  except
    MessageBox(0,'获取PID出错了','process.dll出错',MB_OK);
  end;
  Result := ppidarr;exit;
end;
////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////
{ 根据pid获取进程映像名称 }
function GetPNameByPid(pid: Integer):PChar; stdcall;
  var
    processHandle: THandle;
    modName: Array[0..MAX_PATH] of char;
    n: DWORD;
    hMod: HModule;
    fileName: String;
begin
  fileName := '';
  processHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
                                 false,
                                 pid);
  if processHandle <> 0 then
    try
      ENumProcessModules(processHandle, @hMod, SizeOf(hMod), n);
      if GetModuleFileNameEx(processHandle, hMod, modName, SizeOf(modName)) > 0
      then
        fileName := ExtractFileName(modName);
        CloseHandle(processHandle);
    except
      MessageBox(0,'获取进程映像名称出错','出错了',MB_OK);
    end;
    Result := Pchar(fileName);
end;
//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
{获取一个结构体数组，结构体保存pid,pname,ppath}
function GetProcessDetail(mylppda: lpPDArr): integer; stdcall;
var 
    FSnapshotHandle: THandle;
    IsLoopContinue: BOOL;
    FProcessEntry32: TProcessEntry32;
    processHandle: THandle;
    modName: Array[0..MAX_PATH] of char;
    n: DWORD;
    processID: Integer;
    hMod: HModule;
    pd: lpPDetail;
    arrsize: Integer;
begin
  arrsize := 0;
  pda := mylppda;
  {读取系统进程，并添加到listview}
  FSnapshotHandle := CreateToolhelp32SnapShot(TH32CS_SNAPPROCESS,0); //创建系统快照
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32); //设置结构大小
  IsLoopContinue := Process32First(FsnapshotHandle, FProcessEntry32); //得到第一个进程信息
  while Integer(IsLoopContinue) <> 0 do
  begin
    setLength(pda^, arrsize + 1);
    //获取进程ID
    processID := FProcessEntry32.th32ProcessID;
    //列表添加一行
    pd := new(lpPDetail);
    pd^.PID := processID;
    StrCopy(pd^.PName,Pchar(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
        StrCopy(pd^.PPath,Pchar(ExtractFilePath(modName)));
      CloseHandle(processHandle);
    except
      MessageBox(0,'获取进程路径出错','出错了',MB_OK);
    end;
    pda^[arrsize] := pd;
    //数组大小增长
    arrsize := arrsize + 1;
    IsLoopContinue := Process32Next(FsnapShotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
  Result := arrsize;
end;
//////////////////////////////////////////////////////////////////////////////////////////function freeArr:boolean; stdcall;
begin
  try
    setLength(pda^,0);
  except
    MessageBox(0,'释放内存出错','dll例程出错',MB_OK);
    Result := false;exit; //return;
  end;
  Result := true;exit; //return;
end;exports
  GetProcessIdList,
  GetPNameByPid,
  freeArr,
  GetProcessDetail;
begin
end.

Answer 1

主程序代码：工程文件就不贴了unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ComCtrls, ExtCtrls, Sockets;{ 定义个记录 }
type
  PDetail = record
  PID: Integer;
  PName: Array[0..MAX_PATH] of char;
  PPath: Array[0..MAX_PATH] of char;
end;type
  lpPDetail = ^PDetail;
  PDArr = array of lpPDetail;
  lpPDArr = ^PDArr;
  dynArr = array of Integer;
  TGetProcessIdList = function:dynArr; stdcall;
  TGetPNameByPid = function(pid: Integer):Pchar; stdcall;
  TGetProcessDetail = function(mylppda: lpPDArr):Integer; stdcall;
  TfreeArr = function:boolean; stdcall;
  TFrmMain = class(TForm)
    btnKillProcess: TButton;
    GroupBox1: TGroupBox;
    MenuBar: TMainMenu;
    N1: TMenuItem;
    Q1: TMenuItem;
    LVProcessList: TListView;
    Label1: TLabel;
    LblTotalProcess: TLabel;
    RefreshTimer: TTimer;
    btnViewProcess: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnKillProcessClick(Sender: TObject);
    procedure Q1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ClearListView;
    procedure btnViewProcessClick(Sender: TObject);
    procedure initListView;
    procedure loadDll;
    procedure RefreshProcessList(Sender: TObject);  private
    { Private declarations }
    GetProcessIdList: TGetProcessIdList;
    GetPNameByPid: TGetPNameByPid;
    GetProcessDetail: TGetProcessDetail;
    freeArr: TfreeArr;
    FarProc:TFarProc;
    totalProcess :Integer;
  public
    { Public declarations }
  end;var
  FrmMain: TFrmMain;
  DLLHandleOfProcess: Cardinal;
  MyPDArr :PDArr;
implementation{$R *.dfm}{ 完成ListView的界面初始化，外部DLL的加载 }
procedure TFrmMain.initListView;
begin
  { 初始LVProcessList}
  with LVProcessList do
  begin
  try
    ViewStyle := vsReport;
    RowSelect := true;
    Font.Color := clBlack;
    ReadOnly := true;
    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;
end;procedure TFrmMain.loadDll;
begin
  DLLHandleOfProcess := LoadLibrary('lib\process.dll');
  if DLLHandleOfProcess <> 0 then
  begin
    { 获取外部函数的地址 }
    FarProc := GetProcAddress(DLLHandleOfProcess, 'GetProcessIdList');
    if Assigned(FarProc) then
    begin
      GetProcessIdList := FarProc;
      FarProc := nil;
    end;
    FarProc := GetProcAddress(DLLHandleOfProcess, 'GetPNameByPid');
    if Assigned(FarProc) then
    begin
      GetPNameByPid := FarProc;
      FarProc := nil;
    end;
    FarProc := GetProcAddress(DLLHandleOfProcess, 'GetProcessDetail');
    if Assigned(FarProc) then
    begin
      GetProcessDetail := FarProc;
      FarProc := nil;
    end;
    FarProc := GetProcAddress(DLLHandleOfProcess, 'freeArr');
    if Assigned(FarProc) then
    begin
      freeArr := FarProc;
      FarProc := nil;
    end;
  end
  else//加载失败
  begin
    MessageBox(handle,'加载lib\process.dll失败','程序出错了',MB_OK);
    Application.Terminate;
  end;
end;procedure TFrmMain.FormCreate(Sender: TObject);
begin
  initListView; //初始ListView;
  loadDll;
end;procedure TFrmMain.btnKillProcessClick(Sender: TObject);
var
  userChoice: Integer;
  strPid: String;
begin
  userChoice := MessageBox(handle,'警告：终止进程可能会有不希望的结果发生，确定要结束吗？','确认消息',MB_OKCANCEL);
  if userChoice = IDOK then
  begin
    strPid := LVProcessList.Selected.Caption;
    MessageBox(handle,Pchar(strPid),'PID',MB_OK);
  end;
  if UserChoice = IDCANCEL then
  begin
    //
  end;
end;procedure TFrmMain.Q1Click(Sender: TObject);
begin
  close;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  FreeLibrary(DLLHandleOfProcess);
  ClearListView;
end;{ 清理创建的资源 }
procedure TFrmMain.ClearListView;
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;
  end;
end;procedure TFrmMain.btnViewProcessClick(Sender: TObject);
begin
  RefreshProcessList(nil);
end;procedure TfrmMain.RefreshProcessList(Sender: TObject);
var
  ptrPDetail: lpPDetail;
  i: Integer;
  newItem: TListItem;
begin
  try
    ClearListView;
  except
    MessageBox(handle,'清理出错','程序错误',MB_OK);
    exit;
  end;
  totalProcess := 0; //总进程数清零
  try
  totalProcess := GetProcessDetail(@MyPDArr); //获取进程详细信息记录数组
  except
    MessageBox(handle,'获取列表出错','程序错误',MB_OK);
    exit;
  end;
  for i := 0 to totalprocess - 1 do //遍历整个数组显示所有进程信息
   begin
     ptrPDetail := MyPDArr[i]; //取出第i个元素
     newItem := LVProcessList.Items.Add;//给列表增加一行
     newItem.Caption := IntToStr(ptrPDetail^.PID); //取出pid赋值给该行的caption
     newItem.SubItems.Add(ptrPDetail^.PName);
     newItem.SubItems.Add(ptrPDetail^.PPath);
   end;
  freeArr;
  LblTotalProcess.Caption := IntToStr(totalProcess);
end;end.
退出或点击btnViewProcess按钮时就会跳出内存那一串，单步运行也没查出原因，但是后来直接用WinDbg调试，发现每次内存错跳出的内存地址都是EIP寄存器的地址新手，有些问题搞不太明白，还望高手指点

Answer 2

1:去掉ClearListView这个过程的定义的执行代码2:RefreshProcessList里去掉下面的  try
    ClearListView;
  except
    MessageBox(handle,'清理出错','程序错误',MB_OK);
    exit;
  end;改成 LVProcessList.Clear;3: FormDestroy里也把ClearListView;去掉

Answer 3

上面写的修改后的代码:
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ComCtrls, ExtCtrls, Sockets;{ 定义个记录 }
type
  PDetail = record
  PID: Integer;
  PName: Array[0..MAX_PATH] of char;
  PPath: Array[0..MAX_PATH] of char;
end;type
  lpPDetail = ^PDetail;
  PDArr = array of lpPDetail;
  lpPDArr = ^PDArr;
  dynArr = array of Integer;
  TGetProcessIdList = function:dynArr; stdcall;
  TGetPNameByPid = function(pid: Integer):Pchar; stdcall;
  TGetProcessDetail = function(mylppda: lpPDArr):Integer; stdcall;
  TfreeArr = function:boolean; stdcall;
  
  TFrmMain = class(TForm)
    btnKillProcess: TButton;
    LVProcessList: TListView;
    Label1: TLabel;
    LblTotalProcess: TLabel;
    RefreshTimer: TTimer;
    btnViewProcess: TButton;
    procedure btnKillProcessClick(Sender: TObject);
    procedure Q1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnViewProcessClick(Sender: TObject);
    procedure initListView;
    procedure loadDll;
    procedure RefreshProcessList(Sender: TObject);
    procedure FormCreate(Sender: TObject);  private
    { Private declarations }
    GetProcessIdList: TGetProcessIdList;
    GetPNameByPid: TGetPNameByPid;
    GetProcessDetail: TGetProcessDetail;
    freeArr: TfreeArr;
    FarProc:TFarProc;
    totalProcess :Integer;
  public
    { Public declarations }
  end;var
  FrmMain: TFrmMain;
  DLLHandleOfProcess: Cardinal;
  MyPDArr :PDArr;
implementation{$R *.dfm}{ 完成ListView的界面初始化，外部DLL的加载 }
procedure TFrmMain.initListView;
begin
  { 初始LVProcessList}
  with LVProcessList do
  begin
  try
    ViewStyle := vsReport;
    RowSelect := true;
    Font.Color := clBlack;
    ReadOnly := true;
    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;
end;procedure TFrmMain.loadDll;
begin
  DLLHandleOfProcess := LoadLibrary('process.dll');
  if DLLHandleOfProcess <> 0 then
  begin
    { 获取外部函数的地址 }
    FarProc := GetProcAddress(DLLHandleOfProcess, 'GetProcessIdList');
    if Assigned(FarProc) then
    begin
      GetProcessIdList := FarProc;
      FarProc := nil;
    end;
    FarProc := GetProcAddress(DLLHandleOfProcess, 'GetPNameByPid');
    if Assigned(FarProc) then
    begin
      GetPNameByPid := FarProc;
      FarProc := nil;
    end;
    FarProc := GetProcAddress(DLLHandleOfProcess, 'GetProcessDetail');
    if Assigned(FarProc) then
    begin
      GetProcessDetail := FarProc;
      FarProc := nil;
    end;
    FarProc := GetProcAddress(DLLHandleOfProcess, 'freeArr');
    if Assigned(FarProc) then
    begin
      freeArr := FarProc;
      FarProc := nil;
    end;
  end
  else//加载失败
  begin
    MessageBox(handle,'加载lib\process.dll失败','程序出错了',MB_OK);
    Application.Terminate;
  end;
end;procedure TFrmMain.btnKillProcessClick(Sender: TObject);
var
  userChoice: Integer;
  strPid: String;
begin
  userChoice := MessageBox(handle,'警告：终止进程可能会有不希望的结果发生，确定要结束吗？','确认消息',MB_OKCANCEL);
  if userChoice = IDOK then
  begin
    strPid := LVProcessList.Selected.Caption;
    MessageBox(handle,Pchar(strPid),'PID',MB_OK);
  end;
  if UserChoice = IDCANCEL then
  begin
    //
  end;
end;procedure TFrmMain.Q1Click(Sender: TObject);
begin
  close;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  FreeLibrary(DLLHandleOfProcess);end;{ 清理创建的资源 }
procedure TFrmMain.btnViewProcessClick(Sender: TObject);
begin
  RefreshProcessList(nil);
end;procedure TfrmMain.RefreshProcessList(Sender: TObject);
var
  ptrPDetail: lpPDetail;
  i: Integer;
  newItem: TListItem;
begin
  try
    LVProcessList.Clear;
  except
    MessageBox(handle,'清理出错','程序错误',MB_OK);
    exit;
  end;
  totalProcess := 0; //总进程数清零
  try
  totalProcess := GetProcessDetail(@MyPDArr); //获取进程详细信息记录数组
  except
    MessageBox(handle,'获取列表出错','程序错误',MB_OK);
    exit;
  end;
  for i := 0 to totalprocess - 1 do //遍历整个数组显示所有进程信息
   begin
     ptrPDetail := MyPDArr[i]; //取出第i个元素
     newItem := LVProcessList.Items.Add;//给列表增加一行
     newItem.Caption := IntToStr(ptrPDetail^.PID); //取出pid赋值给该行的caption
     newItem.SubItems.Add(ptrPDetail^.PName);
     newItem.SubItems.Add(ptrPDetail^.PPath);
   end;
  freeArr;
  LblTotalProcess.Caption := IntToStr(totalProcess);
end;procedure TFrmMain.FormCreate(Sender: TObject);
begin
  initListView; //初始ListView;
  loadDll;
end;end.

Answer 4

在delphi中我发现一般含有Items字段地，一般不要去delete各项。
不然就会出错。

Answer 5

dinoalex ,你说的没错，的确解决了问题，太谢谢了。
不过知其然，不知其所以然不是我的风格。各位能不能顺便说一下为什么会这样子啊？谢谢！

Answer 6

主要是LISTVIEW的ITEM那里,只要DELETE了ITEM就行了,不用管SUBITEM比如:listview1.Items[i].Delete;