{ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ}
{Û                                                       Û}
{Û      Virtual Pascal Utilities Library v2.1            Û}
{Û      ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÛ}
{Û      Copyright (C) 1995-2000 vpascal.com              Û}
{Û                                                       Û}
{ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}

Unit VPUtils;

Interface

{$Delphi+,X+,T-,Use32+,R-}

{$IFDEF WIN32}  {$DEFINE WIN32_DPMI32_Linux} {$ENDIF}
{$IFDEF DPMI32} {$DEFINE WIN32_DPMI32_Linux} {$ENDIF}
{$IFDEF Linux}  {$DEFINE WIN32_DPMI32_Linux} {$ENDIF}

uses
  {$IFDEF OS2}    Os2Def, Os2Base, {$ENDIF}
  {$IFDEF WIN32}  Windows,         {$ENDIF}
  {$IFDEF DPMI32} Dpmi32,          {$ENDIF}
  VPSysLow, Strings;

{ --- System Information functions --- }

{ Get the version of OS/2 or Windows }
function OsVersion : Word;
{ Returns the time of day in milliseconds }
function GetTimemSec : LongInt;
{ Get the process id of the current foreground process }
function GetForegroundProcessId : Word;

{ --- Disk related functions --- }

type
  DriveSet   = Set of 'A'..'Z';

{ Get the volume label of the specified drive letter }
function GetVolumeLabel( Drive : Char ) : String;
{ Search for fName in Current Dir, then in the PATH }
function FileExistsOnPath( FName : string; var FullName : string ) : Boolean;
{ Check if specified file handle is console(True) or redirected(False) }
function IsFileHandleConsole( Handle : Word ) : Boolean;
{ Get the current boot drive letter }
function GetBootDrive : Char;
{ Get the format of a drive letter }
function GetDriveType( Ch: Char ) : TDriveType;
{ Get a list of all valid drive letters }
procedure GetValidDrives( var Drives : DriveSet );
{ Returns true if the _Path specified exists }
function DirExists( _Path: String ): Boolean;

{ --- Keyboard functions --- }

const
  kbd_Insert    =
    {$IFDEF OS2}   kbdstf_Insert_On   {$ENDIF}
    {$IFDEF WIN32} VK_INSERT          {$ENDIF}
    {$IFDEF DPMI32}1 shl 7            {$ENDIF}
    {$IFDEF Linux} 1 shl 7            {$ENDIF} ;
  kbd_CapsLock  =
    {$IFDEF OS2}   kbdstf_CapsLock_On {$ENDIF}
    {$IFDEF WIN32} VK_CAPITAL         {$ENDIF}
    {$IFDEF DPMI32}1 shl 6            {$ENDIF}
    {$IFDEF Linux} 1 shl 6            {$ENDIF} ;
  kbd_NumLock   =
    {$IFDEF OS2}   kbdstf_NumLock_On  {$ENDIF}
    {$IFDEF WIN32} VK_NUMLOCK         {$ENDIF}
    {$IFDEF DPMI32}1 shl 5            {$ENDIF}
    {$IFDEF Linux} 1 shl 5            {$ENDIF} ;
  kbd_Ctrl      =
    {$IFDEF OS2}   kbdstf_Control     {$ENDIF}
    {$IFDEF WIN32} VK_CONTROL         {$ENDIF}
    {$IFDEF DPMI32}1 shl 2            {$ENDIF}
    {$IFDEF Linux} 1 shl 2            {$ENDIF} ;
  kbd_Alt       =
    {$IFDEF OS2}   kbdstf_Alt         {$ENDIF}
    {$IFDEF WIN32} VK_MENU            {$ENDIF}
    {$IFDEF DPMI32}1 shl 3            {$ENDIF}
    {$IFDEF Linux} 1 shl 3            {$ENDIF} ;
  kbd_Shift     =
    {$IFDEF OS2}   kbdstf_LeftShift or kbdstf_RightShift {$ENDIF}
    {$IFDEF WIN32} VK_SHIFT           {$ENDIF}
    {$IFDEF DPMI32}1 shl 0 or 1 shl 1 {$ENDIF}
    {$IFDEF Linux} 1 shl 0 or 1 shl 1 {$ENDIF} ;

{ Set/reset a bit in the keyboard state - works ONLY in full screen mode! }
Procedure SetKeyboardState( Bit : SmallWord; _Or : Boolean );
{ Get the state of a keyboard status bit }
Function GetKeyboardState( Bit : SmallWord ) : Boolean;
{ Get current codepage; 0 if the hardware codepage is used }
Function GetCodePage : Word;
{ Check the next available character in the keyboard buffer }
Function PeekKey( Var Ch : Char ) : Boolean;

