////////////////////////////////////////////////////////////////////////////////
//
//  The Original Code is:
//   SysUpTime.pas, released 2004-01-30.
//
//  The Initial Developer of the Original Code is Nico Bendlin.
//
//  Portions created by Nico Bendlin are
//   Copyright (c) 2004-2006 Nico Bendlin. All Rights Reserved.
//
//  Contributor(s):
//   Nico Bendlin <nicode@gmx.net>
//
//  The contents of this file are subject to the Mozilla Public License Version
//  1.1 (the "License"); you may not use this file except in compliance with the
//  License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
//
//  Software distributed under the License is distributed on an "AS IS" basis,
//  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
//  the specific language governing rights and limitations under the License.
//
//  Alternatively, the contents of this file may be used under the terms of
//  either the GNU General Public License Version 2 or later (the "GPL"), or
//  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
//  in which case the provisions of the GPL or the LGPL are applicable instead
//  of those above. If you wish to allow use of your version of this file only
//  under the terms of either the GPL or the LGPL, and not to allow others to
//  use your version of this file under the terms of the MPL, indicate your
//  decision by deleting the provisions above and replace them with the notice
//  and other provisions required by the GPL or the LGPL. If you do not delete
//  the provisions above, a recipient may use your version of this file under
//  the terms of any one of the MPL, the GPL or the LGPL.
//
////////////////////////////////////////////////////////////////////////////////
//
//  Revision:
//
//    2004-01-30  1.0  [NicoDE]
//                     - initial version, posted at Delphi-PRAXiS
//                       http://www.delphipraxis.net/post125761.html#125761
//    2005-11-10  1.1  [NicoDE]
//                     - SetLastError() added to support better error handling
//    2006-01-18  1.2  [NicoDE]
//                     - Workaround for a ReallocMemory(nil, ...) crash
//
////////////////////////////////////////////////////////////////////////////////

unit SysUpTime;

interface

{$WEAKPACKAGEUNIT}

{$NOINCLUDE System}
{$NOINCLUDE SysInit}

// OS specific versions
function GetSystemUpTimeWinNT(): Int64;
function GetSystemUpTimeWin9x(): Int64;
function GetSystemUpTimeLinux(): Int64;
// Wrapper
function GetSystemUpTime(): Int64;

implementation

uses
{$IFDEF WIN32}
  Windows, SysUtils;
{$ELSE}
{$IFDEF LINUX}
  Libc;
  
 const
   ERROR_CALL_NOT_IMPLEMENTED = ENOSYS;
   
 function SetLastError(Error: Longword): Longword;
 var
   errno: PInteger;
begin
  errno := __errno_location();
  Result := LongWord(errno^);
  LongWord(errno^) := Error;
end;

{$ELSE}
  {$MESSAGE ERROR 'SysUpTime: Unsupported Target Platform'}
{$ENDIF}
{$ENDIF}

////////////////////////////////////////////////////////////////////////////////
//
//  GetSystemUpTimeWinNT()
//
//    Uses the registry interface to get the value of the performance counter
//    '\\localhost\System\System Up Time' in seconds (Result is 0 on error).
//

function GetSystemUpTimeWinNT(): Int64;
{$IFDEF WIN32}
type
  PPerfDataBlock = ^TPerfDataBlock;
  TPerfDataBlock = packed record
    Signature       : array [0..3] of WCHAR;
    LittleEndian    : DWORD;
    Version         : DWORD;
    Revision        : DWORD;
    TotalByteLength : DWORD;
    HeaderLength    : DWORD;
    NumObjectTypes  : DWORD;
    DefaultObject   : DWORD;
    SystemTime      : SYSTEMTIME;
    PerfTime        : LARGE_INTEGER;
    PerfFreq        : LARGE_INTEGER;
    PerfTime100nSec : LARGE_INTEGER;
    SystemNameLength: DWORD;
    SystemNameOffset: DWORD;
  end;
  PPerfObjectType = ^TPerfObjectType;
  TPerfObjectType = packed record
    TotalByteLength     : DWORD;
    DefinitionLength    : DWORD;
    HeaderLength        : DWORD;
    ObjectNameTitleIndex: DWORD;
    ObjectNameTitle     : LPWSTR;
    ObjectHelpTitleIndex: DWORD;
    ObjectHelpTitle     : LPWSTR;
    DetailLevel         : DWORD;
    NumCounters         : DWORD;
    DefaultCounter      : DWORD;
    NumInstances        : DWORD;
    CodePage            : DWORD;
    PerfTime            : LARGE_INTEGER;
    PerfFreq            : LARGE_INTEGER;
  end;
  PPerfCounterDefinition = ^TPerfCounterDefinition;
  TPerfCounterDefinition = packed record
    ByteLength           : DWORD;
    CounterNameTitleIndex: DWORD;
    CounterNameTitle     : LPWSTR;
    CounterHelpTitleIndex: DWORD;
    CounterHelpTitle     : LPWSTR;
    DefaultScale         : DWORD;
    DetailLevel          : DWORD;
    CounterType          : DWORD;
    CounterSize          : DWORD;
    CounterOffset        : DWORD;
  end;
  PPerfInstanceDefinition = ^TPerfInstanceDefinition;
  TPerfInstanceDefinition = packed record
    ByteLength            : DWORD;
    ParentObjectTitleIndex: DWORD;
    ParentObjectInstance  : DWORD;
    UniqueID              : DWORD;
    NameOffset            : DWORD;
    NameLength            : DWORD;
  end;
  PLARGE_INTEGER = ^LARGE_INTEGER;
