MiTec/Common/MiTeC_CommonDefs.pas

{*******************************************************}
{         MiTeC Common Definitions & Types              }
{                                                       }
{        Copyright (c) 1997-2021 Michal Mutl            }
{                                                       }
{*******************************************************}

{$INCLUDE Compilers.Inc}

unit MiTeC_CommonDefs;

interface

uses {$IFDEF RAD9PLUS}
     WinAPI.Windows, System.SysUtils, System.Math, System.Classes,
     {$ELSE}
     Windows, SysUtils, Math, Classes,
     {$ENDIF}
     MiTeC_Windows;

type
  TSample = record
    Value: double;
    Delta: double;
    Max: double;
    Min: double;
    MaxDelta: double;
    MinDelta: double;
    AccumulatedValue: double;
    AccumulatedDelta: double;
    AccumulatedCount: Cardinal;

    procedure Clear(AOnlyAccumulated: boolean = False);
    procedure Update(ANewValue: double);
    function AverageValue: double;
    function AverageDelta: double;
    function RoundDelta: Int64;
    function RoundValue: Int64;
    function RoundUValue: UInt64;
    function RoundAccumulatedValue: Int64;
    function RoundAccumulatedDelta: Int64;
    function RoundMax: Int64;
    function RoundMin: Int64;
    function RoundMaxDelta: Int64;
    function RoundMinDelta: Int64;
  end;

  TSamples = record
    Items: array of TSample;

    procedure Clear;
    procedure ClearValues(AOnlyAccumulated: boolean = False);
    procedure Update(AIndex: integer; ANewValue: double);
    function Count: integer;
    function Sum: double;
    function SumDelta: double;
    function SumAccumulatedValue: double;
    function SumAccumulatedDelta: double;
    function AverageValue: double;
    function AverageDelta: double;
  end;

  TVersionInfo = record
    FileName,
    FileVersion,
    ProductVersion,
    FileVersionText,
    ProductVersionText,
    ProductName,
    CompanyName,
    Description,
    Comments,
    Copyright,
    Trademarks,
    InternalName,
    OriginalFilename: string;
    Major,
    Minor,
    Release,
    Build: Cardinal;
    ProductMajor,
    ProductMinor,
    ProductRelease,
    ProductBuild: Cardinal;
    SpecialBuild: string;
    PreReleaseBuild: Boolean;
    DebugBuild: Boolean;
    PrivateBuild: Boolean;
    BuildTimestamp: string;

    function GetCompany: string;
    function GetFullDesc(AIncludeVersion: boolean = True): string;
  end;

  TPrivilegeInfo = record
    Name,
    DisplayName: String;
    Flags: Cardinal;
  end;
  TPrivilegeList = array of TPrivilegeInfo;

  TTokenGroupInfo = record
    SID,
    Domain,
    Name: String;
    Flags: Cardinal;
  end;
  TTokenGroupList = array of TTokenGroupInfo;

  TVolumeEntry = record
    DiskSign: string;
    DeviceName: string;
    VolumeID: string;
  end;
  TVolumeTable = record
    Items: array of TVolumeEntry;
    function FindVolume(ADiskSign: string): integer;
  end;

  THandleRecord = record
    PID: Cardinal;
    Handle: WORD;
    Typ: integer;
    Access: Cardinal;
    Address: Cardinal;
    Attributes: Cardinal;
    Name,
    TypeName: string;
    FilePos: Int64;
    _Exists: boolean;
    _ProcessName: string;
  end;
  PHandleRecord = ^THandleRecord;

  TThreadRecord = record
    ID: Cardinal;
    Handle: THandle;
    StartAddress: NativeUInt;
    ContextSwitchCount: Cardinal;
    State: Cardinal;
    WaitReason: Cardinal;
    Priority: KPRIORITY;
    BasePriority: integer;
    CPUUsage,
    MaxCPUUsage: Double;
    AvgCPUUsage: Double;
    KernelTime,
    UserTime: Int64;
    WaitTime: Cardinal;
    CreateTime: TDateTime;
    CPUTime,
    Cycles: TSample;
    Text: string;
    StartAddressString: string;
    Description: string;
    _Exists: Boolean;
  end;
  PThreadRecord = ^TThreadRecord;

  TThreadHistoryRecord = record
    ID: Cardinal;
    CreateTime,
    TerminateTime: TDateTime;
    MaxCPUUsage: Double;
    AvgCPUUsage: Double;
    StartAddressString: string;
    Text: string;
  end;
  PThreadHistoryRecord = ^TThreadHistoryRecord;

  TModuleRecord = record
    Name,
    ImageName: String;
    ImageSize: Cardinal;
    EntryPoint: Cardinal;
    BaseAddress: NativeUInt;
    VersionInfo: TVersionInfo;
    Size: Int64;
    _Exists: Boolean;
  end;
  PModuleRecord = ^TModuleRecord;

  PWindowRecord = ^TWindowRecord;
  TWindowRecord = record
    ClassName,
    Text :String;
    Handle: THandle;
    Process,
    Thread :Cardinal;
    ParentWin,
    WndProc,
    Instance,
    ID,
    UserData,
    Style,
    ExStyle :integer;
    Rect,
    ClientRect :TRect;
    Atom,
    ClassBytes,
    WinBytes,
    ClassWndProc,
    ClassInstance,
    Background,
    Cursor,
    Icon,
    ClassStyle :integer;
    Styles,
    ExStyles,
    ClassStyles :TStringList;
    Visible,
    Enabled :boolean;
    WindowAffinity: Cardinal;
    DPIAwareness: TDpiAwareness;
    _Flag: Boolean;
  end;

  TProcessPerformanceRecord = record
    CPUUsage,
    PrivateBytes,
    IOReadUsage,
    IOWriteUsage,
    IOOtherUsage,
    CPUTime,
    CycleTime: TSample;
  end;

  TProcessRecord = record
    PID,
    SessionID :Cardinal;
    Handle: THandle;
    Name,
    ImageName,
    DomainName,
    UserName,
    CommandLine,
    Environment,
    ParentImage,
    ParentCmd: string;
    Priority,
    BasePriority,
    ParentPID,
    HandleCount,
    GDIHandleCount,
    USERHandleCount,
    ThreadCount: Cardinal;
    Affinity: NativeUInt;
    //PMCounters: TProcessMemoryCountersEx;
    VMCounters: TVMCounters;
    IOCounters: TIOCounters;
    KernelTime: UInt64;
    UserTime: UInt64;
    Privileges: TPrivilegeList;
    Groups: TTokenGroupList;
    &Platform: Cardinal;
    CreationTime: TDateTime;
    VersionInfo: TVersionInfo;
    Performance: TProcessPerformanceRecord;
    IsSuspended: Boolean;
    System: Boolean;
    Elevation: Cardinal;
    DpiAwareness: TDpiAwareness;
    Cycles: UInt64;
    ChildCount: integer;
    ChildInstancesPrivateBytes: UInt64;
    ChildInstancesUsage: double;
    WindowCount: integer;
    //MainThreadId: Cardinal;
    ThreadList: TList;
    ModuleList: TList;
    HandleList: TList;
    IsNew: Boolean;
    SHA1: string;
    _Exists: Boolean;
    _ImageIndex: integer;

    procedure Initialize;
    procedure Finalize;

    function IndexOfThread(ATID: Cardinal): integer;
  end;
  PProcessRecord = ^TProcessRecord;

