{ Keep Track of open files } const max_files = 50; var openfiles : array [0..max_files-1] of boolean; {$ifdef SYSTEMDEBUG} opennames : array [0..max_files-1] of pchar; const free_closed_names : boolean = true; {$endif SYSTEMDEBUG} {**************************************************************************** Low level File Routines ****************************************************************************} procedure do_close(handle : longint); var regs : trealregs; begin if Handle<=4 then exit; regs.realebx:=handle; if handle 0 then GetInOutRes(lo(regs.realeax)); end; procedure do_erase(p : pchar); var regs : trealregs; begin DoDirSeparators(p); syscopytodos(longint(p),strlen(p)+1); regs.realedx:=tb_offset; regs.realds:=tb_segment; if LFNSupport then regs.realeax:=$7141 else regs.realeax:=$4100; regs.realesi:=0; regs.realecx:=0; sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then GetInOutRes(lo(regs.realeax)); end; procedure do_rename(p1,p2 : pchar); var regs : trealregs; begin DoDirSeparators(p1); DoDirSeparators(p2); if strlen(p1)+strlen(p2)+3>tb_size then HandleError(217); sysseg_move(get_ds,sizeuint(p2),dos_selector,tb,strlen(p2)+1); sysseg_move(get_ds,sizeuint(p1),dos_selector,tb+strlen(p2)+2,strlen(p1)+1); regs.realedi:=tb_offset; regs.realedx:=tb_offset + strlen(p2)+2; regs.realds:=tb_segment; regs.reales:=tb_segment; if LFNSupport then regs.realeax:=$7156 else regs.realeax:=$5600; regs.realecx:=$ff; { attribute problem here ! } sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then GetInOutRes(lo(regs.realeax)); end; function do_write(h:longint;addr:pointer;len : longint) : longint; var regs : trealregs; size, writesize : longint; begin writesize:=0; while len > 0 do begin if len>tb_size then size:=tb_size else size:=len; syscopytodos(ptrint(addr)+writesize,size); regs.realecx:=size; regs.realedx:=tb_offset; regs.realds:=tb_segment; regs.realebx:=h; regs.realeax:=$4000; sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then begin GetInOutRes(lo(regs.realeax)); exit(writesize); end; inc(writesize,lo(regs.realeax)); dec(len,lo(regs.realeax)); { stop when not the specified size is written } if lo(regs.realeax) 0 do begin if len>tb_size then size:=tb_size else size:=len; regs.realecx:=size; regs.realedx:=tb_offset; regs.realds:=tb_segment; regs.realebx:=h; regs.realeax:=$3f00; sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then begin GetInOutRes(lo(regs.realeax)); do_read:=0; exit; end; syscopyfromdos(ptrint(addr)+readsize,lo(regs.realeax)); inc(readsize,lo(regs.realeax)); dec(len,lo(regs.realeax)); { stop when not the specified size is read } if lo(regs.realeax) 0 then Begin GetInOutRes(lo(regs.realeax)); do_filepos:=0; end else do_filepos:=lo(regs.realedx) shl 16+lo(regs.realeax); end; procedure do_seek(handle,pos : longint); var regs : trealregs; begin regs.realebx:=handle; regs.realecx:=pos shr 16; regs.realedx:=pos and $ffff; regs.realeax:=$4200; sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then GetInOutRes(lo(regs.realeax)); end; function do_seekend(handle:longint):longint; var regs : trealregs; begin regs.realebx:=handle; regs.realecx:=0; regs.realedx:=0; regs.realeax:=$4202; sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then Begin GetInOutRes(lo(regs.realeax)); do_seekend:=0; end else do_seekend:=lo(regs.realedx) shl 16+lo(regs.realeax); end; function do_filesize(handle : longint) : longint; var aktfilepos : longint; begin aktfilepos:=do_filepos(handle); do_filesize:=do_seekend(handle); do_seek(handle,aktfilepos); end; { truncate at a given position } procedure do_truncate (handle,pos:longint); var regs : trealregs; begin do_seek(handle,pos); regs.realecx:=0; regs.realedx:=tb_offset; regs.realds:=tb_segment; regs.realebx:=handle; regs.realeax:=$4000; sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then GetInOutRes(lo(regs.realeax)); end; const FileHandleCount : longint = 20; function Increase_file_handle_count : boolean; var regs : trealregs; begin Inc(FileHandleCount,10); regs.realebx:=FileHandleCount; regs.realeax:=$6700; sysrealintr($21,regs); if (regs.realflags and carryflag) <> 0 then begin Increase_file_handle_count:=false; Dec (FileHandleCount, 10); end else Increase_file_handle_count:=true; end; function dos_version : word; var regs : trealregs; begin regs.realeax := $3000; sysrealintr($21,regs); dos_version := regs.realeax end; procedure do_open(var f;p:pchar;flags:longint); { filerec and textrec have both handle and mode as the first items so they could use the same routine for opening/creating. when (flags and $100) the file will be append when (flags and $1000) the file will be truncate/rewritten when (flags and $10000) there is no check for close (needed for textfiles) } var regs : trealregs; action : longint; Avoid6c00 : boolean; begin DoDirSeparators(p); { check if Extended Open/Create API is safe to use } Avoid6c00 := lo(dos_version) < 7; { close first if opened } if ((flags and $10000)=0) then begin case filerec(f).mode of fminput,fmoutput,fminout : Do_Close(filerec(f).handle); fmclosed : ; else begin inoutres:=102; {not assigned} exit; end; end; end; { reset file handle } filerec(f).handle:=UnusedHandle; action:=$1; { convert filemode to filerec modes } case (flags and 3) of 0 : filerec(f).mode:=fminput; 1 : filerec(f).mode:=fmoutput; 2 : filerec(f).mode:=fminout; end; if (flags and $1000)<>0 then action:=$12; {create file function} { empty name is special } if p[0]=#0 then begin case FileRec(f).mode of fminput : FileRec(f).Handle:=StdInputHandle; fminout, { this is set by rewrite } fmoutput : FileRec(f).Handle:=StdOutputHandle; fmappend : begin FileRec(f).Handle:=StdOutputHandle; FileRec(f).mode:=fmoutput; {fool fmappend} end; end; exit; end; { real dos call } syscopytodos(longint(p),strlen(p)+1); {$ifndef RTLLITE} if LFNSupport then regs.realeax := $716c { Use LFN Open/Create API } else regs.realeax:=$6c00; {$endif RTLLITE} if Avoid6c00 then regs.realeax := $3d00 + (flags and $ff) { For now, map to Open API } else regs.realeax := $6c00; { Use Extended Open/Create API } if byte(regs.realeax shr 8) = $3d then begin { Using the older Open or Create API's } if (action and $00f0) <> 0 then regs.realeax := $3c00; { Map to Create/Replace API } regs.realds := tb_segment; regs.realedx := tb_offset; end else begin { Using LFN or Extended Open/Create API } regs.realedx := action; { action if file does/doesn't exist } regs.realds := tb_segment; regs.realesi := tb_offset; regs.realebx := $2000 + (flags and $ff); { file open mode } end; regs.realecx := $20; { file attributes } sysrealintr($21,regs); {$ifndef RTLLITE} if (regs.realflags and carryflag) <> 0 then if lo(regs.realeax)=4 then if Increase_file_handle_count then begin { Try again } if LFNSupport then regs.realeax := $716c {Use LFN Open/Create API} else if Avoid6c00 then regs.realeax := $3d00+(flags and $ff) {For now, map to Open API} else regs.realeax := $6c00; {Use Extended Open/Create API} if byte(regs.realeax shr 8) = $3d then begin { Using the older Open or Create API's } if (action and $00f0) <> 0 then regs.realeax := $3c00; {Map to Create/Replace API} regs.realds := tb_segment; regs.realedx := tb_offset; end else begin { Using LFN or Extended Open/Create API } regs.realedx := action; {action if file does/doesn't exist} regs.realds := tb_segment; regs.realesi := tb_offset; regs.realebx := $2000+(flags and $ff); {file open mode} end; regs.realecx := $20; {file attributes} sysrealintr($21,regs); end; {$endif RTLLITE} if (regs.realflags and carryflag) <> 0 then begin GetInOutRes(lo(regs.realeax)); exit; end else begin filerec(f).handle:=lo(regs.realeax); {$ifndef RTLLITE} { for systems that have more then 20 by default ! } if lo(regs.realeax)>FileHandleCount then FileHandleCount:=lo(regs.realeax); {$endif RTLLITE} end; if lo(regs.realeax) 0) and (FileRec (F).Handle <> UnusedHandle) then begin do_seekend(filerec(f).handle); filerec(f).mode:=fmoutput; {fool fmappend} end; end; function do_isdevice(handle:THandle):boolean; var regs : trealregs; begin regs.realebx:=handle; regs.realeax:=$4400; sysrealintr($21,regs); do_isdevice:=(regs.realedx and $80)<>0; if (regs.realflags and carryflag) <> 0 then GetInOutRes(lo(regs.realeax)); end;