Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/UPDATE.ZIP/UPDATE.PAS

Pascal/Delphi Source File | 1987-12-16 | 16.5 KB | 503 lines

{-----------------------------------------------------------------------------}

Unit Update;
{
| The Update unit supports up to sixteen files in read/write (update) mode.
| Each file may reside on either floppy disk or hard disk, may have a record
| size of up to 64K bytes, and may contain as many records as the disk capacity
| will allow (no 64K limit).  Both random and sequential file access is
| supported.  DOS 2.0 or higher is required.  The sections of this unit that
| have been commented out were used to test this unit prior to release.  Please
| refer to the Test_Update_Unit procedure (at the end of this unit) for
| examples of how to use this unit.
|
| Version 1.0
| Written by Mike Heffron, CyberSoft, Inc.
| CompuServe 72170,126
| Released to the public domain.
}
{-----------------------------------------------------------------------------}

interface

Uses Dos;
{
| Refer to Peter Norton's book, "Programmer's Guide to the IBM PC,"
| pages 308-310, for an explanation of the DOS functions used by this unit.
|
| Set the following constants as desired.  Note that even if both constants
| are false, error checking will be performed and can be checked via the
| Update_IOresult function (which is similar to the IOresult function).
| An Update_IOresult of zero indicates no error, any other value indicates an
| error as specified in the Identify_Error procedure.
}
Const Halt_On_Update_Error = TRUE;
      Show_Update_Errors   = TRUE;

{-----------------------------------------------------------------------------}

Procedure Check_Error_Status(Reg : Registers);
Function  Handle_Valid(File_Handle : Integer) : Boolean;
Procedure Identify_Error(Error_Code,File_Handle : Integer);
Procedure Identify_Procedure;
Procedure Process_Error(File_Handle : Integer; Error_Code : Byte);
Procedure Update_Assign(Var File_Handle : Integer; File_Name : String;
                        Record_Size : Word);
Procedure Update_Close(File_Handle : Integer);
Function  Update_FileSize(File_Handle : Integer) : LongInt;
Function  Update_IOresult : Byte;
Procedure Update_Read(File_Handle : Integer; Var One_Record);
Procedure Update_Seek(File_Handle : Integer; Record_Number : LongInt);
Procedure Update_Write(File_Handle : Integer; Var One_Record);

{-----------------------------------------------------------------------------}

implementation

Type  Update_Type = Record
         {
         | 5..20 = DOS 2.0+ file handles.
         }
         Record_Size   : Array[5..20] of Word;
         Procedure_ID,
         IOresult      : Byte;
         File_Name     : Array[5..20] of String[30];
         Temp_Name     : String[30]
         end;

Var   Up_Date     : Update_Type;

{-----------------------------------------------------------------------------}

Procedure Check_DOS;
{
| The Check_DOS procedure prevents the Update unit from being used if an
| incorrect version of DOS is installed.
}
Var   Reg : Registers;

begin
   Reg.Ax := $3000;
   Msdos(Reg);
   If Reg.Al<2 then begin
      writeln('*** Error: DOS 2.0 or higher required to use Update unit.');
      halt
      end
end;

{-----------------------------------------------------------------------------}

Function Update_IOresult : Byte;
{
| The Update_IOresult function returns the IOresult from the most recently
| performed Update unit I/O procedure.
}
begin
   Update_IOresult := Up_Date.IOresult
end;

{-----------------------------------------------------------------------------}

Procedure Identify_Procedure;
{
| The Identify_Procedure procedure identifies the update procedure that was
| most recently performed (the procedure in which an IO error occured).
}
begin
   Write('*** Error: ');
   Case Up_Date.Procedure_ID of
      0  : Write('Update_Create  ');
      1  : Write('Update_Open    ');
      2  : Write('Update_Close   ');
      3  : Write('Update_Seek    ');
      4  : Write('Update_Read    ');
      5  : Write('Update_Write   ')
      else Write('Update_Unknown ')
      end {Case}
end;

{-----------------------------------------------------------------------------}

