DosFile.pas workaround for the CrLF-bug under old DOS

22 Sep 1996


      {   BP-like file operations for binary files    }
{ simple workaround for the CRLF-bug in GCC/GPC }
{     Sven Hilscher - sven@rufus.central.de     }


unit DosFile;
{    version 0.01Beta     }
{ provisional arrangement }

Interface

Type
  WrkStr  = String(255);
  Pointer = ^void;
  NameT   = array[1..13] of char;

  BinFile  = record
             Name   : NameT;
             Handle : Integer;
             BSize  : Integer;
           end;

Var
  IOResultTemp : Integer;

procedure Assign(var F: BinFile; Name: WrkStr);
procedure Reset(var F: BinFile; RecSize: Integer);
procedure Rewrite(var F: BinFile; RecSize: Integer);
procedure BlockWrite(var F: BinFile; var Buf: void; Count: Integer; var Result: Integer);
procedure BlockRead(var F: BinFile; var Buf: Void; Count: Integer; var Result: Integer);
procedure Close(var F: BinFile);
function  IOResult: Integer;


Implementation


procedure Assign(var F: BinFile; Name: WrkStr);
var
  i : Integer;
begin
  for i := 1 to 12 do
    if length(Name) >= i then
      F.Name[i] := Name[i]
    else
      F.Name[i] := chr(0);

  F.Name[13] := chr(0);
  F.Handle   := 0;
end;


{ functions converted from "dos.h" }

function DosOpen(n: Pointer; i: Integer; h: pointer):Integer; AsmName '_dos_open';
function DosCreate(var n: NameT; i: Integer; h: pointer):Integer; AsmName '_dos_creat';
function DosClose(h: Integer): Integer; AsmName '_dos_close';
function DosWrite(h: Integer; b: Pointer; c: Integer; var r: Integer): Integer; AsmName '_dos_write';
function DosRead(h: Integer; b: Pointer; c: Integer; var r: Integer): Integer; AsmName '_dos_read';


procedure Reset(var F: BinFile; RecSize: Integer);
begin
  if F.handle <> 0 then IOResultTemp := DosClose(F.Handle);
  IOResultTemp := DosOpen(@F.Name, 0, @F.Handle);
  F.BSize      := RecSize;
end;


procedure Rewrite(var F: BinFile; RecSize: Integer);
begin
  if F.Handle <> 0 then IOResultTemp := DosClose(F.Handle);
  IOResultTemp := DosCreate(F.Name, 0, @F.Handle);
  F.BSize      := RecSize;
end;


procedure Close(var F: BinFile);
begin
  IOResultTemp := DosClose(F.Handle);
  F.Handle     := 0;
  F.BSize      := 0;
end;


function  IOResult: Integer;
begin
  IOResult     := IOResultTemp;
  IOResultTemp := 0;
end;


procedure BlockWrite(var F: BinFile; var Buf: void; Count: Integer; var Result: Integer);
begin
  IOResultTemp := DosWrite(F.Handle, @Buf, Count * F.BSize, Result);
  Result := Result div F.BSize
end;


procedure BlockRead(var F: BinFile; var Buf: Void; Count: Integer; var Result: Integer);
begin
  IOResultTemp := DosRead(F.Handle, @Buf, Count * F.BSize, Result);
  Result := Result div F.BSize
end;

begin
  IOResultTemp := 0;
end.

Sven＠rufus.central.de

tags

participants (1)