mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 11:48:04 +02:00
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
This commit is contained in:
Tomas Hajny
parent
4c96b2777e
commit
09fd537acf
@ -94,9 +94,6 @@ Type
|
||||
|
||||
{OS/2 specific functions}
|
||||
|
||||
function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
|
||||
const comline:comstr):longint;
|
||||
|
||||
function GetEnvPChar (EnvVar: string): PChar;
|
||||
|
||||
|
||||
@ -962,8 +959,7 @@ begin
|
||||
end;
|
||||
{$ASMMODE ATT}
|
||||
|
||||
function GetEnv (const EnvVar: string): string;
|
||||
(* The assembler version is more than three times as fast as Pascal. *)
|
||||
function GetEnv (EnvVar: string): string;
|
||||
begin
|
||||
GetEnv := StrPas (GetEnvPChar (EnvVar));
|
||||
end;
|
||||
@ -1201,6 +1197,16 @@ procedure SetIntVec (IntNo: byte; Vector: pointer);
|
||||
begin
|
||||
end;
|
||||
|
||||
function GetShortName(var p : String) : boolean;
|
||||
begin
|
||||
GetShortName:=true;
|
||||
end;
|
||||
|
||||
function GetLongName(var p : String) : boolean;
|
||||
begin
|
||||
GetLongName:=true;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
begin
|
||||
@ -1211,7 +1217,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 2004-02-17 17:37:26 daniel
|
||||
Revision 1.13 2004-02-22 15:01:49 hajny
|
||||
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
|
||||
|
||||
Revision 1.12 2004/02/17 17:37:26 daniel
|
||||
* Enable threadvars again
|
||||
|
||||
Revision 1.11 2004/02/16 22:16:58 hajny
|
||||
|
||||
@ -82,7 +82,7 @@ type
|
||||
FileAlloc:cardinal; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
Name:string; {Also possible to use as ASCIIZ.
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
@ -101,7 +101,7 @@ type
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
cbList:longint; {Size of the file's extended attributes.}
|
||||
Name:string; {Also possible to use as ASCIIZ.
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
@ -393,15 +393,19 @@ const
|
||||
function FileOpen (const FileName: string; Mode: integer): longint; assembler;
|
||||
asm
|
||||
push ebx
|
||||
mov eax, Mode
|
||||
(* DenyAll if sharing not specified. *)
|
||||
test eax, 112
|
||||
jnz @FOpen1
|
||||
or eax, 16
|
||||
@FOpen1:
|
||||
mov ecx, eax
|
||||
mov eax, 7F2Bh
|
||||
{$IFDEF REGCALL}
|
||||
mov ecx, edx
|
||||
mov edx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov ecx, Mode
|
||||
mov edx, FileName
|
||||
{$ENDIF REGCALL}
|
||||
(* DenyAll if sharing not specified. *)
|
||||
test ecx, 112
|
||||
jnz @FOpen1
|
||||
or ecx, 16
|
||||
@FOpen1:
|
||||
mov eax, 7F2Bh
|
||||
call syscall
|
||||
pop ebx
|
||||
end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
@ -410,9 +414,13 @@ end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
function FileCreate (const FileName: string): longint; assembler;
|
||||
asm
|
||||
push ebx
|
||||
mov eax, 7F2Bh
|
||||
mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
|
||||
{$IFDEF REGCALL}
|
||||
mov edx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov edx, FileName
|
||||
{$ENDIF REGCALL}
|
||||
mov eax, 7F2Bh
|
||||
mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
|
||||
call syscall
|
||||
pop ebx
|
||||
end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
@ -428,13 +436,17 @@ function FileRead (Handle: longint; var Buffer; Count: longint): longint;
|
||||
assembler;
|
||||
asm
|
||||
push ebx
|
||||
mov eax, 3F00h
|
||||
mov ebx, Handle
|
||||
mov ecx, Count
|
||||
mov edx, Buffer
|
||||
call syscall
|
||||
jnc @FReadEnd
|
||||
mov eax, -1
|
||||
{$IFDEF REGCALL}
|
||||
mov ebx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov ebx, Handle
|
||||
mov ecx, Count
|
||||
mov edx, Buffer
|
||||
{$ENDIF REGCALL}
|
||||
mov eax, 3F00h
|
||||
call syscall
|
||||
jnc @FReadEnd
|
||||
mov eax, -1
|
||||
@FReadEnd:
|
||||
pop ebx
|
||||
end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
@ -444,13 +456,17 @@ function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
|
||||
assembler;
|
||||
asm
|
||||
push ebx
|
||||
mov eax, 4000h
|
||||
mov ebx, Handle
|
||||
mov ecx, Count
|
||||
mov edx, Buffer
|
||||
call syscall
|
||||
jnc @FWriteEnd
|
||||
mov eax, -1
|
||||
{$IFDEF REGCALL}
|
||||
mov ebx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov ebx, Handle
|
||||
mov ecx, Count
|
||||
mov edx, Buffer
|
||||
{$ENDIF REGCALL}
|
||||
mov eax, 4000h
|
||||
call syscall
|
||||
jnc @FWriteEnd
|
||||
mov eax, -1
|
||||
@FWriteEnd:
|
||||
pop ebx
|
||||
end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
@ -459,13 +475,18 @@ end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
|
||||
asm
|
||||
push ebx
|
||||
mov eax, Origin
|
||||
mov ah, 42h
|
||||
mov ebx, Handle
|
||||
mov edx, FOffset
|
||||
call syscall
|
||||
jnc @FSeekEnd
|
||||
mov eax, -1
|
||||
{$IFDEF REGCALL}
|
||||
mov ebx, eax
|
||||
mov eax, ecx
|
||||
{$ELSE REGCALL}
|
||||
mov ebx, Handle
|
||||
mov eax, Origin
|
||||
mov edx, FOffset
|
||||
{$ENDIF REGCALL}
|
||||
mov ah, 42h
|
||||
call syscall
|
||||
jnc @FSeekEnd
|
||||
mov eax, -1
|
||||
@FSeekEnd:
|
||||
pop ebx
|
||||
end {['eax', 'ebx', 'edx']};
|
||||
@ -492,18 +513,23 @@ end;
|
||||
function FileTruncate (Handle, Size: longint): boolean; assembler;
|
||||
asm
|
||||
push ebx
|
||||
mov eax, 7F25h
|
||||
mov ebx, Handle
|
||||
mov edx, Size
|
||||
call syscall
|
||||
jc @FTruncEnd
|
||||
mov eax, 4202h
|
||||
mov ebx, Handle
|
||||
mov edx, 0
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jnc @FTruncEnd
|
||||
dec eax
|
||||
{$IFDEF REGCALL}
|
||||
mov ebx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov ebx, Handle
|
||||
mov edx, Size
|
||||
{$ENDIF REGCALL}
|
||||
mov eax, 7F25h
|
||||
push ebx
|
||||
call syscall
|
||||
pop ebx
|
||||
jc @FTruncEnd
|
||||
mov eax, 4202h
|
||||
mov edx, 0
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jnc @FTruncEnd
|
||||
dec eax
|
||||
@FTruncEnd:
|
||||
pop ebx
|
||||
end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
@ -525,14 +551,18 @@ end;
|
||||
|
||||
function FileExists (const FileName: string): boolean; assembler;
|
||||
asm
|
||||
mov ax, 4300h
|
||||
{$IFDEF REGCALL}
|
||||
mov edx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov edx, FileName
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FExistsEnd
|
||||
test cx, 18h
|
||||
jnz @FExistsEnd
|
||||
inc eax
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, 4300h
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FExistsEnd
|
||||
test cx, 18h
|
||||
jnz @FExistsEnd
|
||||
inc eax
|
||||
@FExistsEnd:
|
||||
end {['eax', 'ecx', 'edx']};
|
||||
|
||||
@ -551,25 +581,25 @@ var SR: PSearchRec;
|
||||
|
||||
begin
|
||||
if os_mode = osOS2 then
|
||||
begin
|
||||
New (FStat);
|
||||
Rslt.FindHandle := $FFFFFFFF;
|
||||
Count := 1;
|
||||
Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
|
||||
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
|
||||
ilStandard);
|
||||
if (Err = 0) and (Count = 0) then Err := 18;
|
||||
FindFirst := -Err;
|
||||
if Err = 0 then
|
||||
begin
|
||||
Rslt.Name := FStat^.Name;
|
||||
Rslt.Size := FStat^.FileSize;
|
||||
Rslt.Attr := FStat^.AttrFile;
|
||||
Rslt.ExcludeAttr := 0;
|
||||
TRec (Rslt.Time).T := FStat^.TimeLastWrite;
|
||||
TRec (Rslt.Time).D := FStat^.DateLastWrite;
|
||||
end;
|
||||
Dispose (FStat);
|
||||
begin
|
||||
New (FStat);
|
||||
Rslt.FindHandle := $FFFFFFFF;
|
||||
Count := 1;
|
||||
Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
|
||||
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
|
||||
ilStandard);
|
||||
if (Err = 0) and (Count = 0) then Err := 18;
|
||||
FindFirst := -Err;
|
||||
if Err = 0 then
|
||||
begin
|
||||
Rslt.Name := FStat^.Name;
|
||||
Rslt.Size := FStat^.FileSize;
|
||||
Rslt.Attr := FStat^.AttrFile;
|
||||
Rslt.ExcludeAttr := 0;
|
||||
TRec (Rslt.Time).T := FStat^.TimeLastWrite;
|
||||
TRec (Rslt.Time).D := FStat^.DateLastWrite;
|
||||
end;
|
||||
Dispose (FStat);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -600,7 +630,7 @@ var SR: PSearchRec;
|
||||
|
||||
begin
|
||||
if os_mode = osOS2 then
|
||||
begin
|
||||
begin
|
||||
New (FStat);
|
||||
Count := 1;
|
||||
Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
|
||||
@ -645,7 +675,7 @@ var SR: PSearchRec;
|
||||
begin
|
||||
if os_mode = osOS2 then
|
||||
begin
|
||||
DosFindClose (F.FindHandle);
|
||||
DosFindClose (F.FindHandle);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -660,13 +690,17 @@ end;
|
||||
function FileGetDate (Handle: longint): longint; assembler;
|
||||
asm
|
||||
push ebx
|
||||
mov ax, 5700h
|
||||
mov ebx, Handle
|
||||
call syscall
|
||||
mov eax, -1
|
||||
jc @FGetDateEnd
|
||||
mov ax, dx
|
||||
shld eax, ecx, 16
|
||||
{$IFDEF REGCALL}
|
||||
mov ebx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov ebx, Handle
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, 5700h
|
||||
call syscall
|
||||
mov eax, -1
|
||||
jc @FGetDateEnd
|
||||
mov ax, dx
|
||||
shld eax, ecx, 16
|
||||
@FGetDateEnd:
|
||||
pop ebx
|
||||
end {['eax', 'ebx', 'ecx', 'edx']};
|
||||
@ -717,36 +751,49 @@ end;
|
||||
|
||||
function FileGetAttr (const FileName: string): longint; assembler;
|
||||
asm
|
||||
mov ax, 4300h
|
||||
{$IFDEF REGCALL}
|
||||
mov edx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov edx, FileName
|
||||
call syscall
|
||||
jnc @FGetAttrEnd
|
||||
mov eax, -1
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, 4300h
|
||||
call syscall
|
||||
jnc @FGetAttrEnd
|
||||
mov eax, -1
|
||||
@FGetAttrEnd:
|
||||
end {['eax', 'edx']};
|
||||
|
||||
|
||||
function FileSetAttr (const Filename: string; Attr: longint): longint; assembler;
|
||||
asm
|
||||
mov ax, 4301h
|
||||
mov ecx, Attr
|
||||
{$IFDEF REGCALL}
|
||||
mov ecx, edx
|
||||
mov edx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov ecx, Attr
|
||||
mov edx, FileName
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jnc @FSetAttrEnd
|
||||
mov eax, -1
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, 4301h
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jnc @FSetAttrEnd
|
||||
mov eax, -1
|
||||
@FSetAttrEnd:
|
||||
end {['eax', 'ecx', 'edx']};
|
||||
|
||||
|
||||
function DeleteFile (const FileName: string): boolean; assembler;
|
||||
asm
|
||||
mov ax, 4100h
|
||||
{$IFDEF REGCALL}
|
||||
mov edx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov edx, FileName
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FDeleteEnd
|
||||
inc eax
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, 4100h
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FDeleteEnd
|
||||
inc eax
|
||||
@FDeleteEnd:
|
||||
end {['eax', 'edx']};
|
||||
|
||||
@ -754,13 +801,18 @@ end {['eax', 'edx']};
|
||||
function RenameFile (const OldName, NewName: string): boolean; assembler;
|
||||
asm
|
||||
push edi
|
||||
mov ax, 5600h
|
||||
mov edx, OldName
|
||||
mov edi, NewName
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FRenameEnd
|
||||
inc eax
|
||||
{$IFDEF REGCALL}
|
||||
mov edx, eax
|
||||
mov edi, edx
|
||||
{$ELSE REGCALL}
|
||||
mov edx, OldName
|
||||
mov edi, NewName
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, 5600h
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FRenameEnd
|
||||
inc eax
|
||||
@FRenameEnd:
|
||||
pop edi
|
||||
end {['eax', 'edx', 'edi']};
|
||||
@ -810,7 +862,7 @@ begin
|
||||
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
|
||||
else
|
||||
DiskFree := -1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function DiskSize (Drive: byte): int64;
|
||||
@ -852,7 +904,7 @@ begin
|
||||
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
|
||||
else
|
||||
DiskSize := -1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -892,14 +944,18 @@ end;
|
||||
{$ASMMODE INTEL}
|
||||
function DirectoryExists (const Directory: string): boolean; assembler;
|
||||
asm
|
||||
{$IFDEF REGCALL}
|
||||
mov edx, eax
|
||||
{$ELSE REGCALL}
|
||||
mov edx, Directory
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, 4300h
|
||||
mov edx, Directory
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FExistsEnd
|
||||
test cx, 10h
|
||||
jz @FExistsEnd
|
||||
inc eax
|
||||
call syscall
|
||||
mov eax, 0
|
||||
jc @FExistsEnd
|
||||
test cx, 10h
|
||||
jz @FExistsEnd
|
||||
inc eax
|
||||
@FExistsEnd:
|
||||
end {['eax', 'ecx', 'edx']};
|
||||
|
||||
@ -912,30 +968,37 @@ procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
|
||||
asm
|
||||
(* Expects the default record alignment (word)!!! *)
|
||||
push edi
|
||||
mov ah, 2Ah
|
||||
call syscall
|
||||
mov edi, SystemTime
|
||||
mov ax, cx
|
||||
stosw
|
||||
xor eax, eax
|
||||
mov al, 10
|
||||
mul dl
|
||||
shl eax, 16
|
||||
mov al, dh
|
||||
stosd
|
||||
push edi
|
||||
mov ah, 2Ch
|
||||
call syscall
|
||||
pop edi
|
||||
xor eax, eax
|
||||
mov al, cl
|
||||
shl eax, 16
|
||||
mov al, ch
|
||||
stosd
|
||||
mov al, dl
|
||||
shl eax, 16
|
||||
mov al, dh
|
||||
stosd
|
||||
{$IFDEF REGCALL}
|
||||
push eax
|
||||
{$ENDIF REGCALL}
|
||||
mov ah, 2Ah
|
||||
call syscall
|
||||
{$IFDEF REGCALL}
|
||||
pop eax
|
||||
{$ELSE REGCALL}
|
||||
mov edi, SystemTime
|
||||
{$ENDIF REGCALL}
|
||||
mov ax, cx
|
||||
stosw
|
||||
xor eax, eax
|
||||
mov al, 10
|
||||
mul dl
|
||||
shl eax, 16
|
||||
mov al, dh
|
||||
stosd
|
||||
push edi
|
||||
mov ah, 2Ch
|
||||
call syscall
|
||||
pop edi
|
||||
xor eax, eax
|
||||
mov al, cl
|
||||
shl eax, 16
|
||||
mov al, ch
|
||||
stosd
|
||||
mov al, dl
|
||||
shl eax, 16
|
||||
mov al, dh
|
||||
stosd
|
||||
pop edi
|
||||
end {['eax', 'ecx', 'edx', 'edi']};
|
||||
{$asmmode default}
|
||||
@ -1144,7 +1207,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2004-02-15 21:26:37 hajny
|
||||
Revision 1.16 2004-02-22 15:01:49 hajny
|
||||
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
|
||||
|
||||
Revision 1.15 2004/02/15 21:26:37 hajny
|
||||
* overloaded ExecuteProcess added, EnvStr param changed to longint
|
||||
|
||||
Revision 1.14 2004/01/20 23:05:31 hajny
|
||||
|
||||
@ -669,12 +669,13 @@ end;
|
||||
function GetShortName(var p : String) : boolean;
|
||||
begin
|
||||
GetShortName:=true;
|
||||
{$WARNING EA .shortname support (see FAT32 driver) should be probably added here!}
|
||||
end;
|
||||
|
||||
function GetLongName(var p : String) : boolean;
|
||||
begin
|
||||
GetLongName:=true;
|
||||
{$WARNING EA .longname support should be probably added here}
|
||||
{$WARNING EA .longname support should be probably added here!}
|
||||
end;
|
||||
|
||||
|
||||
@ -684,7 +685,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.38 2004-02-17 17:37:26 daniel
|
||||
Revision 1.39 2004-02-22 15:01:49 hajny
|
||||
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
|
||||
|
||||
Revision 1.38 2004/02/17 17:37:26 daniel
|
||||
* Enable threadvars again
|
||||
|
||||
Revision 1.37 2004/02/16 22:16:59 hajny
|
||||
|
||||
@ -187,31 +187,31 @@ procedure DosExit(Action, Result: cardinal); cdecl;
|
||||
external 'DOSCALLS' index 234;
|
||||
|
||||
// EAs not used in System unit
|
||||
function DosOpen(FileName:PChar;var Handle:longint;var Action:cardinal;
|
||||
function DosOpen(FileName:PChar;var Handle: THandle;var Action:cardinal;
|
||||
InitSize,Attrib,OpenFlags,FileMode:cardinal;
|
||||
EA:Pointer):longint; cdecl;
|
||||
EA:Pointer): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 273;
|
||||
|
||||
function DosClose(Handle:longint): longint; cdecl;
|
||||
function DosClose(Handle: THandle): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 257;
|
||||
|
||||
function DosRead(Handle:longint; Buffer: Pointer;Count:longint;
|
||||
var ActCount:longint):longint; cdecl;
|
||||
function DosRead(Handle: THandle; Buffer: Pointer; Count: cardinal;
|
||||
var ActCount: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 281;
|
||||
|
||||
function DosWrite(Handle:longint; Buffer: Pointer;Count:longint;
|
||||
var ActCount:longint):longint; cdecl;
|
||||
function DosWrite(Handle: THandle; Buffer: Pointer;Count: cardinal;
|
||||
var ActCount: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 282;
|
||||
|
||||
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal;
|
||||
var PosActual:longint):longint; cdecl;
|
||||
function DosSetFilePtr(Handle: THandle; Pos:longint; Method:cardinal;
|
||||
var PosActual: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 256;
|
||||
|
||||
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl;
|
||||
function DosSetFileSize(Handle: THandle; Size: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 272;
|
||||
|
||||
function DosQueryHType(Handle:longint;var HandType:longint;
|
||||
var Attr:longint):longint; cdecl;
|
||||
function DosQueryHType(Handle: THandle; var HandType: cardinal;
|
||||
var Attr: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 224;
|
||||
|
||||
type
|
||||
@ -227,7 +227,7 @@ type
|
||||
WeekDay: byte;
|
||||
end;
|
||||
|
||||
function DosGetDateTime(var Buf:TSysDateTime):longint; cdecl;
|
||||
function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 230;
|
||||
|
||||
{ converts an OS/2 error code to a TP compatible error }
|
||||
@ -480,10 +480,10 @@ end;
|
||||
versions of OS/2.
|
||||
Flags = One or more of the mfXXXX constants.}
|
||||
|
||||
function DosAllocMem(var P:pointer;Size,Flag:cardinal):longint; cdecl;
|
||||
function DosAllocMem(var P:pointer;Size,Flag:cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 299;
|
||||
|
||||
function DosSetMem(P:pointer;Size,Flag:cardinal):longint; cdecl;
|
||||
function DosSetMem(P:pointer;Size,Flag:cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 305;
|
||||
|
||||
var
|
||||
@ -584,13 +584,13 @@ end;
|
||||
|
||||
function do_read(h,addr,len:longint):longint;
|
||||
Var
|
||||
T: Longint;
|
||||
T: cardinal;
|
||||
begin
|
||||
{$ifdef IODEBUG}
|
||||
write('do_read: handle=', h, ', addr=', addr, ', length=', len);
|
||||
{$endif}
|
||||
InOutRes:=DosRead(H, Pointer(Addr), Len, T);
|
||||
do_read:=T;
|
||||
do_read:= longint (T);
|
||||
{$ifdef IODEBUG}
|
||||
writeln(', actual_len=', t, ', InOutRes=', InOutRes);
|
||||
{$endif}
|
||||
@ -598,13 +598,13 @@ end;
|
||||
|
||||
function do_write(h,addr,len:longint) : longint;
|
||||
Var
|
||||
T: Longint;
|
||||
T: cardinal;
|
||||
begin
|
||||
{$ifdef IODEBUG}
|
||||
write('do_write: handle=', h, ', addr=', addr, ', length=', len);
|
||||
{$endif}
|
||||
InOutRes:=DosWrite(H, Pointer(Addr), Len, T);
|
||||
do_write:=T;
|
||||
do_write:= longint (T);
|
||||
{$ifdef IODEBUG}
|
||||
writeln(', actual_len=', t, ', InOutRes=', InOutRes);
|
||||
{$endif}
|
||||
@ -612,10 +612,10 @@ end;
|
||||
|
||||
function do_filepos(handle:longint): longint;
|
||||
var
|
||||
PosActual: Longint;
|
||||
PosActual: cardinal;
|
||||
begin
|
||||
InOutRes:=DosSetFilePtr(Handle, 0, 1, PosActual);
|
||||
do_filepos:=PosActual;
|
||||
do_filepos:=longint (PosActual);
|
||||
{$ifdef IODEBUG}
|
||||
writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
||||
{$endif}
|
||||
@ -623,7 +623,7 @@ end;
|
||||
|
||||
procedure do_seek(handle,pos:longint);
|
||||
var
|
||||
PosActual: Longint;
|
||||
PosActual: cardinal;
|
||||
begin
|
||||
InOutRes:=DosSetFilePtr(Handle, Pos, 0 {ZeroBased}, PosActual);
|
||||
{$ifdef IODEBUG}
|
||||
@ -633,17 +633,17 @@ end;
|
||||
|
||||
function do_seekend(handle:longint):longint;
|
||||
var
|
||||
PosActual: Longint;
|
||||
PosActual: cardinal;
|
||||
begin
|
||||
InOutRes:=DosSetFilePtr(Handle, 0, 2 {EndBased}, PosActual);
|
||||
do_seekend:=PosActual;
|
||||
do_seekend:=longint (PosActual);
|
||||
{$ifdef IODEBUG}
|
||||
writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function do_filesize(handle:longint):longint;
|
||||
var aktfilepos:longint;
|
||||
var aktfilepos: cardinal;
|
||||
begin
|
||||
aktfilepos:=do_filepos(handle);
|
||||
do_filesize:=do_seekend(handle);
|
||||
@ -778,7 +778,7 @@ end;
|
||||
|
||||
function do_isdevice (Handle: longint): boolean;
|
||||
var
|
||||
HT, Attr: longint;
|
||||
HT, Attr: cardinal;
|
||||
begin
|
||||
do_isdevice:=false;
|
||||
If DosQueryHType(Handle, HT, Attr)<>0 then exit;
|
||||
@ -1471,7 +1471,10 @@ the compiler, of course, but more should get allocated dynamically on demand.
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.66 2004-02-16 22:18:44 hajny
|
||||
Revision 1.67 2004-02-22 15:01:49 hajny
|
||||
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
|
||||
|
||||
Revision 1.66 2004/02/16 22:18:44 hajny
|
||||
* LastDosExitCode changed back from threadvar temporarily
|
||||
|
||||
Revision 1.65 2004/02/02 03:24:09 yuri
|
||||
|
||||
@ -82,7 +82,7 @@ type
|
||||
FileAlloc:cardinal; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
Name:string; {Also possible to use as ASCIIZ.
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
@ -101,7 +101,7 @@ type
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
cbList:longint; {Size of the file's extended attributes.}
|
||||
Name:string; {Also possible to use as ASCIIZ.
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
@ -316,29 +316,29 @@ const
|
||||
the size and placement.}
|
||||
|
||||
|
||||
function DosSetFileInfo (Handle: longint; InfoLevel: cardinal; AFileStatus: PFileStatus;
|
||||
function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
|
||||
FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
|
||||
|
||||
function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
|
||||
BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
|
||||
|
||||
function DosQueryFileInfo (Handle: longint; InfoLevel: cardinal;
|
||||
function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
|
||||
AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 279;
|
||||
|
||||
function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 227;
|
||||
|
||||
function DosFindFirst (FileMask: PChar; var Handle: longint; Attrib: cardinal;
|
||||
function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
|
||||
AFileStatus: PFileStatus; FileStatusLen: cardinal;
|
||||
var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 264;
|
||||
|
||||
function DosFindNext (Handle: longint; AFileStatus: PFileStatus;
|
||||
function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
|
||||
FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 265;
|
||||
|
||||
function DosFindClose (Handle: longint): cardinal; cdecl;
|
||||
function DosFindClose (Handle: THandle): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 263;
|
||||
|
||||
function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
|
||||
@ -348,42 +348,42 @@ function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
|
||||
function DosMapCase (Size: cardinal; var Country: TCountryCode;
|
||||
AString: PChar): cardinal; cdecl; external 'NLS' index 7;
|
||||
|
||||
function DosDelete(FileName:PChar): Longint; cdecl;
|
||||
function DosDelete(FileName:PChar): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 259;
|
||||
|
||||
function DosMove(OldFile, NewFile:PChar): Longint; cdecl;
|
||||
function DosMove(OldFile, NewFile:PChar): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 271;
|
||||
|
||||
function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
|
||||
AFileStatus:PFileStatus;FileStatusLen:cardinal): Longint; cdecl;
|
||||
AFileStatus:PFileStatus;FileStatusLen:cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 223;
|
||||
|
||||
function DosSetPathInfo(FileName:PChar;InfoLevel:longint;
|
||||
function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
|
||||
AFileStatus:PFileStatus;FileStatusLen,
|
||||
Options:longint):longint; cdecl;
|
||||
Options:cardinal):cardinal; cdecl;
|
||||
external 'DOSCALLS' index 219;
|
||||
|
||||
function DosOpen(FileName:PChar;var Handle:longint;var Action: Longint;
|
||||
function DosOpen(FileName:PChar;var Handle: THandle; var Action: cardinal;
|
||||
InitSize,Attrib,OpenFlags,FileMode:cardinal;
|
||||
EA:Pointer):longint; cdecl;
|
||||
EA:Pointer):cardinal; cdecl;
|
||||
external 'DOSCALLS' index 273;
|
||||
|
||||
function DosClose(Handle:longint): longint; cdecl;
|
||||
function DosClose(Handle: THandle): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 257;
|
||||
|
||||
function DosRead(Handle:longint; var Buffer; Count:longint;
|
||||
var ActCount:longint):longint; cdecl;
|
||||
function DosRead(Handle:THandle; var Buffer; Count: cardinal;
|
||||
var ActCount: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 281;
|
||||
|
||||
function DosWrite(Handle:longint; Buffer: pointer; Count:longint;
|
||||
var ActCount:longint):longint; cdecl;
|
||||
function DosWrite(Handle: THandle; Buffer: pointer; Count: cardinal;
|
||||
var ActCount: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 282;
|
||||
|
||||
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal;
|
||||
var PosActual:longint):longint; cdecl;
|
||||
function DosSetFilePtr(Handle: THandle; Pos: longint; Method: cardinal;
|
||||
var PosActual: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 256;
|
||||
|
||||
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl;
|
||||
function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 272;
|
||||
|
||||
procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
|
||||
@ -421,7 +421,7 @@ type
|
||||
WeekDay: byte;
|
||||
end;
|
||||
|
||||
function DosGetDateTime(var Buf: TDT):longint; cdecl;
|
||||
function DosGetDateTime(var Buf: TDT): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 230;
|
||||
|
||||
|
||||
@ -443,15 +443,12 @@ const
|
||||
|
||||
function FileOpen (const FileName: string; Mode: integer): longint;
|
||||
Var
|
||||
Rc, Action, Handle: Longint;
|
||||
P: PChar;
|
||||
Handle: THandle;
|
||||
Rc, Action: cardinal;
|
||||
begin
|
||||
P:=StrAlloc(length(FileName)+1);
|
||||
StrPCopy(P, FileName);
|
||||
(* DenyNone if sharing not specified. *)
|
||||
if Mode and 112 = 0 then Mode:=Mode or 64;
|
||||
Rc:=DosOpen(P, Handle, Action, 0, 0, 1, Mode, nil);
|
||||
StrDispose(P);
|
||||
Rc:=DosOpen(PChar (FileName), Handle, Action, 0, 0, 1, Mode, nil);
|
||||
If Rc=0 then
|
||||
FileOpen:=Handle
|
||||
else
|
||||
@ -462,13 +459,10 @@ function FileCreate (const FileName: string): longint;
|
||||
Const
|
||||
Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *)
|
||||
Var
|
||||
RC, Action, Handle: Longint;
|
||||
P: PChar;
|
||||
Handle: THandle;
|
||||
RC, Action: cardinal;
|
||||
Begin
|
||||
P:=StrAlloc(length(FileName)+1);
|
||||
StrPCopy(P, FileName);
|
||||
RC:=DosOpen(P, Handle, Action, 0, 0, $12, Mode, Nil);
|
||||
StrDispose(P);
|
||||
RC:=DosOpen(PChar (FileName), Handle, Action, 0, 0, $12, Mode, Nil);
|
||||
If RC=0 then
|
||||
FileCreate:=Handle
|
||||
else
|
||||
@ -483,26 +477,26 @@ end;
|
||||
|
||||
function FileRead (Handle: longint; var Buffer; Count: longint): longint;
|
||||
Var
|
||||
T: Longint;
|
||||
T: cardinal;
|
||||
begin
|
||||
DosRead(Handle, Buffer, Count, T);
|
||||
FileRead:=T;
|
||||
FileRead := longint (T);
|
||||
end;
|
||||
|
||||
function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
|
||||
Var
|
||||
T: Longint;
|
||||
T: cardinal;
|
||||
begin
|
||||
DosWrite (Handle, @Buffer, Count, T);
|
||||
FileWrite:=T;
|
||||
FileWrite := longint (T);
|
||||
end;
|
||||
|
||||
function FileSeek (Handle, FOffset, Origin: longint): longint;
|
||||
var
|
||||
npos: longint;
|
||||
npos: cardinal;
|
||||
begin
|
||||
if DosSetFilePtr(Handle, FOffset, Origin, npos)=0 Then
|
||||
FileSeek:=npos
|
||||
if DosSetFilePtr (Handle, FOffset, Origin, npos) = 0 Then
|
||||
FileSeek:= longint (npos)
|
||||
else
|
||||
FileSeek:=-1;
|
||||
end;
|
||||
@ -541,9 +535,10 @@ end;
|
||||
function FileExists (const FileName: string): boolean;
|
||||
var
|
||||
SR: TSearchRec;
|
||||
RC: longint;
|
||||
begin
|
||||
FileExists:=False;
|
||||
if FindFirst(FileName, faAnyFile, SR)=0 then FileExists:=True;
|
||||
if FindFirst (FileName, faAnyFile, SR)=0 then FileExists:=True;
|
||||
FindClose(SR);
|
||||
end;
|
||||
|
||||
@ -558,14 +553,14 @@ var SR: PSearchRec;
|
||||
FStat: PFileFindBuf3;
|
||||
Count: cardinal;
|
||||
Err: cardinal;
|
||||
I: cardinal;
|
||||
|
||||
begin
|
||||
New (FStat);
|
||||
Rslt.FindHandle := $FFFFFFFF;
|
||||
Count := 1;
|
||||
Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
|
||||
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count,
|
||||
ilStandard);
|
||||
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
|
||||
if (Err = 0) and (Count = 0) then Err := 18;
|
||||
FindFirst := -Err;
|
||||
if Err = 0 then
|
||||
@ -658,13 +653,9 @@ end;
|
||||
function FileGetAttr (const FileName: string): longint;
|
||||
var
|
||||
FS: PFileStatus3;
|
||||
S: PChar;
|
||||
begin
|
||||
New(FS);
|
||||
S:=StrAlloc(length(FileName)+1);
|
||||
StrPCopy(S, FileName);
|
||||
Result:=-DosQueryPathInfo(S, ilStandard, FS, SizeOf(FS^));
|
||||
StrDispose(S);
|
||||
Result:=-DosQueryPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^));
|
||||
If Result=0 Then Result:=FS^.attrFile;
|
||||
Dispose(FS);
|
||||
end;
|
||||
@ -672,40 +663,23 @@ end;
|
||||
function FileSetAttr (const Filename: string; Attr: longint): longint;
|
||||
Var
|
||||
FS: PFileStatus3;
|
||||
S: PChar;
|
||||
Begin
|
||||
New(FS);
|
||||
FillChar(FS, SizeOf(FS^), 0);
|
||||
FS^.attrFile:=Attr;
|
||||
S:=StrAlloc(length(FileName)+1);
|
||||
StrPCopy(S, FileName);
|
||||
Result:=-DosSetPathInfo(S, ilStandard, FS, SizeOf(FS^), 0);
|
||||
StrDispose(S);
|
||||
FS^.AttrFile:=Attr;
|
||||
Result:=-DosSetPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^), 0);
|
||||
Dispose(FS);
|
||||
end;
|
||||
|
||||
|
||||
function DeleteFile (const FileName: string): boolean;
|
||||
Var
|
||||
S: PChar;
|
||||
Begin
|
||||
S:=StrAlloc(length(FileName)+1);
|
||||
StrPCopy(S, FileName);
|
||||
Result:=(DosDelete(S)=0);
|
||||
StrDispose(S);
|
||||
Result:=(DosDelete(PChar (FileName))=0);
|
||||
End;
|
||||
|
||||
function RenameFile (const OldName, NewName: string): boolean;
|
||||
Var
|
||||
S1, S2: PChar;
|
||||
Begin
|
||||
S1:=StrAlloc(length(OldName)+1);
|
||||
StrPCopy(S1, OldName);
|
||||
S2:=StrAlloc(length(NewName)+1);
|
||||
StrPCopy(S2, NewName);
|
||||
Result:=(DosMove(S1, S2)=0);
|
||||
StrDispose(S1);
|
||||
StrDispose(S2);
|
||||
Result:=(DosMove(PChar (OldName), PChar (NewName))=0);
|
||||
End;
|
||||
|
||||
{****************************************************************************
|
||||
@ -752,6 +726,7 @@ end;
|
||||
function SetCurrentDir (const NewDir: string): boolean;
|
||||
begin
|
||||
{$I-}
|
||||
{$WARNING Should be rewritten to avoid unit dos dependancy!}
|
||||
ChDir (NewDir);
|
||||
Result := (IOResult = 0);
|
||||
{$I+}
|
||||
@ -761,6 +736,7 @@ end;
|
||||
function CreateDir (const NewDir: string): boolean;
|
||||
begin
|
||||
{$I-}
|
||||
{$WARNING Should be rewritten to avoid unit dos dependancy!}
|
||||
MkDir (NewDir);
|
||||
Result := (IOResult = 0);
|
||||
{$I+}
|
||||
@ -770,6 +746,7 @@ end;
|
||||
function RemoveDir (const Dir: string): boolean;
|
||||
begin
|
||||
{$I-}
|
||||
{$WARNING Should be rewritten to avoid unit dos dependancy!}
|
||||
RmDir (Dir);
|
||||
Result := (IOResult = 0);
|
||||
{$I+}
|
||||
@ -977,7 +954,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.42 2004-02-15 21:36:10 hajny
|
||||
Revision 1.43 2004-02-22 15:01:49 hajny
|
||||
* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)
|
||||
|
||||
Revision 1.42 2004/02/15 21:36:10 hajny
|
||||
* overloaded ExecuteProcess added, EnvStr param changed to longint
|
||||
|
||||
Revision 1.41 2004/02/15 08:02:44 yuri
|
||||
|
||||
Loading…
Reference in New Issue
Block a user