{
    $Id$

    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by Florian Klaempfl
    member of the Free Pascal development team

    Sysutils unit for OS/2

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    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.

 **********************************************************************}
unit sysutils;
interface

{$MODE objfpc}
{ force ansistrings }
{$H+}

uses
 Dos, Strings;

{ Include platform independent interface part }
{$i sysutilh.inc}


implementation

{ Include platform independent implementation part }
{$i sysutils.inc}


{****************************************************************************
                        System (imported) calls
****************************************************************************}

(* "uses DosCalls" could not be used here due to type    *)
(* conflicts, so needed parts had to be redefined here). *)

type
 TFileStatus = object
               end;
 PFileStatus = ^TFileStatus;

 TFileStatus0 = object (TFileStatus)
                 DateCreation,        {Date of file creation.}
                 TimeCreation,        {Time of file creation.}
                 DateLastAccess,      {Date of last access to file.}
                 TimeLastAccess,      {Time of last access to file.}
                 DateLastWrite,       {Date of last modification of file.}
                 TimeLastWrite: word; {Time of last modification of file.}
                 FileSize,            {Size of file.}
                 FileAlloc: cardinal; {Amount of space the file really
                                       occupies on disk.}
                end;
 PFileStatus0 = ^TFileStatus0;

 TFileStatus3 = object (TFileStatus)
                 NextEntryOffset: cardinal; {Offset of next entry}
                 DateCreation,             {Date of file creation.}
                 TimeCreation,             {Time of file creation.}
                 DateLastAccess,           {Date of last access to file.}
                 TimeLastAccess,           {Time of last access to file.}
                 DateLastWrite,            {Date of last modification of file.}
                 TimeLastWrite: word;      {Time of last modification of file.}
                 FileSize,                 {Size of file.}
                 FileAlloc: cardinal;      {Amount of space the file really
                                            occupies on disk.}
                 AttrFile: cardinal;       {Attributes of file.}
                end;
 PFileStatus3 = ^TFileStatus3;

 TFileFindBuf3 = object (TFileStatus3)
                  Name: ShortString;       {Also possible to use as ASCIIZ.
                                            The byte following the last string
                                            character is always zero.}
                 end;
 PFileFindBuf3 = ^TFileFindBuf3;

 TFSInfo = record
            case word of
             1:
              (File_Sys_ID,
               Sectors_Per_Cluster,
               Total_Clusters,
               Free_Clusters: cardinal;
               Bytes_Per_Sector: word);
             2:                           {For date/time description,
                                           see file searching realted
                                           routines.}
              (Label_Date,                {Date when volume label was created.}
               Label_Time: word;          {Time when volume label was created.}
               VolumeLabel: ShortString); {Volume label. Can also be used
                                           as ASCIIZ, because the byte
                                           following the last character of
                                           the string is always zero.}
           end;
 PFSInfo = ^TFSInfo;

 TCountryCode=record
               Country,            {Country to query info about (0=current).}
               CodePage: cardinal; {Code page to query info about (0=current).}
              end;
 PCountryCode=^TCountryCode;

 TTimeFmt = (Clock12, Clock24);

 TCountryInfo=record
               Country, CodePage: cardinal;  {Country and codepage requested.}
               case byte of
                0:
                 (DateFormat: cardinal;     {1=ddmmyy 2=yymmdd 3=mmddyy}
                  CurrencyUnit: array [0..4] of char;
                  ThousandSeparator: char;  {Thousands separator.}
                  Zero1: byte;              {Always zero.}
                  DecimalSeparator: char;   {Decimals separator,}
                  Zero2: byte;
                  DateSeparator: char;      {Date separator.}
                  Zero3: byte;
                  TimeSeparator: char;      {Time separator.}
                  Zero4: byte;
                  CurrencyFormat,           {Bit field:
                                             Bit 0: 0=indicator before value
                                                    1=indicator after value
                                             Bit 1: 1=insert space after
                                                      indicator.
                                             Bit 2: 1=Ignore bit 0&1, replace
                                                      decimal separator with
                                                      indicator.}
                  DecimalPlace: byte;       {Number of decimal places used in
                                             currency indication.}
                  TimeFormat: TTimeFmt;     {12/24 hour.}
                  Reserve1: array [0..1] of word;
                  DataSeparator: char;      {Data list separator}
                  Zero5: byte;
                  Reserve2: array [0..4] of word);
                1:
                 (fsDateFmt: cardinal;      {1=ddmmyy 2=yymmdd 3=mmddyy}
                  szCurrency: array [0..4] of char;
                                            {null terminated currency symbol}
                  szThousandsSeparator: array [0..1] of char;
                                            {Thousands separator + #0}
                  szDecimal: array [0..1] of char;
                                            {Decimals separator + #0}
                  szDateSeparator: array [0..1] of char;
                                            {Date separator + #0}
                  szTimeSeparator: array [0..1] of char;
                                            {Time separator + #0}
                  fsCurrencyFmt,            {Bit field:
                                             Bit 0: 0=indicator before value
                                                    1=indicator after value
                                             Bit 1: 1=insert space after
                                                      indicator.
                                             Bit 2: 1=Ignore bit 0&1, replace
                                                      decimal separator with
                                                      indicator}
                  cDecimalPlace: byte;      {Number of decimal places used in
                                             currency indication}
                  fsTimeFmt: byte;          {0=12,1=24 hours}
                  abReserved1: array [0..1] of word;
                  szDataSeparator: array [0..1] of char;
                                            {Data list separator + #0}
                  abReserved2: array [0..4] of word);
              end;
 PCountryInfo=^TCountryInfo;

const
 ilStandard      = 1;
 ilQueryEAsize   = 2;
 ilQueryEAs      = 3;
 ilQueryFullName = 5;

{This is the correct way to call external assembler procedures.}
procedure syscall;external name '___SYSCALL';

function DosSetFileInfo (Handle: longint; InfoLevel: cardinal; AFileStatus: PFileStatus;
        FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;

function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
               BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;

function DosQueryFileInfo (Handle: longint; InfoLevel: cardinal;
           AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
                                                 external 'DOSCALLS' index 279;

function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
                                                 external 'DOSCALLS' index 227;

function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: cardinal;
                       AFileStatus: PFileStatus; FileStatusLen: cardinal;
                    var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
                                                 external 'DOSCALLS' index 264;

function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
                FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
                                                 external 'DOSCALLS' index 265;

function DosFindClose (Handle: longint): cardinal; cdecl;
                                                 external 'DOSCALLS' index 263;

function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
           var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
                                                        external 'NLS' index 5;

function DosMapCase (Size: cardinal; var Country: TCountryCode;
                      AString: PChar): cardinal; cdecl; external 'NLS' index 7;

function DosDelete(FileName:PChar): Longint; cdecl;
    external 'DOSCALLS' index 259;

function DosMove(OldFile, NewFile:PChar): Longint; cdecl;
    external 'DOSCALLS' index 271;

function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
                 AFileStatus:PFileStatus;FileStatusLen:cardinal): Longint; cdecl;
    external 'DOSCALLS' index 223;

function DosSetPathInfo(FileName:PChar;InfoLevel:longint;
                        AFileStatus:PFileStatus;FileStatusLen,
                        Options:longint):longint; cdecl;
    external 'DOSCALLS' index 219;

type
  TDT=packed record
    Hour,
    Minute,
    Second,
    Sec100,
    Day,
    Month: byte;
    Year: word;
    TimeZone: smallint;
    WeekDay: byte;
  end;

function DosGetDateTime(var Buf: TDT):longint; cdecl;
    external 'DOSCALLS' index 230;


{****************************************************************************
                              File Functions
****************************************************************************}

const
 ofRead        = $0000;     {Open for reading}
 ofWrite       = $0001;     {Open for writing}
 ofReadWrite   = $0002;     {Open for reading/writing}
 doDenyRW      = $0010;     {DenyAll (no sharing)}
 faCreateNew   = $00010000; {Create if file does not exist}
 faOpenReplace = $00040000; {Truncate if file exists}
 faCreate      = $00050000; {Create if file does not exist, truncate otherwise}

 FindResvdMask = $00003737; {Allowed bits in attribute
                             specification for DosFindFirst call.}

{$ASMMODE INTEL}
function FileOpen (const FileName: string; Mode: integer): longint; assembler;
asm
 push ebx
 mov eax, Mode
(* DenyAll if sharing not specified. *)
 test eax, 112
 jnz @FOpen1
 or eax, 16
@FOpen1:
 mov ecx, eax
 mov eax, 7F2Bh
 mov edx, FileName
 call syscall
 pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};


function FileCreate (const FileName: string): longint; assembler;
asm
 push ebx
 mov eax, 7F2Bh
 mov ecx, ofReadWrite or faCreate or doDenyRW   (* Sharing to DenyAll *)
 mov edx, FileName
 call syscall
 pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};


function FileCreate (const FileName: string; Mode: longint): longint;
begin
 FileCreate := FileCreate(FileName);
end;


function FileRead (Handle: longint; var Buffer; Count: longint): longint;
                                                                     assembler;
asm
 push ebx
 mov eax, 3F00h
 mov ebx, Handle
 mov ecx, Count
 mov edx, Buffer
 call syscall
 jnc @FReadEnd
 mov eax, -1
@FReadEnd:
 pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};


function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
                                                                     assembler;
asm
 push ebx
 mov eax, 4000h
 mov ebx, Handle
 mov ecx, Count
 mov edx, Buffer
 call syscall
 jnc @FWriteEnd
 mov eax, -1
@FWriteEnd:
 pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};


function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
asm
 push ebx
 mov eax, Origin
 mov ah, 42h
 mov ebx, Handle
 mov edx, FOffset
 call syscall
 jnc @FSeekEnd
 mov eax, -1
@FSeekEnd:
 pop ebx
end {['eax', 'ebx', 'edx']};

function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64;
begin
  {$warning need to add 64bit call }
  Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin));
