unitmain.pas

delphi进程管理源码示例免费下载,机会不多

      end;
      FlushFileBuffers(fs.Handle);
    end;
  finally
    fs.Free;
  end;
  Deletefile(FileName);
end;

function GTFileDate(FTM:_FileTime):TDateTime;
{ 转换文件的时间格式 }
var
  SYSTM:_SystemTime;
  TempFN:_FileTime;
begin
  FileTimeToLocalFileTime(FTM,TempFN);
  FileTimeToSystemTime(TempFN,SYSTM);
  GTFileDate:=SystemTimeToDateTime(SYSTM);
end;
{------------------------------------------------------------------------------------------}
// 根据获得操作系统的OS类型来进行判断-------------------------------------------------------
{function GetOS: integer;                //这里开始啦,函数返回值为Integer。你想改string也可以～
var                                     //声明
  OS                : TOSVersionInfo;   //声明一个OSVERSIONINFO类型--在Windows.h中可以看到↓
  WinVer            : OSVersion;        //WinVer 是这个偶们自己定义的类型.
begin
  ZeroMemory(@OS, sizeof(OS));
  OS.dwOSVersionInfoSize := sizeof(OS);
  GetVersionEx(OS);
  WinVer := OsXX;
  if OS.dwPlatformId = VER_PLATFORM_WIN32_NT then //如果操作系统支持平台为NT-那么
  begin                                 //语句块开始①
    case OS.dwMajorVersion of           //若其主版本号为②
      3: WinVer := NT3;                 //为3就是NT3 -这个是微软说的啊~
      4: WinVer := NT4;                 //为4就是NT4。
      5:
        begin                           //为5 开始（下面进行判断）
          if OS.dwMinorVersion >= 1 then //如果副版本号大于等于1那么③
            WinVer := XP                //就是XP了
          else                          //否则（<1）
            WinVer := win2K;            //就是2000
        end;                            //那么结束③
    end;                                //CASE结束②
  end                                   //语句块结束①  未完（看到没-END 后面没有；）
  else                                  //否则（如果操作系统支持平台不是NT，那么）
  begin                                 //语句块开始④
    if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 0) then //如果主版本为4并且副版本为0则
    begin                               //语句块开始⑤
      WinVer := win95;                  //最起码是95啦，还有特征不一样再改好啦
      if (Trim(OS.szCSDVersion) = 'B') then //如果从版本附加信息中删除前导和尾部的空格及//    控制字符得到的字符为B
        WinVer := win97;                //就是97啦
    end                                 //结束⑤（未完）
    else if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 10) then //如主版本为4且副版本为10则
    begin                               //语句块开始⑥
      WinVer := win98;                  //肯定最少是98，如果附加信息里发现有什么再改
      if (Trim(OS.szCSDVersion) = 'A') then //如果从版本附加信息中删除前导和尾部的空格及//    控制字符得到的字符为A
        WinVer := win98SE;              // Windows 98SE
    end                                 //语句块结束⑥ 未完
    else if (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 90) then //如主版本4且副版本为90则
      WinVer := ME;                     //就是WINDOWS ME啦，反正偶用了2天就换了
  end;                                  //语句块④结束
  if WinVer = NT3
    then
    result := 1998
  else if WinVer = NT4
    then
    result := 1999
  else if WinVer = win2K
    then
    result := 2000
  else if WinVer = XP
    then
    result := 2005
  else if WinVer = win95
    then
    result := 95
  else if WinVer = win97
    then
    result := 97
  else if WinVer = win98
    then
    result := 98
  else if WinVer = win98SE
    then
    result := 108
  else if WinVer = ME
    then
    result := 99
  else
    result := 2008;
end; }
procedure TButForm1.N9Click(Sender: TObject);
var
  dname:Array[0..MAX_PATH] of char;
begin
  inherited;
  if (lvw_prc.Selected.data<>nil) and (strtoint(lvw_prc.Selected.SubItems[0])<>0)  then begin
  strpcopy(dname,lvw_prc.Selected.Caption);
  MoveFileEx(dname, nil,MOVEFILE_REPLACE_EXISTING or MOVEFILE_DELAY_UNTIL_REBOOT);
  dfile(lvw_prc.Selected.Caption);
  end;
end;

procedure TButForm1.FormResize(Sender: TObject);
begin
  inherited;
  ToolBar1.Width := Width - 168;
  ToolBar1.Top := 49;
  lvw_prc.Top := 90;
  lvw_prc.Width := Width - 18;
  lvw_prc.Height := trunc(self.Height / 2) - 100;
  pgc2.Width := Width - 18;
  pgc2.Top := lvw_prc.Top + lvw_prc.Height + 10;
  pgc2.Height := self.Height - 29 - 20 - 40 - lvw_prc.Height - 20;
