mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 16:59:45 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			820 lines
		
	
	
		
			19 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			820 lines
		
	
	
		
			19 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
 | 
						|
  doscalls,dos;
 | 
						|
 | 
						|
{ Include platform independent interface part }
 | 
						|
{$i sysutilh.inc}
 | 
						|
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
{ Include platform independent implementation part }
 | 
						|
{$i sysutils.inc}
 | 
						|
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                              File Functions
 | 
						|
****************************************************************************}
 | 
						|
 | 
						|
{This is the correct way to call external assembler procedures.}
 | 
						|
procedure syscall;external name '___SYSCALL';
 | 
						|
 | 
						|
 | 
						|
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}
 | 
						|
 | 
						|
{$ASMMODE INTEL}
 | 
						|
function FileOpen (const FileName: string; Mode: integer): longint;
 | 
						|
{$IFOPT H+}
 | 
						|
                                                                    assembler;
 | 
						|
{$ELSE}
 | 
						|
var FN: string;
 | 
						|
begin
 | 
						|
    FN := FileName + #0;
 | 
						|
{$ENDIF}
 | 
						|
    asm
 | 
						|
        mov eax, Mode
 | 
						|
(* DenyAll if sharing not specified. *)
 | 
						|
        test eax, 112
 | 
						|
        jnz @FOpen1
 | 
						|
        or eax, 16
 | 
						|
@FOpen1:
 | 
						|
        mov ecx, eax
 | 
						|
        mov eax, 7F2Bh
 | 
						|
{$IFOPT H+}
 | 
						|
        mov edx, FileName
 | 
						|
{$ELSE}
 | 
						|
        lea edx, FN
 | 
						|
        inc edx
 | 
						|
{$ENDIF}
 | 
						|
        call syscall
 | 
						|
{$IFOPT H-}
 | 
						|
        mov [ebp - 4], eax
 | 
						|
    end;
 | 
						|
{$ENDIF}
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileCreate (const FileName: string): longint;
 | 
						|
{$IFOPT H+}
 | 
						|
                                                                    assembler;
 | 
						|
{$ELSE}
 | 
						|
var FN: string;
 | 
						|
begin
 | 
						|
    FN := FileName + #0;
 | 
						|
{$ENDIF}
 | 
						|
    asm
 | 
						|
        mov eax, 7F2Bh
 | 
						|
        mov ecx, ofReadWrite or faCreate or doDenyRW   (* Sharing to DenyAll *)
 | 
						|
{$IFOPT H+}
 | 
						|
        mov edx, FileName
 | 
						|
{$ELSE}
 | 
						|
        lea edx, FN
 | 
						|
        inc edx
 | 
						|
{$ENDIF}
 | 
						|
        call syscall
 | 
						|
{$IFOPT H-}
 | 
						|
        mov [ebp - 4], eax
 | 
						|
    end;
 | 
						|
{$ENDIF}
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileRead (Handle: longint; var Buffer; Count: longint): longint;
 | 
						|
                                                                     assembler;
 | 
						|
asm
 | 
						|
    mov eax, 3F00h
 | 
						|
    mov ebx, Handle
 | 
						|
    mov ecx, Count
 | 
						|
    mov edx, Buffer
 | 
						|
    call syscall
 | 
						|
    jnc @FReadEnd
 | 
						|
    mov eax, -1
 | 
						|
@FReadEnd:
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
 | 
						|
                                                                     assembler;
 | 
						|
asm
 | 
						|
    mov eax, 4000h
 | 
						|
    mov ebx, Handle
 | 
						|
    mov ecx, Count
 | 
						|
    mov edx, Buffer
 | 
						|
    call syscall
 | 
						|
    jnc @FWriteEnd
 | 
						|
    mov eax, -1
 | 
						|
@FWriteEnd:
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
 | 
						|
asm
 | 
						|
    mov eax, Origin
 | 
						|
    mov ah, 42h
 | 
						|
    mov ebx, Handle
 | 
						|
    mov edx, FOffset
 | 
						|
    call syscall
 | 
						|
    jnc @FSeekEnd
 | 
						|
    mov eax, -1
 | 
						|
@FSeekEnd:
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
procedure FileClose (Handle: longint);
 | 
						|