procedure ResetMemory(out P; Size: Longint);

implementation

procedure ResetMemory(out P; Size: Longint);
begin
  if Size>0 then begin
    Byte(P):=0;
    FillChar(P,Size,0);
  end;
end;

{ TSample }

function TSample.AverageDelta: double;
begin
  if AccumulatedCount>1 then
    Result:=AccumulatedDelta/AccumulatedCount
  else
    Result:=0;
end;

function TSample.AverageValue: double;
begin
  if AccumulatedCount>0 then
    Result:=AccumulatedValue/AccumulatedCount
  else
    Result:=0;
end;

procedure TSample.Clear(AOnlyAccumulated: boolean);
begin
  if not AOnlyAccumulated then begin
    Delta:=0;
    Value:=0;
    Min:=0;
    Max:=0;
    MaxDelta:=0;
    MinDelta:=0;
  end;
  AccumulatedValue:=0;
  AccumulatedDelta:=0;
  AccumulatedCount:=0;
end;

function TSample.RoundAccumulatedDelta: Int64;
begin
  Result:=Round(AccumulatedDelta);
end;

function TSample.RoundAccumulatedValue: Int64;
begin
  Result:=Round(AccumulatedValue);
end;

function TSample.RoundDelta: Int64;
begin
  Result:=Round(Delta);
end;

function TSample.RoundMax: Int64;
begin
  Result:=Round(Max);
end;

function TSample.RoundMaxDelta: Int64;
begin
  Result:=Round(MaxDelta);
end;

function TSample.RoundMin: Int64;
begin
  Result:=Round(Min);
end;

