paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 17:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...)

Browse Source
This commit is contained in:
Tomas Hajny 2004-02-22 15:01:49 +00:00
parent 4c96b2777e
commit 09fd537acf
5 changed files with 305 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
rtl/emx/dos.pas
View File

@ -94,9 +94,6 @@ Type
{OS/2 specific functions} {OS/2 specific functions}
function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
const comline:comstr):longint;
function GetEnvPChar (EnvVar: string): PChar; function GetEnvPChar (EnvVar: string): PChar;
@ -962,8 +959,7 @@ begin
end; end;
{$ASMMODE ATT} {$ASMMODE ATT}
function GetEnv (const EnvVar: string): string; function GetEnv (EnvVar: string): string;
(* The assembler version is more than three times as fast as Pascal. *)
begin begin
GetEnv := StrPas (GetEnvPChar (EnvVar)); GetEnv := StrPas (GetEnvPChar (EnvVar));
end; end;
@ -1201,6 +1197,16 @@ procedure SetIntVec (IntNo: byte; Vector: pointer);
begin begin
end; end;
function GetShortName(var p : String) : boolean;
begin
GetShortName:=true;
end;
function GetLongName(var p : String) : boolean;
begin
GetLongName:=true;
end;
begin begin
@ -1211,7 +1217,10 @@ begin
end. end.
{ {
$Log$ $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 * Enable threadvars again
Revision 1.11 2004/02/16 22:16:58 hajny Revision 1.11 2004/02/16 22:16:58 hajny

124
rtl/emx/sysutils.pp
View File

@ -82,7 +82,7 @@ type
FileAlloc:cardinal; {Amount of space the file really FileAlloc:cardinal; {Amount of space the file really
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} 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 The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -101,7 +101,7 @@ type
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} AttrFile:cardinal; {Attributes of file.}
cbList:longint; {Size of the file's extended attributes.} 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 The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -393,15 +393,19 @@ const
function FileOpen (const FileName: string; Mode: integer): longint; assembler; function FileOpen (const FileName: string; Mode: integer): longint; assembler;
asm asm
push ebx push ebx
mov eax, Mode {$IFDEF REGCALL}
(* DenyAll if sharing not specified. *) mov ecx, edx
test eax, 112 mov edx, eax
jnz @FOpen1 {$ELSE REGCALL}
or eax, 16 mov ecx, Mode
@FOpen1:
mov ecx, eax
mov eax, 7F2Bh
mov edx, FileName mov edx, FileName
{$ENDIF REGCALL}
(* DenyAll if sharing not specified. *)
test ecx, 112
jnz @FOpen1
or ecx, 16
@FOpen1:
mov eax, 7F2Bh
call syscall call syscall
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -410,9 +414,13 @@ end {['eax', 'ebx', 'ecx', 'edx']};
function FileCreate (const FileName: string): longint; assembler; function FileCreate (const FileName: string): longint; assembler;
asm asm
push ebx push ebx
{$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName
{$ENDIF REGCALL}
mov eax, 7F2Bh mov eax, 7F2Bh
mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *) mov ecx, ofReadWrite or faCreate or doDenyRW (* Sharing to DenyAll *)
mov edx, FileName
call syscall call syscall
pop ebx pop ebx
end {['eax', 'ebx', 'ecx', 'edx']}; end {['eax', 'ebx', 'ecx', 'edx']};
@ -428,10 +436,14 @@ function FileRead (Handle: longint; var Buffer; Count: longint): longint;
assembler; assembler;
asm asm
push ebx push ebx
mov eax, 3F00h {$IFDEF REGCALL}
mov ebx, eax
{$ELSE REGCALL}
mov ebx, Handle mov ebx, Handle
mov ecx, Count mov ecx, Count
mov edx, Buffer mov edx, Buffer
{$ENDIF REGCALL}
mov eax, 3F00h
call syscall call syscall
jnc @FReadEnd jnc @FReadEnd
mov eax, -1 mov eax, -1
@ -444,10 +456,14 @@ function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
assembler; assembler;
asm asm
push ebx push ebx
mov eax, 4000h {$IFDEF REGCALL}
mov ebx, eax
{$ELSE REGCALL}
mov ebx, Handle mov ebx, Handle
mov ecx, Count mov ecx, Count
mov edx, Buffer mov edx, Buffer
{$ENDIF REGCALL}
mov eax, 4000h
call syscall call syscall
jnc @FWriteEnd jnc @FWriteEnd
mov eax, -1 mov eax, -1
@ -459,10 +475,15 @@ end {['eax', 'ebx', 'ecx', 'edx']};
function FileSeek (Handle, FOffset, Origin: longint): longint; assembler; function FileSeek (Handle, FOffset, Origin: longint): longint; assembler;
asm asm
push ebx push ebx
mov eax, Origin {$IFDEF REGCALL}
mov ah, 42h mov ebx, eax
mov eax, ecx
{$ELSE REGCALL}
mov ebx, Handle mov ebx, Handle
mov eax, Origin
mov edx, FOffset mov edx, FOffset
{$ENDIF REGCALL}
mov ah, 42h
call syscall call syscall
jnc @FSeekEnd jnc @FSeekEnd
mov eax, -1 mov eax, -1
@ -492,13 +513,18 @@ end;
function FileTruncate (Handle, Size: longint): boolean; assembler; function FileTruncate (Handle, Size: longint): boolean; assembler;
asm asm
push ebx push ebx
mov eax, 7F25h {$IFDEF REGCALL}
mov ebx, eax
{$ELSE REGCALL}
mov ebx, Handle mov ebx, Handle
mov edx, Size mov edx, Size
{$ENDIF REGCALL}
mov eax, 7F25h
push ebx
call syscall call syscall
pop ebx
jc @FTruncEnd jc @FTruncEnd
mov eax, 4202h mov eax, 4202h
mov ebx, Handle
mov edx, 0 mov edx, 0
call syscall call syscall
mov eax, 0 mov eax, 0
@ -525,8 +551,12 @@ end;
function FileExists (const FileName: string): boolean; assembler; function FileExists (const FileName: string): boolean; assembler;
asm asm
mov ax, 4300h {$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName mov edx, FileName
{$ENDIF REGCALL}
mov ax, 4300h
call syscall call syscall
mov eax, 0 mov eax, 0
jc @FExistsEnd jc @FExistsEnd
@ -551,7 +581,7 @@ var SR: PSearchRec;
begin begin
if os_mode = osOS2 then if os_mode = osOS2 then
begin begin
New (FStat); New (FStat);
Rslt.FindHandle := $FFFFFFFF; Rslt.FindHandle := $FFFFFFFF;
Count := 1; Count := 1;
@ -600,7 +630,7 @@ var SR: PSearchRec;
begin begin
if os_mode = osOS2 then if os_mode = osOS2 then
begin begin
New (FStat); New (FStat);
Count := 1; Count := 1;
Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^),
@ -660,8 +690,12 @@ end;
function FileGetDate (Handle: longint): longint; assembler; function FileGetDate (Handle: longint): longint; assembler;
asm asm
push ebx push ebx
mov ax, 5700h {$IFDEF REGCALL}
mov ebx, eax
{$ELSE REGCALL}
mov ebx, Handle mov ebx, Handle
{$ENDIF REGCALL}
mov ax, 5700h
call syscall call syscall
mov eax, -1 mov eax, -1
jc @FGetDateEnd jc @FGetDateEnd
@ -717,8 +751,12 @@ end;
function FileGetAttr (const FileName: string): longint; assembler; function FileGetAttr (const FileName: string): longint; assembler;
asm asm
mov ax, 4300h {$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName mov edx, FileName
{$ENDIF REGCALL}
mov ax, 4300h
call syscall call syscall
jnc @FGetAttrEnd jnc @FGetAttrEnd
mov eax, -1 mov eax, -1
@ -728,9 +766,14 @@ end {['eax', 'edx']};
function FileSetAttr (const Filename: string; Attr: longint): longint; assembler; function FileSetAttr (const Filename: string; Attr: longint): longint; assembler;
asm asm
mov ax, 4301h {$IFDEF REGCALL}
mov ecx, edx
mov edx, eax
{$ELSE REGCALL}
mov ecx, Attr mov ecx, Attr
mov edx, FileName mov edx, FileName
{$ENDIF REGCALL}
mov ax, 4301h
call syscall call syscall
mov eax, 0 mov eax, 0
jnc @FSetAttrEnd jnc @FSetAttrEnd
@ -741,8 +784,12 @@ end {['eax', 'ecx', 'edx']};
function DeleteFile (const FileName: string): boolean; assembler; function DeleteFile (const FileName: string): boolean; assembler;
asm asm
mov ax, 4100h {$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, FileName mov edx, FileName
{$ENDIF REGCALL}
mov ax, 4100h
call syscall call syscall
mov eax, 0 mov eax, 0
jc @FDeleteEnd jc @FDeleteEnd
@ -754,9 +801,14 @@ end {['eax', 'edx']};
function RenameFile (const OldName, NewName: string): boolean; assembler; function RenameFile (const OldName, NewName: string): boolean; assembler;
asm asm
push edi push edi
mov ax, 5600h {$IFDEF REGCALL}
mov edx, eax
mov edi, edx
{$ELSE REGCALL}
mov edx, OldName mov edx, OldName
mov edi, NewName mov edi, NewName
{$ENDIF REGCALL}
mov ax, 5600h
call syscall call syscall
mov eax, 0 mov eax, 0
jc @FRenameEnd jc @FRenameEnd
@ -810,7 +862,7 @@ begin
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector) int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
else else
DiskFree := -1; DiskFree := -1;
end; end;
end; end;
function DiskSize (Drive: byte): int64; function DiskSize (Drive: byte): int64;
@ -852,7 +904,7 @@ begin
int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector) int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
else else
DiskSize := -1; DiskSize := -1;
end; end;
end; end;
@ -892,8 +944,12 @@ end;
{$ASMMODE INTEL} {$ASMMODE INTEL}
function DirectoryExists (const Directory: string): boolean; assembler; function DirectoryExists (const Directory: string): boolean; assembler;
asm asm
mov ax, 4300h {$IFDEF REGCALL}
mov edx, eax
{$ELSE REGCALL}
mov edx, Directory mov edx, Directory
{$ENDIF REGCALL}
mov ax, 4300h
call syscall call syscall
mov eax, 0 mov eax, 0
jc @FExistsEnd jc @FExistsEnd
@ -912,9 +968,16 @@ procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
asm asm
(* Expects the default record alignment (word)!!! *) (* Expects the default record alignment (word)!!! *)
push edi push edi
{$IFDEF REGCALL}
push eax
{$ENDIF REGCALL}
mov ah, 2Ah mov ah, 2Ah
call syscall call syscall
{$IFDEF REGCALL}
pop eax
{$ELSE REGCALL}
mov edi, SystemTime mov edi, SystemTime
{$ENDIF REGCALL}
mov ax, cx mov ax, cx
stosw stosw
xor eax, eax xor eax, eax
@ -1144,7 +1207,10 @@ end.
{ {
$Log$ $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 * overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.14 2004/01/20 23:05:31 hajny Revision 1.14 2004/01/20 23:05:31 hajny

8
rtl/os2/dos.pas
View File

@ -669,12 +669,13 @@ end;
function GetShortName(var p : String) : boolean; function GetShortName(var p : String) : boolean;
begin begin
GetShortName:=true; GetShortName:=true;
{$WARNING EA .shortname support (see FAT32 driver) should be probably added here!}
end; end;
function GetLongName(var p : String) : boolean; function GetLongName(var p : String) : boolean;
begin begin
GetLongName:=true; GetLongName:=true;
{$WARNING EA .longname support should be probably added here} {$WARNING EA .longname support should be probably added here!}
end; end;
@ -684,7 +685,10 @@ begin
end. end.
{ {
$Log$ $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 * Enable threadvars again
Revision 1.37 2004/02/16 22:16:59 hajny Revision 1.37 2004/02/16 22:16:59 hajny

57
rtl/os2/system.pas
View File

@ -187,31 +187,31 @@ procedure DosExit(Action, Result: cardinal); cdecl;
external 'DOSCALLS' index 234; external 'DOSCALLS' index 234;
// EAs not used in System unit // 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; InitSize,Attrib,OpenFlags,FileMode:cardinal;
EA:Pointer):longint; cdecl; EA:Pointer): cardinal; cdecl;
external 'DOSCALLS' index 273; external 'DOSCALLS' index 273;
function DosClose(Handle:longint): longint; cdecl; function DosClose(Handle: THandle): cardinal; cdecl;
external 'DOSCALLS' index 257; external 'DOSCALLS' index 257;
function DosRead(Handle:longint; Buffer: Pointer;Count:longint; function DosRead(Handle: THandle; Buffer: Pointer; Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 281; external 'DOSCALLS' index 281;
function DosWrite(Handle:longint; Buffer: Pointer;Count:longint; function DosWrite(Handle: THandle; Buffer: Pointer;Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 282; external 'DOSCALLS' index 282;
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal; function DosSetFilePtr(Handle: THandle; Pos:longint; Method:cardinal;
var PosActual:longint):longint; cdecl; var PosActual: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 256; external 'DOSCALLS' index 256;
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl; function DosSetFileSize(Handle: THandle; Size: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 272; external 'DOSCALLS' index 272;
function DosQueryHType(Handle:longint;var HandType:longint; function DosQueryHType(Handle: THandle; var HandType: cardinal;
var Attr:longint):longint; cdecl; var Attr: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 224; external 'DOSCALLS' index 224;
type type
@ -227,7 +227,7 @@ type
WeekDay: byte; WeekDay: byte;
end; end;
function DosGetDateTime(var Buf:TSysDateTime):longint; cdecl; function DosGetDateTime(var Buf:TSysDateTime): cardinal; cdecl;
external 'DOSCALLS' index 230; external 'DOSCALLS' index 230;
{ converts an OS/2 error code to a TP compatible error } { converts an OS/2 error code to a TP compatible error }
@ -480,10 +480,10 @@ end;
versions of OS/2. versions of OS/2.
Flags = One or more of the mfXXXX constants.} 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; 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; external 'DOSCALLS' index 305;
var var
@ -584,13 +584,13 @@ end;
function do_read(h,addr,len:longint):longint; function do_read(h,addr,len:longint):longint;
Var Var
T: Longint; T: cardinal;
begin begin
{$ifdef IODEBUG} {$ifdef IODEBUG}
write('do_read: handle=', h, ', addr=', addr, ', length=', len); write('do_read: handle=', h, ', addr=', addr, ', length=', len);
{$endif} {$endif}
InOutRes:=DosRead(H, Pointer(Addr), Len, T); InOutRes:=DosRead(H, Pointer(Addr), Len, T);
do_read:=T; do_read:= longint (T);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln(', actual_len=', t, ', InOutRes=', InOutRes); writeln(', actual_len=', t, ', InOutRes=', InOutRes);
{$endif} {$endif}
@ -598,13 +598,13 @@ end;
function do_write(h,addr,len:longint) : longint; function do_write(h,addr,len:longint) : longint;
Var Var
T: Longint; T: cardinal;
begin begin
{$ifdef IODEBUG} {$ifdef IODEBUG}
write('do_write: handle=', h, ', addr=', addr, ', length=', len); write('do_write: handle=', h, ', addr=', addr, ', length=', len);
{$endif} {$endif}
InOutRes:=DosWrite(H, Pointer(Addr), Len, T); InOutRes:=DosWrite(H, Pointer(Addr), Len, T);
do_write:=T; do_write:= longint (T);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln(', actual_len=', t, ', InOutRes=', InOutRes); writeln(', actual_len=', t, ', InOutRes=', InOutRes);
{$endif} {$endif}
@ -612,10 +612,10 @@ end;
function do_filepos(handle:longint): longint; function do_filepos(handle:longint): longint;
var var
PosActual: Longint; PosActual: cardinal;
begin begin
InOutRes:=DosSetFilePtr(Handle, 0, 1, PosActual); InOutRes:=DosSetFilePtr(Handle, 0, 1, PosActual);
do_filepos:=PosActual; do_filepos:=longint (PosActual);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes); writeln('do_filepos: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
{$endif} {$endif}
@ -623,7 +623,7 @@ end;
procedure do_seek(handle,pos:longint); procedure do_seek(handle,pos:longint);
var var
PosActual: Longint; PosActual: cardinal;
begin begin
InOutRes:=DosSetFilePtr(Handle, Pos, 0 {ZeroBased}, PosActual); InOutRes:=DosSetFilePtr(Handle, Pos, 0 {ZeroBased}, PosActual);
{$ifdef IODEBUG} {$ifdef IODEBUG}
@ -633,17 +633,17 @@ end;
function do_seekend(handle:longint):longint; function do_seekend(handle:longint):longint;
var var
PosActual: Longint; PosActual: cardinal;
begin begin
InOutRes:=DosSetFilePtr(Handle, 0, 2 {EndBased}, PosActual); InOutRes:=DosSetFilePtr(Handle, 0, 2 {EndBased}, PosActual);
do_seekend:=PosActual; do_seekend:=longint (PosActual);
{$ifdef IODEBUG} {$ifdef IODEBUG}
writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes); writeln('do_seekend: handle=', Handle, ', actual_pos=', PosActual, ', InOutRes=', InOutRes);
{$endif} {$endif}
end; end;
function do_filesize(handle:longint):longint; function do_filesize(handle:longint):longint;
var aktfilepos:longint; var aktfilepos: cardinal;
begin begin
aktfilepos:=do_filepos(handle); aktfilepos:=do_filepos(handle);
do_filesize:=do_seekend(handle); do_filesize:=do_seekend(handle);
@ -778,7 +778,7 @@ end;
function do_isdevice (Handle: longint): boolean; function do_isdevice (Handle: longint): boolean;
var var
HT, Attr: longint; HT, Attr: cardinal;
begin begin
do_isdevice:=false; do_isdevice:=false;
If DosQueryHType(Handle, HT, Attr)<>0 then exit; 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. end.
{ {
$Log$ $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 * LastDosExitCode changed back from threadvar temporarily
Revision 1.65 2004/02/02 03:24:09 yuri Revision 1.65 2004/02/02 03:24:09 yuri

124
rtl/os2/sysutils.pp
View File

@ -82,7 +82,7 @@ type
FileAlloc:cardinal; {Amount of space the file really FileAlloc:cardinal; {Amount of space the file really
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} 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 The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -101,7 +101,7 @@ type
occupies on disk.} occupies on disk.}
AttrFile:cardinal; {Attributes of file.} AttrFile:cardinal; {Attributes of file.}
cbList:longint; {Size of the file's extended attributes.} 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 The byte following the last string
character is always zero.} character is always zero.}
end; end;
@ -316,29 +316,29 @@ const
the size and placement.} 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; FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo; function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278; 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; AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 279; external 'DOSCALLS' index 279;
function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl; function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
external 'DOSCALLS' index 227; 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; AFileStatus: PFileStatus; FileStatusLen: cardinal;
var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl; var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 264; external 'DOSCALLS' index 264;
function DosFindNext (Handle: longint; AFileStatus: PFileStatus; function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl; FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 265; external 'DOSCALLS' index 265;
function DosFindClose (Handle: longint): cardinal; cdecl; function DosFindClose (Handle: THandle): cardinal; cdecl;
external 'DOSCALLS' index 263; external 'DOSCALLS' index 263;
function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode; 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; function DosMapCase (Size: cardinal; var Country: TCountryCode;
AString: PChar): cardinal; cdecl; external 'NLS' index 7; AString: PChar): cardinal; cdecl; external 'NLS' index 7;
function DosDelete(FileName:PChar): Longint; cdecl; function DosDelete(FileName:PChar): cardinal; cdecl;
external 'DOSCALLS' index 259; external 'DOSCALLS' index 259;
function DosMove(OldFile, NewFile:PChar): Longint; cdecl; function DosMove(OldFile, NewFile:PChar): cardinal; cdecl;
external 'DOSCALLS' index 271; external 'DOSCALLS' index 271;
function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal; function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
AFileStatus:PFileStatus;FileStatusLen:cardinal): Longint; cdecl; AFileStatus:PFileStatus;FileStatusLen:cardinal): cardinal; cdecl;
external 'DOSCALLS' index 223; external 'DOSCALLS' index 223;
function DosSetPathInfo(FileName:PChar;InfoLevel:longint; function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
AFileStatus:PFileStatus;FileStatusLen, AFileStatus:PFileStatus;FileStatusLen,
Options:longint):longint; cdecl; Options:cardinal):cardinal; cdecl;
external 'DOSCALLS' index 219; 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; InitSize,Attrib,OpenFlags,FileMode:cardinal;
EA:Pointer):longint; cdecl; EA:Pointer):cardinal; cdecl;
external 'DOSCALLS' index 273; external 'DOSCALLS' index 273;
function DosClose(Handle:longint): longint; cdecl; function DosClose(Handle: THandle): cardinal; cdecl;
external 'DOSCALLS' index 257; external 'DOSCALLS' index 257;
function DosRead(Handle:longint; var Buffer; Count:longint; function DosRead(Handle:THandle; var Buffer; Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 281; external 'DOSCALLS' index 281;
function DosWrite(Handle:longint; Buffer: pointer; Count:longint; function DosWrite(Handle: THandle; Buffer: pointer; Count: cardinal;
var ActCount:longint):longint; cdecl; var ActCount: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 282; external 'DOSCALLS' index 282;
function DosSetFilePtr(Handle:longint;Pos:longint;Method:cardinal; function DosSetFilePtr(Handle: THandle; Pos: longint; Method: cardinal;
var PosActual:longint):longint; cdecl; var PosActual: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 256; external 'DOSCALLS' index 256;
function DosSetFileSize(Handle:longint;Size:cardinal):longint; cdecl; function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl;
external 'DOSCALLS' index 272; external 'DOSCALLS' index 272;
procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229; procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
@ -421,7 +421,7 @@ type
WeekDay: byte; WeekDay: byte;
end; end;
function DosGetDateTime(var Buf: TDT):longint; cdecl; function DosGetDateTime(var Buf: TDT): cardinal; cdecl;
external 'DOSCALLS' index 230; external 'DOSCALLS' index 230;
@ -443,15 +443,12 @@ const
function FileOpen (const FileName: string; Mode: integer): longint; function FileOpen (const FileName: string; Mode: integer): longint;
Var Var
Rc, Action, Handle: Longint; Handle: THandle;
P: PChar; Rc, Action: cardinal;
begin begin
P:=StrAlloc(length(FileName)+1);
StrPCopy(P, FileName);
(* DenyNone if sharing not specified. *) (* DenyNone if sharing not specified. *)
if Mode and 112 = 0 then Mode:=Mode or 64; if Mode and 112 = 0 then Mode:=Mode or 64;
Rc:=DosOpen(P, Handle, Action, 0, 0, 1, Mode, nil); Rc:=DosOpen(PChar (FileName), Handle, Action, 0, 0, 1, Mode, nil);
StrDispose(P);
If Rc=0 then If Rc=0 then
FileOpen:=Handle FileOpen:=Handle
else else
@ -462,13 +459,10 @@ function FileCreate (const FileName: string): longint;
Const Const
Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *) Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *)
Var Var
RC, Action, Handle: Longint; Handle: THandle;
P: PChar; RC, Action: cardinal;
Begin Begin
P:=StrAlloc(length(FileName)+1); RC:=DosOpen(PChar (FileName), Handle, Action, 0, 0, $12, Mode, Nil);
StrPCopy(P, FileName);
RC:=DosOpen(P, Handle, Action, 0, 0, $12, Mode, Nil);
StrDispose(P);
If RC=0 then If RC=0 then
FileCreate:=Handle FileCreate:=Handle
else else
@ -483,26 +477,26 @@ end;
function FileRead (Handle: longint; var Buffer; Count: longint): longint; function FileRead (Handle: longint; var Buffer; Count: longint): longint;
Var Var
T: Longint; T: cardinal;
begin begin
DosRead(Handle, Buffer, Count, T); DosRead(Handle, Buffer, Count, T);
FileRead:=T; FileRead := longint (T);
end; end;
function FileWrite (Handle: longint; const Buffer; Count: longint): longint; function FileWrite (Handle: longint; const Buffer; Count: longint): longint;
Var Var
T: Longint; T: cardinal;
begin begin
DosWrite (Handle, @Buffer, Count, T); DosWrite (Handle, @Buffer, Count, T);
FileWrite:=T; FileWrite := longint (T);
end; end;
function FileSeek (Handle, FOffset, Origin: longint): longint; function FileSeek (Handle, FOffset, Origin: longint): longint;
var var
npos: longint; npos: cardinal;
begin begin
if DosSetFilePtr(Handle, FOffset, Origin, npos)=0 Then if DosSetFilePtr (Handle, FOffset, Origin, npos) = 0 Then
FileSeek:=npos FileSeek:= longint (npos)
else else
FileSeek:=-1; FileSeek:=-1;
end; end;
@ -541,9 +535,10 @@ end;
function FileExists (const FileName: string): boolean; function FileExists (const FileName: string): boolean;
var var
SR: TSearchRec; SR: TSearchRec;
RC: longint;
begin begin
FileExists:=False; FileExists:=False;
if FindFirst(FileName, faAnyFile, SR)=0 then FileExists:=True; if FindFirst (FileName, faAnyFile, SR)=0 then FileExists:=True;
FindClose(SR); FindClose(SR);
end; end;
@ -558,14 +553,14 @@ var SR: PSearchRec;
FStat: PFileFindBuf3; FStat: PFileFindBuf3;
Count: cardinal; Count: cardinal;
Err: cardinal; Err: cardinal;
I: cardinal;
begin begin
New (FStat); New (FStat);
Rslt.FindHandle := $FFFFFFFF; Rslt.FindHandle := $FFFFFFFF;
Count := 1; Count := 1;
Err := DosFindFirst (PChar (Path), Rslt.FindHandle, Err := DosFindFirst (PChar (Path), Rslt.FindHandle,
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
ilStandard);
if (Err = 0) and (Count = 0) then Err := 18; if (Err = 0) and (Count = 0) then Err := 18;
FindFirst := -Err; FindFirst := -Err;
if Err = 0 then if Err = 0 then
@ -658,13 +653,9 @@ end;
function FileGetAttr (const FileName: string): longint; function FileGetAttr (const FileName: string): longint;
var var
FS: PFileStatus3; FS: PFileStatus3;
S: PChar;
begin begin
New(FS); New(FS);
S:=StrAlloc(length(FileName)+1); Result:=-DosQueryPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^));
StrPCopy(S, FileName);
Result:=-DosQueryPathInfo(S, ilStandard, FS, SizeOf(FS^));
StrDispose(S);
If Result=0 Then Result:=FS^.attrFile; If Result=0 Then Result:=FS^.attrFile;
Dispose(FS); Dispose(FS);
end; end;
@ -672,40 +663,23 @@ end;
function FileSetAttr (const Filename: string; Attr: longint): longint; function FileSetAttr (const Filename: string; Attr: longint): longint;
Var Var
FS: PFileStatus3; FS: PFileStatus3;
S: PChar;
Begin Begin
New(FS); New(FS);
FillChar(FS, SizeOf(FS^), 0); FillChar(FS, SizeOf(FS^), 0);
FS^.attrFile:=Attr; FS^.AttrFile:=Attr;
S:=StrAlloc(length(FileName)+1); Result:=-DosSetPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^), 0);
StrPCopy(S, FileName);
Result:=-DosSetPathInfo(S, ilStandard, FS, SizeOf(FS^), 0);
StrDispose(S);
Dispose(FS); Dispose(FS);
end; end;
function DeleteFile (const FileName: string): boolean; function DeleteFile (const FileName: string): boolean;
Var
S: PChar;
Begin Begin
S:=StrAlloc(length(FileName)+1); Result:=(DosDelete(PChar (FileName))=0);
StrPCopy(S, FileName);
Result:=(DosDelete(S)=0);
StrDispose(S);
End; End;
function RenameFile (const OldName, NewName: string): boolean; function RenameFile (const OldName, NewName: string): boolean;
Var
S1, S2: PChar;
Begin Begin
S1:=StrAlloc(length(OldName)+1); Result:=(DosMove(PChar (OldName), PChar (NewName))=0);
StrPCopy(S1, OldName);
S2:=StrAlloc(length(NewName)+1);
StrPCopy(S2, NewName);
Result:=(DosMove(S1, S2)=0);
StrDispose(S1);
StrDispose(S2);
End; End;
{**************************************************************************** {****************************************************************************
@ -752,6 +726,7 @@ end;
function SetCurrentDir (const NewDir: string): boolean; function SetCurrentDir (const NewDir: string): boolean;
begin begin
{$I-} {$I-}
{$WARNING Should be rewritten to avoid unit dos dependancy!}
ChDir (NewDir); ChDir (NewDir);
Result := (IOResult = 0); Result := (IOResult = 0);
{$I+} {$I+}
@ -761,6 +736,7 @@ end;
function CreateDir (const NewDir: string): boolean; function CreateDir (const NewDir: string): boolean;
begin begin
{$I-} {$I-}
{$WARNING Should be rewritten to avoid unit dos dependancy!}
MkDir (NewDir); MkDir (NewDir);
Result := (IOResult = 0); Result := (IOResult = 0);
{$I+} {$I+}
@ -770,6 +746,7 @@ end;
function RemoveDir (const Dir: string): boolean; function RemoveDir (const Dir: string): boolean;
begin begin
{$I-} {$I-}
{$WARNING Should be rewritten to avoid unit dos dependancy!}
RmDir (Dir); RmDir (Dir);
Result := (IOResult = 0); Result := (IOResult = 0);
{$I+} {$I+}
@ -977,7 +954,10 @@ end.
{ {
$Log$ $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 * overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.41 2004/02/15 08:02:44 yuri Revision 1.41 2004/02/15 08:02:44 yuri