end;

procedure FileClose (Handle: longint); assembler;
asm
 push ebx
 mov eax, Handle
 cmp eax, 2
 jbe @FCloseEnd
 mov ebx, eax
 mov eax, 3E00h
 call syscall
@FCloseEnd:
 pop ebx
end {['eax', 'ebx']};


function FileTruncate (Handle, Size: longint): boolean; assembler;
asm
 push ebx
 mov eax, 7F25h
 mov ebx, Handle
 mov edx, Size
 call syscall
 jc @FTruncEnd
 mov eax, 4202h
 mov ebx, Handle
 mov edx, 0
 call syscall
 mov eax, 0
 jnc @FTruncEnd
 dec eax
@FTruncEnd:
 pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};


function FileAge (const FileName: string): longint;
var Handle: longint;
begin
    Handle := FileOpen (FileName, 0);
    if Handle <> -1 then
        begin
            Result := FileGetDate (Handle);
            FileClose (Handle);
        end
    else
        Result := -1;
end;


function FileExists (const FileName: string): boolean;
var
  SR: TSearchRec;
begin
  FileExists:=False;
  if FindFirst(FileName, faAnyFile, SR)=0 then FileExists:=True;
  FindClose(SR);
end;

type    TRec = record
            T, D: word;
        end;
        PSearchRec = ^SearchRec;