function TSample.RoundMinDelta: Int64;
begin
  Result:=Round(MinDelta);
end;

function TSample.RoundUValue: UInt64;
begin
  Result:=Round(Value);
end;

function TSample.RoundValue: Int64;
begin
  Result:=Round(Value);
end;

procedure TSample.Update(ANewValue: double);
var
  d: double;
begin
  d:=ANewValue-Value;
  AccumulatedDelta:=AccumulatedDelta+d;
  if CompareValue(d,MaxDelta)=1 then
    Max:=d;
  if CompareValue(d,MinDelta)=-1 then
    Min:=d;
  Delta:=d;
  Value:=ANewValue;
  AccumulatedValue:=AccumulatedValue+ANewValue;
  inc(AccumulatedCount);
  if CompareValue(ANewValue,Max)=1 then
    Max:=ANewValue;
  if CompareValue(ANewValue,Min)=-1 then
    Min:=ANewValue;
end;

{ TSamples }

function TSamples.AverageDelta: double;
begin
  if Count>0 then
    Result:=SumDelta/Count
  else
    Result:=0;
end;

function TSamples.AverageValue: double;
begin
  if Count>0 then
    Result:=Sum/Count
  else
    Result:=0;
end;

procedure TSamples.Clear;
begin
  Finalize(Items);
end;

procedure TSamples.ClearValues(AOnlyAccumulated: boolean);
var
  v: TSample;
begin
  for v in Items do
    v.Clear(AOnlyAccumulated);
end;

function TSamples.Count: integer;
begin
  Result:=Length(Items);
end;

function TSamples.Sum: double;
var
  v: TSample;
begin
  Result:=0;
  for v in Items do
    Result:=Result+v.Value;
end;

function TSamples.SumAccumulatedDelta: double;
var
  v: TSample;
begin
  Result:=0;
  for v in Items do
    Result:=Result+v.AccumulatedDelta;
end;

function TSamples.SumAccumulatedValue: double;
var
  v: TSample;
begin
  Result:=0;
  for v in Items do
    Result:=Result+v.AccumulatedValue;
end;

function TSamples.SumDelta: double;
var
  v: TSample;
begin
  Result:=0;
  for v in Items do
    Result:=Result+v.Delta;
end;

procedure TSamples.Update(AIndex: integer; ANewValue: double);
begin
  Items[AIndex].Update(ANewValue);
end;

{ TProcessRecord }

function TProcessRecord.IndexOfThread(ATID: Cardinal): integer;
var
  i: integer;
begin
  Result:=-1;
  for i:=0 to ThreadList.Count-1 do
    if PThreadRecord(ThreadList[i]).ID=ATID then begin
      Result:=i;
      Break;
    end;
end;

procedure TProcessRecord.Initialize;
begin
  ResetMemory(Self,SizeOf(TProcessRecord));
  ThreadList:=TList.Create;
  ModuleList:=TList.Create;
  HandleList:=TList.Create;
end;

procedure TProcessRecord.Finalize;
begin
  CloseHandle(Handle);
  if Assigned(ThreadList) then
    ThreadList.Free;
  if Assigned(ModuleList) then
    ModuleList.Free;
  if Assigned(HandleList) then
    HandleList.Free;
end;


{ TVersionInfo }

function TVersionInfo.GetCompany: string;
begin
  if (Trim(CompanyName)<>'') and (Pos(AnsiUppercase(CompanyName),AnsiUpperCase(Copyright))=0) then begin
    if (Trim(Copyright)<>'') then
      Result:=Trim(CompanyName)+' - '+Trim(Copyright)
    else
      Result:=Trim(CompanyName);
  end else
    Result:=Trim(Copyright);
end;

function TVersionInfo.GetFullDesc(AIncludeVersion: boolean = True): string;
begin
  Result:=Trim(Description);
  if Result='' then
    Result:=Trim(ProductName);
  if Result='' then
    Result:=ChangeFileExt(ExtractFileName(FileName),'');
  if AIncludeVersion then
    Result:=Trim(Result+' '+FileVersion);
  if (Trim(ProductName)<>'') and (Trim(Description)<>'') and not SameText(ProductName,Description) then
    Result:=Trim(Result)+' - '+Trim(ProductName);
end;


{ TVolumeTable }

function TVolumeTable.FindVolume(ADiskSign: string): integer;
var
  i: integer;
begin
  Result:=-1;
  for i:=0 to High(Items) do
    if SameText(ADiskSign,Items[i].DiskSign) then begin
      Result:=i;
      Break;
    end;
end;

end.