unit sysutils; {$i _defines.inc} interface {$mode objfpc} { force ansistrings } {$h+} {$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 Assign(F, FileName); try Reset(F); FileSize(F); Result := True; except Result := False; end; Close(F); 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.