begin
 | 
						|
    if (Handle <= 4) or (os_mode = osOS2) and (Handle <= 2) then
 | 
						|
        asm
 | 
						|
            mov eax, 3E00h
 | 
						|
            mov ebx, Handle
 | 
						|
            call syscall
 | 
						|
        end;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileTruncate (Handle, Size: longint): boolean; assembler;
 | 
						|
asm
 | 
						|
    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:
 | 
						|
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;
 | 
						|
{$IFOPT H+}
 | 
						|
                                                       assembler;
 | 
						|
{$ELSE}
 | 
						|
var FN: string;
 | 
						|
begin
 | 
						|
    FN := FileName + #0;
 | 
						|
{$ENDIF}
 | 
						|
asm
 | 
						|
    mov ax, 4300h
 | 
						|
{$IFOPT H+}
 | 
						|
    mov edx, FileName
 | 
						|
{$ELSE}
 | 
						|
    lea edx, FN
 | 
						|
    inc edx
 | 
						|
{$ENDIF}
 | 
						|
    call syscall
 | 
						|
    mov eax, 0
 | 
						|
    jc @FExistsEnd
 | 
						|
    test cx, 18h
 | 
						|
    jnz @FExistsEnd
 | 
						|
    inc eax
 | 
						|
@FExistsEnd:
 | 
						|
{$IFOPT H-}
 | 
						|
end;
 | 
						|
{$ENDIF}
 | 
						|
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: longint;
 | 
						|
    Err: longint;
 | 
						|
 | 
						|
