mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-07 04:39:02 +02:00
* Kylix fixes, mostly case names of units
This commit is contained in:
parent
c430926744
commit
add30a428e
@ -20,14 +20,14 @@
|
|||||||
|
|
||||||
****************************************************************************
|
****************************************************************************
|
||||||
}
|
}
|
||||||
Unit CRC;
|
Unit crc;
|
||||||
|
|
||||||
{$i defines.inc}
|
{$i defines.inc}
|
||||||
|
|
||||||
Interface
|
Interface
|
||||||
|
|
||||||
Function Crc32(Const HStr:String):cardinal;
|
Function Crc32(Const HStr:String):cardinal;
|
||||||
Function UpdateCrc32(InitCrc:cardinal;var InBuf;InLen:integer):cardinal;
|
Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:integer):cardinal;
|
||||||
Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
|
Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
|
||||||
|
|
||||||
|
|
||||||
@ -73,7 +73,7 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
Function UpdateCrc32(InitCrc:cardinal;var InBuf;InLen:Integer):cardinal;
|
Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:Integer):cardinal;
|
||||||
var
|
var
|
||||||
i : integer;
|
i : integer;
|
||||||
p : pchar;
|
p : pchar;
|
||||||
@ -101,7 +101,10 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.5 2001-05-09 14:11:10 jonas
|
Revision 1.6 2001-06-03 20:21:08 peter
|
||||||
|
* Kylix fixes, mostly case names of units
|
||||||
|
|
||||||
|
Revision 1.5 2001/05/09 14:11:10 jonas
|
||||||
* range check error fixes from Peter
|
* range check error fixes from Peter
|
||||||
|
|
||||||
Revision 1.4 2000/09/24 15:06:14 peter
|
Revision 1.4 2000/09/24 15:06:14 peter
|
||||||
|
@ -20,6 +20,7 @@
|
|||||||
|
|
||||||
{$ifdef DELPHI}
|
{$ifdef DELPHI}
|
||||||
{$H-}
|
{$H-}
|
||||||
|
{$J+}
|
||||||
|
|
||||||
{$Z1}
|
{$Z1}
|
||||||
|
|
||||||
|
@ -27,7 +27,12 @@ unit dmisc;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
windows,sysutils;
|
{$ifdef linux}
|
||||||
|
Libc,
|
||||||
|
{$else}
|
||||||
|
windows,
|
||||||
|
{$endif}
|
||||||
|
sysutils;
|
||||||
|
|
||||||
Const
|
Const
|
||||||
Max_Path = 255;
|
Max_Path = 255;
|
||||||
@ -57,6 +62,8 @@ Const
|
|||||||
|
|
||||||
|
|
||||||
Type
|
Type
|
||||||
|
DWord = Cardinal;
|
||||||
|
|
||||||
{ Needed for Win95 LFN Support }
|
{ Needed for Win95 LFN Support }
|
||||||
ComStr = String[255];
|
ComStr = String[255];
|
||||||
PathStr = String[255];
|
PathStr = String[255];
|
||||||
@ -75,29 +82,7 @@ Type
|
|||||||
Sec : word;
|
Sec : word;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
PWin32FindData = ^TWin32FindData;
|
SearchRec = Sysutils.TSearchRec;
|
||||||
TWin32FindData = packed record
|
|
||||||
dwFileAttributes: Cardinal;
|
|
||||||
ftCreationTime: TFileTime;
|
|
||||||
ftLastAccessTime: TFileTime;
|
|
||||||
ftLastWriteTime: TFileTime;
|
|
||||||
nFileSizeHigh: Cardinal;
|
|
||||||
nFileSizeLow: Cardinal;
|
|
||||||
dwReserved0: Cardinal;
|
|
||||||
dwReserved1: Cardinal;
|
|
||||||
cFileName: array[0..MAX_PATH - 1] of Char;
|
|
||||||
cAlternateFileName: array[0..13] of Char;
|
|
||||||
end;
|
|
||||||
|
|
||||||
Searchrec = Packed Record
|
|
||||||
FindHandle : THandle;
|
|
||||||
W32FindData : TWin32FindData;
|
|
||||||
time : longint;
|
|
||||||
size : longint;
|
|
||||||
attr : longint;
|
|
||||||
name : string;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
registers = packed record
|
registers = packed record
|
||||||
case i : integer of
|
case i : integer of
|
||||||
@ -117,8 +102,6 @@ Procedure MSDos(var regs: registers);
|
|||||||
Function DosVersion: Word;
|
Function DosVersion: Word;
|
||||||
Procedure GetDate(var year, month, mday, wday: word);
|
Procedure GetDate(var year, month, mday, wday: word);
|
||||||
Procedure GetTime(var hour, minute, second, sec100: word);
|
Procedure GetTime(var hour, minute, second, sec100: word);
|
||||||
procedure SetDate(year,month,day: word);
|
|
||||||
Procedure SetTime(hour,minute,second,sec100: word);
|
|
||||||
Procedure UnpackTime(p: longint; var t: datetime);
|
Procedure UnpackTime(p: longint; var t: datetime);
|
||||||
Procedure PackTime(var t: datetime; var p: longint);
|
Procedure PackTime(var t: datetime; var p: longint);
|
||||||
|
|
||||||
@ -127,15 +110,15 @@ Procedure Exec(const path: pathstr; const comline: comstr);
|
|||||||
Function DosExitCode: word;
|
Function DosExitCode: word;
|
||||||
|
|
||||||
{Disk}
|
{Disk}
|
||||||
Function DiskFree(drive: byte) : longint;
|
Function DiskFree(drive: byte) : int64;
|
||||||
Function DiskSize(drive: byte) : longint;
|
Function DiskSize(drive: byte) : int64;
|
||||||
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
|
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
|
||||||
Procedure FindNext(var f: searchRec);
|
Procedure FindNext(var f: searchRec);
|
||||||
Procedure FindClose(Var f: SearchRec);
|
Procedure FindClose(Var f: SearchRec);
|
||||||
|
|
||||||
{File}
|
{File}
|
||||||
Procedure GetFAttr(var f; var attr: word);
|
Procedure GetFAttr(var f; var attr: word);
|
||||||
Procedure GetFTime(var f; var time: longint);
|
Procedure GetFTime(var f; var tim: longint);
|
||||||
Function FSearch(path: pathstr; dirlist: string): pathstr;
|
Function FSearch(path: pathstr; dirlist: string): pathstr;
|
||||||
Function FExpand(const path: pathstr): pathstr;
|
Function FExpand(const path: pathstr): pathstr;
|
||||||
Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
|
Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
|
||||||
@ -180,6 +163,7 @@ implementation
|
|||||||
--- Conversion ---
|
--- Conversion ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
|
{$ifdef MSWindows}
|
||||||
function GetLastError : DWORD;stdcall;
|
function GetLastError : DWORD;stdcall;
|
||||||
external 'Kernel32.dll' name 'GetLastError';
|
external 'Kernel32.dll' name 'GetLastError';
|
||||||
function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : boolean;stdcall;
|
function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : boolean;stdcall;
|
||||||
@ -230,6 +214,7 @@ begin
|
|||||||
WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
|
WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
|
||||||
FileTimeToDosDateTime(lft,longrec(dtime).hi,longrec(dtime).lo);
|
FileTimeToDosDateTime(lft,longrec(dtime).hi,longrec(dtime).lo);
|
||||||
end;
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
@ -251,72 +236,22 @@ end;
|
|||||||
--- Info / Date / Time ---
|
--- Info / Date / Time ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
function GetVersion : longint;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'GetVersion';
|
|
||||||
procedure GetLocalTime(var t : Windows.TSystemTime);stdcall;
|
|
||||||
external 'Kernel32.dll' name 'GetLocalTime';
|
|
||||||
function SetLocalTime(const t : Windows.TSystemTime) : boolean;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'SetLocalTime';
|
|
||||||
|
|
||||||
function dosversion : word;
|
function dosversion : word;
|
||||||
begin
|
begin
|
||||||
dosversion:=GetVersion;
|
dosversion:=0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure getdate(var year,month,mday,wday : word);
|
procedure getdate(var year,month,mday,wday : word);
|
||||||
var
|
|
||||||
t : Windows.TSystemTime;
|
|
||||||
begin
|
begin
|
||||||
GetLocalTime(t);
|
DecodeDateFully(Now,Year,Month,MDay,WDay);
|
||||||
year:=t.wYear;
|
|
||||||
month:=t.wMonth;
|
|
||||||
mday:=t.wDay;
|
|
||||||
wday:=t.wDayOfWeek;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure setdate(year,month,day : word);
|
|
||||||
var
|
|
||||||
t : Windows.TSystemTime;
|
|
||||||
begin
|
|
||||||
{ we need the time set privilege }
|
|
||||||
{ so this function crash currently }
|
|
||||||
{!!!!!}
|
|
||||||
GetLocalTime(t);
|
|
||||||
t.wYear:=year;
|
|
||||||
t.wMonth:=month;
|
|
||||||
t.wDay:=day;
|
|
||||||
{ only a quite good solution, we can loose some ms }
|
|
||||||
SetLocalTime(t);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure gettime(var hour,minute,second,sec100 : word);
|
procedure gettime(var hour,minute,second,sec100 : word);
|
||||||
var
|
|
||||||
t : Windows.TSystemTime;
|
|
||||||
begin
|
begin
|
||||||
GetLocalTime(t);
|
DecodeTime(Now,Hour,Minute,Second,Sec100);
|
||||||
hour:=t.wHour;
|
Sec100:=Sec100 div 10;
|
||||||
minute:=t.wMinute;
|
|
||||||
second:=t.wSecond;
|
|
||||||
sec100:=t.wMilliSeconds div 10;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure settime(hour,minute,second,sec100 : word);
|
|
||||||
var
|
|
||||||
t : Windows.TSystemTime;
|
|
||||||
begin
|
|
||||||
{ we need the time set privilege }
|
|
||||||
{ so this function crash currently }
|
|
||||||
{!!!!!}
|
|
||||||
GetLocalTime(t);
|
|
||||||
t.wHour:=hour;
|
|
||||||
t.wMinute:=minute;
|
|
||||||
t.wSecond:=second;
|
|
||||||
t.wMilliSeconds:=sec100*10;
|
|
||||||
SetLocalTime(t);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -346,6 +281,7 @@ End;
|
|||||||
var
|
var
|
||||||
lastdosexitcode : word;
|
lastdosexitcode : word;
|
||||||
|
|
||||||
|
{$ifdef MSWindows}
|
||||||
procedure exec(const path : pathstr;const comline : comstr);
|
procedure exec(const path : pathstr;const comline : comstr);
|
||||||
var
|
var
|
||||||
SI: TStartupInfo;
|
SI: TStartupInfo;
|
||||||
@ -380,7 +316,36 @@ begin
|
|||||||
CloseHandle(Proc);
|
CloseHandle(Proc);
|
||||||
LastDosExitCode:=l;
|
LastDosExitCode:=l;
|
||||||
end;
|
end;
|
||||||
|
{$endif MSWindows}
|
||||||
|
{$ifdef Linux}
|
||||||
|
Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
|
||||||
|
var
|
||||||
|
pid,status : longint;
|
||||||
|
Begin
|
||||||
|
LastDosExitCode:=0;
|
||||||
|
pid:=Fork;
|
||||||
|
if pid=0 then
|
||||||
|
begin
|
||||||
|
{The child does the actual exec, and then exits}
|
||||||
|
Execl(@Path[1],@ComLine[1]);
|
||||||
|
{If the execve fails, we return an exitvalue of 127, to let it be known}
|
||||||
|
__exit(127);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
if pid=-1 then {Fork failed}
|
||||||
|
begin
|
||||||
|
DosError:=8;
|
||||||
|
exit
|
||||||
|
end;
|
||||||
|
{We're in the parent, let's wait.}
|
||||||
|
WaitPid(Pid,@Status,0);
|
||||||
|
LastDosExitCode:=Status; // WaitPid and result-convert
|
||||||
|
if (LastDosExitCode>=0) and (LastDosExitCode<>127) then
|
||||||
|
DosError:=0
|
||||||
|
else
|
||||||
|
DosError:=8; // perhaps one time give an better error
|
||||||
|
End;
|
||||||
|
{$endif Linux}
|
||||||
|
|
||||||
function dosexitcode : word;
|
function dosexitcode : word;
|
||||||
begin
|
begin
|
||||||
@ -388,6 +353,11 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure swapvectors;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure getcbreak(var breakvalue : boolean);
|
procedure getcbreak(var breakvalue : boolean);
|
||||||
begin
|
begin
|
||||||
{ !! No Win32 Function !! }
|
{ !! No Win32 Function !! }
|
||||||
@ -416,141 +386,98 @@ end;
|
|||||||
--- Disk ---
|
--- Disk ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
function diskfree(drive : byte) : longint;
|
{$ifdef Linux]
|
||||||
|
{
|
||||||
|
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
|
var
|
||||||
disk : array[1..4] of char;
|
Drives : byte = 4;
|
||||||
secs,bytes,
|
var
|
||||||
free,total : DWord;
|
DriveStr : array[4..26] of pchar;
|
||||||
|
|
||||||
|
Procedure AddDisk(const path:string);
|
||||||
begin
|
begin
|
||||||
if drive=0 then
|
if not (DriveStr[Drives]=nil) then
|
||||||
begin
|
FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
|
||||||
disk[1]:='\';
|
GetMem(DriveStr[Drives],length(Path)+1);
|
||||||
disk[2]:=#0;
|
StrPCopy(DriveStr[Drives],path);
|
||||||
end
|
inc(Drives);
|
||||||
|
if Drives>26 then
|
||||||
|
Drives:=4;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function DiskFree(Drive: Byte): int64;
|
||||||
|
var
|
||||||
|
fs : tstatfs;
|
||||||
|
Begin
|
||||||
|
if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(fixdrivestr[drive],fs)=0)) or
|
||||||
|
((not (drivestr[Drive]=nil)) and (statfs(drivestr[drive],fs)=0)) then
|
||||||
|
Diskfree:=int64(fs.f_bavail)*int64(fs.f_bsize)
|
||||||
else
|
else
|
||||||
begin
|
Diskfree:=-1;
|
||||||
disk[1]:=chr(drive+64);
|
End;
|
||||||
disk[2]:=':';
|
|
||||||
disk[3]:='\';
|
Function DiskSize(Drive: Byte): int64;
|
||||||
disk[4]:=#0;
|
var
|
||||||
end;
|
fs : tstatfs;
|
||||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
Begin
|
||||||
diskfree:=free*secs*bytes
|
if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(fixdrivestr[drive],fs)=0)) or
|
||||||
|
((not (drivestr[Drive]=nil)) and (statfs(drivestr[drive],fs)=0)) then
|
||||||
|
Disksize:=int64(fs.f_blocks)*int64(fs.f_bsize)
|
||||||
else
|
else
|
||||||
diskfree:=-1;
|
Disksize:=-1;
|
||||||
|
End;
|
||||||
|
|
||||||
|
{$else linux}
|
||||||
|
|
||||||
|
function diskfree(drive : byte) : int64;
|
||||||
|
begin
|
||||||
|
DiskFree:=SysUtils.DiskFree(drive);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function disksize(drive : byte) : longint;
|
function disksize(drive : byte) : int64;
|
||||||
var
|
|
||||||
disk : array[1..4] of char;
|
|
||||||
secs,bytes,
|
|
||||||
free,total : DWord;
|
|
||||||
begin
|
begin
|
||||||
if drive=0 then
|
DiskSize:=SysUtils.DiskSize(drive);
|
||||||
begin
|
|
||||||
disk[1]:='\';
|
|
||||||
disk[2]:=#0;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
disk[1]:=chr(drive+64);
|
|
||||||
disk[2]:=':';
|
|
||||||
disk[3]:='\';
|
|
||||||
disk[4]:=#0;
|
|
||||||
end;
|
|
||||||
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
|
||||||
disksize:=total*secs*bytes
|
|
||||||
else
|
|
||||||
disksize:=-1;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$endif linux}
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
--- Findfirst FindNext ---
|
--- Findfirst FindNext ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
{ Needed kernel calls }
|
|
||||||
function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'FindFirstFileA';
|
|
||||||
function FindNextFile (hFindFile: THandle; var lpFindFileData: TWIN32FindData): Boolean;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'FindNextFileA';
|
|
||||||
function FindCloseFile (hFindFile: THandle): Boolean;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'FindClose';
|
|
||||||
|
|
||||||
Procedure StringToPchar (Var S : String);
|
|
||||||
Var L : Longint;
|
|
||||||
begin
|
|
||||||
L:=ord(S[0]);
|
|
||||||
Move (S[1],S[0],L);
|
|
||||||
S[L]:=#0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure FindMatch(var f:searchrec);
|
|
||||||
Var
|
|
||||||
TheAttr : Longint;
|
|
||||||
begin
|
|
||||||
TheAttr:=DosToWinAttr(F.Attr);
|
|
||||||
{ Find file with correct attribute }
|
|
||||||
While (F.W32FindData.dwFileAttributes and TheAttr)=0 do
|
|
||||||
begin
|
|
||||||
if not FindNextFile (F.FindHandle,F.W32FindData) then
|
|
||||||
begin
|
|
||||||
DosError:=Last2DosError(GetLastError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
{ Convert some attributes back }
|
|
||||||
f.size:=F.W32FindData.NFileSizeLow;
|
|
||||||
f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
|
|
||||||
WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
|
|
||||||
f.Name:=StrPas(@F.W32FindData.cFileName);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
|
procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
|
||||||
begin
|
begin
|
||||||
{ no error }
|
DosError:=SysUtils.FindFirst(Path,Attr,f);
|
||||||
doserror:=0;
|
|
||||||
F.Name:=Path;
|
|
||||||
F.Attr:=attr;
|
|
||||||
StringToPchar(f.name);
|
|
||||||
{ FindFirstFile is a Win32 Call. }
|
|
||||||
F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData);
|
|
||||||
If longint(F.FindHandle)=longint(Invalid_Handle_value) then
|
|
||||||
begin
|
|
||||||
DosError:=Last2DosError(GetLastError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
{ Find file with correct attribute }
|
|
||||||
FindMatch(f);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure findnext(var f : searchRec);
|
procedure findnext(var f : searchRec);
|
||||||
begin
|
begin
|
||||||
{ no error }
|
DosError:=Sysutils.FindNext(f);
|
||||||
doserror:=0;
|
|
||||||
if not FindNextFile (F.FindHandle,F.W32FindData) then
|
|
||||||
begin
|
|
||||||
DosError:=Last2DosError(GetLastError);
|
|
||||||
exit;
|
|
||||||
end;
|
|
||||||
{ Find file with correct attribute }
|
|
||||||
FindMatch(f);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure swapvectors;
|
|
||||||
begin
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
Procedure FindClose(Var f: SearchRec);
|
Procedure FindClose(Var f: SearchRec);
|
||||||
begin
|
begin
|
||||||
If longint(F.FindHandle)<>longint(Invalid_Handle_value) then
|
Sysutils.FindClose(f);
|
||||||
FindCloseFile(F.FindHandle);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -558,15 +485,6 @@ end;
|
|||||||
--- File ---
|
--- File ---
|
||||||
******************************************************************************}
|
******************************************************************************}
|
||||||
|
|
||||||
function GetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'GetFileTime';
|
|
||||||
function SetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'SetFileTime';
|
|
||||||
function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : boolean;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'SetFileAttributesA';
|
|
||||||
function GetFileAttributes(lpFileName : pchar) : longint;stdcall;
|
|
||||||
external 'Kernel32.dll' name 'GetFileAttributesA';
|
|
||||||
|
|
||||||
procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
|
procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
|
||||||
var
|
var
|
||||||
p1,i : longint;
|
p1,i : longint;
|
||||||
@ -728,43 +646,58 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure getftime(var f;var time : longint);
|
procedure getftime(var f;var tim : longint);
|
||||||
var
|
|
||||||
ft : TFileTime;
|
|
||||||
begin
|
begin
|
||||||
if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
|
tim:=FileGetDate(filerec(f).handle);
|
||||||
WinToDosTime(ft,time) then
|
|
||||||
exit
|
|
||||||
else
|
|
||||||
time:=0;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure setftime(var f;time : longint);
|
procedure setftime(var f;time : longint);
|
||||||
var
|
|
||||||
ft : TFileTime;
|
|
||||||
begin
|
begin
|
||||||
if DosToWinTime(time,ft) then
|
FileSetDate(filerec(f).name,Time);
|
||||||
SetFileTime(filerec(f).Handle,nil,nil,@ft);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{$ifdef linux}
|
||||||
|
procedure getfattr(var f;var attr : word);
|
||||||
|
Var
|
||||||
|
info : tstatbuf;
|
||||||
|
LinAttr : longint;
|
||||||
|
Begin
|
||||||
|
DosError:=0;
|
||||||
|
if (FStat(filerec(f).handle,info)<>0) then
|
||||||
|
begin
|
||||||
|
Attr:=0;
|
||||||
|
DosError:=3;
|
||||||
|
exit;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
LinAttr:=Info.st_Mode;
|
||||||
|
if S_ISDIR(LinAttr) then
|
||||||
|
Attr:=$10
|
||||||
|
else
|
||||||
|
Attr:=$20;
|
||||||
|
if Access(@filerec(f).name,W_OK)<>0 then
|
||||||
|
Attr:=Attr or $1;
|
||||||
|
if (not S_ISDIR(LinAttr)) and (filerec(f).name[0]='.') then
|
||||||
|
Attr:=Attr or $2;
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
procedure getfattr(var f;var attr : word);
|
procedure getfattr(var f;var attr : word);
|
||||||
var
|
var
|
||||||
l : longint;
|
l : longint;
|
||||||
begin
|
begin
|
||||||
l:=GetFileAttributes(filerec(f).name);
|
l:=FileGetAttr(filerec(f).handle);
|
||||||
if l=longint($ffffffff) then
|
|
||||||
doserror:=getlasterror;
|
|
||||||
attr:=l;
|
attr:=l;
|
||||||
end;
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
procedure setfattr(var f;attr : word);
|
procedure setfattr(var f;attr : word);
|
||||||
begin
|
begin
|
||||||
doserror:=0;
|
{$ifndef linux}
|
||||||
if not(SetFileAttributes(filerec(f).name,attr)) then
|
FileSetAttr(filerec(f).handle,attr);
|
||||||
doserror:=getlasterror;
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -777,6 +710,7 @@ end;
|
|||||||
terminated by a #0
|
terminated by a #0
|
||||||
}
|
}
|
||||||
|
|
||||||
|
{$ifdef MSWindows}
|
||||||
function GetEnvironmentStrings : pchar;stdcall;
|
function GetEnvironmentStrings : pchar;stdcall;
|
||||||
external 'Kernel32.dll' name 'GetEnvironmentStringsA';
|
external 'Kernel32.dll' name 'GetEnvironmentStringsA';
|
||||||
function FreeEnvironmentStrings(p : pchar) : boolean;stdcall;
|
function FreeEnvironmentStrings(p : pchar) : boolean;stdcall;
|
||||||
@ -850,6 +784,26 @@ begin
|
|||||||
end;
|
end;
|
||||||
FreeEnvironmentStrings(p);
|
FreeEnvironmentStrings(p);
|
||||||
end;
|
end;
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
function envcount : longint;
|
||||||
|
begin
|
||||||
|
envcount:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function EnvStr(index: integer): string;
|
||||||
|
begin
|
||||||
|
envstr:='';
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function GetEnv(envvar: string): string;
|
||||||
|
begin
|
||||||
|
getenv:=GetEnvironmentVariable(envvar);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
|
||||||
{******************************************************************************
|
{******************************************************************************
|
||||||
@ -872,7 +826,10 @@ End;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.4 2000-09-24 21:19:50 peter
|
Revision 1.5 2001-06-03 20:21:08 peter
|
||||||
|
* Kylix fixes, mostly case names of units
|
||||||
|
|
||||||
|
Revision 1.4 2000/09/24 21:19:50 peter
|
||||||
* delphi compile fixes
|
* delphi compile fixes
|
||||||
|
|
||||||
Revision 1.3 2000/09/24 15:06:15 peter
|
Revision 1.3 2000/09/24 15:06:15 peter
|
||||||
|
@ -41,7 +41,7 @@ interface
|
|||||||
doscalls,
|
doscalls,
|
||||||
{$endif}
|
{$endif}
|
||||||
{$ifdef Delphi}
|
{$ifdef Delphi}
|
||||||
sysutils,
|
SysUtils,
|
||||||
dmisc,
|
dmisc,
|
||||||
{$else}
|
{$else}
|
||||||
strings,
|
strings,
|
||||||
@ -972,7 +972,7 @@ implementation
|
|||||||
{$ifdef GETENVOK}
|
{$ifdef GETENVOK}
|
||||||
{$undef GETENVOK}
|
{$undef GETENVOK}
|
||||||
{$else}
|
{$else}
|
||||||
GetEnvPchar:=StrPNew(Dos.Getenv(envname));
|
GetEnvPchar:=StrPNew({$ifdef delphi}DMisc{$else}Dos{$endif}.Getenv(envname));
|
||||||
{$endif}
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1282,7 +1282,10 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.35 2001-05-30 21:35:48 peter
|
Revision 1.36 2001-06-03 20:21:08 peter
|
||||||
|
* Kylix fixes, mostly case names of units
|
||||||
|
|
||||||
|
Revision 1.35 2001/05/30 21:35:48 peter
|
||||||
* netware patches for copyright, screenname, threadname directives
|
* netware patches for copyright, screenname, threadname directives
|
||||||
|
|
||||||
Revision 1.34 2001/05/12 12:11:31 peter
|
Revision 1.34 2001/05/12 12:11:31 peter
|
||||||
|
@ -20,7 +20,7 @@
|
|||||||
|
|
||||||
****************************************************************************
|
****************************************************************************
|
||||||
}
|
}
|
||||||
Unit CPUInfo;
|
Unit cpuinfo;
|
||||||
|
|
||||||
{$i defines.inc}
|
{$i defines.inc}
|
||||||
|
|
||||||
@ -52,7 +52,10 @@ Implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 2001-02-08 13:09:03 jonas
|
Revision 1.3 2001-06-03 20:21:08 peter
|
||||||
|
* Kylix fixes, mostly case names of units
|
||||||
|
|
||||||
|
Revision 1.2 2001/02/08 13:09:03 jonas
|
||||||
* fixed web bug 1396: tpointerord is now a cardinal instead of a longint,
|
* fixed web bug 1396: tpointerord is now a cardinal instead of a longint,
|
||||||
but added a hack in ncnv so that pointer(-1) still works
|
but added a hack in ncnv so that pointer(-1) still works
|
||||||
|
|
||||||
|
@ -20,7 +20,7 @@
|
|||||||
|
|
||||||
****************************************************************************
|
****************************************************************************
|
||||||
}
|
}
|
||||||
unit Messages;
|
unit messages;
|
||||||
|
|
||||||
{$i defines.inc}
|
{$i defines.inc}
|
||||||
|
|
||||||
@ -443,15 +443,18 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.9 2001-05-27 14:30:55 florian
|
Revision 1.10 2001-06-03 20:21:08 peter
|
||||||
|
* Kylix fixes, mostly case names of units
|
||||||
|
|
||||||
|
Revision 1.9 2001/05/27 14:30:55 florian
|
||||||
+ some widestring stuff added
|
+ some widestring stuff added
|
||||||
|
|
||||||
Revision 1.8 2001/04/21 13:32:07 peter
|
Revision 1.8 2001/04/21 13:32:07 peter
|
||||||
* remove endless loop with replacements (merged)
|
* remove endless loop with replacements (merged)
|
||||||
|
|
||||||
Revision 1.7 2001/04/14 16:05:41 jonas
|
Revision 1.7 2001/04/14 16:05:41 jonas
|
||||||
* allow a single replacement string to be substituted more than once per
|
* allow a single replacement string to be substituted more than once per
|
||||||
message (already used in assembler reader messages for "fsub x" etc.
|
message (already used in assembler reader messages for "fsub x" etc.
|
||||||
transformations) (merged)
|
transformations) (merged)
|
||||||
|
|
||||||
Revision 1.6 2001/03/10 13:19:10 peter
|
Revision 1.6 2001/03/10 13:19:10 peter
|
||||||
|
39
compiler/ppc.conf
Normal file
39
compiler/ppc.conf
Normal file
@ -0,0 +1,39 @@
|
|||||||
|
-$A8
|
||||||
|
-$B-
|
||||||
|
-$C+
|
||||||
|
-$D+
|
||||||
|
-$E-
|
||||||
|
-$F-
|
||||||
|
-$G+
|
||||||
|
-$H+
|
||||||
|
-$I+
|
||||||
|
-$J-
|
||||||
|
-$K-
|
||||||
|
-$L+
|
||||||
|
-$M-
|
||||||
|
-$N+
|
||||||
|
-$O+
|
||||||
|
-$P+
|
||||||
|
-$Q-
|
||||||
|
-$R-
|
||||||
|
-$S-
|
||||||
|
-$T-
|
||||||
|
-$U-
|
||||||
|
-$V+
|
||||||
|
-$W-
|
||||||
|
-$X+
|
||||||
|
-$YD
|
||||||
|
-$Z1
|
||||||
|
-cg
|
||||||
|
-H+
|
||||||
|
-W+
|
||||||
|
-M
|
||||||
|
-$M16384,1048576
|
||||||
|
-K$00400000
|
||||||
|
-E"."
|
||||||
|
-N"."
|
||||||
|
-U"i386:targets"
|
||||||
|
-O"i386:targets"
|
||||||
|
-I"i386:targets"
|
||||||
|
-R"i386:targets"
|
||||||
|
-DDELPHI;i386
|
@ -569,12 +569,16 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
finalization
|
finalization
|
||||||
DeregisterInfos;
|
DeregisterInfos;
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.18 2001-06-03 15:15:31 peter
|
Revision 1.19 2001-06-03 20:21:08 peter
|
||||||
|
* Kylix fixes, mostly case names of units
|
||||||
|
|
||||||
|
Revision 1.18 2001/06/03 15:15:31 peter
|
||||||
* dllprt0 stub for linux shared libs
|
* dllprt0 stub for linux shared libs
|
||||||
* pass -init and -fini for linux shared libs
|
* pass -init and -fini for linux shared libs
|
||||||
* libprefix splitted into staticlibprefix and sharedlibprefix
|
* libprefix splitted into staticlibprefix and sharedlibprefix
|
||||||
|
Loading…
Reference in New Issue
Block a user