unit COSBI_Common;
{
  COSBI: Comprehensive Open Source Benchmarking Initiative
  Copyright (c) 2004 Van Smith

  This program is free software; you can redistribute it and/or
  modify it under the terms of the GNU General Public License
  as published by the Free Software Foundation; either version 2
  of the License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

  The current web address of the GNU General Public License is:
  http://www.gnu.org/licenses/gpl.html

  You can contact the authors of this software at:
  cosbi@vanshardware.com
  See www.vanshardware.com or www.cosbi.org for more contact details.
}
//==============================================================================
// Unit name: COSBI_Common
// Unit description: Contains a library of common routines
// Author: Van Smith
// Date: March 31, 2004
// OS dependent: Yes: Windows
// Resolution dependent: There are screen res routines.
// External unit dependencies: math
//==============================================================================
// Modification History
// ------------ -------
// Ver  Date   Who    Description
// ==== ====== ====== ==========================================================
// 1.0  040331 Van     Created.
//==============================================================================

interface

uses
  // if you use Delphi7, add DateUtils unit in uses clause.
  Windows, Messages, SysUtils, Classes, ShellAPI, Forms, StdCtrls, DateUtils,
  Dialogs, math, Registry;

type
  TComplexNumber = record
    Real : double;
    Imaginary : double;
  end; // record

  TDynamicIntegerArray = array of Integer;
  TStopWatchRes = (swresHigh, swresLow, swresCPU);
  EHiResNotAvailable = class( Exception );
  //EAbort = class( Exception );

  Bits = (Bit0,  Bit1,  Bit2,  Bit3,  Bit4,  Bit5,  Bit6,  Bit7,
          Bit8,  Bit9,  Bit10, Bit11, Bit12, Bit13, Bit14, Bit15,
          Bit16, Bit17, Bit18, Bit19, Bit20, Bit21, Bit22, Bit23,
          Bit24, Bit25, Bit26, Bit27, Bit28, Bit29, Bit30, Bit31,
          Bit32, Bit33, Bit34, Bit35, Bit36, Bit37, Bit38, Bit39,
          Bit40, Bit41, Bit42, Bit43, Bit44, Bit45, Bit46, Bit47,
          Bit48, Bit49, Bit50, Bit51, Bit52, Bit53, Bit54, Bit55,
          Bit56, Bit57, Bit58, Bit59, Bit60, Bit61, Bit62, Bit63);

  T8Bits  = set of Bit0..Bit7;
  T16Bits = set of Bit0..Bit15;
  T32Bits = set of Bit0..Bit31;
  T64Bits = set of Bit0..Bit63;

  TRDTSCTimeStamp = record
  case byte of
     1: (int64:  int64);
     2: (low32, high32: dword);
  end;

  Tx86_32_GPRegisters = record
  case byte of
    1: (_eax : LongWord;
        _ebx : LongWord;
        _ecx : LongWord;
        _edx : LongWord);
    2: (str : array [0..15] of char);
    3: (str_eax : array [0..3] of char;
        str_ebx : array [0..3] of char;
        str_ecx : array [0..3] of char;
        str_edx : array [0..3] of char);
    4: (bits_eax : T32Bits;
        bits_ebx : T32Bits;
        bits_ecx : T32Bits;
        bits_edx : T32Bits);
  end; // Tx86_32_GPRegisters

  // TStopWatch begins
  TStopWatch = class( TObject )
  private
    fStartTick    : Int64;
    fStopTick     : Int64;
    fFrequency    : Int64;
    fCPUSpeed     : Extended;
    fElapsedTime  : Extended;
    fLapTick      : Extended;
    fResolution   : TStopWatchRes;
    fCalibrated   : Boolean;
    fIsHiRes      : Boolean;
    fOverhead     : Int64;
    fSleepTime    : integer;
    function GetElapsedTime: Extended;
    function GetFrequency: Int64;
    function GetStartTick: Int64;
    function GetStopTick: Int64;
    function GetResolution: TStopWatchRes;
    procedure SetResolution(Value : TStopWatchRes);
    procedure SetSleepTime(Value : integer);
    procedure CalibrateTimer;
  public
    constructor Create; overload;
    procedure StartTimer;
    function  StopTimer: Extended;
    function  SplitTime: Extended;
    function  LapTime: Extended;
    function  GetCPUClockspeed( ForceCalibrate : Boolean ): Extended;
    property  ElapsedTime: Extended read GetElapsedTime;
    property  Frequency: Int64 read GetFrequency;
    property  Resolution: TStopWatchRes read GetResolution write SetResolution;
    property  SleepTime: integer read fSleepTime write SetSleepTime;
    property  StartTick: Int64 read GetStartTick;
    property  StopTick: Int64 read GetStopTick;
  end; // TStopWatch

