Subversion Repositories Kolibri OS

{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: Int64): 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.