{ --- Screen related functions --- }

Procedure SetBorder;
{ Get the number of text columns, rows and colours }
Procedure GetVideoModeInfo( Var Cols, Rows, Colours : Word );
{ Set the number of text columns and rows }
Function SetVideoMode( Cols, Rows : Word ) : Boolean;
{ Get the state of ANSI interpretation }
Function GetANSIState : Boolean;
{ Set the state of ANSI interpretation }
Procedure SetANSI( State : Boolean );
{ Get the cursor size }
Function GetCursorSize : Word;
{ Set the cursor size }
procedure SetCursorSize(Startline, EndLine : Integer);
{ Hide the cursor }
procedure HideCursor;
{ Show the cursor }
procedure ShowCursor;

{ --- String functions --- }

{ Return zero-padded string representation of Number of length N }
Function Int2StrZ( Number : Longint; N : Byte ) : String;
{ Return string representation of Number }
Function Int2Str( Number : Longint ) : String;
{ Return hexadecimal equivalent of parameter Number as a string }
Function Int2Hex( Number : Longint; N : Byte ) : String;
{ Return hexadecimal equivalent of Pointer }
Function Ptr2Hex( p : Pointer ) : String;

{ --- System functions --- }

{ Start a thread with default parameters, returning thread ID }
Function VPBeginThread( ThreadFunc : tThreadFunc; StackSize : Word; Parameters : Pointer ) : Longint;
{ Return the amount of memory allocated on the heap }
function MemUsed: Longint;
function MemComm: Longint;

{ --- Math functions --- }
Function Max( a,b : Longint ) : Longint; inline;
  begin
    if a > b then
      Max := a
    else
      Max := b;
  end;

Function Min( a,b : Longint ) : Longint; inline;
  begin
    if a < b then
      Min := a
    else
      Min := b;
  end;

Implementation

uses
  Dos;

threadvar
  SaveCursor : Word;     { Used for show/hide cursor }

{ Get the OS Version }
function OsVersion : Word;
begin
  Result := SysOSVersion;
end;

{ Returns the volume label of the specified drive }
function GetVolumeLabel( Drive : Char ) : String;
begin
  Result := SysGetVolumeLabel(Drive);
end;

{ Returns the time of day in milliseconds }
function GetTimemSec : LongInt;
Var
  Hour, Minute, Second, MSec: Longint;
begin
  SysGetDateTime(nil, nil, nil, nil, @Hour, @Minute, @Second, @MSec);
  Result := 1000*( 60*(60*Hour + Minute) + Second) + MSec;
end;

{ Get the process id of the current foreground process }
function GetForegroundProcessId : Word;
begin
  Result := SysGetForegroundProcessId;
end;

{ Search for fName in Current Dir, then PATH environment }
function FileExistsOnPath(FName : string; var FullName : string) : Boolean;
Var
  FNameZ  : array [0..259] of Char;
  Buffer  : Array [0..259] of Char;
  Path    : String;

begin
  FileExistsOnPath := False;

  Path := Dos.GetEnv('PATH')+#0;
  StrPCopy( FNameZ, FName );
  SysFileSearch(Buffer, FNameZ, @Path[1]);
  FullName := StrPas( Buffer );
  Result := Buffer[0] <> #0;
end;

{ Check if specified handle is console }
function IsFileHandleConsole( Handle : Word ) : Boolean;
begin
  Result := SysFileIsDevice(handle) = 1;
end;

{ Get the current boot drive letter }
function GetBootDrive : Char;
begin
  Result := SysGetBootDrive;
end;

{ Get the format of a drive letter }
function GetDriveType( Ch: Char ) : TDriveType;
begin
  Result := SysGetDriveType(Ch);
end;

{ Get a list of all valid drive letters }
procedure GetValidDrives( var Drives : DriveSet );
var
  DrivesWord : Longint absolute Drives;
begin
  DrivesWord := SysGetValidDrives shl 1;
end;

function DirExists( _Path: String ): Boolean;
var
  DirInfo: SearchRec;
begin
  // Remove trailing backslash, if any
  if _Path[Length(_Path)] = SysPathSep then
    Delete( _Path, Length(_Path), 1 );
  // FindFirst: Allow any attribute; require Directory attribute
  FindFirst( _Path, $3F, DirInfo );
  Result := DosError = 0;
  if Result then
    FindClose(DirInfo);