// process code take from:
// http://www.thedelphimagazine.com/samples/1328/1328.htm
// example usage:
//procedure TForm1.RadioGroup1Click(Sender: TObject);
//var
//  i : integer;
//  LibHandle : THandle;
//  MemUsageStart : integer;
//  DllName : string;
//  ProcessID : DWord;
//begin
//  ...
//  ProcessID := GetCurrentProcessID;
//  // Dummy call to force PSAPI.DLL to be loaded and added to
//  // the workingset
//  MemUsageStart := ProcessMemoryUsage(ProcessID);
//  // Dummy Load and unload the DLL once to get a more
//  // accurate picture of the full workingset
//  LibHandle := Loadlibrary(PChar(DllName));
//  if LibHandle <> 0 then
//    FreeLibrary(LibHandle)
//  else
//    RaiseLastWin32Error;
//  MemUsageStart := ProcessMemoryUsage(ProcessID);
//  for i := 1 to 200 do begin
//    LibHandle := Loadlibrary(PChar(DllName));
//      if LibHandle <> 0 then
//        FreeLibrary(LibHandle)
//      else
//        RaiseLastWin32Error;
//      Caption := 'Memory Lost '+ IntToStr(
//        (ProcessMemoryUsage(ProcessID) - MemUsageStart)
//        div 1024) +' kbytes Loaded '+IntToStr(i);
//      Application.ProcessMessages;
//    end;
//  ...
//end;
  PPROCESS_MEMORY_COUNTERS = ^PROCESS_MEMORY_COUNTERS;
  PROCESS_MEMORY_COUNTERS = record
    cb : DWORD;
    PageFaultCount : DWORD;
    PeakWorkingSetSize : DWORD;
    WorkingSetSize : DWORD; //Task managers MemUsage number
    QuotaPeakPagedPoolUsage : DWORD;
    QuotaPagedPoolUsage : DWORD;
    QuotaPeakNonPagedPoolUsage : DWORD;
    QuotaNonPagedPoolUsage : DWORD;
    PagefileUsage : DWORD; //TaskMan's VM Size number
    PeakPagefileUsage : DWORD;
  end;
  TProcessMemoryCounters = PROCESS_MEMORY_COUNTERS;
//... end process memory stuff

  procedure RandomizeArray(FillMe: TDynamicIntegerArray); overload;
  procedure RandomizeArray(var FillMe: array of Int64); overload;
  procedure RandomizeArray(var FillMe: array of Double); overload;
  procedure RandomizeArray(var FillMe: array of Extended); overload;
  procedure StartProgram(const ProgramName: String;
                         const Parameters: String = '';
                         const WorkDir: String = '';
                         const ShowCmd: Integer = SW_SHOWNORMAL);
  procedure StartProgramWait(asProgramName  : String;
                             awVisible     : Word );
  function  GetCycleCount:  Int64;
  function  Fibonacci( n : integer ) : integer;
procedure SaveStringListToFile(aStrings : TStrings;
                               asFileName : string;
                               abAppend : Boolean = FALSE;
                               abOverWrite : Boolean = FALSE);
  procedure SaveStringListViaFileBrowser(aStrings : TStrings;
                             asDefaultFileName : string = 'DefaultFileName.txt';
                             abAppend : Boolean = FALSE);
  procedure KillProcess( ahwndKillMe : Hwnd );
  procedure ShowTaskBar(abShow: Boolean);
  procedure DisableScreenSaver;
  procedure EnableScreenSaver;
  procedure SystemKeys(aDisable: Boolean);
  function GetScreenRes: string;
  function ExtractBitValue( aDoubleWord : DWord;
                            aStartBit, aEndBit : integer ) : cardinal;
  function BooleanToYesNo( aBoolean : Boolean): string;
  function BooleanToTrueFalse( aBoolean : Boolean): string;
  function IsByteInDWord( aByte : Byte;
                          aDWord : DWord;
                          aiSkip : integer = 0 ): Boolean;
  function GetPhysicalMemoryInBytes: int64;
  function GetPhysicalVirtualMemoryInBytes: int64;
  function GetAvailableMemoryInBytes: int64;
  function GetMemoryLoad: integer;
  procedure SetWinMHz(Value : integer);
  procedure RunProcessIdleTasks;
  procedure RunDiskDefrag( acDriveLetter : char; aiNumberOfTimes : integer );
  function GetDriveFreeSpace( acDriveLetter : char ): Int64;
  function DriveIsBigEnough( acDriveLetter : char; ai64SizeNeeded : int64 ): Boolean;
  function DriveNbr( acDriveLetter : char ): integer;
  function ReadEnvironmentVariable( asEnvironmentVariableName : string ): string;
  function GetNumberOfProcessors: integer;

