mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-29 21:20:24 +02:00
- rm unported code from go32v2, generate runtime 304 if an unimplemented function is called
git-svn-id: branches/i8086@24094 -
This commit is contained in:
nickysn
parent
3d6dbfe1f7
commit
96fd997a97
595
rtl/msdos/dos.pp
595
rtl/msdos/dos.pp
@ -192,258 +192,9 @@ const
|
||||
DOS_MAX_COMMAND_LINE_LENGTH = 126;
|
||||
|
||||
procedure exec_ansistring(path : string;comline : ansistring);
|
||||
type
|
||||
realptr = packed record
|
||||
ofs,seg : word;
|
||||
end;
|
||||
texecblock = packed record
|
||||
envseg : word;
|
||||
comtail : realptr;
|
||||
firstFCB : realptr;
|
||||
secondFCB : realptr;
|
||||
{ iniStack : realptr;
|
||||
iniCSIP : realptr;}
|
||||
end;
|
||||
var
|
||||
current_dos_buffer_pos,
|
||||
arg_ofs,
|
||||
i,la_env,
|
||||
la_p,la_c,la_e,
|
||||
fcb1_la,fcb2_la : longint;
|
||||
use_proxy : boolean;
|
||||
proxy_argc : longint;
|
||||
execblock : texecblock;
|
||||
c : ansistring;
|
||||
p : string;
|
||||
|
||||
function paste_to_dos(src : string;add_cr_at_end, include_string_length : boolean) : boolean;
|
||||
{Changed by Laaca - added parameter N}
|
||||
var
|
||||
c : pchar;
|
||||
CLen : cardinal;
|
||||
start_pos,ls : longint;
|
||||
begin
|
||||
paste_to_dos:=false;
|
||||
if include_string_length then
|
||||
start_pos:=0
|
||||
else
|
||||
start_pos:=1;
|
||||
ls:=Length(src)-start_pos;
|
||||
if current_dos_buffer_pos+ls+3>transfer_buffer+tb_size then
|
||||
RunError(217);
|
||||
getmem(c,ls+3);
|
||||
move(src[start_pos],c^,ls+1);
|
||||
if add_cr_at_end then
|
||||
begin
|
||||
c[ls+1]:=#13;
|
||||
c[ls+2]:=#0;
|
||||
end
|
||||
else
|
||||
c[ls+1]:=#0;
|
||||
CLen := StrLen (C) + 1;
|
||||
seg_move(get_ds,longint(c),dosmemselector,current_dos_buffer_pos,CLen);
|
||||
current_dos_buffer_pos:=current_dos_buffer_pos+CLen;
|
||||
freemem(c,ls+3);
|
||||
paste_to_dos:=true;
|
||||
end;
|
||||
|
||||
procedure setup_proxy_cmdline;
|
||||
const
|
||||
MAX_ARGS = 128;
|
||||
var
|
||||
i : longint;
|
||||
quote : char;
|
||||
end_of_arg, skip_char : boolean;
|
||||
la_proxy_seg : word;
|
||||
la_proxy_ofs : longint;
|
||||
current_arg : string;
|
||||
la_argv_ofs : array [0..MAX_ARGS] of word;
|
||||
begin
|
||||
quote:=#0;
|
||||
current_arg:='';
|
||||
proxy_argc:=0;
|
||||
end_of_arg:=false;
|
||||
while current_dos_buffer_pos mod 16 <> 0 do
|
||||
inc(current_dos_buffer_pos);
|
||||
la_proxy_seg:=current_dos_buffer_pos shr 4;
|
||||
{ Also copy parameter 0 }
|
||||
la_argv_ofs[0]:=current_dos_buffer_pos-la_proxy_seg*16;
|
||||
{ Note that this should be done before
|
||||
alteriing p value }
|
||||
paste_to_dos(p,false,false);
|
||||
inc(proxy_argc);
|
||||
for i:=1 to length(c) do
|
||||
begin
|
||||
skip_char:=false;
|
||||
case c[i] of
|
||||
#1..#32:
|
||||
begin
|
||||
if quote=#0 then
|
||||
end_of_arg:=true;
|
||||
end;
|
||||
'"' :
|
||||
begin
|
||||
if quote=#0 then
|
||||
begin
|
||||
quote:='"';
|
||||
skip_char:=true;
|
||||
end
|
||||
else if quote='"' then
|
||||
end_of_arg:=true;
|
||||
end;
|
||||
'''' :
|
||||
begin
|
||||
if quote=#0 then
|
||||
begin
|
||||
quote:='''';
|
||||
skip_char:=true;
|
||||
end
|
||||
else if quote='''' then
|
||||
end_of_arg:=true;
|
||||
end;
|
||||
end;
|
||||
if not end_of_arg and not skip_char then
|
||||
current_arg:=current_arg+c[i];
|
||||
if i=length(c) then
|
||||
end_of_arg:=true;
|
||||
if end_of_arg then
|
||||
begin
|
||||
{ Allow empty args using "" or '' }
|
||||
if (current_arg<>'') or (quote<>#0) then
|
||||
begin
|
||||
if proxy_argc>MAX_ARGS then
|
||||
begin
|
||||
writeln(stderr,'Too many arguments in Dos.exec');
|
||||
RunError(217);
|
||||
end;
|
||||
la_argv_ofs[proxy_argc]:=current_dos_buffer_pos-la_proxy_seg*16;
|
||||
{$ifdef DEBUG_PROXY}
|
||||
writeln(stderr,'arg ',proxy_argc,'="',current_arg,'"');
|
||||
{$endif DEBUG_PROXY}
|
||||
paste_to_dos(current_arg,false,false);
|
||||
inc(proxy_argc);
|
||||
quote:=#0;
|
||||
current_arg:='';
|
||||
end;
|
||||
{ Always reset end_of_arg boolean }
|
||||
end_of_arg:=false;
|
||||
end;
|
||||
end;
|
||||
la_proxy_ofs:=current_dos_buffer_pos - la_proxy_seg*16;
|
||||
seg_move(get_ds,longint(@la_argv_ofs),dosmemselector,
|
||||
current_dos_buffer_pos,proxy_argc*sizeof(word));
|
||||
current_dos_buffer_pos:=current_dos_buffer_pos + proxy_argc*sizeof(word);
|
||||
c:='!proxy '+hexstr(proxy_argc,4)+' '+hexstr(la_proxy_seg,4)
|
||||
+' '+hexstr(la_proxy_ofs,4);
|
||||
{$ifdef DEBUG_PROXY}
|
||||
writeln(stderr,'Using comline "',c,'"');
|
||||
{$endif DEBUG_PROXY}
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
{ create command line }
|
||||
c:=comline;
|
||||
use_proxy:=false;
|
||||
if force_go32v2_proxy then
|
||||
Use_proxy:=true
|
||||
else if length(c)>DOS_MAX_COMMAND_LINE_LENGTH then
|
||||
begin
|
||||
if Use_go32v2_proxy then
|
||||
begin
|
||||
Use_Proxy:=true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
writeln(stderr,'Dos.exec command line truncated to ',
|
||||
DOS_MAX_COMMAND_LINE_LENGTH,' chars');
|
||||
writeln(stderr,'Before: "',c,'"');
|
||||
setlength(c, DOS_MAX_COMMAND_LINE_LENGTH);
|
||||
writeln(stderr,'After: "',c,'"');
|
||||
end;
|
||||
end;
|
||||
{ create path }
|
||||
{$ifdef DEBUG_PROXY}
|
||||
writeln(stderr,'Dos.exec path="',path,'"');
|
||||
{$endif DEBUG_PROXY}
|
||||
p:=path;
|
||||
{ create buffer }
|
||||
la_env:=transfer_buffer;
|
||||
while (la_env and 15)<>0 do
|
||||
inc(la_env);
|
||||
current_dos_buffer_pos:=la_env;
|
||||
{ copy environment }
|
||||
for i:=1 to envcount do
|
||||
paste_to_dos(envstr(i),false,false);
|
||||
{the behaviour is still suboptimal because variable COMMAND is stripped out}
|
||||
paste_to_dos(chr(0),false,false); { adds a double zero at the end }
|
||||
if use_proxy then
|
||||
setup_proxy_cmdline;
|
||||
{ allow slash as backslash }
|
||||
DoDirSeparators(p);
|
||||
if LFNSupport then
|
||||
GetShortName(p);
|
||||
{ Add program to DosBuffer with
|
||||
length at start }
|
||||
la_p:=current_dos_buffer_pos;
|
||||
paste_to_dos(p,false,true);
|
||||
{ Add command line args to DosBuffer with
|
||||
length at start and Carriage Return at end }
|
||||
la_c:=current_dos_buffer_pos;
|
||||
paste_to_dos(c,true,true);
|
||||
|
||||
la_e:=current_dos_buffer_pos;
|
||||
fcb1_la:=la_e;
|
||||
la_e:=la_e+16;
|
||||
fcb2_la:=la_e;
|
||||
la_e:=la_e+16;
|
||||
{ allocate FCB see dosexec code }
|
||||
arg_ofs:=1;
|
||||
while (c[arg_ofs] in [' ',#9]) and
|
||||
(arg_ofs<length(c)) do
|
||||
inc(arg_ofs);
|
||||
dosregs.ax:=$2901;
|
||||
dosregs.ds:=(la_c+arg_ofs) shr 4;
|
||||
dosregs.esi:=(la_c+arg_ofs) and 15;
|
||||
dosregs.es:=fcb1_la shr 4;
|
||||
dosregs.edi:=fcb1_la and 15;
|
||||
msdos(dosregs);
|
||||
{ allocate second FCB see dosexec code }
|
||||
dosregs.ax:=$2901;
|
||||
dosregs.ds:=(la_c+arg_ofs) shr 4;
|
||||
dosregs.esi:=(la_c+arg_ofs) and 15;
|
||||
dosregs.es:=fcb2_la shr 4;
|
||||
dosregs.edi:=fcb2_la and 15;
|
||||
{$ifdef DEBUG_PROXY}
|
||||
flush(stderr);
|
||||
{$endif DEBUG_PROXY}
|
||||
msdos(dosregs);
|
||||
with execblock do
|
||||
begin
|
||||
envseg:=la_env shr 4;
|
||||
comtail.seg:=la_c shr 4;
|
||||
comtail.ofs:=la_c and 15;
|
||||
firstFCB.seg:=fcb1_la shr 4;
|
||||
firstFCB.ofs:=fcb1_la and 15;
|
||||
secondFCB.seg:=fcb2_la shr 4;
|
||||
secondFCB.ofs:=fcb2_la and 15;
|
||||
end;
|
||||
seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
|
||||
dosregs.edx:=la_p and 15+1;
|
||||
dosregs.ds:=la_p shr 4;
|
||||
dosregs.ebx:=la_p and 15+la_e-la_p;
|
||||
dosregs.es:=la_p shr 4;
|
||||
dosregs.ax:=$4b00;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
if DosError=0 then
|
||||
begin
|
||||
dosregs.ax:=$4d00;
|
||||
msdos(dosregs);
|
||||
LastDosExitCode:=DosRegs.al
|
||||
end
|
||||
else
|
||||
LastDosExitCode:=0;
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
procedure exec(const path : pathstr;const comline : comstr);
|
||||
@ -536,157 +287,9 @@ type
|
||||
|
||||
|
||||
function do_diskdata(drive : byte; Free : boolean) : Int64;
|
||||
var
|
||||
blocksize, freeblocks, totblocks : longword;
|
||||
|
||||
{ Get disk data via old int21/36 (GET FREE DISK SPACE). It's always supported
|
||||
even if it returns wrong values for volumes > 2GB and for cdrom drives when
|
||||
in pure DOS. Note that it's also the only way to get some data on WinNTs. }
|
||||
function DiskData_36 : boolean;
|
||||
begin
|
||||
DiskData_36:=false;
|
||||
dosregs.dl:=drive;
|
||||
dosregs.ah:=$36;
|
||||
msdos(dosregs);
|
||||
if dosregs.ax=$FFFF then exit;
|
||||
|
||||
blocksize:=dosregs.ax*dosregs.cx;
|
||||
freeblocks:=dosregs.bx;
|
||||
totblocks:=dosregs.dx;
|
||||
Diskdata_36:=true;
|
||||
end;
|
||||
|
||||
{ Get disk data via int21/7303 (FAT32 - GET EXTENDED FREE SPACE ON DRIVE).
|
||||
It is supported by win9x even in pure DOS }
|
||||
function DiskData_7303 : boolean;
|
||||
var
|
||||
s : shortstring;
|
||||
rec : ExtendedFat32FreeSpaceRec;
|
||||
begin
|
||||
DiskData_7303:=false;
|
||||
s:=chr(drive+$40)+':\'+#0;
|
||||
|
||||
rec.Strucversion:=0;
|
||||
rec.RetSize := 0;
|
||||
dosmemput(tb_segment,tb_offset,Rec,sizeof(ExtendedFat32FreeSpaceRec));
|
||||
dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,s[1],4);
|
||||
dosregs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.di:=tb_offset;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
|
||||
dosregs.ax:=$7303;
|
||||
msdos(dosregs);
|
||||
if (dosregs.flags and fcarry) <> 0 then
|
||||
exit;
|
||||
copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
|
||||
if Rec.RetSize = 0 then
|
||||
exit;
|
||||
|
||||
blocksize:=rec.SecPerClus*rec.BytePerSec;
|
||||
freeblocks:=rec.AvailAllocUnits;
|
||||
totblocks:=rec.TotalAllocUnits;
|
||||
DiskData_7303:=true;
|
||||
end;
|
||||
|
||||
{ Get disk data asking to MSCDEX. Pure DOS returns wrong values with
|
||||
int21/7303 or int21/36 if the drive is a CDROM drive }
|
||||
function DiskData_CDROM : boolean;
|
||||
var req : TRequestHeader;
|
||||
sectreq : TCDSectSizeReq;
|
||||
sizereq : TCDVolSizeReq;
|
||||
i : integer;
|
||||
status,byteswritten : word;
|
||||
drnum : byte;
|
||||
begin
|
||||
DiskData_CDROM:=false;
|
||||
drnum:=drive-1; //for MSCDEX, 0 = a, 1 = b etc, unlike int21/36
|
||||
|
||||
{ Is this a CDROM drive? }
|
||||
dosregs.ax:=$150b;
|
||||
dosregs.cx:=drnum;
|
||||
realintr($2f,dosregs);
|
||||
if (dosregs.bx<>$ADAD) or (dosregs.ax=0) then
|
||||
exit; // no, it isn't
|
||||
|
||||
{ Prepare the request header to send to the cdrom driver }
|
||||
FillByte(req,sizeof(req),0);
|
||||
req.length:=sizeof(req);
|
||||
req.command:=IOCTL_INPUT;
|
||||
req.transf_ofs:=tb_offset+sizeof(req); //CDROM control block will follow
|
||||
req.transf_seg:=tb_segment; //the request header
|
||||
req.numbytes:=sizeof(sectreq);
|
||||
|
||||
{ We're asking the sector size }
|
||||
sectreq.func:=CDFUNC_SECTSIZE;
|
||||
sectreq.mode:=0; //cooked
|
||||
sectreq.secsize:=0;
|
||||
|
||||
for i:=1 to 2 do
|
||||
begin
|
||||
{ Send the request to the cdrom driver }
|
||||
dosmemput(tb_segment,tb_offset,req,sizeof(req));
|
||||
dosmemput(tb_segment,tb_offset+sizeof(req),sectreq,sizeof(sectreq));
|
||||
dosregs.ax:=$1510;
|
||||
dosregs.cx:=drnum;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.bx:=tb_offset;
|
||||
realintr($2f,dosregs);
|
||||
dosmemget(tb_segment,tb_offset+3,status,2);
|
||||
{ status = $800F means "disk changed". Try once more. }
|
||||
if (status and $800F) <> $800F then break;
|
||||
end;
|
||||
dosmemget(tb_segment,tb_offset+$12,byteswritten,2);
|
||||
if (status<>$0100) or (byteswritten<>sizeof(sectreq)) then
|
||||
exit; //An error occurred
|
||||
dosmemget(tb_segment,tb_offset+sizeof(req),sectreq,sizeof(sectreq));
|
||||
|
||||
{ Update the request header for the next request }
|
||||
req.numbytes:=sizeof(sizereq);
|
||||
|
||||
{ We're asking the volume size (in blocks) }
|
||||
sizereq.func:=CDFUNC_VOLSIZE;
|
||||
sizereq.size:=0;
|
||||
|
||||
{ Send the request to the cdrom driver }
|
||||
dosmemput(tb_segment,tb_offset,req,sizeof(req));
|
||||
dosmemput(tb_segment,tb_offset+sizeof(req),sizereq,sizeof(sizereq));
|
||||
dosregs.ax:=$1510;
|
||||
dosregs.cx:=drnum;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.bx:=tb_offset;
|
||||
realintr($2f,dosregs);
|
||||
dosmemget(tb_segment,tb_offset,req,sizeof(req));
|
||||
if (req.status<>$0100) or (req.numbytes<>sizeof(sizereq)) then
|
||||
exit; //An error occurred
|
||||
dosmemget(tb_segment,tb_offset+sizeof(req)+1,sizereq.size,4);
|
||||
|
||||
blocksize:=sectreq.secsize;
|
||||
freeblocks:=0; //always 0 for a cdrom
|
||||
totblocks:=sizereq.size;
|
||||
DiskData_CDROM:=true;
|
||||
end;
|
||||
|
||||
begin
|
||||
if drive=0 then
|
||||
begin
|
||||
dosregs.ax:=$1900; //get current default drive
|
||||
msdos(dosregs);
|
||||
drive:=dosregs.al+1;
|
||||
end;
|
||||
|
||||
if not DiskData_CDROM then
|
||||
if not DiskData_7303 then
|
||||
if not DiskData_36 then
|
||||
begin
|
||||
do_diskdata:=-1;
|
||||
exit;
|
||||
end;
|
||||
do_diskdata:=blocksize;
|
||||
if free then
|
||||
do_diskdata:=do_diskdata*freeblocks
|
||||
else
|
||||
do_diskdata:=do_diskdata*totblocks;
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
function diskfree(drive : byte) : int64;
|
||||
@ -752,85 +355,23 @@ var
|
||||
{$endif DEBUG_LFN}
|
||||
|
||||
procedure LFNFindFirst(path:pchar;attr:longint;var s:searchrec);
|
||||
var
|
||||
i : longint;
|
||||
w : LFNSearchRec;
|
||||
begin
|
||||
{ allow slash as backslash }
|
||||
DoDirSeparators(path);
|
||||
dosregs.si:=1; { use ms-dos time }
|
||||
{ don't include the label if not asked for it, needed for network drives }
|
||||
if attr=$8 then
|
||||
dosregs.ecx:=8
|
||||
else
|
||||
dosregs.ecx:=attr and (not 8);
|
||||
dosregs.edx:=tb_offset+Sizeof(LFNSearchrec)+1;
|
||||
dosmemput(tb_segment,tb_offset+Sizeof(LFNSearchrec)+1,path^,strlen(path)+1);
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.edi:=tb_offset;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.ax:=$714e;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
if DosError=2 then
|
||||
DosError:=18;
|
||||
{$ifdef DEBUG_LFN}
|
||||
if (DosError=0) and LogLFN then
|
||||
begin
|
||||
Append(lfnfile);
|
||||
inc(LFNOpenNb);
|
||||
Writeln(lfnfile,LFNOpenNb,' LFNFindFirst called ',path);
|
||||
close(lfnfile);
|
||||
end;
|
||||
{$endif DEBUG_LFN}
|
||||
copyfromdos(w,sizeof(LFNSearchRec));
|
||||
LFNSearchRec2Dos(w,dosregs.ax,s,true);
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
procedure LFNFindNext(var s:searchrec);
|
||||
var
|
||||
hdl : longint;
|
||||
w : LFNSearchRec;
|
||||
begin
|
||||
Move(s.Fill,hdl,4);
|
||||
dosregs.si:=1; { use ms-dos time }
|
||||
dosregs.edi:=tb_offset;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.ebx:=hdl;
|
||||
dosregs.ax:=$714f;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
copyfromdos(w,sizeof(LFNSearchRec));
|
||||
LFNSearchRec2Dos(w,hdl,s,false);
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
procedure LFNFindClose(var s:searchrec);
|
||||
var
|
||||
hdl : longint;
|
||||
begin
|
||||
Move(s.Fill,hdl,4);
|
||||
{ Do not call MsDos if FindFirst returned with an error }
|
||||
if hdl=-1 then
|
||||
begin
|
||||
DosError:=0;
|
||||
exit;
|
||||
end;
|
||||
dosregs.ebx:=hdl;
|
||||
dosregs.ax:=$71a1;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
{$ifdef DEBUG_LFN}
|
||||
if (DosError=0) and LogLFN then
|
||||
begin
|
||||
Append(lfnfile);
|
||||
Writeln(lfnfile,LFNOpenNb,' LFNFindClose called ');
|
||||
close(lfnfile);
|
||||
if LFNOpenNb>0 then
|
||||
dec(LFNOpenNb);
|
||||
end;
|
||||
{$endif DEBUG_LFN}
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
@ -853,40 +394,16 @@ end;
|
||||
|
||||
|
||||
procedure DosFindfirst(path : pchar;attr : word;var f : searchrec);
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
{ allow slash as backslash }
|
||||
DoDirSeparators(path);
|
||||
copytodos(f,sizeof(searchrec));
|
||||
dosregs.edx:=tb_offset;
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.ah:=$1a;
|
||||
msdos(dosregs);
|
||||
dosregs.ecx:=attr;
|
||||
dosregs.edx:=tb_offset+Sizeof(searchrec)+1;
|
||||
dosmemput(tb_segment,tb_offset+Sizeof(searchrec)+1,path^,strlen(path)+1);
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.ah:=$4e;
|
||||
msdos(dosregs);
|
||||
copyfromdos(f,sizeof(searchrec));
|
||||
LoadDosError;
|
||||
dossearchrec2searchrec(f);
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
procedure Dosfindnext(var f : searchrec);
|
||||
begin
|
||||
copytodos(f,sizeof(searchrec));
|
||||
dosregs.edx:=tb_offset;
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.ah:=$1a;
|
||||
msdos(dosregs);
|
||||
dosregs.ah:=$4f;
|
||||
msdos(dosregs);
|
||||
copyfromdos(f,sizeof(searchrec));
|
||||
LoadDosError;
|
||||
dossearchrec2searchrec(f);
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
@ -997,57 +514,17 @@ end;
|
||||
|
||||
{ change to short filename if successful DOS call PM }
|
||||
function GetShortName(var p : String) : boolean;
|
||||
var
|
||||
c : array[0..255] of char;
|
||||
begin
|
||||
move(p[1],c[0],length(p));
|
||||
c[length(p)]:=#0;
|
||||
copytodos(c,length(p)+1);
|
||||
dosregs.ax:=$7160;
|
||||
dosregs.cx:=1;
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.si:=tb_offset;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.di:=tb_offset;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
if DosError=0 then
|
||||
begin
|
||||
copyfromdos(c,256);
|
||||
move(c[0],p[1],strlen(c));
|
||||
p[0]:=char(strlen(c));
|
||||
GetShortName:=true;
|
||||
end
|
||||
else
|
||||
GetShortName:=false;
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
{ change to long filename if successful DOS call PM }
|
||||
function GetLongName(var p : String) : boolean;
|
||||
var
|
||||
c : array[0..255] of char;
|
||||
begin
|
||||
move(p[1],c[0],length(p));
|
||||
c[length(p)]:=#0;
|
||||
copytodos(c,length(p)+1);
|
||||
dosregs.ax:=$7160;
|
||||
dosregs.cx:=2;
|
||||
dosregs.ds:=tb_segment;
|
||||
dosregs.si:=tb_offset;
|
||||
dosregs.es:=tb_segment;
|
||||
dosregs.di:=tb_offset;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
if DosError=0 then
|
||||
begin
|
||||
copyfromdos(c,256);
|
||||
move(c[0],p[1],strlen(c));
|
||||
p[0]:=char(strlen(c));
|
||||
GetLongName:=true;
|
||||
end
|
||||
else
|
||||
GetLongName:=false;
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
@ -1078,43 +555,15 @@ end;
|
||||
|
||||
procedure getfattr(var f;var attr : word);
|
||||
begin
|
||||
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
|
||||
dosregs.edx:=tb_offset;
|
||||
dosregs.ds:=tb_segment;
|
||||
if LFNSupport then
|
||||
begin
|
||||
dosregs.ax:=$7143;
|
||||
dosregs.bx:=0;
|
||||
end
|
||||
else
|
||||
dosregs.ax:=$4300;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
Attr:=dosregs.cx;
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
procedure setfattr(var f;attr : word);
|
||||
begin
|
||||
{ Fail for setting VolumeId. }
|
||||
if ((attr and VolumeID)<>0) then
|
||||
begin
|
||||
doserror:=5;
|
||||
exit;
|
||||
end;
|
||||
copytodos(filerec(f).name,strlen(filerec(f).name)+1);
|
||||
dosregs.edx:=tb_offset;
|
||||
dosregs.ds:=tb_segment;
|
||||
if LFNSupport then
|
||||
begin
|
||||
dosregs.ax:=$7143;
|
||||
dosregs.bx:=1;
|
||||
end
|
||||
else
|
||||
dosregs.ax:=$4301;
|
||||
dosregs.cx:=attr;
|
||||
msdos(dosregs);
|
||||
LoadDosError;
|
||||
{TODO: implement}
|
||||
runerror(304);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user