|
@@ -13,12 +13,44 @@
|
|
|
|
|
|
**********************************************************************}
|
|
|
|
|
|
+ { 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 : thandle);
|
|
|
+var
|
|
|
+ regs : Registers;
|
|
|
begin
|
|
|
+ if Handle<=4 then
|
|
|
+ exit;
|
|
|
+ regs.BX:=handle;
|
|
|
+ if handle<max_files then
|
|
|
+ begin
|
|
|
+ openfiles[handle]:=false;
|
|
|
+{$ifdef SYSTEMDEBUG}
|
|
|
+ if assigned(opennames[handle]) and free_closed_names then
|
|
|
+ begin
|
|
|
+ sysfreememsize(opennames[handle],strlen(opennames[handle])+1);
|
|
|
+ opennames[handle]:=nil;
|
|
|
+ end;
|
|
|
+{$endif SYSTEMDEBUG}
|
|
|
+ end;
|
|
|
+ regs.AX:=$3e00;
|
|
|
+ MsDos(regs);
|
|
|
+ if (regs.Flags and fCarry) <> 0 then
|
|
|
+ GetInOutRes(regs.AX);
|
|
|
end;
|
|
|
|
|
|
|
|
@@ -96,8 +128,163 @@ procedure do_truncate (handle:thandle;pos:longint);
|
|
|
begin
|
|
|
end;
|
|
|
|
|
|
+const
|
|
|
+ FileHandleCount : word = 20;
|
|
|
+
|
|
|
+function Increase_file_handle_count : boolean;
|
|
|
+var
|
|
|
+ regs : Registers;
|
|
|
+begin
|
|
|
+ Inc(FileHandleCount,10);
|
|
|
+ regs.BX:=FileHandleCount;
|
|
|
+ regs.AX:=$6700;
|
|
|
+ MsDos(regs);
|
|
|
+ if (regs.Flags and fCarry) <> 0 then
|
|
|
+ begin
|
|
|
+ Increase_file_handle_count:=false;
|
|
|
+ Dec (FileHandleCount, 10);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ Increase_file_handle_count:=true;
|
|
|
+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 : Registers;
|
|
|
+ action : longint;
|
|
|
begin
|
|
|
+ DoDirSeparators(p);
|
|
|
+{ 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;
|
|
|
+{$ifndef RTLLITE}
|
|
|
+ if LFNSupport then
|
|
|
+ begin
|
|
|
+ regs.AX := $716c; { Use LFN Open/Create API }
|
|
|
+ regs.DX := action; { action if file does/doesn't exist }
|
|
|
+ regs.SI := Ofs(p^);
|
|
|
+ regs.BX := $2000 + (flags and $ff); { file open mode }
|
|
|
+ end
|
|
|
+ else
|
|
|
+{$endif RTLLITE}
|
|
|
+ begin
|
|
|
+ if (action and $00f0) <> 0 then
|
|
|
+ regs.AX := $3c00 { Map to Create/Replace API }
|
|
|
+ else
|
|
|
+ regs.AX := $3d00 + (flags and $ff); { Map to Open_Existing API }
|
|
|
+ regs.DX := Ofs(p^);
|
|
|
+ end;
|
|
|
+ regs.DS := Seg(p^);
|
|
|
+ regs.CX := $20; { file attributes }
|
|
|
+ MsDos(regs);
|
|
|
+{$ifndef RTLLITE}
|
|
|
+ if (regs.Flags and fCarry) <> 0 then
|
|
|
+ if regs.AX=4 then
|
|
|
+ if Increase_file_handle_count then
|
|
|
+ begin
|
|
|
+ { Try again }
|
|
|
+ if LFNSupport then
|
|
|
+ begin
|
|
|
+ regs.AX := $716c; {Use LFN Open/Create API}
|
|
|
+ regs.DX := action; {action if file does/doesn't exist}
|
|
|
+ regs.SI := Ofs(p^);
|
|
|
+ regs.BX := $2000 + (flags and $ff); {file open mode}
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if (action and $00f0) <> 0 then
|
|
|
+ regs.AX := $3c00 {Map to Create/Replace API}
|
|
|
+ else
|
|
|
+ regs.AX := $3d00 + (flags and $ff); {Map to Open API}
|
|
|
+ regs.DX := Ofs(p^);
|
|
|
+ end;
|
|
|
+ regs.DS := Seg(p^);
|
|
|
+ regs.CX := $20; {file attributes}
|
|
|
+ MsDos(regs);
|
|
|
+ end;
|
|
|
+{$endif RTLLITE}
|
|
|
+ if (regs.Flags and fCarry) <> 0 then
|
|
|
+ begin
|
|
|
+ GetInOutRes(regs.AX);
|
|
|
+ exit;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ filerec(f).handle:=regs.AX;
|
|
|
+{$ifndef RTLLITE}
|
|
|
+ { for systems that have more then 20 by default ! }
|
|
|
+ if regs.AX>FileHandleCount then
|
|
|
+ FileHandleCount:=regs.AX;
|
|
|
+{$endif RTLLITE}
|
|
|
+ end;
|
|
|
+ if regs.AX<max_files then
|
|
|
+ begin
|
|
|
+{$ifdef SYSTEMDEBUG}
|
|
|
+ if openfiles[regs.AX] and
|
|
|
+ assigned(opennames[regs.AX]) then
|
|
|
+ begin
|
|
|
+ Writeln(stderr,'file ',opennames[regs.AX],'(',regs.AX,') not closed but handle reused!');
|
|
|
+ sysfreememsize(opennames[regs.AX],strlen(opennames[regs.AX])+1);
|
|
|
+ end;
|
|
|
+{$endif SYSTEMDEBUG}
|
|
|
+ openfiles[regs.AX]:=true;
|
|
|
+{$ifdef SYSTEMDEBUG}
|
|
|
+ opennames[regs.AX] := sysgetmem(strlen(p)+1);
|
|
|
+ move(p^,opennames[regs.AX]^,strlen(p)+1);
|
|
|
+{$endif SYSTEMDEBUG}
|
|
|
+ end;
|
|
|
+{ append mode }
|
|
|
+ if ((flags and $100) <> 0) and
|
|
|
+ (FileRec (F).Handle <> UnusedHandle) then
|
|
|
+ begin
|
|
|
+ do_seekend(filerec(f).handle);
|
|
|
+ filerec(f).mode:=fmoutput; {fool fmappend}
|
|
|
+ end;
|
|
|
end;
|
|
|
|
|
|
|