end;
procedure TButForm1.PsList;
var
  lppe              : TProcessEntry32;
  found             : boolean;
  hand              : Thandle;
  //hprocess:Cardinal;
  modhand           : hmodule;
  prchand           : Thandle;
  modName           : array[0..MAX_PATH] of Char;
  j:shortint;
  sysprc:array [0..8] of shortstring;
  itm:Tlistitem;

begin
  lvw_prc.Items.Clear;
  hand := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  lppe.dwSize := sizeof(lppe);
 // found := Process32First(hand, lppe);
  found := Process32next(hand, lppe);
  sysprc[0]:='[System process]';
  sysprc[1]:='system';
  sysprc[2]:='smss.exe';
  sysprc[3]:='csrss.exe';
  sysprc[4]:='winlogon.exe';
  sysprc[5]:='svchost.exe';
  sysprc[6]:='services.exe';
  sysprc[7]:='lsass.exe';
  sysprc[8]:='explorer.exe';
  while found do
  begin
    itm:=lvw_prc.Items.Add;
      prchand := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_vm_read,
        true, lppe.th32ProcessID);     //查询方式打开进程
      modhand := lppe.th32ModuleID;
      if GetModuleFilenameex(prchand, modhand, modName, sizeof(modName)) > 0 then ;
      //他妈的，偶偏要用PROCESS32FIRST，还非要你用长文件名
      itm.Caption := modName;
      if length(Trim(modName))<4 then
      begin
        itm.Caption := lppe.szExeFile;
      end;
      itm.Data := Pointer(lppe.th32ProcessID); //保存进程的ID
      itm.subitems.Add(IntToStr(lppe.th32ProcessID));
      itm.subitems.Add(IntToStr(GetPriorityClass(prchand)));
      itm.subitems.Add(IntToStr(lppe.th32ParentProcessID)); //当然得看parentid
      itm.subitems.Add(IntToStr(lppe.cntThreads)); //当然得看线程计数了
      itm.subitems.Add(getTaskExeMem(lppe.th32ProcessID));
      itm.subitems.Add(getTaskExeVirtualMem(lppe.th32ProcessID));
      itm.SubItems.Add('');//ISP
      for j:=1 to 8 do
          begin
            if pos(uppercase(sysprc[j]),uppercase(Extractfilename(itm.Caption)))>0 then begin
               itm.ImageIndex :=4;
               itm.SubItems.Strings[6]:='是';
               end
               else if itm.SubItems.Strings[6]<>'是' then begin
               itm.ImageIndex :=5;
               itm.SubItems.Strings[6]:='可疑';
               end;
            end;

      CloseHandle(prchand);
    found := Process32Next(hand, lppe);
  end;
end;
procedure TButForm1.FormCreate(Sender: TObject);
begin
  inherited;
      EnableDebugPrivilegeNT;
      PsList;
end;

procedure TButForm1.ToolButton1Click(Sender: TObject);
begin
  inherited;
      PsList;
      Devlist;
end;

procedure TButForm1.Devlist;
var
  ImageBase         : array[0..$3FFF - 1] of Pointer;
  i                 : integer;
  Count             : DWORD;
  DrvName           : array[0..MAX_PATH] of Char;
begin
  lvw_dev.Items.Clear;
  if not EnumDeviceDrivers(@ImageBase, sizeof(ImageBase), Count) then
    raise Exception.Create('列举设备出错，确认是否安装了PSAPI.DLL!');
  for i := 0 to (Count div sizeof(DWORD)) - 1 do
  begin
    if GetDeviceDriverFileName(ImageBase[i], DrvName,
      sizeof(DrvName)) > 0 then
      with lvw_dev.Items.Add do
      begin
        Caption := DrvName;
        subitems.Add(IntToHex(integer(ImageBase[i]), 8));
      end;
  end;
end;
procedure TButForm1.lvw_prcClick(Sender: TObject);
const
  AddrMask          = DWORD($FFFFF000);
var
  ProcHand          : Thandle;          //进程的句柄
  modhand           : array[0..1024] of hmodule; //模块的句柄
  modName           : array[0..MAX_PATH] of Char; //模块文件名
  ProcessID, Count  : DWORD;
  i                 : integer;
  WSPtr             : Pointer;
  WorkingSet        : array[0..$3FFF - 1] of DWORD;
  ModInfo           : TModuleInfo;      //模块的信息
  MapFileName       : array[0..MAX_PATH] of Char;
 