// process code take from:
// http://www.thedelphimagazine.com/samples/1328/1328.htm
  function GetProcessMemoryInfo(Process : THandle;
   var MemoryCounters : TProcessMemoryCounters;
   cb : DWORD) : BOOL; stdcall;
  function ProcessMemoryUsage(ProcessID : DWORD): DWORD;
  function RandomCentaurInteger( aiEDX :integer ): integer;
  function ComplexNumberModulus( aComplexNumber : TComplexNumber ): double;
  function ComplexNumberAdd( aComplexNumber1,
                           aComplexNumber2 : TComplexNumber ): TComplexNumber;
  function ComplexNumberSquare( aComplexNumber : TComplexNumber ): TComplexNumber;

const
  KEY_ESC       = #27;
  CR_LF         = #13 + #10;
  CRLF          = CR_LF;
  TAB           = #9;
  ONE_BILLION   = 1000000000;
  ONE_KB        = 1024;
  ONE_MB        = ONE_KB * ONE_KB;
  ONE_MEGABYTE  = ONE_MB;
  ONE_KILOBYTE  = ONE_KB;
  ONE_MILLION   = 1000000;
  PI = 3.141592653589793238462643383279502884197;

implementation

const

  LOW_RES_TICKS = 1000;
  PROCESS_KILL = $0001;
  REG_KEY_PROCESSOR   = 'HARDWARE\DESCRIPTION\System\CentralProcessor\0';
  REG_VALUE_CPU_NAME  = 'ProcessorNameString';
  REG_VALUE_VENDOR_ID = 'VendorIdentifier';
  REG_VALUE_CORE_ID   = 'Identifier';
  REG_VALUE_MHZ       = '~Mhz';

  procedure KillProcess( ahwndKillMe : Hwnd );
  var
     lcPID: cardinal;
     lhandleProcess: THandle;
  begin
    GetWindowThreadProcessId( ahwndKillMe, @lcPID );
    lhandleProcess := OpenProcess( PROCESS_KILL, FALSE, lcPID );
    TerminateProcess( lhandleProcess, 4 );
  end; // procedure KillProcess

  {
   Supply a fully qualified path name in ProgramName
   and any arguments on the command line. As the help file
   states: "If lpApplicationName is NULL, the first white space-delimited
   token of the command line specifies the module name..." In English,
   the characters before the first space encountered (or if no space is
   encountered as in a single program call) is interpreted as the
   EXE to execute. The rest of the string is the argument line.
   Note that awVisible should be one of the SW constants like SW_HIDE,
   SW_MAXIMIZE, SW_MINIMIZE, SW_RESTORE, SW_SHOW, SW_SHOWDEFAULT, etc.
   Derived from: http://www.delphicorner.f9.co.uk/articles/wapi4.htm
   also see:
     ShellExecute(Handle, 'Open', 'notepad', nil, nil, SW_SHOW);
     WinExec( ls_RunProgram SW_HIDE);
     ShellExecute(Handle, 'Open', 'ChgRatio.exe', PAnsiChar(edClockRatio.Text), nil, SW_HIDE);
     CreateProcess(PAnsiChar(ls_RunProgram),
   }
  procedure StartProgramWait(asProgramName  : String;
                             awVisible     : Word );
  var
    StartInfo  : TStartupInfo;
    ProcInfo   : TProcessInformation;
    CreateOK   : Boolean;
    lcExitCode : Cardinal;
  begin

    { fill with known state }
    FillChar(StartInfo,SizeOf(TStartupInfo),#0);
    FillChar(ProcInfo,SizeOf(TProcessInformation),#0);

    with StartInfo do begin
      cb := SizeOf(TStartupInfo);
      lpReserved := nil;
      lpDesktop := nil;
      lpTitle := nil;
      dwFlags := STARTF_USESHOWWINDOW;
      wShowWindow := awVisible;
      cbReserved2 := 0;
      lpReserved2 := nil;
    end;

    CreateOK := CreateProcess(nil, PChar(asProgramName), nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
              nil, nil, StartInfo, ProcInfo);

    { check to see if successful }
    if CreateOK then begin
      //may or may not be needed. Usually wait for child processes
      WaitForSingleObject(ProcInfo.hProcess, INFINITE);
      GetExitCodeProcess(ProcInfo.hProcess, lcExitCode);
      CloseHandle(ProcInfo.hProcess);
    end else begin
      raise Exception.CreateFmt('Error starting program ' + asProgramName +
            '.Error Code %d', [GetLastError]);
    end;
  end; // StartProgramWait

  // from http://www.alistairkeys.co.uk/hints.shtml
  procedure StartProgram(const ProgramName: String;
                         const Parameters: String = '';
                         const WorkDir: String = '';
                         const ShowCmd: Integer = SW_SHOWNORMAL);
  begin
    ShellExecute(0, 'open', PChar(ProgramName), PChar(Parameters), PChar(WorkDir), ShowCmd);
  end; // procedure StartProgram

  // only works on WinXP and above
  procedure RunProcessIdleTasks;
  var
    lsCommandString : string;
  begin
    lsCommandString := 'rundll32.exe advapi32.dll,ProcessIdleTasks';
    StartProgramWait( lsCommandString, SW_MAXIMIZE );
  end; // procedure RunProcessIdleTasks;

  // only works on WinXP and above
  procedure RunDiskDefrag( acDriveLetter : char; aiNumberOfTimes : integer );
  var
    lsCommandString : string;
    i : integer;
  begin
    if acDriveLetter = '' then acDriveLetter := 'c';
    if aiNumberOfTimes < 1 then aiNumberOfTimes := 1;
    if aiNumberOfTimes > 1000 then aiNumberOfTimes := 1000; // set limit to 1000 defrags;
    lsCommandString := 'defrag ' + acDriveLetter + ': -v';
    for i := 1 to aiNumberOfTimes do begin
      StartProgramWait( lsCommandString, SW_SHOWNORMAL );
    end; // for
  end; // procedure RunDiskDefrag

  function DriveNbr( acDriveLetter : char ): integer;
  var
    lsDrive : string;
  begin
    lsDrive := UpperCase( acDriveLetter );
    acDriveLetter := lsDrive[1];
    result := ord( acDriveLetter ) - 64;
  end; //function DriveNbr

  function GetDriveFreeSpace( acDriveLetter : char ): Int64;
  var
    liDriveNbr : integer;
  begin
    result := -1;
    liDriveNbr := DriveNbr( acDriveLetter );
    result := DiskFree( liDriveNbr );
  end; // function GetDriveFreeSpace

  function DriveIsBigEnough( acDriveLetter : char; ai64SizeNeeded : int64 ): Boolean;
  begin
    result := FALSE;
    if GetDriveFreeSpace( acDriveLetter ) > ai64SizeNeeded then result := TRUE;
  end; // function IsDriveBigEnough( acDriveLetter : char; ai64SizeNeeded : int64 );

  function Fibonacci( n : integer ) : integer;
  begin
    if n > 2 then
      result := Fibonacci( n - 1 ) + Fibonacci( n - 2 )
    else
      result := 1;
  end;

  function GetCycleCount:  Int64;
  asm
    RDTSC;
  end;

  procedure RandomizeArray(FillMe: TDynamicIntegerArray); overload;
  var
    I: Integer;
    li_ArraySize : integer;
  begin
//    RandSeed := 1;
    li_ArraySize := High(FillMe);
    for I := Low(FillMe) to li_ArraySize do
    begin
      FillMe[I] := Random(li_ArraySize);
    end;
  end;

  procedure RandomizeArray(var FillMe: array of Int64); overload;
  var
    I: Integer;
    li_ArraySize : integer;
  begin
//    RandSeed := 1;
    li_ArraySize := High(FillMe);
    for I := Low(FillMe) to li_ArraySize do
    begin
      FillMe[I] := Random(li_ArraySize);
    end;
  end;

  procedure RandomizeArray(var FillMe: array of Double); overload;
  var
    I: Integer;
    li_ArraySize : integer;
  begin
//    RandSeed := 1;
    li_ArraySize := High(FillMe);
    for I := Low(FillMe) to li_ArraySize do
    begin
      FillMe[I] := Random(li_ArraySize * 777) / PI;
    end;
  end;

  procedure RandomizeArray(var FillMe: array of Extended); overload;
  var
    I: Integer;
    li_ArraySize : integer;
  begin
//    RandSeed := 1;
    li_ArraySize := High(FillMe);
    for I := Low(FillMe) to li_ArraySize do
    begin
      FillMe[I] := Random(li_ArraySize);
    end;
  end;


// TStopWatch begins............................................................
  constructor TStopWatch.Create;
  begin
    inherited;
    fIsHiRes := QueryPerformanceFrequency(fFrequency);
    fStartTick := -1;
    fStopTick := -1;
    fElapsedTime := -1;
    fLapTick := -1;
    fCalibrated := FALSE;
    fCPUSpeed := -1;
    SleepTime := 1000;
  end; // constructor TStopWatch.Create

  procedure TStopWatch.SetSleepTime( Value : integer );
  begin
    fSleepTime := Value;
  end; // procedure SetSleepTime( Value : integer );

  function TStopWatch.GetResolution: TStopWatchRes;
  begin
    Result := fResolution;
  end; // function TStopWatch.GetResolution: TStopWatchRes;

  procedure TStopWatch.SetResolution(Value : TStopWatchRes);
  begin
    if (not fIsHiRes) and (Value = swresHigh) then begin
      raise EHiResNotAvailable.Create('High resolution timer is not available');
    end;
    fResolution := Value;
    If ( fResolution = swresCPU ) and ( not fCalibrated ) then begin
      CalibrateTimer;
    end;
    fStartTick := -1;
    fStopTick := -1;
    fElapsedTime := -1;
    fLapTick := -1;
  end; // procedure TStopWatch.SetResolution

  procedure TStopWatch.CalibrateTimer;
  var
    li_dummy : double;
    // these variables have been added
    li_PriorityClass  : integer;
    li_Priority       : integer;
    // ================================
    li64_StartTick    : Int64;
    li64_StopTick     : Int64;
    li64_TickCount    : Int64;
    // these variables are added to save actual time
    EncodedTime       : TDateTime;
    EncodedTime1      : TDateTime;
    // ============================
//    // this function, which taken from DateUtils unit, is used to count the
//    // difference between two DateTimes given in milliseconds unit.
//    // if you use Delphi7, make sure to remove this function.
//    function MilliSecondsBetween(ANow, AThen: TDateTime): Int64;
//      function SpanOfNowAndThen(ANow, AThen: TDateTime): Double;
//      begin
//        if ANow < AThen then
//          Result := AThen - ANow
//        else
//          Result := ANow - AThen;
//      end;
//
//    begin
//      Result := Trunc(MSecsPerDay * SpanOfNowAndThen(ANow, AThen));
//    end;
//    // =====================================================================
  begin
    // These instructions below are used to save our priority class and
    // our priority thread and then set their priority to 'realtime' and
    // 'time critical'.
    // This step is used to prevent other applications using the processor time
    // to do their instructions, so the result is closely more accurate.
//    li_PriorityClass := GetPriorityClass(GetCurrentProcess);
//    li_Priority := GetthreadPriority(GetCurrentthread);
//    SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
//    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
    // ========================================================================
    // for power saving technologies we need to spin up CPU:
    li_dummy := Fibonacci( 38 );
    // now get cpu frequency:
    li64_StartTick := GetCycleCount;
    if fIsHiRes then begin
      QueryPerformanceCounter( fStartTick );
    end else begin
      fStartTick := Int64( GetTickCount );
    end;
    // use 'big loop' instead of 'sleep' function to prevent mobile processor
    // going to sleep mode operation. It doesnt seem elegant, but it works.
    EncodedTime := Now;
    repeat
      // for power saving technologies we need to keep CPU spinning:
      li_dummy := Fibonacci(36);
      EncodedTime1 := Now;
    until MilliSecondsBetween(EncodedTime1, EncodedTime) > (fSleepTime);
    // ======================================================================
//    Sleep( fSleepTime );
    if fIsHiRes then begin
      QueryPerformanceCounter( fStopTick );
      fElapsedTime := ( fStopTick - fStartTick ) / fFrequency;
    end else begin
      fStopTick := Int64( GetTickCount );
      fElapsedTime := ( fStopTick - fStartTick ) / LOW_RES_TICKS;
    end;
    li64_StopTick := GetCycleCount;
    li64_TickCount := li64_StopTick - li64_StartTick;
    fCPUSpeed := li64_TickCount / fElapsedTime;
    // measure overhead:
    li64_StartTick := GetCycleCount;
    li64_StopTick := GetCycleCount;
    fOverhead := li64_StopTick - li64_StartTick;
    fCalibrated := TRUE;
    // restore our priority back.
//    SetThreadPriority(GetCurrentThread, li_Priority);
//    SetPriorityClass(GetCurrentProcess, li_PriorityClass);
    // ========================================================================
  end;

  function  TStopWatch.GetCPUClockspeed( ForceCalibrate : Boolean ): Extended;
  begin
    if (ForceCalibrate or ( fCPUSpeed = -1) ) then CalibrateTimer;
    result := fCPUSpeed;
  end;

  procedure TStopWatch.StartTimer;
  begin
    case fResolution of
      swresCPU  : begin
                    fStartTick := GetCycleCount;
                  end;
      swresHigh : begin
                    QueryPerformanceCounter( fStartTick );
                  end;
      swresLow  : begin
                    fStartTick := Int64( GetTickCount );
                  end;
    end; // case
    fStopTick := -1;
    fElapsedTime := -1;
    fLapTick := fStartTick;
  end; // procedure TStopWatch.StartTimer

  function TStopWatch.GetFrequency: Int64;
  begin
    GetFrequency := -1;
    case fResolution of
      swresCPU  : GetFrequency := Round( fCPUSpeed );
      swresHigh : GetFrequency := fFrequency;
      swresLow  : GetFrequency := LOW_RES_TICKS;
    end;
  end; // function TStopWatch.GetFrequency

  function TStopWatch.GetStartTick: Int64;
  begin
    GetStartTick := fStartTick;
  end; // function TStopWatch.GetStartTick

  function TStopWatch.GetStopTick: Int64;
  begin
    GetStopTick := fStopTick;
  end; // function TStopWatch.GetStopTick:

  function TStopWatch.StopTimer: Extended;
  begin
    case fResolution of
      swresCPU  : begin
                    fStopTick := GetCycleCount;
                    fElapsedTime := (( fStopTick - fStartTick ) - fOverhead) / fCPUSpeed;
                  end;
      swresHigh : begin
                    QueryPerformanceCounter( fStopTick );
                    fElapsedTime := ( fStopTick - fStartTick ) / fFrequency;
                  end;
      swresLow  : begin
                    fStopTick := Int64( GetTickCount );
                    fElapsedTime := ( fStopTick - fStartTick ) / LOW_RES_TICKS;
                  end;
    end; // case
    StopTimer := fElapsedTime;
  end; // function TStopWatch.StopTimer


  function TStopWatch.SplitTime: Extended;
  var
    li64_Split  : Int64;
  begin
    SplitTime := -1;
    case fResolution of
      swresCPU  : begin
                    li64_Split := GetCycleCount;
                    SplitTime := (( li64_Split - fStartTick )- fOverhead) / fCPUSpeed;
                  end;
      swresHigh : begin
                    QueryPerformanceCounter( li64_Split );
                    SplitTime := ( li64_Split - fStartTick ) / fFrequency;
                  end;
      swresLow  : begin
                    li64_Split := Int64( GetTickCount );
                    SplitTime := ( li64_Split - fStartTick ) / LOW_RES_TICKS;
                  end;
    end; // case
  end; // function TStopWatch.SplitTime


  function TStopWatch.LapTime: Extended;
  var
    li64_Split  : Int64;
  begin
    LapTime := -1;
    case fResolution of
      swresCPU  : begin
                    li64_Split := GetCycleCount;
                    LapTime := (( li64_Split - fLapTick ) - fOverhead) / fCPUSpeed;
                  end;
      swresHigh : begin
                    QueryPerformanceCounter( li64_Split );
                    LapTime := ( li64_Split - fLapTick ) / fFrequency;
                  end;
      swresLow  : begin
                    li64_Split := Int64( GetTickCount );
                    LapTime := ( li64_Split - fLapTick ) / LOW_RES_TICKS;
                  end;
    end; // case
    fLapTick := li64_Split;
  end; // function TStopWatch.LapTime

  function TStopWatch.GetElapsedTime: Extended;
  begin
    GetElapsedTime := fElapsedTime;
  end; // function TStopWatch.GetElapsedTime

// TStopWatch ends..............................................................

procedure SaveStringListViaFileBrowser(aStrings : TStrings;
                             asDefaultFileName : string = 'DefaultFileName.txt';
                             abAppend : Boolean = FALSE);
var
  lSaveDialog : TSaveDialog;
const
  FILE_SUFFIX = '.txt';
begin
  // set default filename:
  lSaveDialog := TSaveDialog.Create(Application);
  with lSaveDialog do try
    FileName := asDefaultFileName;
    //execute the save dialog:
    if Execute then begin
      asDefaultFileName := FileName;
      if Pos('.', asDefaultFileName) = 0 then begin
        asDefaultFileName := asDefaultFileName + FILE_SUFFIX;
      end; // if
      SaveStringListToFile(aStrings, asDefaultFileName, abAppend);
    end; // if
  finally
    FreeAndNil(lSaveDialog);
  end;
end; // procedure SaveStringListDataBrowse

procedure SaveStringListToFile(aStrings : TStrings;
                                   asFileName : string;
                                   abAppend : Boolean = FALSE;
                                   abOverWrite : Boolean = FALSE);
var
  ltxtfile_out  : TextFile;
  li_YesNo      : integer;
  ls_Msg        : string;
begin
  if asFileName = '' then begin
    ShowMessage('"' + asFileName + '" is not a valid file name.');
    exit;
  end; // if
  if FileExists(asFileName) then begin
    // if we are intending to append to a file then we are good to go, but
    // if the file exists, and we are not trying to append to a file then we
    // need to warn the user that the old file will be erased if they continue:
    if (not abAppend) AND (not abOverWrite) then begin
      ls_Msg := 'A file already exists with the name: "' + asFileName
        + '".' + CR_LF + 'Save anyway (WARNING: old file will be overwritten)?';
      li_YesNo := Application.MessageBox(PAnsiChar(ls_Msg),
        'File already exists!', MB_YESNO);
      // exit procedure if the answer is "no":
      if li_YesNo = IDNO then exit;
    end; // if not
  end else begin // file does not exist
    // if the file does not exist and we are supposed to append to it, then we
    // need to warn the user that a new file will have to be created:
    if abAppend then begin
      ls_Msg := 'I cannot append to a file named: "' + asFileName
        + '" because the file does not exist.' + CR_LF
        + 'Do you want me to create a new file and save anyway?';
      li_YesNo := Application.MessageBox(PAnsiChar(ls_Msg),
        'File does not exist for append!', MB_YESNO);
      // exit procedure if the answer is "no":
      if li_YesNo = IDNO then exit;
      // turn off append in order to create a new file:
      abAppend := FALSE;
    end; // if abAppend
  end; // if  FileExists(asFileName)
  AssignFile( ltxtfile_out, asFileName );
  if abAppend then begin
    Append( ltxtfile_out );
  end else begin
    Rewrite( ltxtfile_out );
  end; // if
  Write( ltxtfile_out, aStrings.Text);
  Flush( ltxtfile_out );
  CloseFile( ltxtfile_out );
end; // procedure SaveStringListDataToFile

procedure DisableScreenSaver;
begin
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, nil, 0);
end; // DisableScreenSaver

procedure EnableScreenSaver;
begin
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, nil, 0);
end; // EnableScreenSaver

function GetScreenRes: string;
var
  liWidth, liHeight, liColorDepth, liVerticalRefreshRate : integer;
begin
  liWidth := Screen.Width;
  liHeight := Screen.Height;
  liColorDepth := GetDeviceCaps( GetDc( GetDesktopWindow ), BITSPIXEL );
  try
    liVerticalRefreshRate :=
      GetDeviceCaps( GetWindowDC( GetDesktopWindow ), VREFRESH );
  except
    liVerticalRefreshRate := -1;
  end; //try
  result := intToStr( liWidth ) + 'x'
     + intToStr( liHeight ) + 'x'
     + intToStr( liColorDepth ) + '@'
     + intToStr( liVerticalRefreshRate ) + 'Hz';
end; // function GetScreenRes

function ExtractBitValue( aDoubleWord : DWord;
                          aStartBit, aEndBit : integer ) : cardinal;
var
  i, liMask : cardinal;
begin
  if ( aStartBit < 0 ) or ( aStartBit > aEndBit ) or ( aEndBit > 31 ) then begin
   raise exception.Create(
     'ExtractBitValue: You passed me invalid start, stop bits!');
  end; // if
  liMask := 0;
  for i := aStartBit to aEndBit do begin
    liMask := liMask + round( power( 2, i ) );
  end; // for
  Result := aDoubleWord and liMask;
  Result := Result shr aStartBit;
end; // function

function BooleanToYesNo( aBoolean : Boolean): string;
begin
  if aBoolean then result := 'Yes' else result := 'No';
end; // function BooleanToYesNo( aBoolean : Boolean): string;

function BooleanToTrueFalse( aBoolean : Boolean): string;
begin
  if aBoolean then result := 'True' else result := 'False';
end; // function BooleanToTrueFalse( aBoolean : Boolean): string;

function IsByteInDWord( aByte : Byte;
                             aDWord : Dword;
                             aiSkip : integer = 0 ): Boolean;
var
  i, liStartBit, liEndBit : integer;
begin
  result := FALSE;
  for i := 1 to 4 do begin
    if i > aiSkip then begin
      liStartBit := ( i - 1 ) * 8;
      liEndBit := ( i * 8 ) - 1;
      if ExtractBitValue( aDWord, liStartBit, liEndBit) = aByte then begin
        result := TRUE;
        exit;
      end; // if
    end; // if
  end; // for
end; // function LookForByteInDWord

// diables system keys if aDisable = TRUE
procedure SystemKeys(aDisable: Boolean);
 var OldVal : LongInt;
begin
 SystemParametersInfo(SPI_SCREENSAVERRUNNING, Word(aDisable), @OldVal, 0);
end; // procedure SystemKeys(Disable: Boolean);

// process code take from:
// http://www.thedelphimagazine.com/samples/1328/1328.htm
function GetProcessMemoryInfo; external 'psapi.dll';
function ProcessMemoryUsage(ProcessID : DWORD): DWORD;
var
  ProcessHandle : THandle;
  MemCounters   : TProcessMemoryCounters;
begin
  Result := 0;
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or
    PROCESS_VM_READ, false, ProcessID );
  try
    if GetProcessMemoryInfo( ProcessHandle, MemCounters,
      sizeof(MemCounters))  then
      Result := MemCounters.WorkingSetSize;
  finally
    CloseHandle( ProcessHandle );
  end;