begin
 | 
						|
    if os_mode = osOS2 then
 | 
						|
        begin
 | 
						|
            New (FStat);
 | 
						|
            Rslt.FindHandle := $FFFFFFFF;
 | 
						|
            Count := 1;
 | 
						|
            Err := DosFindFirst (Path, Rslt.FindHandle, Attr, 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
 | 
						|
    else
 | 
						|
        begin
 | 
						|
            GetMem (SR, SizeOf (SearchRec));
 | 
						|
            Rslt.FindHandle := longint(SR);
 | 
						|
            DOS.FindFirst (Path, Attr, SR^);
 | 
						|
            FindFirst := -DosError;
 | 
						|
            if DosError = 0 then
 | 
						|
                begin
 | 
						|
                    Rslt.Time := SR^.Time;
 | 
						|
                    Rslt.Size := SR^.Size;
 | 
						|
                    Rslt.Attr := SR^.Attr;
 | 
						|
                    Rslt.ExcludeAttr := 0;
 | 
						|
                    Rslt.Name := SR^.Name;
 | 
						|
                end;
 | 
						|
        end;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FindNext (var Rslt: TSearchRec): longint;
 | 
						|
 | 
						|
var SR: PSearchRec;
 | 
						|
    FStat: PFileFindBuf3;
 | 
						|
    Count: longint;
 | 
						|
    Err: longint;
 | 
						|
 | 
						|
begin
 | 
						|
    if os_mode = osOS2 then
 | 
						|
        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
 | 
						|
    else
 | 
						|
        begin
 | 
						|
            SR := PSearchRec (Rslt.FindHandle);
 | 
						|
            if SR <> nil then
 | 
						|
                begin
 | 
						|
                    DOS.FindNext (SR^);
 | 
						|
                    FindNext := -DosError;
 | 
						|
                    if DosError = 0 then
 | 
						|
                        begin
 | 
						|
                            Rslt.Time := SR^.Time;
 | 
						|
                            Rslt.Size := SR^.Size;
 | 
						|
                            Rslt.Attr := SR^.Attr;
 | 
						|
                            Rslt.ExcludeAttr := 0;
 | 
						|
                            Rslt.Name := SR^.Name;
 | 
						|
                        end;
 | 
						|
                end;
 | 
						|
        end;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
procedure FindClose (var F: TSearchrec);
 | 
						|
 | 
						|
var SR: PSearchRec;
 | 
						|
 | 
						|
begin
 | 
						|
    if os_mode = osOS2 then
 | 
						|
        begin
 | 
						|
            DosFindClose (F.FindHandle);
 | 
						|
        end
 | 
						|
    else
 | 
						|
        begin
 | 
						|
            SR := PSearchRec (F.FindHandle);
 | 
						|
            DOS.FindClose (SR^);
 | 
						|
            FreeMem (SR, SizeOf (SearchRec));
 | 
						|
        end;
 | 
						|
    F.FindHandle := 0;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileGetDate (Handle: longint): longint; assembler;
 | 
						|
asm
 | 
						|
    mov ax, 5700h
 | 
						|
    mov ebx, Handle
 | 
						|
    call syscall
 | 
						|
    mov eax, -1
 | 
						|
    jc @FGetDateEnd
 | 
						|
    mov ax, dx
 | 
						|
    shld eax, ecx, 16
 | 
						|
@FGetDateEnd:
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileSetDate (Handle, Age: longint): longint;
 | 
						|
var FStat: PFileStatus0;
 | 
						|
    RC: longint;
 | 
						|
begin
 | 
						|
    if os_mode = osOS2 then
 | 
						|
        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
 | 
						|
    else
 | 
						|
        asm
 | 
						|
            mov ax, 5701h
 | 
						|
            mov ebx, Handle
 | 
						|
            mov cx, word ptr [Age]
 | 
						|
            mov dx, word ptr [Age + 2]
 | 
						|
            call syscall
 | 
						|
            jnc @FSetDateEnd
 | 
						|
            mov eax, -1
 | 
						|
@FSetDateEnd:
 | 
						|
            mov [ebp - 4], eax
 | 
						|
        end;
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileGetAttr (const FileName: string): longint;
 | 
						|
{$IFOPT H+}
 | 
						|
                                                        assembler;
 | 
						|
{$ELSE}
 | 
						|
var FN: string;
 | 
						|
begin
 | 
						|
    FN := FileName + #0;
 | 
						|
{$ENDIF}
 | 
						|
asm
 | 
						|
    mov ax, 4300h
 | 
						|
{$IFOPT H+}
 | 
						|
    mov edx, FileName
 | 
						|
{$ELSE}
 | 
						|
    lea edx, FN
 | 
						|
    inc edx
 | 
						|
{$ENDIF}
 | 
						|
    call syscall
 | 
						|
    jnc @FGetAttrEnd
 | 
						|
    mov eax, -1
 | 
						|
@FGetAttrEnd:
 | 
						|
{$IFOPT H-}
 | 
						|
    mov [ebp - 4], eax
 | 
						|
end;
 | 
						|
{$ENDIF}
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileSetAttr (const Filename: string; Attr: longint): longint;
 | 
						|
{$IFOPT H+}
 | 
						|
                                                                     assembler;
 | 
						|
{$ELSE}
 | 
						|
var FN: string;
 | 
						|
begin
 | 
						|
    FN := FileName + #0;
 | 
						|
{$ENDIF}
 | 
						|
asm
 | 
						|
    mov ax, 4301h
 | 
						|
    mov ecx, Attr
 | 
						|
{$IFOPT H+}
 | 
						|
    mov edx, FileName
 | 
						|
{$ELSE}
 | 
						|
    lea edx, FN
 | 
						|
    inc edx
 | 
						|
{$ENDIF}
 | 
						|
    call syscall
 | 
						|
    mov eax, 0
 | 
						|
    jnc @FSetAttrEnd
 | 
						|
    mov eax, -1
 | 
						|
@FSetAttrEnd:
 | 
						|
{$IFOPT H-}
 | 
						|
    mov [ebp - 4], eax
 | 
						|
end;
 | 
						|
{$ENDIF}
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function DeleteFile (const FileName: string): boolean;
 | 
						|
{$IFOPT H+}
 | 
						|
                                                       assembler;
 | 
						|
{$ELSE}
 | 
						|
var FN: string;
 | 
						|
begin
 | 
						|
    FN := FileName + #0;
 | 
						|
{$ENDIF}
 | 
						|
asm
 | 
						|
    mov ax, 4100h
 | 
						|
{$IFOPT H+}
 | 
						|
    mov edx, FileName
 | 
						|
{$ELSE}
 | 
						|
    lea edx, FN
 | 
						|
    inc edx
 | 
						|
{$ENDIF}
 | 
						|
    call syscall
 | 
						|
    mov eax, 0
 | 
						|
    jc @FDeleteEnd
 | 
						|
    inc eax
 | 
						|
@FDeleteEnd:
 | 
						|
{$IFOPT H-}
 | 
						|
    mov [ebp - 4], eax
 | 
						|
end;
 | 
						|
{$ENDIF}
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function RenameFile (const OldName, NewName: string): boolean;
 | 
						|
{$IFOPT H+}
 | 
						|
                                                       assembler;
 | 
						|
{$ELSE}
 | 
						|
var FN1, FN2: string;
 | 
						|
begin
 | 
						|
    FN1 := OldName + #0;
 | 
						|
    FN2 := NewName + #0;
 | 
						|
{$ENDIF}
 | 
						|
asm
 | 
						|
    mov ax, 5600h
 | 
						|
{$IFOPT H+}
 | 
						|
    mov edx, OldName
 | 
						|
    mov edi, NewName
 | 
						|
{$ELSE}
 | 
						|
    lea edx, FN1
 | 
						|
    inc edx
 | 
						|
    lea edi, FN2
 | 
						|
    inc edi
 | 
						|
{$ENDIF}
 | 
						|
    call syscall
 | 
						|
    mov eax, 0
 | 
						|
    jc @FRenameEnd
 | 
						|
    inc eax
 | 
						|
@FRenameEnd:
 | 
						|
{$IFOPT H-}
 | 
						|
    mov [ebp - 4], eax
 | 
						|
end;
 | 
						|
{$ENDIF}
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
function FileSearch (const Name, DirList: string): string;
 | 
						|
begin
 | 
						|
    Result := Dos.FSearch (Name, DirList);
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                              Disk Functions
 | 
						|
****************************************************************************}
 | 
						|
 | 
						|
{$ASMMODE ATT}
 | 
						|
 | 
						|