function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint;

var SR: PSearchRec;
    FStat: PFileFindBuf3;
    Count: cardinal;
    Err: cardinal;

begin
  New (FStat);
  Rslt.FindHandle := $FFFFFFFF;
  Count := 1;
  Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
               Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
                                                          ilStandard);
  if (Err = 0) and (Count = 0) then Err := 18;
  FindFirst := -Err;
  if Err = 0 then
  begin
    Rslt.Name := FStat^.Name;
    Rslt.Size := FStat^.FileSize;
    Rslt.Attr := FStat^.AttrFile;
    Rslt.ExcludeAttr := 0;
    TRec (Rslt.Time).T := FStat^.TimeLastWrite;
    TRec (Rslt.Time).D := FStat^.DateLastWrite;
  end;
  Dispose (FStat);
end;


function FindNext (var Rslt: TSearchRec): longint;

var SR: PSearchRec;
    FStat: PFileFindBuf3;
    Count: cardinal;
    Err: cardinal;

begin
            New (FStat);
            Count := 1;
            Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
                                                                        Count);
            if (Err = 0) and (Count = 0) then Err := 18;
            FindNext := -Err;
            if Err = 0 then
                begin
                    Rslt.Name := FStat^.Name;
                    Rslt.Size := FStat^.FileSize;
                    Rslt.Attr := FStat^.AttrFile;
                    Rslt.ExcludeAttr := 0;
                    TRec (Rslt.Time).T := FStat^.TimeLastWrite;
                    TRec (Rslt.Time).D := FStat^.DateLastWrite;
                end;
            Dispose (FStat);
end;


procedure FindClose (var F: TSearchrec);

var SR: PSearchRec;

begin
    DosFindClose (F.FindHandle);
    F.FindHandle := 0;
end;


function FileGetDate (Handle: longint): longint; assembler;
asm
 push ebx
 mov ax, 5700h
 mov ebx, Handle
 call syscall
 mov eax, -1
 jc @FGetDateEnd
 mov ax, dx
 shld eax, ecx, 16
@FGetDateEnd:
 pop ebx
end {['eax', 'ebx', 'ecx', 'edx']};


function FileSetDate (Handle, Age: longint): longint;
var FStat: PFileStatus0;
    RC: cardinal;