end; // function ProcessMemoryUsage(ProcessID : DWORD): DWORD;

function GetPhysicalMemoryInBytes: int64;
var
  lMemoryStatus: TMemoryStatus;
begin
  GlobalMemoryStatus(lMemoryStatus);
  result := lMemoryStatus.dwTotalPhys;
end; // function GetPhysicalMemoryInBytes: int64;

function GetPhysicalVirtualMemoryInBytes: int64;
var
  lMemoryStatus: TMemoryStatus;
begin
  GlobalMemoryStatus(lMemoryStatus);
  result := lMemoryStatus.dwTotalVirtual;
end; // function GetPhysicalVirtualMemoryInBytes: int64;

function GetAvailableMemoryInBytes: int64;
var
  lMemoryStatus: TMemoryStatus;
begin
  GlobalMemoryStatus(lMemoryStatus);
  result := lMemoryStatus.dwAvailPhys;
end; // function GetAvailableMemoryInBytes: int64;

function GetMemoryLoad: integer;
var
  lMemoryStatus: TMemoryStatus;
begin
  GlobalMemoryStatus(lMemoryStatus);
  result := lMemoryStatus.dwMemoryLoad;
end; // function GetAvailableMemoryInBytes: int64;

// show / hide taskbar:
procedure ShowTaskBar(abShow: Boolean);
begin
  if abShow then begin
   ShowWindow(FindWindow('Shell_TrayWnd',nil), SW_SHOWNA)
  end else begin
   ShowWindow(FindWindow('Shell_TrayWnd',nil), SW_HIDE);
  end; // if
