diff --git a/rtl/msdos/dos.pp b/rtl/msdos/dos.pp index 29d1afe1c6..606d0e1fa3 100644 --- a/rtl/msdos/dos.pp +++ b/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 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;