begin
            New (FStat);
            RC := DosQueryFileInfo (Handle, ilStandard, FStat,
                                                              SizeOf (FStat^));
            if RC <> 0 then
                FileSetDate := -1
            else
                begin
                    FStat^.DateLastAccess := Hi (Age);
                    FStat^.DateLastWrite := Hi (Age);
                    FStat^.TimeLastAccess := Lo (Age);
                    FStat^.TimeLastWrite := Lo (Age);
                    RC := DosSetFileInfo (Handle, ilStandard, FStat,
                                                              SizeOf (FStat^));
                    if RC <> 0 then
                        FileSetDate := -1
                    else
                        FileSetDate := 0;
                end;
            Dispose (FStat);
end;


function FileGetAttr (const FileName: string): longint;
var
  FS: PFileStatus3;
  S: PChar;
begin
  New(FS);
  S:=StrAlloc(length(FileName)+1);
  StrPCopy(S, FileName);
  Result:=-DosQueryPathInfo(S, ilStandard, FS, SizeOf(FS^));
  StrDispose(S);
  If Result=0 Then Result:=FS^.attrFile;
  Dispose(FS);
end;

function FileSetAttr (const Filename: string; Attr: longint): longint;
Var
  FS: PFileStatus3;
  S: PChar;
Begin
  New(FS);
  FillChar(FS, SizeOf(FS^), 0);
  FS^.attrFile:=Attr;
  S:=StrAlloc(length(FileName)+1);
  StrPCopy(S, FileName);
  Result:=-DosSetPathInfo(S, ilStandard, FS, SizeOf(FS^), 0);
  StrDispose(S);
  Dispose(FS);
end;


function DeleteFile (const FileName: string): boolean;
Var
  S: PChar;
Begin
  S:=StrAlloc(length(FileName)+1);
  StrPCopy(S, FileName);
  Result:=(DosDelete(S)=0);
  StrDispose(S);
End;

function RenameFile (const OldName, NewName: string): boolean;
Var
  S1, S2: PChar;
Begin
  S1:=StrAlloc(length(OldName)+1);
  StrPCopy(S1, OldName);
  S2:=StrAlloc(length(NewName)+1);
  StrPCopy(S2, NewName);
  Result:=(DosMove(S1, S2)=0);
  StrDispose(S1);
  StrDispose(S2);
End;

{****************************************************************************
                              Disk Functions
****************************************************************************}

{$ASMMODE ATT}

function DiskFree (Drive: byte): int64;

var FI: TFSinfo;
    RC: cardinal;

begin
        {In OS/2, we use the filesystem information.}
            RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
            if RC = 0 then
                DiskFree := int64 (FI.Free_Clusters) *
                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
            else
                DiskFree := -1;
end;

function DiskSize (Drive: byte): int64;

var FI: TFSinfo;
    RC: cardinal;

begin
        {In OS/2, we use the filesystem information.}
            RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
            if RC = 0 then
                DiskSize := int64 (FI.Total_Clusters) *
                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
            else
                DiskSize := -1;
end;


function GetCurrentDir: string;
begin
 GetDir (0, Result);
end;


function SetCurrentDir (const NewDir: string): boolean;
begin
{$I-}
 ChDir (NewDir);
 Result := (IOResult = 0);
{$I+}
end;


function CreateDir (const NewDir: string): boolean;
begin
{$I-}
 MkDir (NewDir);
 Result := (IOResult = 0);
{$I+}
end;


function RemoveDir (const Dir: string): boolean;
begin
{$I-}
 RmDir (Dir);
 Result := (IOResult = 0);
 {$I+}
end;


{$ASMMODE INTEL}
function DirectoryExists (const Directory: string): boolean; assembler;
asm
 mov ax, 4300h
 mov edx, Directory
 call syscall
 mov eax, 0
 jc @FExistsEnd
 test cx, 10h
 jz @FExistsEnd
 inc eax
@FExistsEnd:
end {['eax', 'ecx', 'edx']};


{****************************************************************************
                              Time Functions
****************************************************************************}

procedure GetLocalTime (var SystemTime: TSystemTime);
var
  DT: TDT;
begin
  DosGetDateTime(DT);
  with SystemTime do
  begin
    Year:=DT.Year;
    Month:=DT.Month;
    Day:=DT.Day;
    Hour:=DT.Hour;
    Minute:=DT.Minute;
    Second:=DT.Second;
    MilliSecond:=DT.Sec100;
  end;
end;

{$asmmode default}

{****************************************************************************
                              Misc Functions
****************************************************************************}