Procedure Identify_Error(Error_Code,File_Handle : Integer);
{
| The Identify_Error procedure identifies the specified Error_Code.  These
| error codes are discussed on page 297 of Norton's book.
}
begin
   Case Error_Code of
      1  : Write('Invalid function number');
      2  : Write('File not found');
      3  : Write('Path not found');
      4  : Write('No handle available');
      5  : Write('Access denied');
      6  : Write('Invalid file handle=',File_Handle);
      7  : Write('Memory control blocks destroyed');
      8  : Write('Insufficient memory');
      9  : Write('Invalid memory block address');
      10 : Write('Invalid environment');
      11 : Write('Invalid format');
      12 : Write('Invalid access code');
      13 : Write('Invalid data');
      15 : Write('Invalid drive specification');
      16 : Write('Attempt to remove current directory');
      17 : Write('Not same device');
      18 : Write('No more files to be found')
      else Write('Unknown DOS error=',error_code)
      end; {Case}
   If Error_Code=6 then Writeln(' (',Up_Date.Temp_Name,').')
                   else Writeln(' (',Up_Date.File_Name[File_Handle],').')
end;

{-----------------------------------------------------------------------------}

Procedure Process_Error(File_Handle : Integer; Error_Code : Byte);
{
| The Process_Error procedure identifies an update error if present.
}
begin
   If Error_Code>0 then begin
      If Show_Update_Errors then begin
         Identify_Procedure;
         Identify_Error(Error_Code,File_Handle)
         end; {If Show_Update_Errors}
      If Halt_On_Update_Error then halt
      end {If Error_Code>0}
end;

{-----------------------------------------------------------------------------}

Function Handle_Valid(File_Handle : Integer) : Boolean;
{
| The Handle_Valid function determines whether the specified File_Handle is
| within the range allowed by DOS 2.0+.
}
begin
   If ( (File_Handle<5) or (File_Handle>20) ) then begin
      Up_Date.IOresult := 6;
      Process_Error(File_Handle,6)
      end;
   Handle_Valid := Up_Date.IOresult<>6
end;

{-----------------------------------------------------------------------------}

Procedure Check_Error_Status(Reg : Registers);
{
| The Check_Error_Status procedure sets the Up_Date.IOresult according to
| whether an IO error has occured.
}
begin
   If odd(Reg.Flags) then Up_Date.IOresult := Reg.Al
                     else Up_Date.IOresult := 0
end;

{-----------------------------------------------------------------------------}

Procedure Update_Create(Var File_Handle : Integer);
{
| The Update_Create procedure creates and opens a file for read/write (update)
| operations.
}
Var   Reg : Registers;

begin
   Up_Date.Procedure_ID := 0;
   Reg.Ax := $3c00;                    {Specify DOS create file function.}
   Reg.Cx := 0;
   Reg.Ds := Seg(Up_Date.Temp_Name);   {Point DS:DX to ASCIIZ file name.}
   Reg.Dx := Ofs(Up_Date.Temp_Name)+1; {Skip size byte (first character).}
   Msdos(Reg);
   File_Handle := Reg.Ax;
   Check_Error_Status(Reg)
end;

{-----------------------------------------------------------------------------}
{$V-}
Procedure Update_Assign(Var File_Handle : Integer; File_Name : String;
                        Record_Size : Word);
{
| The Update_Assign procedure opens a file for read/write (update) operations.
}
Const Deny_None  = $40; {File sharing mode -- deny no operation.}
      Read_Write = $02; {File access code -- read/write access allowed.}

Var   Reg : Registers;

begin
   Up_Date.Temp_Name := File_Name+#0;     {DOS requires an ASCIIZ file name.}
   Up_Date.Procedure_ID := 1;
   Reg.Ax := $3d00+Deny_None+Read_Write;  {Specify DOS open file function.}
   Reg.Ds := Seg(Up_Date.Temp_Name);      {Point DS:DX to ASCIIZ file name.}
   Reg.Dx := Ofs(Up_Date.Temp_Name)+1;    {Skip size byte (first character).}
   Msdos(Reg);
   File_Handle := Reg.Ax;
   Check_Error_Status(Reg);
   {
   | Create the specified file if it doesn't yet exist.
   }
   If ( (Reg.Al=2) or (Reg.Al=4) ) then Update_Create(File_Handle);
   {
   | Set up internal file management variables.
   }
   If Handle_Valid(File_Handle) then begin
      Up_Date.Record_Size[File_Handle] := Record_Size;
      Up_Date.File_Name[File_Handle]   := Up_Date.Temp_Name
      end;
   Process_Error(File_Handle,Up_Date.IOresult)
end;
{$V+}
{-----------------------------------------------------------------------------}