end;

{ --- Keyboard functions --- }

{ Set/reset a bit in the keyboard state - ONLY in NOVIO programs! }
Procedure SetKeyboardState( Bit : SmallWord; _Or : Boolean );
{$IFDEF OS2}
Var
  StatData  : ^KbdInfo;
  LStatData : Array[1..2] of KbdInfo;
  rc : Longint;

begin
  StatData := Fix_64k(@LStatData, SizeOf(StatData^));

  StatData^.cb := Sizeof( StatData^ );
  KbdGetStatus( StatData^, 0 );
  StatData^.fsMask  := StatData^.fsMask OR keyboard_modify_State;
  If _Or then
    StatData^.fsState := StatData^.fsState OR Bit
  else
    StatData^.fsState := StatData^.fsState AND NOT Bit;
  rc := KbdSetStatus( StatData^, 0 );
{$ENDIF}
{$IFDEF WIN32}
var
  State: TKeyboardState;
begin
  Windows.GetKeyboardState(State);
  if _Or then
    State[Bit] := 1
  else
    State[Bit] := 0;
  Windows.SetKeyboardState(State);
{$ENDIF}
{$IFDEF DPMI32}
var
  Status: Byte;
begin
  Status := Mem[seg0040+$0017];
  if _Or then
    Status := Status or Bit
  else
    Status := Status and (not Bit);
  mem[seg0040+$0017] := Status;
{$ENDIF}
{$IFDEF Linux}
begin
  // not implemented
{$ENDIF}
end;

{ Get the state of a keyboard status bit }
Function GetKeyboardState( Bit : SmallWord ) : Boolean;
{$IFDEF OS2}
Var
  StatData  : ^KbdInfo;
  LStatData : Array[1..2] of KbdInfo;
  rc : Longint;

begin
  StatData := Fix_64k(@LStatData, SizeOf(StatData^));
  StatData^.cb := Sizeof( StatData^ );
  rc := KbdGetStatus( StatData^, 0 );
  GetKeyboardState := ( StatData^.fsState AND Bit <> 0 );
{$ENDIF}
{$IFDEF WIN32}
var
  State: SmallWord;
begin
  State := Windows.GetKeyState(Bit);
  if (Bit = kbd_Alt) or (Bit = kbd_Shift) or (Bit = kbd_Ctrl) then
    // Ignore "toggle" state in lower bit
    Result := (State and $8000) <> 0
  else
    // Ignore "down" state and return toggle state
    Result := State = 1;
{$ENDIF}
{$IFDEF DPMI32}
begin
  GetKeyboardState := (Mem[seg0040+$0017] and Bit) <> 0;
{$ENDIF}
{$IFDEF Linux}
begin
  // not implemented
  GetKeyboardState := false;
{$ENDIF}
end;

{ Returns current codepage; 0 if hardware codepage }
Function GetCodePage : Word;
begin
  Result := SysGetCodePage;
end;

{ Check the next available character in the keyboard buffer }
Function PeekKey( Var Ch : Char ) : Boolean;
begin
  Result := SysPeekKey(Ch);
end;

{ --- Screen functions --- }

Procedure SetBorder;
{$IFDEF WIN32_DPMI32_Linux}
begin
  // Not implemented
{$ENDIF}
{$IFDEF OS2}
Var
  vm  : ^VioModeInfo;
  Lvm : Array[1..2] of VioModeInfo;
begin
  vm := Fix_64k(@Lvm, SizeOf(vm^));
  vm^.cb := Sizeof( vm^ );
  vm^.fbType := 1;
  vm^.Color := 1;
  VioSetMode( vm^, 0 );
{$ENDIF}
end;

Procedure GetVideoModeInfo( Var Cols, Rows, Colours : Word );
begin
  SysGetVideoModeInfo(Cols, Rows, Colours);
end;

Function SetVideoMode( Cols, Rows : Word ) : Boolean;
begin
  Result := SysSetVideoMode(Cols, Rows);
end;

{ Get the state of ANSI interpretation }
Function GetANSIState : Boolean;
{$IFDEF OS2}
Var
  w : SmallWord;

begin
  If VioGetANSI( w, 0 ) = 0 then
    GetANSIState := ( w = 1 )
  else
    GetANSIState := False;
{$ENDIF}
{$IFDEF WIN32}
begin
  Result := False;
{$ENDIF}
{$IFDEF Linux}
begin
  Result := true;
{$ENDIF}
{$IFDEF DPMI32}
{$FRAME-} {&Uses ebx,esi,edi}
asm
       // Detect ansi.sys
       mov     ax,$1a00
       int     $2f
       cmp     al,$ff
       sete    al
{$ENDIF}
end;