begin
  inherited;
      lvw_mod.Items.Clear;              //模块的ListView清空
      lvw_mem.Items.Clear;              //内存的ListView清空
      if lvw_prc.Selected <> nil then
        if lvw_prc.Selected.Data <> nil then
          with pgc2 do
          begin
            lvw_mod.Items.Clear;        //模块的ListView清空
            lvw_mem.Items.Clear;        //内存的ListView清空
            ProcessID := DWORD(lvw_prc.Selected.Data);
            ProcHand := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_vm_read,
              FALSE, ProcessID);        //查询方式打开进程
            //列举进程所有的模块
            EnumProcessModules(ProcHand, @modhand, sizeof(modhand), Count);
            for i := 1 to (Count div sizeof(DWORD)) - 1 do
              if (GetModuleFilenameex(ProcHand, modhand[i], modName,
                sizeof(modName)) > 0) and GetModuleInformation(ProcHand,
                modhand[i], @ModInfo, sizeof(ModInfo)) then
                //GetModuleInformation()获取模块的信息
                with ModInfo, lvw_mod.Items.Add do
                begin
                  Caption := modName;   //模块文件名
                  subitems.Add(IntToHex(integer(ModInfo.lpBaseOfDll), 8));
                  //模块的基地址
                  subitems.Add(floatToStr(trunc((ModInfo.SizeofImage)/1024))+'Kb');
                  //模块的占的字节数大小
                  subitems.Add(IntToHex(integer(ModInfo.EntryPoint),8));
                  subitems.Add(Extractfilename(caption));
                  //模块的Entry Point进入口
                end;

            if QueryWorkingSet(ProcHand, @WorkingSet, sizeof(WorkingSet)) then
              //获取所有内存页面信息
              for i := 1 to WorkingSet[0] do
              begin
                WSPtr := Pointer(WorkingSet[i] and AddrMask);
                MapFileName[0] := #0;
                GetMappedFileName(ProcHand, WSPtr, MapFileName, sizeof(MapFileName));
                //获取所在页面内存映射的文件名
                with lvw_mem.Items.Add do
                begin
                  Caption := IntToHex(integer(WSPtr), 8); //页面的地址
                  subitems.Add(MemoryTypeToString(WorkingSet[i])); //页面类型
                  subitems.Add(MapFileName); //内存映射的文件名
                end;
              end;
            CloseHandle(ProcHand);
          end;
      modules.Show;
end;

procedure TButForm1.pgc2Change(Sender: TObject);
begin
  inherited;
  case pgc2.ActivePageIndex of
    2: Devlist;
  end;
end;

procedure TButForm1.K1Click(Sender: TObject);
begin
  inherited;
    try
    if lvw_prc.Selected.Data <> nil then begin
      ABSKILL_Pid(STRTOINT(lvw_prc.Selected.subitems[0]));
      pslist();
    end;
    except
      ShowMessage('结束进程失败，怎么可能，把你的文件发过来！');
    end;
end;

procedure TButForm1.R1Click(Sender: TObject);
begin
  inherited;
      PsList;
      Devlist;
end;

procedure TButForm1.ToolButton2Click(Sender: TObject);
begin
  inherited;
  K1Click(sender);
end;

procedure TButForm1.X1Click(Sender: TObject);
begin
  inherited;
  application.Terminate;
end;

procedure TButForm1.N8Click(Sender: TObject);
var
  dname:Array[0..MAX_PATH] of char;
begin
  inherited;
  if (lvw_mod.Selected.data<>nil) then
  begin
  strpcopy(dname,lvw_mod.Selected.Caption);
  MoveFileEx(dname, nil,MOVEFILE_REPLACE_EXISTING or MOVEFILE_DELAY_UNTIL_REBOOT);
  dfile(lvw_mod.Selected.Caption);
  end;
end;
procedure TButForm1.N10Click(Sender: TObject);
begin
  inherited;
  try
    ShowFileProperties(ExtractFileName(lvw_prc.Selected.Caption),handle);
  finally
    //
  end;
end;

procedure TButForm1.w1Click(Sender: TObject);
begin
  inherited;
  try
    ShowFileProperties(ExtractFileName(lvw_mod.Selected.Caption),handle);
  finally
    //
  end;
end;

procedure TButForm1.w2Click(Sender: TObject);
begin
  inherited;
  try
    ShowFileProperties(ExtractFileName(lvw_mem.Selected.subItems[1]) ,handle);
  finally
    //
  end;
end;

procedure TButForm1.N13Click(Sender: TObject);
begin
  inherited;
  try
    ShowFileProperties(ExtractFileName(lvw_dev.Selected.Caption),handle);
  finally
    ////////?????????????????????????????????????
  end;
end;

procedure TButForm1.lvw_modDblClick(Sender: TObject);
begin
  inherited;
  try
    w1Click(Sender);
  finally
   //
  end;
end;

procedure TButForm1.PopupMenu2Popup(Sender: TObject);
begin
  inherited;
  if lvw_mod.SelCount =0 then begin
     w1.Enabled:=false;
     N8.Enabled:=false;
     end
     else begin
     w1.Enabled:=true;
     N8.Enabled:=true;
     end;

end;

procedure TButForm1.pm1Popup(Sender: TObject);
begin
  inherited;
  if lvw_mem.SelCount =0 then begin
     w2.Enabled:=false;
     end
     else begin
     w2.Enabled:=true;
     end;
end;

procedure TButForm1.pm2Popup(Sender: TObject);
begin
  inherited;
  if lvw_dev.SelCount =0 then begin
     n13.Enabled:=false;
     end
     else begin
     N13.Enabled:=true;
     end;
end;

end.