Procedure Update_Close(File_Handle : Integer);
{
| The Update_Close procedure closes a file for read/write (update) operations.
}
Var Reg : Registers;

begin
   Up_Date.Procedure_ID := 2;
   If Handle_Valid(File_Handle) then begin
      Reg.Ax := $3e00;                      {Specify DOS close file function.}
      Reg.Bx := File_Handle;
      Msdos(Reg);
      Check_Error_Status(Reg)
      end;
   Process_Error(File_Handle,Up_Date.IOresult)
end;

{-----------------------------------------------------------------------------}

Procedure Update_Seek(File_Handle : Integer; Record_Number : LongInt);
{
| The Update_Seek procedure positions the file pointer over the requested
| record.  NOTE: the first record is record zero.
}
Var Reg  : Registers;
    Temp : LongInt;

begin
   Up_Date.Procedure_ID := 3;
   If Handle_Valid(File_Handle) then begin
      Temp := Up_Date.Record_Size[File_Handle] * Record_Number;

      Reg.Ax := $4200;       {Specify DOS move file pointer function.}
      Reg.Bx := File_Handle;
      Reg.Cx := Temp shr 16;
      Reg.Dx := Temp and $ffff;
      Msdos(Reg);
      Check_Error_Status(Reg)
      end;
   Process_Error(File_Handle,Up_Date.IOresult)
end;

{-----------------------------------------------------------------------------}

Function Update_FileSize(File_Handle : Integer) : LongInt;
{
| The Update_FileSize function returns the size of the specified file
| in records.  NOTE: the size of an empty file is zero, the size of a file
| containing one record is one, etc.
}
Var Reg   : Registers;
    Cx,Dx : Word;
    Size  : LongInt;

begin
   Up_Date.Procedure_ID := 3;
   If Handle_Valid(File_Handle) then begin
      {
      | Find current file position.
      }
      Reg.Ax := $4201;       {Specify DOS move file pointer function.}
      Reg.Bx := File_Handle;
      Reg.Cx := 0;
      Reg.Dx := 0;
      Msdos(Reg);
      Check_Error_Status(Reg);
      Cx := Reg.Cx;
      Dx := Reg.Dx;
      {
      | Find end of file.
      }
      Reg.Ax := $4202;       {Specify DOS move file pointer function.}
      Reg.Bx := File_Handle;
      Reg.Cx := 0;
      Reg.Dx := 0;
      Msdos(Reg);
      Check_Error_Status(Reg);
      {
      | Determine file size.
      }
      If Up_Date.Record_Size[File_Handle]=0 then Size := 0
      else Size := ((Reg.Cx shl 16)+Reg.Ax) div Up_Date.Record_Size[File_Handle];
      {
      | Restore initial file position.
      }
      Reg.Ax := $4200;       {Specify DOS move file pointer function.}
      Reg.Bx := File_Handle;
      Reg.Cx := Cx;
      Reg.Dx := Dx;
      Msdos(Reg);
      Check_Error_Status(Reg);
      end;
   Process_Error(File_Handle,Up_Date.IOresult);
   Update_FileSize := Size
end;

{-----------------------------------------------------------------------------}

Procedure Update_Read(File_Handle : Integer; Var One_Record);
{
| The Update_Read procedure reads One_Record from the current file position.
| Note that "One_Record" is an untyped variable, i.e., it is passed to this
| procedure as an address only.  DOS reads the data into the specified
| address, and does not care what the actual data type is.
}
Var Reg : Registers;

begin
   Up_Date.Procedure_ID := 4;
   If Handle_Valid(File_Handle) then begin
      Reg.Ax := $3f00;       {Specify DOS read file function.}
      Reg.Bx := File_Handle;
      Reg.Cx := Up_Date.Record_Size[File_Handle];
      Reg.Ds := Seg(One_Record);
      Reg.Dx := Ofs(One_Record);
      Msdos(Reg);
      Check_Error_Status(Reg)
      end;
   Process_Error(File_Handle,Up_Date.IOresult)
end;

{-----------------------------------------------------------------------------}

Procedure Update_Write(File_Handle : Integer; Var One_Record);
{
| The Update_Write procedure writes One_Record to the current file position.
| Note that "One_Record" is an untyped variable, i.e., it is passed to this
| procedure as an address only.  DOS writes the data from the specified
| address, and does not care what the actual data type is.
}
Var Reg : Registers;

