processlist.~pas

File Mon Downloader. File Mon Downloader.

      var Arow : Integer;
      begin
        result := -1;
        for  Arow := 0 to self.FItems.Count - 1 do begin
           if self.FItems.Items[Arow].Handle = Prochandle then begin
              result := Arow;
              break;
           end;
        end;
      end;

      procedure add_programInfo(ProgramInfo : TProgram);
      var tmp : TProgramItem;
      begin
          tmp := self.FItems.Add;
          tmp.ExeName := ProgramInfo.ExeName;
          tmp.Handle  := ProgramInfo.Handle;
          tmp.CheckngTime  := ProgramInfo.CheckngTime;
          tmp.CreateTime   := ProgramInfo.CreateTime;
          tmp.ExitTime     := ProgramInfo.ExitTime;
          tmp.KernelTime   := ProgramInfo.KernelTime;
          tmp.UserTime     := ProgramInfo.UserTime;
      end;

   var retArow : integer;
       ProgramInfo : TProgram;
       Parentvalue : double;
       NewPIDS     : Array of DWORD;


       function  is_PID_NewPIDS(value : DWORD) : Boolean;
       var Arow, datalength : integer;
       begin
         datalength := length(NewPIDS);
         result := False;
         for Arow := 0 to datalength - 1 do begin
             if value = NewPIDS[Arow] then begin
               result := True;
               break;
             end;
         end;
       end;

       procedure  Remove_ExitPID;
       var Arow, datalength : integer;
       begin
           datalength := self.FItems.Count;

           for Arow := 0 to datalength - 1 do begin
               if Not is_PID_NewPIDS(self.FItems.Items[Arow].Handle) then begin
                   self.FItems.Delete(self.FItems.Items[Arow].index);
                   break;
               end;    
           end;

       end;

   begin
     self.FCheck := value;
     if self.FCheck then begin

       ZeroMemory(@PIDS, sizeof(DWORD) * 501);
       dwSize := 0;

       self.FCPURatio := 0;
       if EnumProcesses(PDWORD(@PIDS), sizeof(PIDS), dwSize) then begin
          ProcessCnt := dwSize div Sizeof(DWORD);
          finalize(NewPIDS);
          setlength(NewPIDS, ProcessCnt);
          
          for ProcessIdx := 0 to ProcessCnt -1 do begin
               ProcessHandle := OpenProcess(PROCESS_VM_READ or PROCESS_QUERY_INFORMATION,
                                false,PIDS[ProcessIdx]);
               try

                     NewPIDS[ProcessIdx] := PIDS[ProcessIdx];
                     
                     if ProcessHandle <> 0 then begin

                       if EnumProcessModules(ProcessHandle, @PModule, SizeOf(PModule),
                                             dwSize) then begin
                         FillChar(ProcessName, 256, #0);

                         if GetModuleBaseName(ProcessHandle, PModule,ProcessName, 256) > 0 then begin
                                ProgramInfo.CheckngTime := now;
                            if (GetProcessTimes(ProcessHandle, ftCreation, ftExit, ftKernel, ftUser) = TRUE) then begin
                                FileTimeToSystemTime(ftCreation, tmpSysTime);
                                ProgramInfo.ExeName := ProcessName;
                                ProgramInfo.Handle := PIDS[ProcessIdx];

                                ProgramInfo.CreateTime := SystemtimetoDatetime(tmpSysTime);

                                FileTimeToSystemTime(ftExit, tmpSysTime);
                                ProgramInfo.ExitTime := SystemtimetoDatetime(tmpSysTime);

                                FileTimeToSystemTime(ftKernel, tmpSysTime);
                                ProgramInfo.KernelTime := SystemtimetoDatetime(tmpSysTime);

                                FileTimeToSystemTime(ftUser, tmpSysTime);
                                ProgramInfo.UserTime := SystemtimetoDatetime(tmpSysTime);
                                ProgramInfo.CPURatio := 0.0;

                                retArow := get_ProgramIndex(ProgramInfo.Handle);
                                if retArow < 0 then  Add_ProgramInfo(ProgramInfo)
                                else begin
                                  parentvalue := (millisecondsbetween(ProgramInfo.CheckngTime, self.FItems.Items[retArow].CheckngTime)/100);

                                  if parentvalue = 0 then
                                  ProgramInfo.CPURatio := 0.0 else
                                  ProgramInfo.CPURatio :=
                                  ( millisecondsbetween(ProgramInfo.KernelTime, self.FItems.Items[retArow].KernelTime) +
                                    millisecondsbetween(ProgramInfo.UserTime, self.FItems.Items[retArow].UserTime)  )
                                   / Parentvalue;

                                  self.FCPURatio := self.FCPURatio + ProgramInfo.CPURatio;

                                  self.FItems.Items[retArow].CheckngTime := ProgramInfo.CheckngTime;
                                  self.FItems.Items[retArow].CreateTime  := ProgramInfo.CreateTime;
                                  self.FItems.Items[retArow].ExitTime    := ProgramInfo.ExitTime;
                                  self.FItems.Items[retArow].KernelTime  := ProgramInfo.KernelTime;
                                  self.FItems.Items[retArow].UserTime    := ProgramInfo.UserTime;
                                  self.FItems.Items[retArow].CPURatio    := ProgramInfo.CPURatio;
                                end;


                            end;
                         end;

                       end;
                     end;

                finally
                  CloseHandle(ProcessHandle);
                end;

          end;

       end;

          Remove_ExitPID;
          finalize(NewPIDS);
          self.FCheck := False;

     end;

   end;


   function  TProcessList.get_FRAMQTY : integer;
   var MemoryState : TMemoryStatus;
   begin
        MemoryState.dwLength := sizeof(TMemoryStatus);
        GlobalMemoryStatus(MemoryState);
        self.FRAMQTY := MemoryState.dwTotalPhys;
        result := self.FRAMQTY;
   end;
   
   function  TProcessList.get_FTotalPageSize : integer;
   var MemoryState : TMemoryStatus;
   begin
        MemoryState.dwLength := sizeof(TMemoryStatus);
        GlobalMemoryStatus(MemoryState);
        self.FTotalPageSize := MemoryState.dwTotalPageFile;
        result := self.FTotalPageSize;
   end;

   function  TProcessList.get_FAvailPageSize  : integer;
   var MemoryState : TMemoryStatus;
   begin
        MemoryState.dwLength := sizeof(TMemoryStatus);
        GlobalMemoryStatus(MemoryState);
        self.FAvailPageSize := MemoryState.dwAvailPageFile;
        result := self.FAvailPageSize;
   end;

   function  TProcessList.get_FTotalVirtualSize : integer;
   var MemoryState : TMemoryStatus;
   begin
        MemoryState.dwLength := sizeof(TMemoryStatus);
        GlobalMemoryStatus(MemoryState);
        self.FTotalVirtualSize := MemoryState.dwTotalVirtual;
        result := self.FTotalVirtualSize;
   end;

   function  TProcessList.get_FAvailVirtualSize : integer;
   var MemoryState : TMemoryStatus;
   begin
        MemoryState.dwLength := sizeof(TMemoryStatus);
        GlobalMemoryStatus(MemoryState);
        self.FAvailVirtualSize := MemoryState.dwAvailVirtual;
        result := self.FAvailVirtualSize;
   end;

   function  TProcessList.get_FAvailRAMQTY : integer;
   var MemoryState : TMemoryStatus;
   begin
        MemoryState.dwLength := sizeof(TMemoryStatus);
        GlobalMemoryStatus(MemoryState);
        self.FAvailRAMQTY := MemoryState.dwAvailPhys;
        result := self.FAvailRAMQTY;
        
   end;

   {
     It's all developed by Augustine Lee, in Korea.
     Developer Site : http://www.appshop.net

     Its' License policy is that
     this package can be applied in all fields,
     Commercial, Study, and other goals,
     without removing this License comment.

     The Reason of develping this package
     is that Augustine Lee can not find the Source and Example of Object Pascal,
     for checking CPU Usage Occupation Ratio.

     This checking CPU package is used in MSSL development (Middleware SSL) 


     救崇窍技堪.  俺惯磊 技饭疙 Augustine 牢 捞霖柳 涝聪促.
     胆颇捞肺 等 CPU 痢蜡啦 痢八窍绰 基钱 茫扁啊 距埃 塞甸促绊 积阿登绢
     弊成 茄锅 父甸绢 好嚼聪促.

     困 康巩俊辑 览鞭茄巴鞍捞, 夯 历累鼻 包访等 林籍巩阑 昏力窍瘤 臼绰促搁,
     绢叼俊档 荤侩窍寂档 邓聪促.

     弊府绊, 泅犁 凯缴洒 父甸绊绰 乐瘤父, 个捞 蝶扼啊瘤 给窍绊 乐绰 历锐 权其捞瘤绰
     http://www.appshop.net 涝聪促.

     弊府绊, 夯 盲欧 葛碘篮 MSSL 力累俊 荤侩登菌嚼聪促. 
   }


end.