paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-02 01:06:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

* GetTickCount(64) implementation for OS/2 added

Browse Source 
git-svn-id: trunk@23239 -
This commit is contained in:
Tomas Hajny 2012-12-28 12:53:55 +00:00
parent 91c8177890
commit 2f25717e67
1 changed files with 27 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
rtl/os2/sysutils.pp
View File

@ -40,6 +40,8 @@ type
{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
{$DEFINE FPC_FEXPAND_GETENV_PCHAR}
{$DEFINE HAS_GETTICKCOUNT}
{$DEFINE HAS_GETTICKCOUNT64}
{ Include platform independent implementation part }
{$i sysutils.inc}
@ -647,6 +649,13 @@ begin
DosSleep (Milliseconds);
end;
function SysTimerTick: QWord;
var
L: cardinal;
begin
DosQuerySysInfo (svMsCount, svMsCount, L, 4);
SysTimerTick := L;
end;
function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString;Flags:TExecuteFlags=[]):
integer;
@ -809,6 +818,24 @@ begin
end;
function GetTickCount: LongWord;
var
L: cardinal;
begin
DosQuerySysInfo (svMsCount, svMsCount, L, 4);
GetTickCount := L;
end;
function GetTickCount64: QWord;
var
L: cardinal;
begin
DosQuerySysInfo (svMsCount, svMsCount, L, 4);
GetTickCount64 := L;
end;
{****************************************************************************
Initialization code