home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ROREADER.ZIP / ROREADER.PAS
Encoding:
Pascal/Delphi Source File  |  1986-08-20  |  2.6 KB  |  77 lines
  1. PROGRAM ROReader;
  2.  
  3. Type Regpack = Record Case Integer of
  4.                  1:  (AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS:  Integer);
  5.                  2:  (AL,AH,BL,BH,CL,CH,DL,DH         :  Byte);
  6.                End;
  7. String40 = String[40];
  8.  
  9. Var Target:   Text;
  10.     Fname:    String40;
  11.     F_Attr:   Integer;
  12.     Myfault:  Integer;
  13.     Regs:     Regpack;
  14.     Textline: String40;
  15.  
  16. {This procedure checks the attribute of a file.  If file is write-
  17. protected, it saves the current attribute of the file and unlocks it.}
  18. procedure clear_attr(Fname : String40);
  19. Var TempName: String40;
  20. BEGIN
  21.      TempName := Fname + Chr(0);        {User's pathname in Fname}
  22.      WITH Regs DO                       {  Cap with 0H for DOS   }
  23.         Begin
  24.            AL := $00; AH := $43;  DS := Seg(TempName);
  25.            DX     := Ofs(TempName) + 1; {Go 1 beyond Length byte}
  26.            F_Attr := 0;                 {Clear our attribute}
  27.            CX     := 0;                 {Clear CX for good measure}
  28.            MsDOS(Regs);
  29.           If (Flags AND $1 <> 0) then Exit;
  30.           F_Attr := CX;                 {Save attribute}
  31.           If Odd(CX) then               {If locked CX will be odd}
  32.               Begin
  33.                  AL := $01;             {Set for writing}
  34.                  AH := $43;
  35.                  CX := CX AND $FE;      {Turn off low bit}
  36.                  DS := Seg(TempName); DX := Ofs(TempName)+1;
  37.                 MsDOS(Regs);
  38.               End;
  39.         End;
  40. END;
  41.  
  42. { This procedure restores a file attribute.  The attribute is stored 
  43. in F_Attrib.  The user has stored the file name in variable Fname.}
  44. procedure restore_attr(Fname : String40);
  45. Var TempName: String40;
  46. BEGIN
  47.      TempName := Fname + Chr(0);       {Cap name with 0 for DOS}
  48.      With Regs Do
  49.         Begin
  50.            AL := $01;                  {Set write mode}
  51.            AH := $43;
  52.            DS  := Seg(TempName); DX  := Ofs(TempName) + 1;
  53.            CX  := F_Attr;              {Write old attribute out}
  54.            MsDOS(Regs);
  55.         End;
  56.      F_Attr := 0;                      {Clear our attribute var}
  57. END;
  58. BEGIN
  59.      Fname := 'LOCKTEST.TXT'; Assign(Target,Fname);
  60.      Clear_Attr(Fname);
  61.      {$I-}  Reset(Target)  {$I+};
  62.      MyFault := IOResult; If MyFault <> 0 then
  63.         Begin
  64.            Writeln('Error #',MyFault,' on file open.');
  65.            Exit;
  66.         End;
  67.      While NOT EOF(Target) DO
  68.        BEGIN
  69.          Readln(Target,Textline);
  70.          Writeln(Textline)
  71.        END;
  72.      {$I-}  Close(Target)  {$I+};
  73.      MyFault := IOResult;
  74.      If MyFault <> 0 then Writeln('Error on file close');
  75.      Restore_Attr(Fname);
  76. END.
  77.