const
  PERF_SIZE_LARGE      = $00000100;
  PERF_TYPE_COUNTER    = $00000400;
  PERF_COUNTER_ELAPSED = $00040000;
  PERF_OBJECT_TIMER    = $00200000;
  PERF_DISPLAY_SECONDS = $30000000;
  PERF_ELAPSED_TIME    = PERF_SIZE_LARGE or PERF_TYPE_COUNTER or
                         PERF_COUNTER_ELAPSED or PERF_OBJECT_TIMER or
                         PERF_DISPLAY_SECONDS;
  PERF_NO_INSTANCES = DWORD(-1);
var
  ValSize: DWORD;
  QryRtrn: DWORD;
  Counter: PChar;
  CurrIdx: PChar;
  CurrStr: PChar;
  CntrStr: PChar;
  CntrSys: DWORD;
  CntrSUT: DWORD;
  QrySize: DWORD;
  QryData: PPerfDataBlock;
  CurrObj: PPerfObjectType;
  ObjLoop: DWORD;
  CurrDef: PPerfCounterDefinition;
  DefLoop: DWORD;
  ObjInst: PPerfInstanceDefinition;
  CntrVal: PLARGE_INTEGER;
{$ENDIF}
begin
  Result := 0;  // indicates failure
{$IFDEF WIN32}

  // Query required buffer size for the counter list (009 is always available)
  ValSize := 0;
  QryRtrn := RegQueryValueEx(HKEY_PERFORMANCE_DATA, 'Counter 009',
    nil, nil, nil, @ValSize);
  if QryRtrn <> ERROR_SUCCESS then
  begin
    SetLastError(QryRtrn);
    Exit;
  end;
  try

    // Allocate buffer for the counter list
    Inc(ValSize, $1000);
    Counter := GetMemory(ValSize);
    if not Assigned(Counter) then
    begin
      SetLastError(ERROR_NOT_ENOUGH_MEMORY);
      Exit;
    end;
    try

      // Query the counter list
      QryRtrn := RegQueryValueEx(HKEY_PERFORMANCE_DATA, 'Counter 009',
        nil, nil, PByte(Counter), @ValSize);
      if QryRtrn <> ERROR_SUCCESS then
      begin
        SetLastError(QryRtrn);
        Exit;
      end;

      // Get the counter indices of 'System' and 'System Up Time'
      CntrStr := nil;
      CntrSys := 0;
      CntrSUT := 0;
      CurrIdx := Counter;
      while CurrIdx[0] <> #0 do
      begin
        CurrStr := PChar(@CurrIdx[StrLen(CurrIdx) + 1]);
        if (0 = CntrSys) and (0 = StrComp(CurrStr, 'System')) then
        begin
          CntrStr := CurrIdx;
          CntrSys := StrToInt(string(CurrIdx));
          if CntrSUT <> 0 then
            Break;
        end;
        if (0 = CntrSUT) and (0 = StrComp(CurrStr, 'System Up Time')) then
        begin
          CntrSUT := StrToInt(string(CurrIdx));
          if CntrSys <> 0 then
            Break;
        end;
        CurrIdx := PChar(@CurrStr[StrLen(CurrStr) + 1]);
      end;
      if not Assigned(CntrStr) or (0 = CntrSys) or (0 = CntrSUT) then
      begin
        SetLastError(ERROR_INVALID_DATA);
        Exit;
      end;

      // Query performance data
      QrySize := 0;
      QryData := nil;
      try
        repeat
          Inc(QrySize, $1000);
          // ReallocMemory(nil, ...) might crash - buggy implementation?
          if nil = QryData then
            QryData := GetMemory(QrySize)
          else
            QryData := ReallocMemory(QryData, QrySize);
          if not Assigned(QryData) then
          begin
            SetLastError(ERROR_NOT_ENOUGH_MEMORY);
            Exit;
          end;
          ValSize := QrySize;
          QryRtrn := RegQueryValueEx(HKEY_PERFORMANCE_DATA, CntrStr, nil,
            nil, PByte(QryData), @ValSize);
        until QryRtrn <> ERROR_MORE_DATA;
        if QryRtrn <> ERROR_SUCCESS then
        begin
          SetLastError(QryRtrn);
          Exit;
        end;
        if (ValSize < SizeOf(QryData^)) or (QryData.Signature <> 'PERF') then
        begin
          SetLastError(ERROR_INVALID_DATA);
          Exit;
        end;
        if 0 = QryData.NumObjectTypes then
        begin
          //NOTE: This should never happen. Please run PerfMon.exe and verify
          // that the performance object 'System' (perfos.dll) is available!
          SetLastError(ERROR_SERVICE_NOT_ACTIVE);
          Exit;
        end;

        SetLastError(ERROR_INVALID_DATA);
        // Search for 'System' by index
        CurrObj := PPerfObjectType(Cardinal(QryData) + QryData.HeaderLength);
        for ObjLoop := 1 to QryData.NumObjectTypes do
        begin
          if (CntrSys = CurrObj.ObjectNameTitleIndex) and
            (CurrObj.NumInstances <> 0) and
            (CurrObj.PerfFreq.QuadPart <> 0) then
          begin

            // Search for 'System Up Time' by index
            CurrDef := PPerfCounterDefinition(
              Cardinal(CurrObj) + CurrObj.HeaderLength);
            for DefLoop := 1 to CurrObj.NumCounters do
            begin
              if (CntrSUT = CurrDef.CounterNameTitleIndex) and
                (PERF_ELAPSED_TIME = CurrDef.CounterType) then
              begin

                if (PERF_NO_INSTANCES = CurrObj.NumInstances) then
                  CntrVal := PLARGE_INTEGER(Cardinal(CurrObj) +
                     CurrObj.DefinitionLength + CurrDef.CounterOffset)
                else
                begin
                  // First instance
                  ObjInst := PPerfInstanceDefinition(
                    Cardinal(CurrObj) + CurrObj.DefinitionLength);
                  CntrVal := PLARGE_INTEGER(Cardinal(ObjInst) +
                    ObjInst.ByteLength + CurrDef.CounterOffset);
                end;
                // Convert PERF_ELAPSED_TIME to seconds
                Result :=
                  Int64(CurrObj.PerfTime.QuadPart - CntrVal.QuadPart) div
                  CurrObj.PerfFreq.QuadPart;
                SetLastError(ERROR_SUCCESS);

                Break;
              end;
              CurrDef := PPerfCounterDefinition(Cardinal(CurrDef) +
                CurrDef.ByteLength);
            end;

            Break;
          end;
          CurrObj := PPerfObjectType(
            Cardinal(CurrObj) + CurrObj.TotalByteLength);
        end;

      finally
        if (QryData <> nil) then
          FreeMemory(QryData);
      end;
    finally
      FreeMemory(Counter);
    end;
  finally
    RegCloseKey(HKEY_PERFORMANCE_DATA);
  end;
{$ELSE !WIN32}
  SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
{$ENDIF WIN32}
end;