begin
   Up_Date.Procedure_ID := 5;
   If Handle_Valid(File_Handle) then begin
      Reg.Ax := $4000;       {Specify DOS write file function.}
      Reg.Bx := File_Handle;
      Reg.Cx := Up_Date.Record_Size[File_Handle];
      Reg.Ds := Seg(One_Record);
      Reg.Dx := Ofs(One_Record);
      Msdos(Reg);
      Check_Error_Status(Reg)
      end;
   Process_Error(File_Handle,Up_Date.IOresult)
end;

{-----------------------------------------------------------------------------}
{
| The following section of code (that has been commented out) was used only
| during the initial testing of this unit, and now serves only as an
| example of how to use the Update unit.
}
(*
Procedure Test_Update_Unit;
{
| The Test_Update_Unit procedure tests all the functions and procedures that
| are supplied in the update unit.  NOTE: this is not a rigorous test, i.e.,
| the unit is not pushed to its limits.
}
Const Max_Rec  = 9;
      Max_Rec2 = 7;

Type  Rec_Type  = Array[1..5] of Byte;
      Rec2_Type = Array[1..7] of Byte;

Var   f,f2,i,j : Integer;
      Last_Rec,Last_Rec2 : LongInt;
      r  : Array[0..9] of Rec_Type;
      r2 : Array[0..9] of Rec2_Type;

begin
   {
   | Initialize test program.
   }
   For i := 0 to Max_Rec do
      For j := 1 to 5 do
         r[i][j] := i;
   For i := 0 to Max_Rec2 do
      For j := 1 to 7 do
         r2[i][j] := i;
   {
   | Notice that "Update_Assign" is like "assign," except that "f" is an
   | integer instead of a file variable, and that you must specify the size of
   | ONE of your records (just use the Turbo Pascal "SizeOf" function).
   }
   Update_Assign(f, 'scrap.bin',SizeOf(r[0]));
   Update_Assign(f2,'scrap.too',SizeOf(r2[0]));
   {
   | Notice the absense of an "update_reset" and an "update_rewrite."  Since
   | you may read or write at any time (without changing modes), reset and
   | rewrite are not needed.  The "Update_Assign" procedure initializes the
   | file position pointer to the first record (as would have been done by
   | reset or rewrite).  If it is neccessary to return to the first (or any
   | other) record, just use the Update_Seek procedure.
   |
   | Notice that "Update_Write" is like "write," except that "f" is an
   | integer instead of a file variable.
   }
   For i := 0 to Max_Rec  do Update_Write(f, r[i]);
   For i := 0 to Max_Rec2 do Update_Write(f2,r2[i]);
   {
   | Notice that there is no "update_eof" function.  It is left to the user
   | to use "Update_FileSize" to find out how many records are contained
   | in the file (if not otherwise known).
   |
   | Notice that "Update_FileSize" is like "FileSize," except that "f" is an
   | integer instead of a file variable.
   }
   Last_Rec  := Update_FileSize(f)-1; {-1 because first record is number zero.}
   Last_Rec2 := Update_FileSize(f2)-1;
   {
   | Notice that "Update_Seek" is like "seek," except that "f" is an integer
   | instead of a file variable.
   }
   Update_Seek(f,2);
   Update_Write(f,r[8]);
   Update_Seek(f,8);
   Update_Write(f,r[2]);
   Update_Seek(f,0);
   {
   | Notice that "Update_Read" is like "read," except that "f" is an integer
   | instead of a file variable.
   }
   For i := 0 to Last_Rec do Update_Read(f,r[i]);
   Update_Seek(f2,0);
   For i := 0 to Last_Rec2 do Update_Read(f2,r2[i]);
   {
   | Notice that "Update_Close" is like "close," except that "f" is an
   | integer instead of a file variable.
   }
   Update_Close(f);
   Update_Close(f2);
   {
   | Display file contents to demonstrate that records have been written
   | and read properly.
   }
   For i := 0 to Last_Rec do Write(r[i][1]:4);
   Writeln;
   For i := 0 to Last_Rec2 do Write(r2[i][1]:4);
   Writeln
end;
*)
{-----------------------------------------------------------------------------}

begin
   Check_DOS;
(*
   Test_Update_Unit
*)
end. {end of unit}

{-----------------------------------------------------------------------------}