function DiskFree (Drive: byte): int64;
 | 
						|
 | 
						|
var FI: TFSinfo;
 | 
						|
    RC: longint;
 | 
						|
 | 
						|
begin
 | 
						|
    if (os_mode = osDOS) or (os_mode = osDPMI) then
 | 
						|
    {Function 36 is not supported in OS/2.}
 | 
						|
        asm
 | 
						|
            movb Drive,%dl
 | 
						|
            movb $0x36,%ah
 | 
						|
            call syscall
 | 
						|
            cmpw $-1,%ax
 | 
						|
            je .LDISKFREE1
 | 
						|
            mulw %cx
 | 
						|
            mulw %bx
 | 
						|
            shll $16,%edx
 | 
						|
            movw %ax,%dx
 | 
						|
            movl $0,%eax
 | 
						|
            xchgl %edx,%eax
 | 
						|
            leave
 | 
						|
            ret
 | 
						|
         .LDISKFREE1:
 | 
						|
            cltd
 | 
						|
            leave
 | 
						|
            ret
 | 
						|
        end
 | 
						|
    else
 | 
						|
        {In OS/2, we use the filesystem information.}
 | 
						|
        begin
 | 
						|
            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;
 | 
						|
end;
 | 
						|
 | 
						|
function DiskSize (Drive: byte): int64;
 | 
						|
 | 
						|
var FI: TFSinfo;
 | 
						|
    RC: longint;
 | 
						|
 | 
						|
begin
 | 
						|
    if (os_mode = osDOS) or (os_mode = osDPMI) then
 | 
						|
        {Function 36 is not supported in OS/2.}
 | 
						|
        asm
 | 
						|
            movb Drive,%dl
 | 
						|
            movb $0x36,%ah
 | 
						|
            call syscall
 | 
						|
            movw %dx,%bx
 | 
						|
            cmpw $-1,%ax
 | 
						|
            je .LDISKSIZE1
 | 
						|
            mulw %cx
 | 
						|
            mulw %bx
 | 
						|
            shll $16,%edx
 | 
						|
            movw %ax,%dx
 | 
						|
            movl $0,%eax
 | 
						|
            xchgl %edx,%eax
 | 
						|
            leave
 | 
						|
            ret
 | 
						|
        .LDISKSIZE1:
 | 
						|
            cltd
 | 
						|
            leave
 | 
						|
            ret
 | 
						|
        end
 | 
						|
    else
 | 
						|
        {In OS/2, we use the filesystem information.}
 | 
						|
        begin
 | 
						|
            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;
 | 
						|
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;
 | 
						|
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                              Time Functions
 | 
						|
****************************************************************************}
 | 
						|
 | 
						|
{$asmmode intel}
 | 
						|
procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
 | 
						|
asm
 | 
						|