end; // procedure ShowTaskBar(abShow: Boolean);

procedure SetWinMHz(Value : integer);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do begin
      try
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKey( REG_KEY_PROCESSOR, TRUE);
        WriteInteger(REG_VALUE_MHZ, Value);
        CloseKey;
      except
        ShowMessage( 'SetWinMHz: Failed to set ~MHz!' );
      end; // try..except
    end; // with
  finally
    Reg.Free;
  end;
end; // procedure THardwareInfo.SetWinMHz(Value : integer);

function RandomCentaurInteger( aiEDX :integer ): integer;
var
  lipResultPointer : ^integer;
begin
  lipResultPointer := @result;
  asm
    mov edi, lipResultPointer // move address of result variable into edi
    mov edx, aiEDX  // random bit rate (accumulate every 2^n bits)
    mov ecx, 4  // number of bytes that we need
    db  $f3,$0f,$a7,$c0  // REPXSTORE
  end;
end;// procedure RandomCentaurInteger;

function ReadEnvironmentVariable( asEnvironmentVariableName : string ): string;
var
  liBufferSize : integer;
begin
  // Get required buffer size (inc. terminal #0)
  liBufferSize := GetEnvironmentVariable(
    PChar( asEnvironmentVariableName ), nil, 0 );
  if liBufferSize > 0 then begin
    // Read env var value into result string
    SetLength( result, liBufferSize - 1 );
    GetEnvironmentVariable( PChar( asEnvironmentVariableName ),
                            PChar( result ),
                            liBufferSize );
  end
  else begin
    // No such environment variable
    result := '';
  end;