////////////////////////////////////////////////////////////////////////////////
//
//  GetSystemUpTimeWin9x()
//
//    Uses GetTickCount() to get the 'System Up Time' in seconds.
//    Will wrap around to zero if the system is run continuously for 49.7 days!
//

function GetSystemUpTimeWin9x(): Int64;
begin
{$IFDEF WIN32}
  Result := GetTickCount() div 1000;
{$ELSE !WIN32}
  Result := 0;
  SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
{$ENDIF WIN32}
end;

////////////////////////////////////////////////////////////////////////////////
//
//  GetSystemUpTimeLinux()
//
//    Uses sysinfo() to get the 'System Up Time' in seconds.
//    Will wrap around to zero if the system is run continuously for 497 days!
//

function GetSystemUpTimeLinux(): Int64;
{$IFDEF LINUX}
var
  Info: TSysInfo;
{$ENDIF}
begin
{$IFDEF LINUX}
  if 0 = sysinfo(Info) then
    Result := Info.uptime
  else
    Result := 0;
{$ELSE !LINUX}
  Result := 0;
  SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
{$ENDIF LINUX}
end;

////////////////////////////////////////////////////////////////////////////////
//
//  GetSystemUpTime()
//
//    Wrapper for GetSystemUpTimeXxx()
//

function GetSystemUpTime(): Int64;
begin
{$IFDEF WIN32}
  Result := GetSystemUpTimeWinNT();
  if 0 = Result then
    Result := GetSystemUpTimeWin9x();
{$ELSE !WIN32}
  Result := GetSystemUpTimeLinux();
{$ENDIF WIN32}
end;

end.