home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GSDB21.ZIP / GS_FILEH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-05  |  7.1 KB  |  287 lines
  1. unit GS_FileH;
  2.  
  3. {
  4.                                    Changes
  5.  
  6.       5 Jan 91 -  Corrected GS_FileWrite error is processing memo files
  7.                   greater than 64K.  Changed variable MovLth from type
  8.                   word to type longint.
  9.  
  10. }
  11.  
  12. interface
  13. uses
  14.    Dos,
  15.    GS_Strng,
  16.    GS_Error;
  17.  
  18. var
  19.    BRCmd,
  20.    BWCmd,
  21.    IOAsk,
  22.    IORed,
  23.    IOWri,
  24.    IOPhy  : word;
  25.  
  26. Procedure GS_FileAssign(var dF : file; Fname : string; BufSize : longint);
  27. Procedure GS_FileClose(var dF : file);
  28. Procedure GS_FileErase(var dF : file);
  29. Function  GS_FileExists(var dF : file; Fname : string) : boolean;
  30. Procedure GS_FileRead(var dF : file; blk : longint; var dat; len : longint;
  31.                        var RtnRslt : word);
  32. Procedure GS_FileRename(var dF : file; FName : string);
  33. Procedure GS_FileReset(var dF : file; len : longint);
  34. Procedure GS_FileRewrite(var dF : file; len : longint);
  35. Function  GS_FileSize(var dF : file) : longint;
  36. Procedure GS_FileTruncate(var dF : file; loc : longint);
  37. Procedure GS_FileWrite(var dF : file; blk : longint; var dat; len : longint;
  38.                        var RtnRslt : word);
  39.  
  40. implementation
  41.  
  42. type
  43.    BufferPointer = ^BufferArray;
  44.    BufferArray   = array[0..32767] of char;
  45.    BufrRec = record
  46.                 Size   : word;        {Size of buffer}
  47.                 CntByt : word;        {Bytes stores in buffer}
  48.                 Posn   : longint;     {Beginning byte of file in buffer}
  49.                 FPosn  : longint;     {Last byte read + 1 in buffer}
  50.                 BufPtr : BufferPointer;
  51.              end;
  52.  
  53. var
  54.    Bufr  : BufrRec;
  55.    dbfErr : integer;
  56.    Blok,
  57.    TPosS,
  58.    TPosE  : longint;
  59.    StrFil : string[80];
  60.    istrue : boolean;
  61.  
  62. Function InRam(var dF : file; blk, len : longint; rf : boolean) : boolean;
  63. var
  64.    dFa    : FileRec absolute dF;
  65.    RorW   : string[4];
  66. begin
  67.    istrue := false;
  68.    inc(IOAsk);
  69.    if rf then RorW := 'Read' else RorW := 'Writ';
  70.    move(dFa.UserData, Bufr, sizeof(Bufr));
  71.    if blk > -1 then TPosS := dFa.RecSize * blk
  72.       else TPosS := Bufr.FPosn;
  73.    Blok := TPosS div dFa.RecSize;
  74.    Bufr.FPosn := TPosS + dFa.RecSize * len;
  75.    if Bufr.CntByt > 0 then
  76.    begin
  77.       TPosS := TPosS - Bufr.Posn;
  78.       if (TPosS >= 0) and (TPosS < Bufr.CntByt) then
  79.       begin
  80.          TPosE := (TPosS + dFa.RecSize * len) - 1;
  81.          if TPosE <= Bufr.CntByt then istrue := true;
  82.       end;
  83.    end;
  84.    if not istrue then inc(IOPhy);
  85.    if rf then inc(IORed) else inc(IOWri);
  86.    InRam := istrue;
  87. end;
  88.  
  89. Procedure GS_FileAssign(var dF : file; Fname : string; BufSize : longint);
  90. var
  91.    dFa    : FileRec absolute dF;
  92. begin
  93.    Assign(df, FName);
  94.    Bufr.Posn  := 0;
  95.    Bufr.FPosn := 0;
  96.    Bufr.CntByt := 0;
  97.    Bufr.Size  := BufSize;
  98.    GetMem(Bufr.BufPtr, BufSize);
  99.    move(Bufr, dFa.UserData, sizeof(Bufr));
  100. end;
  101.  
  102. Procedure GS_FileClose(var dF : file);
  103. var
  104.    dFa    : FileRec absolute dF;
  105. begin
  106.    Close(df);
  107.    move(dFa.UserData, Bufr, sizeof(Bufr));
  108.    FreeMem(Bufr.BufPtr, Bufr.Size);
  109. end;
  110.  
  111. Procedure GS_FileErase(var dF : file);
  112. begin
  113.    Erase(df);
  114. end;
  115.  
  116. Function  GS_FileExists(var dF : file; Fname : string) : boolean;
  117. begin
  118.    if (FName <> '') then
  119.    begin
  120.       {$I-}
  121.       Assign(dF, FName);
  122.       Reset(dF);
  123.       Close(dF);
  124.       {$I+}
  125.       GS_FileExists := (IOResult = 0);
  126.    end else GS_FileExists := false;
  127. end;
  128.  
  129. Procedure GS_FileRead(var dF : file; blk : longint; var dat; len : longint;
  130.                       var RtnRslt : word);
  131. var
  132.    dFa    : FileRec absolute dF;
  133.    Result,
  134.    LthHld : word;
  135.  
  136.    StrFil : string[80];
  137. begin
  138.    if InRam(dF, blk, len, true) then
  139.    begin
  140.       move(Bufr.BufPtr^[TPosS],dat,dFa.RecSize * len);
  141.       move(Bufr, dFa.UserData, sizeof(Bufr));
  142.       RtnRslt := len;
  143.       exit;
  144.    end;
  145.    dbfErr := 0;
  146.    begin
  147.       (*$I-*) Seek(dF, Blok); (*$I+*)
  148.       dbfErr := IOResult;
  149.    end;
  150.    IF dbfErr = 0 THEN               {If seek ok, read the record}
  151.    BEGIN
  152.       inc(BRCmd);
  153.       LthHld := dFa.RecSize;
  154.       dFa.RecSize := 1;
  155.       (*$I-*)
  156.       BlockRead(dF, Bufr.BufPtr^, Bufr.Size, Result);
  157.       (*$I+*)
  158.       RtnRslt := Result div LthHld;
  159.       if RtnRslt > len then RtnRslt := len;
  160.       dbfErr := IOResult;
  161.       if dbfErr = 0 then
  162.       begin
  163.          move(Bufr.BufPtr^,dat,LthHld * len);
  164.          Bufr.CntByt := Result;
  165.          Bufr.Posn := Blok * LthHld;
  166.          Bufr.FPosn := (Blok * LthHld)+(LthHld * len);
  167.          move(Bufr, dFa.UserData, sizeof(Bufr));
  168.       end;
  169.       dFa.RecSize := LthHld;
  170.    end;
  171.    if dbfErr <> 0 then
  172.    begin
  173.       CnvAscToStr(dFa.Name,StrFil,64);
  174.       ShowError(dbfErr,StrFil);
  175.    end;
  176. end;
  177.  
  178. Procedure GS_FileRename(var dF : file; Fname : string);
  179. begin
  180.    Rename(df, FName);
  181. end;
  182.  
  183. Procedure GS_FileReset(var dF : file; len : longint);
  184. var
  185.    dFa    : FileRec absolute dF;
  186.    i      : integer;
  187.    StrFil : string[80];
  188. begin
  189.    (*$I-*) Reset(dF, len); (*$I+*)
  190.    dbfErr := IOResult;
  191.    if dbfErr <> 0 then
  192.    begin
  193.       CnvAscToStr(dFa.Name,StrFil,64);
  194.       ShowError(dbfErr,StrFil);
  195.    end;
  196. end;
  197.  
  198. Procedure GS_FileRewrite(var dF : file; len : longint);
  199. var
  200.    dFa    : FileRec absolute dF;
  201.    i      : integer;
  202.    StrFil : string[80];
  203. begin
  204.    (*$I-*) Rewrite(dF, len); (*$I+*)
  205.    dbfErr := IOResult;
  206.    if dbfErr <> 0 then
  207.    begin
  208.       CnvAscToStr(dFa.Name,StrFil,64);
  209.       ShowError(dbfErr,StrFil);
  210.    end;
  211. end;
  212.  
  213. Function GS_FileSize(var dF : file) : longint;
  214. begin
  215.    GS_FileSize := FileSize(df);
  216. end;
  217.  
  218.  
  219. Procedure GS_FileTruncate(var dF : file; loc : longint);
  220. var
  221.    dFa    : FileRec absolute dF;
  222. begin
  223.    dbfErr := 0;
  224.    if loc <> -1 then
  225.    begin
  226.       (*$I-*) Seek(dF, loc); (*$I+*)
  227.       dbfErr := IOResult;
  228.    end;
  229.    IF dbfErr <> 0 THEN
  230.    begin
  231.       CnvAscToStr(dFa.Name,StrFil,64);
  232.       ShowError(dbfErr,StrFil);
  233.    end;
  234.    Truncate(df);
  235. end;
  236.  
  237.  
  238. Procedure GS_FileWrite(var dF : file; blk : longint; var dat; len : longint;
  239.                        var RtnRslt : word);
  240. var
  241.    dFa    : FileRec absolute dF;
  242.    i      : integer;
  243.    Result : word;
  244.    MovLth : longint;
  245.    StrFil : string[80];
  246. begin
  247.    if InRam(dF, blk, len, false) then
  248.          move(dat,Bufr.BufPtr^[TPosS],dFa.RecSize * len)
  249.       else
  250.       begin
  251.          MovLth := (dFa.RecSize * len) + (dFa.RecSize *  Blok);
  252.          if Bufr.Size >= MovLth then
  253.          begin
  254.             move(dat,Bufr.BufPtr^[dFa.RecSize * Blok],dFa.RecSize * len);
  255.             Bufr.CntByt := MovLth;
  256.             Bufr.Posn := 0;
  257.             Bufr.FPosn := MovLth;
  258.          end;
  259.       end;
  260.       move(Bufr, dFa.UserData, sizeof(Bufr));
  261.    dbfErr := 0;
  262.    begin
  263.       (*$I-*) Seek(dF, Blok); (*$I+*)
  264.       dbfErr := IOResult;
  265.    end;
  266.    IF dbfErr = 0 THEN               {If seek ok, read the record}
  267.    BEGIN
  268.       inc(BWCmd);
  269.       (*$I-*) BlockWrite(dF, dat, len, Result); (*$I+*)
  270.       RtnRslt := Result;
  271.       dbfErr := IOResult;
  272.    end;
  273.    if dbfErr <> 0 then
  274.    begin
  275.       CnvAscToStr(dFa.Name,StrFil,64);
  276.       ShowError(dbfErr,StrFil);
  277.    end;
  278. end;
  279.  
  280. begin
  281.    IOAsk := 0;
  282.    IOPhy := 0;
  283.    IORed := 0;
  284.    IOWri := 0;
  285.    BRCmd := 0;
  286.    BWCmd := 0;
  287. end.