procedure Beep;
begin
end;


{****************************************************************************
                              Locale Functions
****************************************************************************}

procedure InitAnsi;
var I: byte;
    Country: TCountryCode;
begin
    for I := 0 to 255 do
        UpperCaseTable [I] := Chr (I);
    Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable));
            FillChar (Country, SizeOf (Country), 0);
            DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
    for I := 0 to 255 do
        if UpperCaseTable [I] <> Chr (I) then
            LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
end;


procedure InitInternational;
var Country: TCountryCode;
    CtryInfo: TCountryInfo;
    Size: cardinal;
    RC: cardinal;
begin
    Size := 0;
    FillChar (Country, SizeOf (Country), 0);
    FillChar (CtryInfo, SizeOf (CtryInfo), 0);
    RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size);
    if RC = 0 then
        begin
            DateSeparator := CtryInfo.DateSeparator;
            case CtryInfo.DateFormat of
             1: begin
                    ShortDateFormat := 'd/m/y';
                    LongDateFormat := 'dd" "mmmm" "yyyy';
                end;
             2: begin
                    ShortDateFormat := 'y/m/d';
                    LongDateFormat := 'yyyy" "mmmm" "dd';
                end;
             3: begin
                    ShortDateFormat := 'm/d/y';
                    LongDateFormat := 'mmmm" "dd" "yyyy';
                end;
            end;
            TimeSeparator := CtryInfo.TimeSeparator;
            DecimalSeparator := CtryInfo.DecimalSeparator;
            ThousandSeparator := CtryInfo.ThousandSeparator;
            CurrencyFormat := CtryInfo.CurrencyFormat;
            CurrencyString := PChar (CtryInfo.CurrencyUnit);
        end;
    InitAnsi;
end;

function SysErrorMessage(ErrorCode: Integer): String;

begin
  Result:=Format(SUnknownErrorCode,[ErrorCode]);
end;


{****************************************************************************
                              OS Utils
****************************************************************************}

Function GetEnvironmentVariable(Const EnvVar : String) : String;

begin
    GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar));
end;


{****************************************************************************
                              Initialization code
****************************************************************************}

Initialization
  InitExceptions;       { Initialize exceptions. OS independent }
  InitInternational;    { Initialize internationalization settings }
Finalization
  DoneExceptions;
end.

{
  $Log$
  Revision 1.36  2003-10-27 12:19:20  yuri
  * GetLocatTime now also native

  Revision 1.35  2003/10/27 11:43:40  yuri
  * New set of native functions

  Revision 1.34  2003/10/18 16:58:39  hajny
    * stdcall fixes again

  Revision 1.33  2003/10/13 21:17:31  hajny
    * longint to cardinal corrections

  Revision 1.32  2003/10/08 05:22:47  yuri
  * Some emx code removed

  Revision 1.31  2003/10/07 21:26:34  hajny
    * stdcall fixes and asm routines cleanup

  Revision 1.30  2003/10/03 21:46:41  peter
    * stdcall fixes

  Revision 1.29  2003/06/06 23:34:40  hajny
    * better fix for bug 2518

  Revision 1.28  2003/06/06 23:31:17  hajny
    * fix for bug 2518 applied to OS/2 as well

  Revision 1.27  2003/04/01 15:57:41  peter
    * made THandle platform dependent and unique type

  Revision 1.26  2003/03/31 02:18:39  yuri
  FileClose bug fixed (again ;))

  Revision 1.25  2003/03/29 19:14:16  yuri
    * Directoryexists function header changed back.

  Revision 1.24  2003/03/29 18:53:10  yuri
    * Fixed DirectoryExists function header

  Revision 1.23  2003/03/29 15:01:20  hajny
    + DirectoryExists added for main branch OS/2 too

  Revision 1.22  2003/03/01 21:19:14  hajny
    * FileClose bug fixed

  Revision 1.21  2003/01/04 16:25:08  hajny
    * modified to make use of the common GetEnv code

  Revision 1.20  2003/01/03 20:41:04  peter
    * FileCreate(string,mode) overload added

  Revision 1.19  2002/11/18 19:51:00  hajny
    * another bunch of type corrections

  Revision 1.18  2002/09/23 17:42:37  hajny
    * AnsiString to PChar typecast

  Revision 1.17  2002/09/07 16:01:25  peter
    * old logs removed and tabs fixed

  Revision 1.16  2002/07/11 16:00:05  hajny
    * FindFirst fix (invalid attribute bits masked out)

  Revision 1.15  2002/01/25 16:23:03  peter
    * merged filesearch() fix

}