{ Set the state of ANSI interpretation }
Procedure SetANSI( State : Boolean );
{$IFDEF OS2}
Var
  w : SmallWord;

begin
  If State then
    w := 1
  else
    w := 0;
  VioSetANSI( w, 0 );
{$ENDIF}
{$IFDEF WIN32_DPMI32_Linux}
begin
  // Not implemented
{$ENDIF}
end;

{ Get the cursor size }
Function GetCursorSize : Word;
Var
  cStart, cEnd: Longint;
  cVisible: Boolean;
begin
  SysTVGetCurType(cStart, cEnd, cVisible);
  Result := cStart shl 8 + cEnd;
end;

{ Set the cursor size }
procedure SetCursorSize(Startline, EndLine : Integer);
begin
  SysTVSetCurType(StartLine, EndLine, (abs(StartLine) <= abs(EndLine)) or ((StartLine and $20)=0));
end;

{ Hide the cursor }
procedure HideCursor;
var
  cStart, cEnd: Integer;
  cVisible: Boolean;
begin
  SysTVGetCurType(cStart, cEnd, cVisible);
  if cVisible then
    SaveCursor := cStart shl 8 + cEnd;
  SetCursorSize($20, 0);
end;

{ Show the cursor }
procedure ShowCursor;
var
  cStart, cEnd: Integer;
  cVisible: Boolean;
begin
  SysTVGetCurType(cStart, cEnd, cVisible);
  if not cVisible then
    SetCursorSize(SaveCursor shr 8, SaveCursor and $FF);
end;

{ Return zero-padded string representation of Number of length N }
Function Int2StrZ( Number : Longint; N : Byte ) : String;
Var
  s : String;
  i : Integer;

begin
  if N = 0 then
    Str( Number, s )
  else
    begin
      Str( Number:N, s );
      i := 1;
      While ( s[i] = ' ' ) and ( i <= length( s ) ) do
        begin
          s[i] := '0';
          inc( i );
        end;
    end;
  Int2StrZ := s;
end;

{ Return string representation of Number }
Function Int2Str( Number : Longint ) : String;
Var
  s : String;
begin
  Str( Number, s );
  Int2Str := s;
end;

{ Return hexadecimal equivalent of parameter Number as a string }
Function Int2Hex( Number : Longint; N : Byte ) : String;
Const
  HexDigit : Array[0..$f] of char = '0123456789ABCDEF';
Var
  s : String;
  i : Integer;

begin
  SetLength(s, N);
  For i := N downto 1 do
    begin
      s[i] := HexDigit[Number and $F];
      Number := Number shr 4;
    end;
  Int2Hex := s;
end;

{ Return hexadecimal equivalent of Pointer }
Function Ptr2Hex( p : Pointer ) : String;
begin
  Ptr2Hex := Int2Hex( Word(p), 8 );
end;

{ --- System functions --- }

{ Start a thread with default parameters, returning thread ID }
Function VPBeginThread( ThreadFunc : tThreadFunc; StackSize : Word; Parameters : Pointer ) : Longint;
begin
  System.BeginThread( nil,             // Security attributes
                      StackSize,       // Stack Size in bytes
                      ThreadFunc,      // Thread routine
                      Parameters,      // Parameter pointer
                      0,               // Create_Ready
                      Result );        // Function result
end;

{ Return the amount of memory allocated on the heap. Complements MemAvail }
type
  TBlockRec = record           // Heap free sub-block record
    Next:      Pointer;        // Pointer to the next free sub-block
    Size:      Longint;        // Size of the sub-block
  end;

  PHeapRec = ^THeapRec;
  THeapRec = record            // Heap Block record
    Signature: Longint;        // Signature = 'VICM'
    FreeList:  TBlockRec;      // Free sub-block list head
    MemFree:   Longint;        // Number of free bytes in the Heap Block
    TotalSize: Longint;        // Total size of the Heap Block
    NextHeap:  Pointer;        // Pointer to the next Heap Block
    HeapOrg:   TBlockRec;      // Heap memory starts here, marks header end
  end;

function MemUsed: Longint;
begin
  Result := GetHeapStatus.TotalAllocated;
end;

function MemComm: Longint;
begin
  Result := GetHeapStatus.TotalCommitted;
end;

end.