(* Expects the default record alignment (word)!!! *)
 | 
						|
    mov ah, 2Ah
 | 
						|
    call syscall
 | 
						|
    mov edi, SystemTime
 | 
						|
    mov ax, cx
 | 
						|
    stosw
 | 
						|
    xor eax, eax
 | 
						|
    mov al, dl
 | 
						|
    shl eax, 16
 | 
						|
    mov al, dh
 | 
						|
    stosd
 | 
						|
    push edi
 | 
						|
    mov ah, 2Ch
 | 
						|
    call syscall
 | 
						|
    pop edi
 | 
						|
    xor eax, eax
 | 
						|
    mov al, cl
 | 
						|
    shl eax, 16
 | 
						|
    mov al, ch
 | 
						|
    stosd
 | 
						|
    mov al, dl
 | 
						|
    shl eax, 16
 | 
						|
    mov al, dh
 | 
						|
    stosd
 | 
						|
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));
 | 
						|
    if os_mode = osOS2 then
 | 
						|
        begin
 | 
						|
            FillChar (Country, SizeOf (Country), 0);
 | 
						|
            DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable);
 | 
						|
        end
 | 
						|
    else
 | 
						|
        begin
 | 
						|
(* !!! TODO: DOS/DPMI mode support!!! *)
 | 
						|
        end;
 | 
						|
    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: longint;
 | 
						|
    RC: longint;
 | 
						|
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;
 | 
						|
 | 
						|
var P: PChar;
 | 
						|
 | 
						|
begin
 | 
						|
    if DosScanEnv (PChar (EnvVar), P) = 0
 | 
						|
                  then GetEnvironmentVariable := StrPas (P)
 | 
						|
                                             else GetEnvironmentVariable := '';
 | 
						|
end;
 | 
						|
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                              Initialization code
 | 
						|
****************************************************************************}
 | 
						|
 | 
						|
Initialization
 | 
						|
  InitExceptions;       { Initialize exceptions. OS independent }
 | 
						|
  InitInternational;    { Initialize internationalization settings }
 | 
						|
Finalization
 | 
						|
  DoneExceptions;
 | 
						|
end.
 | 
						|
 | 
						|
{
 | 
						|
  $Log$
 | 
						|
  Revision 1.12  2001-06-03 15:18:01  peter
 | 
						|
    * eoutofmemory and einvalidpointer fix
 | 
						|
 | 
						|
  Revision 1.11  2001/05/21 20:50:19  hajny
 | 
						|
    * silly mistyping corrected
 | 
						|
 | 
						|
  Revision 1.10  2001/05/20 18:40:33  hajny
 | 
						|
    * merging Carl's fixes from the fixes branch
 | 
						|
 | 
						|
  Revision 1.9  2001/02/21 21:23:38  hajny
 | 
						|
    * GetEnvironmentVariable now really merged
 | 
						|
 | 
						|
  Revision 1.8  2001/02/20 22:14:19  peter
 | 
						|
    * merged getenvironmentvariable
 | 
						|
 | 
						|
  Revision 1.7  2001/01/13 11:10:59  hajny
 | 
						|
    * FileCreate and GetLocalTime fixed
 | 
						|
 | 
						|
  Revision 1.6  2000/10/15 20:44:18  hajny
 | 
						|
    * FindClose correction
 | 
						|
 | 
						|
  Revision 1.5  2000/09/29 21:49:41  jonas
 | 
						|
    * removed warnings
 | 
						|
 | 
						|
  Revision 1.4  2000/08/30 06:30:55  michael
 | 
						|
  + Merged syserrormsg fix
 | 
						|
 | 
						|
  Revision 1.3  2000/08/25 17:23:56  hajny
 | 
						|
    * Sharing mode error fixed
 | 
						|
 | 
						|
  Revision 1.2  2000/08/20 15:46:46  peter
 | 
						|
    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
 | 
						|
  Revision 1.1.2.3  2000/08/25 17:20:57  hajny
 | 
						|
    * Sharing mode error fixed
 | 
						|
 | 
						|
  Revision 1.1.2.2  2000/08/22 19:21:48  michael
 | 
						|
  + Implemented syserrormessage. Made dummies for go32v2 and OS/2
 | 
						|
  * Changed linux/errors.pp so it uses pchars for storage.
 | 
						|
 | 
						|
  Revision 1.1.2.1  2000/08/20 15:08:32  peter
 | 
						|
    * forgot the add command :(
 | 
						|
 | 
						|
}
 |