Delphiを忘れない

[1回]

unit ProcessCpuUsage;

interface

uses
  Windows, Generics.Collections;

type
  TProcessID = DWORD;

  TSystemTimesRec = record
    KernelTime: TFileTIme;
    UserTime: TFileTIme;
  end;

  TProcessTimesRec = record
    KernelTime: TFileTIme;
    UserTime: TFileTIme;
  end;

  TProcessCpuUsage = class
    LastSystemTimes: TSystemTimesRec;
    LastProcessTimes: TProcessTimesRec;
    ProcessCPUusagePercentage: Double;
  end;

  TProcessCpuUsageList = TObjectDictionary<TProcessID, TProcessCpuUsage>;

var
  LatestProcessCpuUsageCache : TProcessCpuUsageList;
  LastQueryTime              : TDateTime;

  function GetProcessCpuUsageHandle( Handle : THandle ) : Double;
  function GetProcessCpuUsageProcessID( ProcessID: TProcessID ): Double;

implementation

function GetProcessCpuUsageHandle( Handle : THandle ) : Double;
var
  li_ProcID:     DWORD;
begin
  GetWindowThreadProcessId(Handle, @li_ProcID);

  result := GetProcessCpuUsageProcessID(li_ProcID);
end;

function GetProcessCpuUsageProcessID(ProcessID: TProcessID): Double;
  function SubtractFileTime(FileTime1: TFileTIme; FileTime2: TFileTime): TFileTime;
  begin
    Result := TFileTime(Int64(FileTime1) - Int64(FileTime2));
  end;
var
  ProcessCpuUsage  : TProcessCpuUsage;
  ProcessHandle    : THandle;
  SystemTimes      : TSystemTimesRec;
  SystemDiffTimes  : TSystemTimesRec;
  ProcessDiffTimes : TProcessTimesRec;
  ProcessTimes     : TProcessTimesRec;

  SystemTimesIdleTime      : TFileTime;
  ProcessTimesCreationTime : TFileTime;
  ProcessTimesExitTime     : TFileTime;
begin
  Result := 0.0;

  LatestProcessCpuUsageCache.TryGetValue(ProcessID, ProcessCpuUsage);
  if ProcessCpuUsage = nil then begin
    ProcessCpuUsage := TProcessCpuUsage.Create;
    LatestProcessCpuUsageCache.Add(ProcessID, ProcessCpuUsage);
  end;

  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
  if ProcessHandle <> 0 then begin
    try
      if GetSystemTimes(SystemTimesIdleTime, SystemTimes.KernelTime, SystemTimes.UserTime) then begin

        SystemDiffTimes.KernelTime := SubtractFileTime(SystemTimes.KernelTime, ProcessCpuUsage.LastSystemTimes.KernelTime);
        SystemDiffTimes.UserTime   := SubtractFileTime(SystemTimes.UserTime, ProcessCpuUsage.LastSystemTimes.UserTime);

        ProcessCpuUsage.LastSystemTimes := SystemTimes;

        if GetProcessTimes(ProcessHandle, ProcessTimesCreationTime, ProcessTimesExitTime, ProcessTimes.KernelTime, ProcessTimes.UserTime) then begin

          ProcessDiffTimes.KernelTime := SubtractFileTime(ProcessTimes.KernelTime, ProcessCpuUsage.LastProcessTimes.KernelTime);
          ProcessDiffTimes.UserTime   := SubtractFileTime(ProcessTimes.UserTime, ProcessCpuUsage.LastProcessTimes.UserTime);

          ProcessCpuUsage.LastProcessTimes := ProcessTimes;

          if (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) > 0 then begin
            Result := (Int64(ProcessDiffTimes.KernelTime) + Int64(ProcessDiffTimes.UserTime)) / (Int64(SystemDiffTimes.KernelTime) + Int64(SystemDiffTimes.UserTime)) * 100;
          end;
        end;
      end;
    finally
      CloseHandle(ProcessHandle);
    end;
  end;
end;

initialization
  LatestProcessCpuUsageCache := TProcessCpuUsageList.Create( [ doOwnsValues ] );
finalization
  LatestProcessCpuUsageCache.Free;

end.


使い方の例

uses ProcessCpuUsage;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := Format('%f', [GetProcessCpuUsageHandle(Handle)] );
end;

