mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 20:19:26 +02:00
818 lines
25 KiB
ObjectPascal
818 lines
25 KiB
ObjectPascal
{
|
|
$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;
|
|
|
|
{ Include platform independent interface part }
|
|
{$i sysutilh.inc}
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
sysconst;
|
|
|
|
{ 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;
|
|
|
|
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;
|
|
|
|
function DosOpen(FileName:PChar;var Handle:longint;var Action: Longint;
|
|
InitSize,Attrib,OpenFlags,FileMode:cardinal;
|
|
EA:Pointer):longint; cdecl;
|
|
external 'DOSCALLS' index 273;
|
|
|
|
function DosClose(Handle:longint): longint; cdecl;
|
|
external 'DOSCALLS' index 257;
|
|
|
|
function DosRead(Handle:longint; var Buffer; Count:longint;
|
|
var ActCount:longint):longint; cdecl;
|
|
external 'DOSCALLS' index 281;
|
|
function DosWrite(Handle:longint; const Buffer; Count:longint;
|
|
var ActCount:longint):longint; cdecl;
|
|
external 'DOSCALLS' index 282;
|
|
|
|
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal;
|
|
var PosActual:longint):longint; cdecl;
|
|
external 'DOSCALLS' index 256;
|
|
|
|
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl;
|
|
external 'DOSCALLS' index 272;
|
|
|
|
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.}
|
|
|
|
function FileOpen (const FileName: string; Mode: integer): longint;
|
|
Var
|
|
Rc, Action, Handle: Longint;
|
|
P: PChar;
|
|
begin
|
|
P:=StrAlloc(length(FileName)+1);
|
|
StrPCopy(P, FileName);
|
|
(* DenyNone if sharing not specified. *)
|
|
if Mode and 112 = 0 then Mode:=Mode or 64;
|
|
Rc:=DosOpen(P, Handle, Action, 0, 0, 1, Mode, nil);
|
|
StrDispose(P);
|
|
If Rc=0 then
|
|
FileOpen:=Handle
|
|
else
|
|
FileOpen:=-RC;
|
|
end;
|
|
|
|
function FileCreate (const FileName: string): longint;
|
|
Const
|
|
Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *)
|
|
Var
|
|
RC, Action, Handle: Longint;
|
|
P: PChar;
|
|
Begin
|
|
P:=StrAlloc(length(FileName)+1);
|
|
StrPCopy(P, FileName);
|
|
RC:=DosOpen(P, Handle, Action, 0, 0, $12, Mode, Nil);
|
|
StrDispose(P);
|
|
If RC=0 then
|
|
FileCreate:=Handle
|
|
else
|
|
FileCreate:=-RC;
|
|
End;
|
|
|
|
function FileCreate (const FileName: string; Mode: longint): longint;
|
|
begin
|
|
FileCreate := FileCreate(FileName);
|
|
end;
|
|
|
|
|
|
function FileRead (Handle: longint; var Buffer; Count: longint): longint;
|
|
Var
|
|
T: Longint;
|
|
begin
|
|
DosRead(Handle, Buffer, Count, T);
|
|
FileRead:=T;
|
|
end;
|
|
|
|
function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
|
|
Var
|
|
T: Longint;
|
|
begin
|
|
DosWrite(Handle, Buffer, Count, T);
|
|
FileWrite:=T;
|
|
end;
|
|
|
|
function FileSeek (Handle, FOffset, Origin: longint): longint;
|
|
var
|
|
npos: longint;
|
|
begin
|
|
if DosSetFilePtr(Handle, FOffset, Origin, npos)=0 Then
|
|
FileSeek:=npos
|
|
else
|
|
FileSeek:=-1;
|
|
end;
|
|
|
|
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);
|
|
begin
|
|
DosClose(Handle);
|
|
end;
|
|
|
|
function FileTruncate (Handle, Size: longint): boolean;
|
|
begin
|
|
FileTruncate:=DosSetFileSize(Handle, Size)=0;
|
|
FileSeek(Handle, 0, 2);
|
|
end;
|
|
|
|
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;
|
|
var
|
|
FStat: TFileStatus3;
|
|
Time: Longint;
|
|
begin
|
|
DosError := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat));
|
|
if DosError=0 then
|
|
begin
|
|
Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
|
|
if Time = 0 then
|
|
Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16;
|
|
end else
|
|
Time:=0;
|
|
FileGetDate:=Time;
|
|
end;
|
|
|
|
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
|
|
****************************************************************************}
|
|
|
|
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;
|
|
|
|
|
|
function DirectoryExists (const Directory: string): boolean;
|
|
var
|
|
SR: TSearchRec;
|
|
begin
|
|
DirectoryExists:=FindFirst(Directory, faDirectory, SR)=0;
|
|
FindClose(SR);
|
|
end;
|
|
|
|
{****************************************************************************
|
|
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;
|
|
|
|
{****************************************************************************
|
|
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.39 2003-11-26 20:00:19 florian
|
|
* error handling for Variants improved
|
|
|
|
Revision 1.38 2003/11/23 15:50:07 yuri
|
|
* Now native
|
|
|
|
Revision 1.37 2003/11/05 09:14:00 yuri
|
|
* exec fix
|
|
* unused units removed
|
|
|
|
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
|
|
|
|
} |