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;

//使用例
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となります。

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    procedure WMDropFiles(var msg: TWMDROPFILES); message WM_DROPFILES;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  //ファイルのドラッグ受け入れ準備
  DragAcceptFiles(Handle, true);
end;

procedure TForm1.WMDropFiles(var msg: TWMDROPFILES);
var
  Count    : Integer;
  FileName : String;
begin
  try
    //ドラッグされたファイルの数を取得（今回は無視） 
    Count := DragQueryFile(msg.Drop, $ffffffff, nil, 0);
    //ファイル名を受け取る文字列を必要な容量分確保する
    SetLength( FileName , DragQueryFile(msg.Drop, 0, nil, 0) + 1 );
    //変数FailNameにドラッグされたファイルのフルパスを代入
    DragQueryFile(msg.Drop, 0, @FileName[1], Length(FileName));
  finally
    //ドラッグ終了
    DragFinish(msg.Drop);
  end;
end;

uses
  Windows,
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

const
  MutexName      = 'TEST_APPLICATION'; //この文字列を一意になるよう変更
var
  hMutex : THANDLE;
begin
  hMutex := OpenMutex(MUTEX_ALL_ACCESS, False, MutexName);
  if (hMutex <> 0) then begin CloseHandle(hMutex); Exit; end;
  hMutex := CreateMutex(nil, False, MutexName);

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;

  CloseHandle(hMutex);
end.

MutexNameの文字列は自由に変更して使いますが、他のミューテックス名と被ると一つも起動できなくなる恐れがありますのでユニークになるように工夫してください。

  GetMem(VerInfo, VerInfoSize);
  try
    GetFileVersionInfo( PChar(ParamStr(0)), 0, VerInfoSize, VerInfo );
    VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);

    with VerValue^ do begin
      Result := Format('Ver%d.%d.%.3d [Build:%.4d]' , [(dwFileVersionMS shr 16)
                                          , (dwFileVersionMS and $FFFF)
                                          , (dwFileVersionLS shr 16)
                                          , (dwFileVersionLS and $FFFF)])
    end;
  finally
    FreeMem(VerInfo, VerInfoSize);
  end;
end;