WebSVN – Kolibri OS – /programs/develop/fp/rtl/sysutils.pp

{utf8}
unit sysutils;
{$i _defines.inc}
{$mode objfpc}
{$h+}
interface
{ force ansistrings }
{$DEFINE HAS_SLEEP}
{-$DEFINE HAS_OSERROR}
{-$DEFINE HAS_OSCONFIG}
{-$DEFINE HAS_CREATEGUID}
{ Include platform independent interface part }
{$i sysutilh.inc}
implementation
uses
SysConst;
{-$define HASCREATEGUID}
{-$define HASEXPANDUNCFILENAME}
{-$DEFINE FPC_NOGENERICANSIROUTINES}
{-$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
{-$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
{ Include platform independent implementation part }
{$i sysutils.inc}
{****************************************************************************
File Functions
****************************************************************************}
const
FILEHANDLEPREFIX = $4000;
type
PFileRecord = ^TFileRecord;
TFileRecord = record
Filled: Boolean;
F: File;
end;
var
FileHandles: array of TFileRecord;
function FileRecordByHandle(Handle: THandle): PFileRecord;
begin
Dec(Handle, FILEHANDLEPREFIX);
Result := @FileHandles[Handle];
end;
function CreateFileRecord(): THandle;
var
I, C: Longword;
begin
Result := -1;
C := Length(FileHandles);
for I := 0 to C - 1 do
if not FileHandles[I].Filled then
begin
Result := I;
Break;
end;
if Result < 0 then
begin
SetLength(FileHandles, C + 1);
Result := C;
end;
FileHandles[Result].Filled := True;
FillChar(FileHandles[Result].F, SizeOf(FileRec), 0);
Inc(Result, FILEHANDLEPREFIX);
end;
procedure ReleaseFileRecord(Handle: THandle);
begin
FileRecordByHandle(Handle)^.Filled := False;
end;
function FileOpen(const FileName: String; Mode: Integer): THandle;
var
F: File;
begin
Filemode := Mode;
Assign(F, FileName);
Reset(F, 1);
if InOutRes = 0 then
begin
Result := CreateFileRecord();
FileRecordByHandle(Result)^.F := F;
end else
Result := feInvalidHandle;
end;
function FileCreate(const FileName: String): THandle;
var
F: File;
begin
Assign(F, FileName);
Rewrite(F, 1);
if InOutRes = 0 then
begin
Result := CreateFileRecord();
FileRecordByHandle(Result)^.F := F;
end else
Result := feInvalidHandle;
end;
function FileCreate(const FileName: String; Mode: Integer): THandle;
var
F: File;
begin
Filemode := Mode;
Assign(F, FileName);
Rewrite(F, 1);
if InOutRes = 0 then
begin
Result := CreateFileRecord();
FileRecordByHandle(Result)^.F := F;
end else
Result := feInvalidHandle;
end;
function FileRead(Handle: THandle; var Buffer; Count: Longint): Longint;
begin
BlockRead(FileRecordByHandle(Handle)^.F, Buffer, Count, Result);
end;
function FileWrite(Handle: THandle; const Buffer; Count: Longint): Longint;
begin
BlockWrite(FileRecordByHandle(Handle)^.F, Buffer, Count, Result);
end;
function FileSeek(Handle: THandle; FOffset, Origin: Longint): Longint;
begin
Result := FileSeek(Handle, Int64(FOffset), Origin);
end;
function FileSeek(Handle: THandle; FOffset: Int64; Origin: Longint): Int64;
var
Position: Int64;
begin
case Origin of
fsFromBeginning: Position := FOffset;
fsFromCurrent: Position := FilePos(FileRecordByHandle(Handle)^.F) + FOffset;
fsFromEnd: Position := FileSize(FileRecordByHandle(Handle)^.F) + FOffset;
end;
{TODO: проверка соответствия [0..filesize]}
Seek(FileRecordByHandle(Handle)^.F, Position);
Result := Position;
end;
procedure FileClose(Handle: THandle);
begin
Close(FileRecordByHandle(Handle)^.F);
ReleaseFileRecord(Handle);
end;
function FileTruncate(Handle: THandle; Size: Longint): Boolean;
begin
Result := False;
end;
function FileAge(const FileName: String): Longint;
begin
Result := 0;
end;
function FileExists(const FileName: String): Boolean;
var
F: File;
begin
{$i-}
Assign(F, FileName);
Reset(F);
if IOResult = 0 then
begin
Result := True;
Close(F);
end else
Result := False;
{$i+}
end;
function DirectoryExists(const Directory: String): Boolean;
begin
Result := False;
end;
function FindMatch(var f: TSearchRec): Longint;
begin
Result := feInvalidHandle;
end;
function FindFirst(const Path: String; Attr: Longint; out Rslt: TSearchRec): Longint;
begin
Result := feInvalidHandle;
end;
function FindNext(var Rslt: TSearchRec): Longint;
begin
Result := feInvalidHandle;
end;
procedure FindClose(var F: TSearchrec);
begin
end;
function FileGetDate(Handle: THandle): Longint;
begin
Result := feInvalidHandle;
end;
function FileSetDate(Handle: THandle; Age: Longint): Longint;
begin
Result := feInvalidHandle;
end;
function FileGetAttr(const FileName: String): Longint;
begin
Result := feInvalidHandle;
end;
function FileSetAttr(const Filename: String; Attr: longint): Longint;
begin
Result := feInvalidHandle;
end;
function DeleteFile(const FileName: String): Boolean;
begin
Result := False;
end;
function RenameFile(const OldName, NewName: String): Boolean;
begin
Result := False;
end;
{****************************************************************************
Disk Functions
****************************************************************************}
function DiskFree(drive: Byte): Int64;
begin
Result := 0;
end;
function DiskSize(drive: Byte): Int64;
begin
Result := 0;
end;
function GetCurrentDir: String;
begin
GetDir(0, Result);
end;
function SetCurrentDir(const NewDir: String): Boolean;
var
Path: String;
begin
ChDir(NewDir);
GetDir(0, Path);
Result := Path = NewDir;
end;
function CreateDir(const NewDir: String): Boolean;
begin
Result := False;
end;
function RemoveDir(const Dir: String): Boolean;
begin
Result := False;
end;
{****************************************************************************
Time Functions
****************************************************************************}
procedure GetLocalTime(var SystemTime: TSystemTime);
begin
end;
{****************************************************************************
Misc Functions
****************************************************************************}
procedure Beep;
begin
end;
{****************************************************************************
Locale Functions
****************************************************************************}
procedure GetFormatSettings;
var
HF: String;
begin
ShortMonthNames[1] := SShortMonthNameJan;
ShortMonthNames[2] := SShortMonthNameFeb;
ShortMonthNames[3] := SShortMonthNameMar;
ShortMonthNames[4] := SShortMonthNameApr;
ShortMonthNames[5] := SShortMonthNameMay;
ShortMonthNames[6] := SShortMonthNameJun;
ShortMonthNames[7] := SShortMonthNameJul;
ShortMonthNames[8] := SShortMonthNameAug;
ShortMonthNames[9] := SShortMonthNameSep;
ShortMonthNames[10] := SShortMonthNameOct;
ShortMonthNames[11] := SShortMonthNameNov;
ShortMonthNames[12] := SShortMonthNameDec;
LongMonthNames[1] := SLongMonthNameJan;
LongMonthNames[2] := SLongMonthNameFeb;
LongMonthNames[3] := SLongMonthNameMar;
LongMonthNames[4] := SLongMonthNameApr;
LongMonthNames[5] := SLongMonthNameMay;
LongMonthNames[6] := SLongMonthNameJun;
LongMonthNames[7] := SLongMonthNameJul;
LongMonthNames[8] := SLongMonthNameAug;
LongMonthNames[9] := SLongMonthNameSep;
LongMonthNames[10] := SLongMonthNameOct;
LongMonthNames[11] := SLongMonthNameNov;
LongMonthNames[12] := SLongMonthNameDec;
ShortDayNames[1] := SShortDayNameMon;
ShortDayNames[2] := SShortDayNameTue;
ShortDayNames[3] := SShortDayNameWed;
ShortDayNames[4] := SShortDayNameThu;
ShortDayNames[5] := SShortDayNameFri;
ShortDayNames[6] := SShortDayNameSat;
ShortDayNames[7] := SShortDayNameSun;
LongDayNames[1] := SLongDayNameMon;
LongDayNames[2] := SLongDayNameTue;
LongDayNames[3] := SLongDayNameWed;
LongDayNames[4] := SLongDayNameThu;
LongDayNames[5] := SLongDayNameFri;
LongDayNames[6] := SLongDayNameSat;
LongDayNames[7] := SShortDayNameSun;
DateSeparator := '/';
ShortDateFormat := 'd/mm/yy';
LongDateFormat := 'd mmmm yyyy';
{ Time stuff }
TimeSeparator := ':';
TimeAMString := 'AM';
TimePMString := 'PM';
HF := 'hh';
// No support for 12 hour stuff at the moment...
ShortTimeFormat := HF + ':nn';
LongTimeFormat := HF + ':nn:ss';
{ Currency stuff }
CurrencyString := '';
CurrencyFormat := 0;
NegCurrFormat := 0;
{ Number stuff }
ThousandSeparator := ',';
DecimalSeparator := '.';
CurrencyDecimals := 2;
end;
Procedure InitInternational;
begin
InitInternationalGeneric;
GetFormatSettings;
end;
{****************************************************************************
Target Dependent
****************************************************************************}
function SysErrorMessage(ErrorCode: Integer): String;
const
MaxMsgSize = 255;
var
MsgBuffer: PChar;
begin
GetMem(MsgBuffer, MaxMsgSize);
FillChar(MsgBuffer^, MaxMsgSize, #0);
{TODO}
Result := StrPas(MsgBuffer);
FreeMem(MsgBuffer, MaxMsgSize);
end;
{****************************************************************************
Initialization code
****************************************************************************}
Function GetEnvironmentVariable(Const EnvVar: String): String;
begin
Result := '';
end;
Function GetEnvironmentVariableCount: Integer;
begin
Result := 0;
end;
Function GetEnvironmentString(Index : Integer) : String;
begin
Result := '';
end;
function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString): Integer;
begin
Result := 0;
end;
function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString): Integer;
var
CommandLine: AnsiString;
i: Integer;
begin
Commandline:='';
For i:=0 to high(ComLine) Do
Commandline:=CommandLine+' '+Comline[i];
ExecuteProcess:=ExecuteProcess(Path,CommandLine);
end;
procedure Sleep(Milliseconds: Cardinal);
begin
kos_delay(Milliseconds div 10);
end;
function GetLastOSError: Integer;
begin
Result := -1;
end;
initialization
InitExceptions;
InitInternational;
finalization
DoneExceptions;
end.

Subversion Repositories Kolibri OS

(root)/programs/develop/fp/rtl/sysutils.pp – Rev 790