[0回]

[14回]

文字列の中から特定の文字列を探しだす関数はPosです。
また指定した文字数以降から探す場合はStrUtilsに含まれるPosExです。
一番最後に見つかる位置を知りたい場合は探す文字列と探される側の文字列の両方をReverseStringでひっくり返してPosを使えば調べることが出来ます。
その結果を使いやすいように加工した例が下記になります。

//最後に見つかる文字列位置を調べる
function LastPos(const substr, str: String) : Integer;
begin
  result := Length(str) - Pos( ReverseString(substr) , ReverseString(str) ) - Length(substr) + 2;
end;

//使用例
procedure TForm1.Button1Click(Sender: TObject);
const
  str    = '012345678901234567890123456789';
  substr = '345';
begin
  Edit1.Text := IntToStr(     Pos  (substr , str    ) );
  Edit2.Text := IntToStr(     PosEx(substr , str , 8) );
  Edit3.Text := IntToStr( LastPos  (substr , str    ) );
end;
結果は4，14，24となります。

[9回]

Delphiで別スレッドを使って処理を行う場合TThreadクラスの継承クラスを作成して行うのが一般的ですが、その際必要なパラメーターをいちいちスレッドクラスに渡したりする必要が出てきたりします。
（それが面倒になってグローバル変数を使ってみたり、自身のポインタを渡してみたり＾＾）
なので簡単に別スレッド処理を使えるように考えてみました。


//簡単スレッドクラス
unit EasyThread;

interface

uses
  Windows, Classes;

type
  TThreadProc = procedure of Object;
  TThreadSync = procedure of Object;

  TEasyThread = class(TObject)
  private type
    TPrivatetThread = class(TThread)
    private
      FThreadProc : TThreadProc;
    public
      constructor Create( ThreadProc : TThreadProc );
    protected
      procedure Execute; override;
    end;
  private
    FThread     : TPrivatetThread;

    function    GetTerminated: Boolean;
  public
    constructor Create( ThreadProc : TThreadProc );
    destructor  Destroy; override;

    procedure   Synchronize( SyncProc : TThreadSync);

    procedure   Terminate;
    procedure   WaitFor;

    property    Terminated : Boolean read GetTerminated;
  end;

implementation

{ TEasyThread }

constructor TEasyThread.Create( ThreadProc : TThreadProc );
begin
  FThread := TPrivatetThread.Create(ThreadProc);
end;

destructor TEasyThread.Destroy;
begin
  if Assigned(FThread) then FThread.Free;

  inherited;
end;

function TEasyThread.GetTerminated: Boolean;
begin
  result := FThread.Terminated;
end;

procedure TEasyThread.Terminate;
begin
   if Assigned(FThread) then FThread.Terminate;
end;

procedure TEasyThread.WaitFor;
begin
  try
     if Assigned(FThread) then FThread.WaitFor;
  except end;
end;

procedure TEasyThread.Synchronize(SyncProc: TThreadSync);
begin
   if Assigned(FThread) then FThread.Synchronize(SyncProc);
end;

{ TEasyThread.TPrivatethread }

constructor TEasyThread.TPrivatetThread.Create(ThreadProc: TThreadProc);
begin
  inherited Create(False);

  FThreadProc := ThreadProc;
end;

procedure TEasyThread.TPrivatetThread.Execute;
begin
  if Assigned(FThreadProc) then FThreadProc;
end;

end.

・簡単スレッドクラスを使う例
unit Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Count : Integer;
    ET    : TEasyThread;
  public
    procedure ThreadProcedure;  //別スレッドから呼ばれる
    procedure VCL;  //別スレッドからVCLにアクセスする場合に使う
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;

  if not Assigned(ET) then ET := TEasyThread.Create(ThreadProcedure);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(ET) then ET.Free;
end;

procedure TForm1.ThreadProcedure;
begin
   //別スレッドから呼ばれる関数内でループ処理を行う場合は、かならずTerminated変数を監視する 
  while not ET.Terminated do begin  
  
    Inc(Count);

    //VCLを使う場合はSynchronizeから呼び出す
    ET.Synchronize(VCL);

    Sleep(1);

    if Count = 3000 then Break;
  end;
end;

procedure TForm1.VCL;
begin
  Label1.Caption := IntToStr(Count);
end;

[5回]