diff --git a/rtl/go32v2/Makefile b/rtl/go32v2/Makefile index 5f6fdfb10d..d42e3f26d8 100644 --- a/rtl/go32v2/Makefile +++ b/rtl/go32v2/Makefile @@ -1,5 +1,5 @@ # -# Makefile generated by fpcmake v0.99.15 [2000/07/02] +# Makefile generated by fpcmake v1.00 [2000/08/14] # defaultrule: all @@ -926,7 +926,7 @@ ifdef INSTALLPPUFILES ifdef PPUFILES INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)) else -INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES))) +INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))) endif endif @@ -1091,7 +1091,7 @@ ifdef CLEANPPUFILES ifdef PPUFILES CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES)) else -CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES))) +CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))) endif endif @@ -1271,9 +1271,9 @@ graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) $(SYSTEMPPU) \ # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/go32v2/Makefile.fpc b/rtl/go32v2/Makefile.fpc index f30922978f..e826cd490e 100644 --- a/rtl/go32v2/Makefile.fpc +++ b/rtl/go32v2/Makefile.fpc @@ -143,9 +143,9 @@ graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) $(SYSTEMPPU) \ # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/go32v2/disk.inc b/rtl/go32v2/disk.inc deleted file mode 100644 index e9921fa710..0000000000 --- a/rtl/go32v2/disk.inc +++ /dev/null @@ -1,143 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - Disk functions from Delphi's sysutils.pas - - 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. - - **********************************************************************} - -TYPE ExtendedFat32FreeSpaceRec=packed Record - RetSize : WORD; { (ret) size of returned structure} - Strucversion : WORD; {(call) structure version (0000h) - (ret) actual structure version (0000h)} - SecPerClus, {number of sectors per cluster} - BytePerSec, {number of bytes per sector} - AvailClusters, {number of available clusters} - TotalClusters, {total number of clusters on the drive} - AvailPhysSect, {physical sectors available on the drive} - TotalPhysSect, {total physical sectors on the drive} - AvailAllocUnits, {Available allocation units} - TotalAllocUnits : DWORD; {Total allocation units} - Dummy,Dummy2 : DWORD; {8 bytes reserved} - END; - -function do_diskdata(drive : byte; Free : BOOLEAN) : Int64; - -VAR S : String; - Rec : ExtendedFat32FreeSpaceRec; - regs : registers; -BEGIN - if (swap(dosversion)>=$070A) AND LFNSupport then - begin - DosError:=0; - S:='C:\'#0; - if Drive=0 then - begin - GetDir(Drive,S); - Setlength(S,4); - S[4]:=#0; - end - else - S[1]:=chr(Drive+64); - Rec.Strucversion:=0; - dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec)); - dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4); - regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1; - regs.ds:=tb_segment; - regs.di:=tb_offset; - regs.es:=tb_segment; - regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec); - regs.ax:=$7303; - msdos(regs); - if regs.ax<>$ffff then - begin - copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec)); - if Free then - Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec - else - Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec; - end - else - Do_DiskData:=-1; - end - else - begin - DosError:=0; - regs.dl:=drive; - regs.ah:=$36; - msdos(regs); - if regs.ax<>$FFFF then - begin - if Free then - Do_DiskData:=int64(regs.ax)*regs.bx*regs.cx - else - Do_DiskData:=int64(regs.ax)*regs.cx*regs.dx; - end - else - do_diskdata:=-1; - end; -end; - -function diskfree(drive : byte) : int64; - -begin - diskfree:=Do_DiskData(drive,TRUE); -end; - - -function disksize(drive : byte) : int64; -begin - disksize:=Do_DiskData(drive,false); -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; - - -{ - $Log$ - Revision 1.3 2000-07-14 10:33:09 michael - + Conditionals fixed - - Revision 1.2 2000/07/13 11:33:39 michael - + removed logs - -} diff --git a/rtl/go32v2/filutil.inc b/rtl/go32v2/filutil.inc deleted file mode 100644 index 56c2688390..0000000000 --- a/rtl/go32v2/filutil.inc +++ /dev/null @@ -1,466 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - File utility calls - - 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. - - **********************************************************************} - -{******************************************************************************} -{ private functions } -{******************************************************************************} - -{ some internal constants } - -const - ofRead = $0000; { Open for reading } - ofWrite = $0001; { Open for writing } - ofReadWrite = $0002; { Open for reading/writing } - faFail = $0000; { Fail if file does not exist } - faCreate = $0010; { Create if file does not exist } - faOpen = $0001; { Open if file exists } - faOpenReplace = $0002; { Clear if file exists } - - -{ converts S to a pchar and copies it to the transfer-buffer. } - -procedure StringToTB(const S: string); -var P: pchar; Len: integer; -begin -Len := Length(S) + 1; -P := StrPCopy(StrAlloc(Len), S); -SysCopyToDos(longint(P), Len); -StrDispose(P); -end ; - -{ Native OpenFile function. - if return value <> 0 call failed. } - -function OpenFile(const FileName: string; var Handle: longint; Mode, Action: word): longint; -var - Regs: registers; -begin -result := 0; -Handle := 0; -StringToTB(FileName); -if LFNSupport then Regs.Eax:=$716c -else Regs.Eax:=$6c00; -Regs.Edx := Action; { Action if file exists/not exists } -Regs.Ds := tb_segment; -Regs.Esi := tb_offset; -Regs.Ebx := $2000 + (Mode and $ff); { file open mode } -Regs.Ecx := $20; { Attributes } -RealIntr($21, Regs); -if Regs.Flags and CarryFlag <> 0 then result := Regs.Ax -else Handle := Regs.Ax; -end ; - -{******************************************************************************} -{ Public functions } -{******************************************************************************} - - -Function FileOpen (Const FileName : string; Mode : Integer) : Longint; -var e: integer; -Begin -e := OpenFile(FileName, result, Mode, faOpen); -if e <> 0 then result := -1; -end ; - - -Function FileCreate (Const FileName : String) : Longint; -var e: integer; -begin -e := OpenFile(FileName, result, ofReadWrite, faCreate or faOpenReplace); -if e <> 0 then result := -1; -end; - - -Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint; -begin -result := Do_Read(Handle, longint(@Buffer), Count); -end; - - -Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint; -begin -result := Do_Write(Handle, longint(@Buffer), Count); -end; - - -Function FileSeek (Handle, FOffset, Origin : Longint) : Longint; -var Regs: registers; -begin -Regs.Eax := $4200; -Regs.Al := Origin; -Regs.Edx := Lo(FOffset); -Regs.Ecx := Hi(FOffset); -Regs.Ebx := Handle; -RealIntr($21, Regs); -if Regs.Flags and CarryFlag <> 0 then - result := -1 -else begin - LongRec(result).Lo := Regs.Ax; - LongRec(result).Hi := Regs.Dx; - end ; -end; - - -Procedure FileClose (Handle : Longint); -var Regs: registers; -begin - if Handle<=4 then - exit; -Regs.Eax := $3e00; -Regs.Ebx := Handle; -RealIntr($21, Regs); -end; - -Function FileTruncate (Handle,Size: Longint) : boolean; -var - regs : trealregs; -begin - FileSeek(Handle,Size,0); - Regs.realecx := 0; - Regs.realedx := tb_offset; - Regs.ds := tb_segment; - Regs.ebx := Handle; - Regs.eax:=$4000; - RealIntr($21, Regs); - FileTruncate:=(regs.realflags and carryflag)=0; -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 Handle: longint; -begin - //!! This can be done quicker, need to find out how -Result := (OpenFile(FileName, Handle, ofRead, faOpen) = 0); -if Handle <> 0 then - FileClose(Handle); -end; - -Type PSearchrec = ^Searchrec; - - -Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint; - -Var Sr : PSearchrec; - -begin -//!! Sr := New(PSearchRec); -getmem(sr,sizeof(searchrec)); -Rslt.FindHandle := longint(Sr); -DOS.FindFirst(Path, Attr, Sr^); -result := -DosError; -if result = 0 then begin - Rslt.Time := Sr^.Time; - Rslt.Size := Sr^.Size; - Rslt.Attr := Sr^.Attr; - Rslt.ExcludeAttr := 0; - Rslt.Name := Sr^.Name; - end ; -end; - - -Function FindNext (Var Rslt : TSearchRec) : Longint; - -var Sr: PSearchRec; - -begin -Sr := PSearchRec(Rslt.FindHandle); -if Sr <> nil then begin - DOS.FindNext(Sr^); - result := -DosError; - if result = 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; - - -Procedure FindClose (Var F : TSearchrec); - -var Sr: PSearchRec; - -begin -Sr := PSearchRec(F.FindHandle); -if Sr <> nil then - begin - //!! Dispose(Sr); - // This call is non dummy if LFNSupport is true PM - DOS.FindClose(SR^); - freemem(sr,sizeof(searchrec)); - end; -F.FindHandle := 0; -end; - - -Function FileGetDate (Handle : Longint) : Longint; -var Regs: registers; -begin - //!! for win95 an alternative function is available. -Regs.Ebx := Handle; -Regs.Eax := $5700; -RealIntr($21, Regs); -if Regs.Flags and CarryFlag <> 0 then result := -1 -else begin - LongRec(result).Lo := Regs.cx; - LongRec(result).Hi := Regs.dx; - end ; -end; - - -Function FileSetDate (Handle, Age : Longint) : Longint; -var Regs: registers; -begin -Regs.Ebx := Handle; -Regs.Eax := $5701; -Regs.Ecx := Lo(Age); -Regs.Edx := Hi(Age); -RealIntr($21, Regs); -if Regs.Flags and CarryFlag <> 0 then result := -Regs.Ax -else result := 0; -end; - - -Function FileGetAttr (Const FileName : String) : Longint; - -var Regs: registers; - -begin - StringToTB(FileName); - Regs.Edx := tb_offset; - Regs.Ds := tb_segment; - if LFNSupport then - begin - Regs.Ax := $7143; - Regs.Bx := 0; - end - else - Regs.Ax := $4300; - RealIntr($21, Regs); - if Regs.Flags and CarryFlag <> 0 then - result := -1 - else - result := Regs.Cx; -end; - - -Function FileSetAttr (Const Filename : String; Attr: longint) : Longint; - -var Regs: registers; - -begin - StringToTB(FileName); - Regs.Edx := tb_offset; - Regs.Ds := tb_segment; - if LFNSupport then - begin - Regs.Ax := $7143; - Regs.Bx := 1; - end - else - Regs.Ax := $4301; - Regs.Cx := Attr; - RealIntr($21, Regs); - if Regs.Flags and CarryFlag <> 0 then result := -Regs.Ax - else result := 0; -end; - - -Function DeleteFile (Const FileName : String) : Boolean; - -var Regs: registers; - -begin - StringToTB(FileName); - Regs.Edx := tb_offset; - Regs.Ds := tb_segment; - if LFNSupport then - Regs.Eax := $7141 - else - Regs.Eax := $4100; - Regs.Esi := 0; - Regs.Ecx := 0; - RealIntr($21, Regs); - result := (Regs.Flags and CarryFlag = 0); -end; - - -Function RenameFile (Const OldName, NewName : String) : Boolean; - -var Regs: registers; - -begin - StringToTB(OldName + #0 + NewName); - Regs.Edx := tb_offset; - Regs.Ds := tb_segment; - Regs.Edi := tb_offset + Length(OldName) + 1; - Regs.Es := tb_segment; - if LFNSupport then - Regs.Eax := $7156 - else - Regs.Eax := $5600; - Regs.Ecx := $ff; - RealIntr($21, Regs); - result := (Regs.Flags and CarryFlag = 0); -end; - - -Function FileSearch (Const Name, DirList : String) : String; - -begin - result := DOS.FSearch(Name, DirList); -end; - -Procedure GetLocalTime(var SystemTime: TSystemTime); - -var Regs: Registers; - -begin -Regs.ah := $2C; -RealIntr($21, Regs); -SystemTime.Hour := Regs.Ch; -SystemTime.Minute := Regs.Cl; -SystemTime.Second := Regs.Dh; -SystemTime.MilliSecond := Regs.Dl; -Regs.ah := $2A; -RealIntr($21, Regs); -SystemTime.Year := Regs.Cx; -SystemTime.Month := Regs.Dh; -SystemTime.Day := Regs.Dl; -end ; - -{ --------------------------------------------------------------------- - Internationalization settings - ---------------------------------------------------------------------} - - -{ Codepage constants } -const - CP_US = 437; - CP_MultiLingual = 850; - CP_SlavicLatin2 = 852; - CP_Turkish = 857; - CP_Portugal = 860; - CP_IceLand = 861; - CP_Canada = 863; - CP_NorwayDenmark = 865; - -{ CountryInfo } -type - TCountryInfo = packed record - InfoId: byte; - case integer of - 1: ( Size: word; - CountryId: word; - CodePage: word; - CountryInfo: array[0..33] of byte ); - 2: ( UpperCaseTable: longint ); - 4: ( FilenameUpperCaseTable: longint ); - 5: ( FilecharacterTable: longint ); - 6: ( CollatingTable: longint ); - 7: ( DBCSLeadByteTable: longint ); - end ; - - -procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo); - -Var Regs: Registers; - -begin - Regs.AH := $65; - Regs.AL := InfoId; - Regs.BX := CodePage; - Regs.DX := CountryId; - Regs.ES := transfer_buffer div 16; - Regs.DI := transfer_buffer and 15; - Regs.CX := SizeOf(TCountryInfo); - RealIntr($21, Regs); - DosMemGet(transfer_buffer div 16, - transfer_buffer and 15, - CountryInfo, Regs.CX ); -end; - -procedure InitAnsi; - -var CountryInfo: TCountryInfo; i: integer; - -begin -{ Fill table entries 0 to 127 } -for i := 0 to 96 do - UpperCaseTable[i] := chr(i); -for i := 97 to 122 do - UpperCaseTable[i] := chr(i - 32); -for i := 123 to 127 do - UpperCaseTable[i] := chr(i); -for i := 0 to 64 do - LowerCaseTable[i] := chr(i); -for i := 65 to 90 do - LowerCaseTable[i] := chr(i + 32); -for i := 91 to 255 do - LowerCaseTable[i] := chr(i); - -{ Get country and codepage info } -GetExtendedCountryInfo(1, $FFFF, $FFFF, CountryInfo); -if CountryInfo.CodePage = 850 then - begin - { Special, known case } - Move(CP850UCT, UpperCaseTable[128], 128); - Move(CP850LCT, LowerCaseTable[128], 128); - end -else - begin - { this needs to be checked !! - this is correct only if UpperCaseTable is - and Offset:Segment word record (PM) } - { get the uppercase table from dosmemory } - GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo); - DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128); - for i := 128 to 255 do - begin - if UpperCaseTable[i] <> chr(i) then - LowerCaseTable[ord(UpperCaseTable[i])] := chr(i); - end; - end; -end; - -Procedure InitInternational; - -{ This routine is called by the unit startup code. } - -begin - { Init upper/lowercase tables } - InitAnsi -end; - -{ - $Log$ - Revision 1.2 2000-07-13 11:33:40 michael - + removed logs - -} diff --git a/rtl/go32v2/sysutils.pp b/rtl/go32v2/sysutils.pp new file mode 100644 index 0000000000..38780f6246 --- /dev/null +++ b/rtl/go32v2/sysutils.pp @@ -0,0 +1,641 @@ +{ + $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 Go32v2 + + 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 + go32,dos; + +{ Include platform independent interface part } +{$i sysutilh.inc} + + +implementation + +{ Include platform independent implementation part } +{$i sysutils.inc} + + +{**************************************************************************** + File Functions +****************************************************************************} + +{ some internal constants } + +const + ofRead = $0000; { Open for reading } + ofWrite = $0001; { Open for writing } + ofReadWrite = $0002; { Open for reading/writing } + faFail = $0000; { Fail if file does not exist } + faCreate = $0010; { Create if file does not exist } + faOpen = $0001; { Open if file exists } + faOpenReplace = $0002; { Clear if file exists } + +Type + PSearchrec = ^Searchrec; + +{ converts S to a pchar and copies it to the transfer-buffer. } + +procedure StringToTB(const S: string); +var + P: pchar; + Len: integer; +begin + Len := Length(S) + 1; + P := StrPCopy(StrAlloc(Len), S); + SysCopyToDos(longint(P), Len); + StrDispose(P); +end ; + +{ Native OpenFile function. + if return value <> 0 call failed. } + +function OpenFile(const FileName: string; var Handle: longint; Mode, Action: word): longint; +var + Regs: registers; +begin + result := 0; + Handle := 0; + StringToTB(FileName); + if LFNSupport then Regs.Eax:=$716c + else Regs.Eax:=$6c00; + Regs.Edx := Action; { Action if file exists/not exists } + Regs.Ds := tb_segment; + Regs.Esi := tb_offset; + Regs.Ebx := $2000 + (Mode and $ff); { file open mode } + Regs.Ecx := $20; { Attributes } + RealIntr($21, Regs); + if Regs.Flags and CarryFlag <> 0 then result := Regs.Ax + else Handle := Regs.Ax; +end ; + + +Function FileOpen (Const FileName : string; Mode : Integer) : Longint; +var + e: integer; +Begin + e := OpenFile(FileName, result, Mode, faOpen); + if e <> 0 then + result := -1; +end; + + +Function FileCreate (Const FileName : String) : Longint; +var + e: integer; +begin + e := OpenFile(FileName, result, ofReadWrite, faCreate or faOpenReplace); + if e <> 0 then + result := -1; +end; + + +Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint; +begin + result := Do_Read(Handle, longint(@Buffer), Count); +end; + + +Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint; +begin + result := Do_Write(Handle, longint(@Buffer), Count); +end; + + +Function FileSeek (Handle, FOffset, Origin : Longint) : Longint; +var + Regs: registers; +begin + Regs.Eax := $4200; + Regs.Al := Origin; + Regs.Edx := Lo(FOffset); + Regs.Ecx := Hi(FOffset); + Regs.Ebx := Handle; + RealIntr($21, Regs); + if Regs.Flags and CarryFlag <> 0 then + result := -1 + else begin + LongRec(result).Lo := Regs.Ax; + LongRec(result).Hi := Regs.Dx; + end ; +end; + + +Procedure FileClose (Handle : Longint); +var + Regs: registers; +begin + if Handle<=4 then + exit; + Regs.Eax := $3e00; + Regs.Ebx := Handle; + RealIntr($21, Regs); +end; + + +Function FileTruncate (Handle,Size: Longint) : boolean; +var + regs : trealregs; +begin + FileSeek(Handle,Size,0); + Regs.realecx := 0; + Regs.realedx := tb_offset; + Regs.ds := tb_segment; + Regs.ebx := Handle; + Regs.eax:=$4000; + RealIntr($21, Regs); + FileTruncate:=(regs.realflags and carryflag)=0; +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 Handle: longint; +begin + //!! This can be done quicker, need to find out how + Result := (OpenFile(FileName, Handle, ofRead, faOpen) = 0); + if Handle <> 0 then + FileClose(Handle); +end; + + +Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint; + +Var Sr : PSearchrec; + +begin + //!! Sr := New(PSearchRec); + getmem(sr,sizeof(searchrec)); + Rslt.FindHandle := longint(Sr); + DOS.FindFirst(Path, Attr, Sr^); + result := -DosError; + if result = 0 then + begin + Rslt.Time := Sr^.Time; + Rslt.Size := Sr^.Size; + Rslt.Attr := Sr^.Attr; + Rslt.ExcludeAttr := 0; + Rslt.Name := Sr^.Name; + end ; +end; + + +Function FindNext (Var Rslt : TSearchRec) : Longint; +var + Sr: PSearchRec; +begin + Sr := PSearchRec(Rslt.FindHandle); + if Sr <> nil then + begin + DOS.FindNext(Sr^); + result := -DosError; + if result = 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; + + +Procedure FindClose (Var F : TSearchrec); +var + Sr: PSearchRec; +begin + Sr := PSearchRec(F.FindHandle); + if Sr <> nil then + begin + //!! Dispose(Sr); + // This call is non dummy if LFNSupport is true PM + DOS.FindClose(SR^); + freemem(sr,sizeof(searchrec)); + end; + F.FindHandle := 0; +end; + + +Function FileGetDate (Handle : Longint) : Longint; +var + Regs: registers; +begin + //!! for win95 an alternative function is available. + Regs.Ebx := Handle; + Regs.Eax := $5700; + RealIntr($21, Regs); + if Regs.Flags and CarryFlag <> 0 then + result := -1 + else + begin + LongRec(result).Lo := Regs.cx; + LongRec(result).Hi := Regs.dx; + end ; +end; + + +Function FileSetDate (Handle, Age : Longint) : Longint; +var + Regs: registers; +begin + Regs.Ebx := Handle; + Regs.Eax := $5701; + Regs.Ecx := Lo(Age); + Regs.Edx := Hi(Age); + RealIntr($21, Regs); + if Regs.Flags and CarryFlag <> 0 then + result := -Regs.Ax + else + result := 0; +end; + + +Function FileGetAttr (Const FileName : String) : Longint; +var + Regs: registers; +begin + StringToTB(FileName); + Regs.Edx := tb_offset; + Regs.Ds := tb_segment; + if LFNSupport then + begin + Regs.Ax := $7143; + Regs.Bx := 0; + end + else + Regs.Ax := $4300; + RealIntr($21, Regs); + if Regs.Flags and CarryFlag <> 0 then + result := -1 + else + result := Regs.Cx; +end; + + +Function FileSetAttr (Const Filename : String; Attr: longint) : Longint; +var + Regs: registers; +begin + StringToTB(FileName); + Regs.Edx := tb_offset; + Regs.Ds := tb_segment; + if LFNSupport then + begin + Regs.Ax := $7143; + Regs.Bx := 1; + end + else + Regs.Ax := $4301; + Regs.Cx := Attr; + RealIntr($21, Regs); + if Regs.Flags and CarryFlag <> 0 then + result := -Regs.Ax + else + result := 0; +end; + + +Function DeleteFile (Const FileName : String) : Boolean; +var + Regs: registers; +begin + StringToTB(FileName); + Regs.Edx := tb_offset; + Regs.Ds := tb_segment; + if LFNSupport then + Regs.Eax := $7141 + else + Regs.Eax := $4100; + Regs.Esi := 0; + Regs.Ecx := 0; + RealIntr($21, Regs); + result := (Regs.Flags and CarryFlag = 0); +end; + + +Function RenameFile (Const OldName, NewName : String) : Boolean; +var + Regs: registers; +begin + StringToTB(OldName + #0 + NewName); + Regs.Edx := tb_offset; + Regs.Ds := tb_segment; + Regs.Edi := tb_offset + Length(OldName) + 1; + Regs.Es := tb_segment; + if LFNSupport then + Regs.Eax := $7156 + else + Regs.Eax := $5600; + Regs.Ecx := $ff; + RealIntr($21, Regs); + result := (Regs.Flags and CarryFlag = 0); +end; + + +Function FileSearch (Const Name, DirList : String) : String; +begin + result := DOS.FSearch(Name, DirList); +end; + + +{**************************************************************************** + Disk Functions +****************************************************************************} + +TYPE ExtendedFat32FreeSpaceRec=packed Record + RetSize : WORD; { (ret) size of returned structure} + Strucversion : WORD; {(call) structure version (0000h) + (ret) actual structure version (0000h)} + SecPerClus, {number of sectors per cluster} + BytePerSec, {number of bytes per sector} + AvailClusters, {number of available clusters} + TotalClusters, {total number of clusters on the drive} + AvailPhysSect, {physical sectors available on the drive} + TotalPhysSect, {total physical sectors on the drive} + AvailAllocUnits, {Available allocation units} + TotalAllocUnits : DWORD; {Total allocation units} + Dummy,Dummy2 : DWORD; {8 bytes reserved} + END; + +function do_diskdata(drive : byte; Free : BOOLEAN) : Int64; +VAR S : String; + Rec : ExtendedFat32FreeSpaceRec; + regs : registers; +BEGIN + if (swap(dosversion)>=$070A) AND LFNSupport then + begin + DosError:=0; + S:='C:\'#0; + if Drive=0 then + begin + GetDir(Drive,S); + Setlength(S,4); + S[4]:=#0; + end + else + S[1]:=chr(Drive+64); + Rec.Strucversion:=0; + dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec)); + dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4); + regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1; + regs.ds:=tb_segment; + regs.di:=tb_offset; + regs.es:=tb_segment; + regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec); + regs.ax:=$7303; + msdos(regs); + if regs.ax<>$ffff then + begin + copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec)); + if Free then + Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec + else + Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec; + end + else + Do_DiskData:=-1; + end + else + begin + DosError:=0; + regs.dl:=drive; + regs.ah:=$36; + msdos(regs); + if regs.ax<>$FFFF then + begin + if Free then + Do_DiskData:=int64(regs.ax)*regs.bx*regs.cx + else + Do_DiskData:=int64(regs.ax)*regs.cx*regs.dx; + end + else + do_diskdata:=-1; + end; +end; + + +function diskfree(drive : byte) : int64; +begin + diskfree:=Do_DiskData(drive,TRUE); +end; + + +function disksize(drive : byte) : int64; +begin + disksize:=Do_DiskData(drive,false); +end; + + +Function GetCurrentDir : String; +begin + GetDir(0, result); +end; + + +Function SetCurrentDir (Const NewDir : String) : Boolean; +begin + {$I-} + ChDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function CreateDir (Const NewDir : String) : Boolean; +begin + {$I-} + MkDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function RemoveDir (Const Dir : String) : Boolean; +begin + {$I-} + RmDir(Dir); + {$I+} + result := (IOResult = 0); +end; + + +{**************************************************************************** + Time Functions +****************************************************************************} + +Procedure GetLocalTime(var SystemTime: TSystemTime); +var + Regs: Registers; +begin + Regs.ah := $2C; + RealIntr($21, Regs); + SystemTime.Hour := Regs.Ch; + SystemTime.Minute := Regs.Cl; + SystemTime.Second := Regs.Dh; + SystemTime.MilliSecond := Regs.Dl; + Regs.ah := $2A; + RealIntr($21, Regs); + SystemTime.Year := Regs.Cx; + SystemTime.Month := Regs.Dh; + SystemTime.Day := Regs.Dl; +end ; + + +{**************************************************************************** + Misc Functions +****************************************************************************} + +procedure Beep; +begin +end; + + +{**************************************************************************** + Locale Functions +****************************************************************************} + +{ Codepage constants } +const + CP_US = 437; + CP_MultiLingual = 850; + CP_SlavicLatin2 = 852; + CP_Turkish = 857; + CP_Portugal = 860; + CP_IceLand = 861; + CP_Canada = 863; + CP_NorwayDenmark = 865; + +{ CountryInfo } +type + TCountryInfo = packed record + InfoId: byte; + case integer of + 1: ( Size: word; + CountryId: word; + CodePage: word; + CountryInfo: array[0..33] of byte ); + 2: ( UpperCaseTable: longint ); + 4: ( FilenameUpperCaseTable: longint ); + 5: ( FilecharacterTable: longint ); + 6: ( CollatingTable: longint ); + 7: ( DBCSLeadByteTable: longint ); + end ; + + +procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo); + +Var Regs: Registers; + +begin + Regs.AH := $65; + Regs.AL := InfoId; + Regs.BX := CodePage; + Regs.DX := CountryId; + Regs.ES := transfer_buffer div 16; + Regs.DI := transfer_buffer and 15; + Regs.CX := SizeOf(TCountryInfo); + RealIntr($21, Regs); + DosMemGet(transfer_buffer div 16, + transfer_buffer and 15, + CountryInfo, Regs.CX ); +end; + + +procedure InitAnsi; +var + CountryInfo: TCountryInfo; i: integer; +begin + { Fill table entries 0 to 127 } + for i := 0 to 96 do + UpperCaseTable[i] := chr(i); + for i := 97 to 122 do + UpperCaseTable[i] := chr(i - 32); + for i := 123 to 127 do + UpperCaseTable[i] := chr(i); + for i := 0 to 64 do + LowerCaseTable[i] := chr(i); + for i := 65 to 90 do + LowerCaseTable[i] := chr(i + 32); + for i := 91 to 255 do + LowerCaseTable[i] := chr(i); + + { Get country and codepage info } + GetExtendedCountryInfo(1, $FFFF, $FFFF, CountryInfo); + if CountryInfo.CodePage = 850 then + begin + { Special, known case } + Move(CP850UCT, UpperCaseTable[128], 128); + Move(CP850LCT, LowerCaseTable[128], 128); + end + else + begin + { this needs to be checked !! + this is correct only if UpperCaseTable is + and Offset:Segment word record (PM) } + { get the uppercase table from dosmemory } + GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo); + DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128); + for i := 128 to 255 do + begin + if UpperCaseTable[i] <> chr(i) then + LowerCaseTable[ord(UpperCaseTable[i])] := chr(i); + end; + end; +end; + + +Procedure InitInternational; +begin + InitAnsi; +end; + + +{**************************************************************************** + Initialization code +****************************************************************************} + +Initialization + InitExceptions; { Initialize exceptions. OS independent } + InitInternational; { Initialize internationalization settings } +Finalization + OutOfMemory.Free; + InValidPointer.Free; +end. +{ + $Log$ + Revision 1.2 2000-08-20 15:46:46 peter + * sysutils.pp moved to target and merged with disk.inc, filutil.inc + +} diff --git a/rtl/linux/Makefile b/rtl/linux/Makefile index b9a39edcd2..81e1c4ab3b 100644 --- a/rtl/linux/Makefile +++ b/rtl/linux/Makefile @@ -1,5 +1,5 @@ # -# Makefile generated by fpcmake v1.00 [2000/07/11] +# Makefile generated by fpcmake v1.00 [2000/08/14] # defaultrule: all @@ -928,7 +928,7 @@ ifdef INSTALLPPUFILES ifdef PPUFILES INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)) else -INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES))) +INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))) endif endif @@ -1093,7 +1093,7 @@ ifdef CLEANPPUFILES ifdef PPUFILES CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES)) else -CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES))) +CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))) endif endif @@ -1251,7 +1251,7 @@ ports$(PPUEXT) : ports.pp linux$(PPUEXT) objpas$(PPUEXT) dl$(PPUEXT) : dl.pp -dynlibs$(PPUEXT) : $(INC)/dynlibs.pp dynlibs.inc dl$(PPUEXT) +dynlibs$(PPUEXT) : $(INC)/dynlibs.pp dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT) # @@ -1285,9 +1285,9 @@ ggigraph$(PPUEXT) : ggigraph.pp linux$(PPUEXT) $(SYSTEMPPU) \ # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ filutil.inc disk.inc objpas$(PPUEXT) linux$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/linux/Makefile.fpc b/rtl/linux/Makefile.fpc index 775b0974b1..7855abb8e9 100644 --- a/rtl/linux/Makefile.fpc +++ b/rtl/linux/Makefile.fpc @@ -166,9 +166,9 @@ ggigraph$(PPUEXT) : ggigraph.pp linux$(PPUEXT) $(SYSTEMPPU) \ # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ filutil.inc disk.inc objpas$(PPUEXT) linux$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/linux/disk.inc b/rtl/linux/disk.inc deleted file mode 100644 index 41952075d6..0000000000 --- a/rtl/linux/disk.inc +++ /dev/null @@ -1,120 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - Disk functions from Delphi's sysutils.pas - - 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. - - **********************************************************************} - -{ - The Diskfree and Disksize functions need a file on the specified drive, since this - is required for the statfs system call. - These filenames are set in drivestr[0..26], and have been preset to : - 0 - '.' (default drive - hence current dir is ok.) - 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system ) - 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system ) - 3 - '/' (C: equivalent of dos is the root partition) - 4..26 (can be set by you're own applications) - ! Use AddDisk() to Add new drives ! - They both return -1 when a failure occurs. -} -Const - FixDriveStr : array[0..3] of pchar=( - '.', - '/fd0/.', - '/fd1/.', - '/.' - ); -var - Drives : byte; - DriveStr : array[4..26] of pchar; - -Procedure AddDisk(const path:string); -begin - if not (DriveStr[Drives]=nil) then - FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1); - GetMem(DriveStr[Drives],length(Path)+1); - StrPCopy(DriveStr[Drives],path); - inc(Drives); - if Drives>26 then - Drives:=4; -end; - - - - -Function DiskFree(Drive: Byte): int64; -var - fs : statfs; -Begin - if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or - ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then - Diskfree:=int64(fs.bavail)*int64(fs.bsize) - else - Diskfree:=-1; -End; - - - -Function DiskSize(Drive: Byte): int64; -var - fs : statfs; -Begin - if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or - ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then - DiskSize:=int64(fs.blocks)*int64(fs.bsize) - 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; - - -{ - $Log$ - Revision 1.3 2000-07-14 10:33:10 michael - + Conditionals fixed - - Revision 1.2 2000/07/13 11:33:48 michael - + removed logs - -} diff --git a/rtl/linux/filutil.inc b/rtl/linux/sysutils.pp similarity index 51% rename from rtl/linux/filutil.inc rename to rtl/linux/sysutils.pp index 06bec7297f..8ae17e156d 100644 --- a/rtl/linux/filutil.inc +++ b/rtl/linux/sysutils.pp @@ -1,9 +1,10 @@ { $Id$ This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team + Copyright (c) 1999-2000 by Florian Klaempfl + member of the Free Pascal development team - File utility calls + Sysutils unit for linux See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,7 +14,29 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} +unit sysutils; +interface +{$MODE objfpc} +{ force ansistrings } +{$H+} + +uses + linux; + +{ Include platform independent interface part } +{$i sysutilh.inc} + + +implementation + +{ Include platform independent implementation part } +{$i sysutils.inc} + + +{**************************************************************************** + File Functions +****************************************************************************} Function FileOpen (Const FileName : string; Mode : Integer) : Longint; @@ -95,10 +118,9 @@ begin FileExists:=fstat(filename,Info); end; + Function LinuxToWinAttr (FN : Char; Const Info : Stat) : Longint; - - begin Result:=faArchive; If FN='.' then @@ -107,9 +129,9 @@ begin Result:=Result or faDirectory; If (Info.Mode and STAT_IWUSR)=0 Then Result:=Result or faReadOnly; - If (Info.Mode and + If (Info.Mode and (STAT_IFSOCK or STAT_IFBLK or STAT_IFCHR or STAT_IFIFO))<>0 then - Result:=Result or faSysFile; + Result:=Result or faSysFile; end; { @@ -244,46 +266,168 @@ begin FileSearch:=Linux.FSearch(Name,Dirlist); end; -Procedure GetLocalTime(var SystemTime: TSystemTime); -begin -linux.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second); -linux.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day); -SystemTime.MilliSecond := 0; -end ; - -Procedure InitAnsi; - -Var i : longint; - -begin -{ Fill table entries 0 to 127 } -for i := 0 to 96 do - UpperCaseTable[i] := chr(i); -for i := 97 to 122 do - UpperCaseTable[i] := chr(i - 32); -for i := 123 to 191 do - UpperCaseTable[i] := chr(i); -Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); - -for i := 0 to 64 do - LowerCaseTable[i] := chr(i); -for i := 65 to 90 do - LowerCaseTable[i] := chr(i + 32); -for i := 91 to 191 do - LowerCaseTable[i] := chr(i); -Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); -end; - -Procedure InitInternational; - -begin - InitAnsi; -end; +{**************************************************************************** + Disk Functions +****************************************************************************} { - $Log$ - Revision 1.2 2000-07-13 11:33:48 michael - + removed logs - + The Diskfree and Disksize functions need a file on the specified drive, since this + is required for the statfs system call. + These filenames are set in drivestr[0..26], and have been preset to : + 0 - '.' (default drive - hence current dir is ok.) + 1 - '/fd0/.' (floppy drive 1 - should be adapted to local system ) + 2 - '/fd1/.' (floppy drive 2 - should be adapted to local system ) + 3 - '/' (C: equivalent of dos is the root partition) + 4..26 (can be set by you're own applications) + ! Use AddDisk() to Add new drives ! + They both return -1 when a failure occurs. } +Const + FixDriveStr : array[0..3] of pchar=( + '.', + '/fd0/.', + '/fd1/.', + '/.' + ); +var + Drives : byte; + DriveStr : array[4..26] of pchar; + +Procedure AddDisk(const path:string); +begin + if not (DriveStr[Drives]=nil) then + FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1); + GetMem(DriveStr[Drives],length(Path)+1); + StrPCopy(DriveStr[Drives],path); + inc(Drives); + if Drives>26 then + Drives:=4; +end; + + +Function DiskFree(Drive: Byte): int64; +var + fs : statfs; +Begin + if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or + ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then + Diskfree:=int64(fs.bavail)*int64(fs.bsize) + else + Diskfree:=-1; +End; + + + +Function DiskSize(Drive: Byte): int64; +var + fs : statfs; +Begin + if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or + ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then + DiskSize:=int64(fs.blocks)*int64(fs.bsize) + else + DiskSize:=-1; +End; + + +Function GetCurrentDir : String; +begin + GetDir (0,Result); +end; + + +Function SetCurrentDir (Const NewDir : String) : Boolean; +begin + {$I-} + ChDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function CreateDir (Const NewDir : String) : Boolean; +begin + {$I-} + MkDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function RemoveDir (Const Dir : String) : Boolean; +begin + {$I-} + RmDir(Dir); + {$I+} + result := (IOResult = 0); +end; + + +{**************************************************************************** + Misc Functions +****************************************************************************} + +procedure Beep; +begin +end; + + +{**************************************************************************** + Locale Functions +****************************************************************************} + +Procedure GetLocalTime(var SystemTime: TSystemTime); +begin + linux.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second); + linux.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day); + SystemTime.MilliSecond := 0; +end ; + + +Procedure InitAnsi; +Var + i : longint; +begin + { Fill table entries 0 to 127 } + for i := 0 to 96 do + UpperCaseTable[i] := chr(i); + for i := 97 to 122 do + UpperCaseTable[i] := chr(i - 32); + for i := 123 to 191 do + UpperCaseTable[i] := chr(i); + Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); + + for i := 0 to 64 do + LowerCaseTable[i] := chr(i); + for i := 65 to 90 do + LowerCaseTable[i] := chr(i + 32); + for i := 91 to 191 do + LowerCaseTable[i] := chr(i); + Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); +end; + + +Procedure InitInternational; +begin + InitAnsi; +end; + + +{**************************************************************************** + Initialization code +****************************************************************************} + +Initialization + InitExceptions; { Initialize exceptions. OS independent } + InitInternational; { Initialize internationalization settings } +Finalization + OutOfMemory.Free; + InValidPointer.Free; +end. +{ + $Log$ + Revision 1.2 2000-08-20 15:46:46 peter + * sysutils.pp moved to target and merged with disk.inc, filutil.inc + +} \ No newline at end of file diff --git a/rtl/objpas/datih.inc b/rtl/objpas/datih.inc index 584cb5a05d..76249b445e 100644 --- a/rtl/objpas/datih.inc +++ b/rtl/objpas/datih.inc @@ -101,12 +101,14 @@ function StrToDateTime(const S: string): TDateTime; function FormatDateTime(FormatStr: string; DateTime: TDateTime):string; procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime); Function DateTimeToFileDate(DateTime : TDateTime) : Longint; -Function FileDateToDateTime (Filedate : Longint) : TDateTime; +Function FileDateToDateTime (Filedate : Longint) :TDateTime; + +{ FPC Extra } +Procedure GetLocalTime(var SystemTime: TSystemTime); { - $Log$ - Revision 1.2 2000-07-13 11:33:51 michael - + removed logs - + Revision 1.3 2000-08-20 15:46:46 peter + * sysutils.pp moved to target and merged with disk.inc, filutil.inc + } diff --git a/rtl/objpas/sysutilh.inc b/rtl/objpas/sysutilh.inc new file mode 100644 index 0000000000..32e3c88bca --- /dev/null +++ b/rtl/objpas/sysutilh.inc @@ -0,0 +1,136 @@ +{ + $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 + + 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. + + **********************************************************************} + + + { Read String Handling functions declaration } + {$i sysstrh.inc} + +type + { some helpful data types } + + tprocedure = procedure; + + tfilename = string; + + tsyscharset = set of char; + + longrec = packed record + lo,hi : word; + end; + + wordrec = packed record + lo,hi : byte; + end; + + TMethod = packed record + Code, Data: Pointer; + end; + + { exceptions } + Exception = class(TObject) + private + fmessage : string; + fhelpcontext : longint; + public + constructor Create(const msg : string); + constructor CreateFmt(const msg : string; const args : array of const); + constructor CreateRes(ResString: PString); + constructor CreateResFmt(ResString: PString; const Args: array of const); + constructor CreateHelp(const Msg: string; AHelpContext: Integer); + constructor CreateFmtHelp(const Msg: string; const Args: array of const; + AHelpContext: Integer); + constructor CreateResHelp(ResString: PString; AHelpContext: Integer); + constructor CreateResFmtHelp(ResString: PString; const Args: array of const; + AHelpContext: Integer); + { !!!! } + property helpcontext : longint read fhelpcontext write fhelpcontext; + property message : string read fmessage write fmessage; + end; + + ExceptClass = class of Exception; + + { integer math exceptions } + EInterror = Class(Exception); + EDivByZero = Class(EIntError); + ERangeError = Class(EIntError); + EIntOverflow = Class(EIntError); + + { General math errors } + EMathError = Class(Exception); + EInvalidOp = Class(EMathError); + EZeroDivide = Class(EMathError); + EOverflow = Class(EMathError); + EUnderflow = Class(EMathError); + + { Run-time and I/O Errors } + EInOutError = class(Exception) + public + ErrorCode : Longint; + end; + EInvalidPointer = Class(Exception); + EOutOfMemory = Class(Exception); + EAccessViolation = Class(Exception); + EInvalidCast = Class(Exception); + + + { String conversion errors } + EConvertError = class(Exception); + + { Other errors } + EAbort = Class(Exception); + EAbstractError = Class(Exception); + EAssertionFailed = Class(Exception); + + { Exception handling routines } + function ExceptObject: TObject; + function ExceptAddr: Pointer; + function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer; + Buffer: PChar; Size: Integer): Integer; + procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer); + procedure Abort; + procedure OutOfMemoryError; + procedure Beep; + +Var + OnShowException : Procedure (Msg : ShortString); + + { FileRec/TextRec } + {$i filerec.inc} + {$i textrec.inc} + + { Read internationalization settings } + {$i sysinth.inc} + + { Read date & Time function declarations } + {$i datih.inc} + + { Read pchar handling functions declration } + {$i syspchh.inc} + + { Read filename handling functions declaration } + {$i finah.inc} + + { Read other file handling function declarations } + {$i filutilh.inc} + + { Read disk function declarations } + {$i diskh.inc} + +{ + $Log$ + Revision 1.2 2000-08-20 15:46:46 peter + * sysutils.pp moved to target and merged with disk.inc, filutil.inc + +} \ No newline at end of file diff --git a/rtl/objpas/sysutils.pp b/rtl/objpas/sysutils.inc similarity index 60% rename from rtl/objpas/sysutils.pp rename to rtl/objpas/sysutils.inc index abbfa99f73..2bb0aa035c 100644 --- a/rtl/objpas/sysutils.pp +++ b/rtl/objpas/sysutils.inc @@ -12,147 +12,6 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} -unit sysutils; -interface - -{$MODE objfpc} -{ force ansistrings } -{$H+} - - uses - {$ifdef linux} - linux - {$endif} - {$ifdef win32} - dos,windows - {$endif} - {$ifdef go32v1} - go32,dos - {$endif} - {$ifdef go32v2} - go32,dos - {$endif} - {$ifdef os2} - doscalls,dos - {$endif} - ; - - - { Read String Handling functions declaration } - {$i sysstrh.inc} - -type - { some helpful data types } - - tprocedure = procedure; - - tfilename = string; - - tsyscharset = set of char; - - longrec = packed record - lo,hi : word; - end; - - wordrec = packed record - lo,hi : byte; - end; - - TMethod = packed record - Code, Data: Pointer; - end; - - { exceptions } - Exception = class(TObject) - private - fmessage : string; - fhelpcontext : longint; - public - constructor Create(const msg : string); - constructor CreateFmt(const msg : string; const args : array of const); - constructor CreateRes(ResString: PString); - constructor CreateResFmt(ResString: PString; const Args: array of const); - constructor CreateHelp(const Msg: string; AHelpContext: Integer); - constructor CreateFmtHelp(const Msg: string; const Args: array of const; - AHelpContext: Integer); - constructor CreateResHelp(ResString: PString; AHelpContext: Integer); - constructor CreateResFmtHelp(ResString: PString; const Args: array of const; - AHelpContext: Integer); - { !!!! } - property helpcontext : longint read fhelpcontext write fhelpcontext; - property message : string read fmessage write fmessage; - end; - - ExceptClass = class of Exception; - - { integer math exceptions } - EInterror = Class(Exception); - EDivByZero = Class(EIntError); - ERangeError = Class(EIntError); - EIntOverflow = Class(EIntError); - - { General math errors } - EMathError = Class(Exception); - EInvalidOp = Class(EMathError); - EZeroDivide = Class(EMathError); - EOverflow = Class(EMathError); - EUnderflow = Class(EMathError); - - { Run-time and I/O Errors } - EInOutError = class(Exception) - public - ErrorCode : Longint; - end; - EInvalidPointer = Class(Exception); - EOutOfMemory = Class(Exception); - EAccessViolation = Class(Exception); - EInvalidCast = Class(Exception); - - - { String conversion errors } - EConvertError = class(Exception); - - { Other errors } - EAbort = Class(Exception); - EAbstractError = Class(Exception); - EAssertionFailed = Class(Exception); - - { Exception handling routines } - function ExceptObject: TObject; - function ExceptAddr: Pointer; - function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer; - Buffer: PChar; Size: Integer): Integer; - procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer); - procedure Abort; - procedure OutOfMemoryError; - procedure Beep; - -Var - OnShowException : Procedure (Msg : ShortString); - - { FileRec/TextRec } - {$i filerec.inc} - {$i textrec.inc} - - { Read internationalization settings } - {$i sysinth.inc} - - { Read date & Time function declarations } - {$i datih.inc} - - { Read pchar handling functions declration } - {$i syspchh.inc} - - { Read filename handling functions declaration } - {$i finah.inc} - - { Read other file handling function declarations } - {$i filutilh.inc} - - { Read disk function declarations } - {$i diskh.inc} - - implementation { Read message string definitions } { @@ -172,12 +31,6 @@ Var { Read String Handling functions implementation } {$i sysstr.inc} - { Read other file handling function implementations } - {$i filutil.inc} - - { Read disk function implementations } - {$i disk.inc} - { Read date & Time function implementations } {$i dati.inc} @@ -328,7 +181,7 @@ begin else E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]); end; - Raise E at longint(Address),longint(Frame); + Raise E at longint(Address){$ifdef ENHANCEDRAISE},longint(Frame){$endif}; end; @@ -434,39 +287,9 @@ begin Raise OutOfMemory; end; -procedure Beep; - -begin - {$ifdef win32} - MessageBeep(0); - {$else} - - {$endif} -end; - -{ Initialization code. } - -Initialization - InitExceptions; { Initialize exceptions. OS independent } - InitInternational; { Initialize internationalization settings } -Finalization - OutOfMemory.Free; - InValidPointer.Free; -end. { $Log$ - Revision 1.5 2000-08-06 14:19:06 peter - * overload directives removed (merged) - - Revision 1.4 2000/07/27 16:20:52 sg - * Applied patch by Markus Kaemmerer with minor modifications: More methods - of the Exception class are now implemented (in a manner so that they can - be used as in Delphi, although the declarations are somewhat different) - - Revision 1.3 2000/07/14 10:33:10 michael - + Conditionals fixed - - Revision 1.2 2000/07/13 11:33:51 michael - + removed logs + Revision 1.2 2000-08-20 15:46:46 peter + * sysutils.pp moved to target and merged with disk.inc, filutil.inc } diff --git a/rtl/os2/Makefile b/rtl/os2/Makefile index a8a453f666..07f85bd244 100644 --- a/rtl/os2/Makefile +++ b/rtl/os2/Makefile @@ -1,5 +1,5 @@ # -# Makefile generated by fpcmake v0.99.15 [2000/07/02] +# Makefile generated by fpcmake v1.00 [2000/08/14] # defaultrule: all @@ -916,7 +916,7 @@ ifdef INSTALLPPUFILES ifdef PPUFILES INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)) else -INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES))) +INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))) endif endif @@ -1081,7 +1081,7 @@ ifdef CLEANPPUFILES ifdef PPUFILES CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES)) else -CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES))) +CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))) endif endif @@ -1246,7 +1246,7 @@ dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMPPU) # dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \ - $(SYSTEMPPU) + doscalls$(PPUEXT) $(SYSTEMPPU) crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMPPU) @@ -1260,9 +1260,9 @@ printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMPPU) # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) doscalls$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/os2/Makefile.fpc b/rtl/os2/Makefile.fpc index f3d8db53da..ee07d21289 100644 --- a/rtl/os2/Makefile.fpc +++ b/rtl/os2/Makefile.fpc @@ -119,7 +119,7 @@ dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMPPU) # dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \ - $(SYSTEMPPU) + doscalls$(PPUEXT) $(SYSTEMPPU) crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMPPU) @@ -133,9 +133,9 @@ printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMPPU) # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) doscalls$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/os2/disk.inc b/rtl/os2/disk.inc deleted file mode 100644 index 42ff6e3f42..0000000000 --- a/rtl/os2/disk.inc +++ /dev/null @@ -1,139 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - Disk functions from Delphi's sysutils.pas - - 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. - - **********************************************************************} - -{$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 8(%ebp),%dl - movb $0x36,%ah - call syscall - cmpw $-1,%ax - je .LDISKFREE1 - mulw %cx - mulw %bx - shll $16,%edx - movw %ax,%dx - 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 8(%ebp),%dl - movb $0x36,%ah - call syscall - movw %dx,%bx - cmpw $-1,%ax - je .LDISKSIZE1 - mulw %cx - mulw %bx - shll $16,%edx - movw %ax,%dx - 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; - - - -{ - $Log$ - Revision 1.3 2000-07-14 10:33:10 michael - + Conditionals fixed - - Revision 1.2 2000/07/13 11:33:52 michael - + removed logs - -} diff --git a/rtl/os2/filutil.inc b/rtl/os2/sysutils.pp similarity index 75% rename from rtl/os2/filutil.inc rename to rtl/os2/sysutils.pp index 8b2c42c56f..cc8e3134bc 100644 --- a/rtl/os2/filutil.inc +++ b/rtl/os2/sysutils.pp @@ -1,9 +1,10 @@ { $Id$ This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team + Copyright (c) 1999-2000 by Florian Klaempfl + member of the Free Pascal development team - File utility calls + Sysutils unit for OS/2 See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,7 +14,29 @@ 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'; @@ -488,6 +511,128 @@ begin 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 8(%ebp),%dl + movb $0x36,%ah + call syscall + cmpw $-1,%ax + je .LDISKFREE1 + mulw %cx + mulw %bx + shll $16,%edx + movw %ax,%dx + 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 8(%ebp),%dl + movb $0x36,%ah + call syscall + movw %dx,%bx + cmpw $-1,%ax + je .LDISKSIZE1 + mulw %cx + mulw %bx + shll $16,%edx + movw %ax,%dx + 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 (DWord)!!! *) @@ -516,6 +661,21 @@ asm mov al, dl stosd end; +{$asmmode default} + + +{**************************************************************************** + Misc Functions +****************************************************************************} + +procedure Beep; +begin +end; + + +{**************************************************************************** + Locale Functions +****************************************************************************} procedure InitAnsi; var I: byte; @@ -538,6 +698,7 @@ begin LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I); end; + procedure InitInternational; var Country: TCountryCode; CtryInfo: TCountryInfo; @@ -575,9 +736,20 @@ begin end; +{**************************************************************************** + Initialization code +****************************************************************************} + +Initialization + InitExceptions; { Initialize exceptions. OS independent } + InitInternational; { Initialize internationalization settings } +Finalization + OutOfMemory.Free; + InValidPointer.Free; +end. { $Log$ - Revision 1.2 2000-07-13 11:33:52 michael - + removed logs - + Revision 1.2 2000-08-20 15:46:46 peter + * sysutils.pp moved to target and merged with disk.inc, filutil.inc + } diff --git a/rtl/win32/Makefile b/rtl/win32/Makefile index 08bb7cb2bb..1aa5c512ac 100644 --- a/rtl/win32/Makefile +++ b/rtl/win32/Makefile @@ -1,5 +1,5 @@ # -# Makefile generated by fpcmake v1.00 [2000/07/11] +# Makefile generated by fpcmake v1.00 [2000/08/14] # defaultrule: all @@ -921,7 +921,7 @@ ifdef INSTALLPPUFILES ifdef PPUFILES INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES)) else -INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES))) +INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))) endif endif @@ -1086,7 +1086,7 @@ ifdef CLEANPPUFILES ifdef PPUFILES CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES)) else -CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES))) +CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))) endif endif @@ -1276,9 +1276,9 @@ graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMPPU) \ # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/win32/Makefile.fpc b/rtl/win32/Makefile.fpc index 4e0b29bb47..15de62c57b 100644 --- a/rtl/win32/Makefile.fpc +++ b/rtl/win32/Makefile.fpc @@ -150,9 +150,9 @@ graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMPPU) \ # Delphi Compatible Units # -sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ - filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR) +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR) typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR) diff --git a/rtl/win32/disk.inc b/rtl/win32/disk.inc deleted file mode 100644 index c66340e96e..0000000000 --- a/rtl/win32/disk.inc +++ /dev/null @@ -1,139 +0,0 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - Disk functions from Delphi's sysutils.pas - - 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. - - **********************************************************************} - - function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector, - freeclusters,totalclusters:longint):longbool; - external 'kernel32' name 'GetDiskFreeSpaceA'; -type - TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller, - total,free):longbool;stdcall; - -var - GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx; - -function diskfree(drive : byte) : int64; -var - disk : array[1..4] of char; - secs,bytes, - free,total : longint; - qwtotal,qwfree,qwcaller : int64; - - -begin - if drive=0 then - begin - disk[1]:='\'; - disk[2]:=#0; - end - else - begin - disk[1]:=chr(drive+64); - disk[2]:=':'; - disk[3]:='\'; - disk[4]:=#0; - end; - if assigned(GetDiskFreeSpaceEx) then - begin - if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then - diskfree:=qwfree - else - diskfree:=-1; - end - else - begin - if GetDiskFreeSpace(@disk,secs,bytes,free,total) then - diskfree:=int64(free)*secs*bytes - else - diskfree:=-1; - end; -end; - - -function disksize(drive : byte) : int64; -var - disk : array[1..4] of char; - secs,bytes, - free,total : longint; - qwtotal,qwfree,qwcaller : int64; - -begin - if drive=0 then - begin - disk[1]:='\'; - disk[2]:=#0; - end - else - begin - disk[1]:=chr(drive+64); - disk[2]:=':'; - disk[3]:='\'; - disk[4]:=#0; - end; - if assigned(GetDiskFreeSpaceEx) then - begin - if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then - disksize:=qwtotal - else - disksize:=-1; - end - else - begin - if GetDiskFreeSpace(@disk,secs,bytes,free,total) then - disksize:=int64(total)*secs*bytes - 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; - -{ - $Log$ - Revision 1.2 2000-07-13 11:33:57 michael - + removed logs - -} diff --git a/rtl/win32/filutil.inc b/rtl/win32/sysutils.pp similarity index 51% rename from rtl/win32/filutil.inc rename to rtl/win32/sysutils.pp index 990ccca7d3..14c9987ce2 100644 --- a/rtl/win32/filutil.inc +++ b/rtl/win32/sysutils.pp @@ -1,9 +1,10 @@ { $Id$ This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team + Copyright (c) 1999-2000 by Florian Klaempfl + member of the Free Pascal development team - File utility calls + Sysutils unit for win32 See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,10 +14,37 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} +unit sysutils; +interface +{$MODE objfpc} +{ force ansistrings } +{$H+} + +uses + dos,windows; + + +{ Include platform independent interface part } +{$i sysutilh.inc} + +{ platform dependent functions } + +function SysErrorMessage(ErrorCode: Integer): String; + + + +implementation + +{ Include platform independent implementation part } +{$i sysutils.inc} + + +{**************************************************************************** + File Functions +****************************************************************************} Function FileOpen (Const FileName : string; Mode : Integer) : Longint; - const AccessMode: array[0..2] of Integer = ( GENERIC_READ, @@ -28,65 +56,61 @@ const FILE_SHARE_READ, FILE_SHARE_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE); - -Var FN : string; - +Var + FN : string; begin FN:=FileName+#0; - Result := CreateFile(@FN[1], AccessMode[Mode and 3], - ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING, + result := CreateFile(@FN[1], AccessMode[Mode and 3], + ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); end; Function FileCreate (Const FileName : String) : Longint; - -Var FN : string; - +Var + FN : string; begin FN:=FileName+#0; - Result := CreateFile(@FN[1], GENERIC_READ or GENERIC_WRITE, - 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + Result := CreateFile(@FN[1], GENERIC_READ or GENERIC_WRITE, + 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); end; Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint; - -Var res : Longint; - +Var + res : Longint; begin - if not ReadFile(Handle, Buffer, Count, res, nil) then res := -1; + if not ReadFile(Handle, Buffer, Count, res, nil) then + res := -1; FileRead:=Res; end; Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint; - -Var Res : longint; - +Var + Res : longint; begin - if not WriteFile(Handle, Buffer, Count, Res, nil) then Res:= -1; + if not WriteFile(Handle, Buffer, Count, Res, nil) then + Res:= -1; FileWrite:=Res; end; Function FileSeek (Handle,FOffset,Origin : Longint) : Longint; - begin Result := SetFilePointer(Handle, FOffset, nil, Origin); end; Procedure FileClose (Handle : Longint); - begin if Handle<=4 then exit; CloseHandle(Handle); end; -Function FileTruncate (Handle,Size: Longint) : boolean; +Function FileTruncate (Handle,Size: Longint) : boolean; begin Result:=SetFilePointer(handle,Size,nil,FILE_BEGIN)<>-1; If Result then @@ -112,25 +136,23 @@ end; Function FileAge (Const FileName : String): Longint; - var Handle: THandle; FindData: TWin32FindData; - begin Handle := FindFirstFile(Pchar(FileName), @FindData); if Handle <> INVALID_HANDLE_VALUE then begin - Windows.FindClose(Handle); - if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then - If WinToDosTime(FindData.ftLastWriteTime,Result) then exit; + Windows.FindClose(Handle); + if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then + If WinToDosTime(FindData.ftLastWriteTime,Result) then + exit; end; Result := -1; end; Function FileExists (Const FileName : String) : Boolean; - var Handle: THandle; FindData: TWin32FindData; @@ -141,16 +163,16 @@ begin Windows.FindClose(Handle); end; -Function FindMatch(var f: TSearchRec) : Longint; +Function FindMatch(var f: TSearchRec) : Longint; begin { Find file with correct attribute } While (F.FindData.dwFileAttributes and F.ExcludeAttr)<>0 do begin if not FindNextFile (F.FindHandle,@F.FindData) then begin - Result:=GetLastError; - exit; + Result:=GetLastError; + exit; end; end; { Convert some attributes back } @@ -161,8 +183,8 @@ begin Result:=0; end; -Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint; +Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint; begin Rslt.Name:=Path; Rslt.Attr:=attr; @@ -171,17 +193,16 @@ begin { FindFirstFile is a Win32 Call } Rslt.FindHandle:=FindFirstFile (PChar(Path),@Rslt.FindData); If Rslt.FindHandle=Invalid_Handle_value then - begin + begin Result:=GetLastError; exit; - end; + end; { Find file with correct attribute } Result:=FindMatch(Rslt); end; Function FindNext (Var Rslt : TSearchRec) : Longint; - begin if FindNextFile(Rslt.FindHandle, @Rslt.FindData) then Result := FindMatch(Rslt) @@ -191,46 +212,42 @@ end; Procedure FindClose (Var F : TSearchrec); - begin if F.FindHandle <> INVALID_HANDLE_VALUE then Windows.FindClose(F.FindHandle); end; - Function FileGetDate (Handle : Longint) : Longint; - -Var FT : TFileTime; - +Var + FT : TFileTime; begin If GetFileTime(Handle,nil,nil,@ft) and - WinToDosTime(FT,Result) then exit; + WinToDosTime(FT,Result) then + exit; Result:=-1; end; Function FileSetDate (Handle,Age : Longint) : Longint; - -Var FT: TFileTime; - +Var + FT: TFileTime; begin Result := 0; if DosToWinTime(Age,FT) and - SetFileTime(Handle, ft, ft, FT) then Exit; + SetFileTime(Handle, ft, ft, FT) then + Exit; Result := GetLastError; end; Function FileGetAttr (Const FileName : String) : Longint; - begin Result:=GetFileAttributes(PChar(FileName)); end; Function FileSetAttr (Const Filename : String; Attr: longint) : Longint; - begin if not SetFileAttributes(PChar(FileName), Attr) then Result := GetLastError @@ -240,24 +257,21 @@ end; Function DeleteFile (Const FileName : String) : Boolean; - begin DeleteFile:=Windows.DeleteFile(Pchar(FileName)); end; Function RenameFile (Const OldName, NewName : String) : Boolean; - begin Result := MoveFile(PChar(OldName), PChar(NewName)); end; Function FileSearch (Const Name, DirList : String) : String; - -Var I : longint; - Temp : String; - +Var + I : longint; + Temp : String; begin Result:=''; temp:=Dirlist; @@ -265,13 +279,13 @@ begin I:=pos(';',Temp); If I<>0 then begin - Result:=Copy (Temp,1,i-1); - system.Delete(Temp,1,I); + Result:=Copy (Temp,1,i-1); + system.Delete(Temp,1,I); end else begin - Result:=Temp; - Temp:=''; + Result:=Temp; + Temp:=''; end; If result[length(result)]<>'\' then Result:=Result+'\'; @@ -281,49 +295,188 @@ begin until (length(temp)=0) or (length(result)<>0); end; -Procedure GetLocalTime(var ST: TSystemTime); -Var Syst:Systemtime; +{**************************************************************************** + Disk Functions +****************************************************************************} +function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector, + freeclusters,totalclusters:longint):longbool; + external 'kernel32' name 'GetDiskFreeSpaceA'; +type + TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;stdcall; + +var + GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx; + +function diskfree(drive : byte) : int64; +var + disk : array[1..4] of char; + secs,bytes, + free,total : longint; + qwtotal,qwfree,qwcaller : int64; + + +begin + if drive=0 then + begin + disk[1]:='\'; + disk[2]:=#0; + end + else + begin + disk[1]:=chr(drive+64); + disk[2]:=':'; + disk[3]:='\'; + disk[4]:=#0; + end; + if assigned(GetDiskFreeSpaceEx) then + begin + if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then + diskfree:=qwfree + else + diskfree:=-1; + end + else + begin + if GetDiskFreeSpace(@disk,secs,bytes,free,total) then + diskfree:=int64(free)*secs*bytes + else + diskfree:=-1; + end; +end; + + +function disksize(drive : byte) : int64; +var + disk : array[1..4] of char; + secs,bytes, + free,total : longint; + qwtotal,qwfree,qwcaller : int64; +begin + if drive=0 then + begin + disk[1]:='\'; + disk[2]:=#0; + end + else + begin + disk[1]:=chr(drive+64); + disk[2]:=':'; + disk[3]:='\'; + disk[4]:=#0; + end; + if assigned(GetDiskFreeSpaceEx) then + begin + if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then + disksize:=qwtotal + else + disksize:=-1; + end + else + begin + if GetDiskFreeSpace(@disk,secs,bytes,free,total) then + disksize:=int64(total)*secs*bytes + else + disksize:=-1; + end; +end; + + +Function GetCurrentDir : String; +begin + GetDir(0, result); +end; + + +Function SetCurrentDir (Const NewDir : String) : Boolean; +begin + {$I-} + ChDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function CreateDir (Const NewDir : String) : Boolean; +begin + {$I-} + MkDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function RemoveDir (Const Dir : String) : Boolean; +begin + {$I-} + RmDir(Dir); + {$I+} + result := (IOResult = 0); +end; + + +{**************************************************************************** + Time Functions +****************************************************************************} + + +Procedure GetLocalTime(var SystemTime: TSystemTime); +Var + Syst : Windows.TSystemtime; begin windows.Getlocaltime(@syst); - st.year:=syst.wYear; - st.month:=syst.wMonth; - st.day:=syst.wDay; - st.hour:=syst.wHour; - st.minute:=syst.wMinute; - st.second:=syst.wSecond; - st.millisecond:=syst.wMilliSeconds; + SystemTime.year:=syst.wYear; + SystemTime.month:=syst.wMonth; + SystemTime.day:=syst.wDay; + SystemTime.hour:=syst.wHour; + SystemTime.minute:=syst.wMinute; + SystemTime.second:=syst.wSecond; + SystemTime.millisecond:=syst.wMilliSeconds; end; -Procedure InitAnsi; -Var i : longint; +{**************************************************************************** + Misc Functions +****************************************************************************} + +procedure Beep; begin -{ Fill table entries 0 to 127 } -for i := 0 to 96 do - UpperCaseTable[i] := chr(i); -for i := 97 to 122 do - UpperCaseTable[i] := chr(i - 32); -for i := 123 to 191 do - UpperCaseTable[i] := chr(i); -Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); - -for i := 0 to 64 do - LowerCaseTable[i] := chr(i); -for i := 65 to 90 do - LowerCaseTable[i] := chr(i + 32); -for i := 91 to 191 do - LowerCaseTable[i] := chr(i); -Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); + MessageBeep(0); end; + +{**************************************************************************** + Locale Functions +****************************************************************************} + +Procedure InitAnsi; +Var + i : longint; +begin + { Fill table entries 0 to 127 } + for i := 0 to 96 do + UpperCaseTable[i] := chr(i); + for i := 97 to 122 do + UpperCaseTable[i] := chr(i - 32); + for i := 123 to 191 do + UpperCaseTable[i] := chr(i); + Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); + + for i := 0 to 64 do + LowerCaseTable[i] := chr(i); + for i := 65 to 90 do + LowerCaseTable[i] := chr(i + 32); + for i := 91 to 191 do + LowerCaseTable[i] := chr(i); + Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); +end; + + function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString; - var L: Integer; Buf: array[0..255] of Char; - begin L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf)); if L > 0 then @@ -332,8 +485,8 @@ begin Result := Def; end; -function GetLocaleChar(LID, LT: Longint; Def: Char): Char; +function GetLocaleChar(LID, LT: Longint; Def: Char): Char; var Buf: array[0..1] of Char; begin @@ -342,12 +495,12 @@ begin else Result := Def; end; -Function GetLocaleInt(LID,TP,Def: LongInt): LongInt; + +Function GetLocaleInt(LID,TP,Def: LongInt): LongInt; Var S: String; C: Integer; - Begin S:=GetLocaleStr(LID,TP,'0'); Val(S,Result,C); @@ -355,13 +508,12 @@ Begin Result:=Def; End; -procedure GetFormatSettings; +procedure GetFormatSettings; var HF : Shortstring; LID : LCID; I,Day,DateOrder : longint; - begin LID := GetThreadLocale; { Date stuff } @@ -413,21 +565,60 @@ begin CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0); end; + Procedure InitInternational; - -{ - called by sysutils initialization routines to set up - internationalization support. -} - begin - InitAnsi; - GetFormatSettings; + InitAnsi; + GetFormatSettings; end; + +{**************************************************************************** + Target Dependent +****************************************************************************} + +function FormatMessageA(dwFlags : DWORD; + lpSource : Pointer; + dwMessageId : DWORD; + dwLanguageId: DWORD; + lpBuffer : PCHAR; + nSize : DWORD; + Arguments : Pointer): DWORD; external 'kernel32' name 'FormatMessageA'; + +function SysErrorMessage(ErrorCode: Integer): String; +const + MaxMsgSize = Format_Message_Max_Width_Mask; +var + MsgBuffer: pChar; +begin + GetMem(MsgBuffer, MaxMsgSize); + FillChar(MsgBuffer^, MaxMsgSize, #0); + FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, + nil, + ErrorCode, + MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT), + MsgBuffer, { This function allocs the memory } + MaxMsgSize, { Maximum message size } + nil); + SysErrorMessage := StrPas(MsgBuffer); + FreeMem(MsgBuffer, MaxMsgSize); +end; + + +{**************************************************************************** + Initialization code +****************************************************************************} + +Initialization + InitExceptions; { Initialize exceptions. OS independent } + InitInternational; { Initialize internationalization settings } +Finalization + OutOfMemory.Free; + InValidPointer.Free; +end. { $Log$ - Revision 1.2 2000-07-13 11:33:57 michael - + removed logs - + Revision 1.2 2000-08-20 15:46:46 peter + * sysutils.pp moved to target and merged with disk.inc, filutil.inc + }