end; // function ReadEnvironmentVariable

function GetNumberOfProcessors: integer;
const
  NUMBER_OF_PROCESSORS = 'NUMBER_OF_PROCESSORS';
var
  lsNumberOfProcessors : string;
begin
  lsNumberOfProcessors := ReadEnvironmentVariable( NUMBER_OF_PROCESSORS );
  if lsNumberOfProcessors = '' then begin
    result := 1;
  end else begin
    result := StrToInt( lsNumberOfProcessors );
  end; // if
end; // function GetNumberOfProcessors: integer;

function ComplexNumberModulus( aComplexNumber : TComplexNumber ): double;
begin
  result := sqrt( sqr(aComplexNumber.Real) + sqr(aComplexNumber.Imaginary) );
end; //

function ComplexNumberAdd( aComplexNumber1,
                           aComplexNumber2 : TComplexNumber ): TComplexNumber;
begin
  result.Real := aComplexNumber1.Real + aComplexNumber2.Real;
  result.Imaginary := aComplexNumber1.Imaginary + aComplexNumber2.Imaginary;
end;

function ComplexNumberSquare( aComplexNumber : TComplexNumber ): TComplexNumber;
begin
  result.Real := sqr( aComplexNumber.Real ) - sqr( aComplexNumber.Imaginary );
  result.Imaginary := 2 * aComplexNumber.Real * aComplexNumber.Imaginary;
end;

end.
