Type

   XKeyrec =   Record
                  XOldKeyWord: String[55];
                  XOldPointer: Integer
               End;

   XCardrec =  Record
                  XOldTag:  Array[1..4] of String[55];
                  XOldLine: ARRAY[1..10] of String[55];
               End;

  YKKeyrec =   Record
                  XTagArray:   Array[1..4] of String[40];
                  XUsed:       Boolean;
               End;

  YCCardrec =  Record
                  XCardArray:  Array[1..55,1..16] of Char;
               End;

Var
   Disk1: File of XKeyrec;
   Disk2: File of XCardrec;
   Disk3: File of YKKeyrec;
   Disk4: File of YCCardrec;
   Keyrec:        XKeyrec;
   Cardrec:       XCardrec;
   KKeyrec:       YKKeyrec;
   CCardrec:      YCCardrec;
   Temp,
   OldKeyWord:    String[55];
   NewKeyWord:    String[18];
   FileName:      String[10];
   Drive:         String[2];
   FilePointer,
   RecordCount,
   OldPointer,
   NewPointer,
   Row,
   Column,
   X, Y:     Integer;
   OldTag:   Array[1..4] of String[55];
   NewTag:   Array[1..4] of String[40];
   OldLine:  Array[1..10] of String[55];
   NewArray: Array[1..55,1..16] of Char;
   NewLine:  Array[1..16] of String[55];
   Used:     Boolean;
   Key:      Char;

Procedure IOError;
Var
   Disk:  File;
   Num:   Integer;
   IOErr: Boolean;
   Key:   Char;

Begin
   Num := 0;
   IOErr := false;
   Num := IOresult;
   IOErr := (Num <> 0);
   If IOErr then
   Begin
      Write(chr(7));
      Clrscr;
      Gotoxy(20,12);
      Case Num of
         $01:  Write('File does not exist');
         $02:  Write('File not open for input');
         $03:  Write('File not open for output');
         $04:  Write('File not open');
         $05:  Write('Can''t read from this file');
         $06:  Write('Can''t write to this file');
         $10:  Write('Error in numeric format');
         $20:  Write('Operation not allowed on a logical device');
         $21:  Write('Not allowed in the direct mode');
         $22:  Write('Assign to standard files not allowed');
         $90:  Write('Record length mismatch');
         $91:  Write('Seek beyond end of file');
         $99:  Write('Unexpected end of file');
         $F0:  Write('Disk write error');
         $F1:  Write('Directory is full');
         $F2:  Write('File size overflow');
         $FF:  Write('File dissappeared!');
         Else  Write('Unknown I/O Error: ',Num:3);
      End;
      Gotoxy(20,14);
      Write('Type any key to continue... ');
      Read(Kbd,Key);
      Clrscr;
      Halt;
   End;
End;

Procedure Screen;
Begin
   Clrscr;
   GotoXY(30,1);
   Write('FILE CARD DATABASE 4.6');
   GotoXY(30,3);
   Write('File Transfer Program');
   GotoXY(1,4);
   Write('--------------------------------------------------------------------------------');
   GotoXY(6,6);
   Write('This program is used to copy and restructure the data files of the original');
   GotoXY(1,7);
   Write('FILE CARD DATABASE program for use by version 4.6 . The original version of the');
   GotoXY(1,8);
   Write('program had no version number displayed at the Main Menu.');
   GotoXY(6,10);
   Write('This program (XFER.COM) must be on the same disk that you intend to use as');
   GotoXY(1,11);
   Write('data file for version 4.6 . It must be run from the currently logged drive. For');
   GotoXY(1,12);
   Write('example, If you are at the A> prompt then the data disk which contains this pro-');
   GotoXY(1,13);
   Write('gram must be in the A: drive.');
   GotoXY(6,15);
   Write('You will be asked, now, for the location of the old data files. If the');
   GotoXY(1,16);
   Write('original data disk is in the B: drive, then enter B: at the prompt. Don`t forget');
   GotoXY(1,17);
   Write('the colon!  It`s not a bad idea to make a copy of your original data files');
   GotoXY(1,18);
   Write('before running this program, just in case something goes wrong. You can`t copy');
   GotoXY(1,19);
   Write('the old files to the new on the SAME DISK!! If you do, the old files will be');
   GotoXY(1,20);
   Write('erased as soon as you start.');
   GotoXY(1,22);
   Write('Enter the original data drive: __');
End;

Procedure GetDrive;
Var
   Done: Boolean;
Begin
   Done := false;
   Repeat
      Gotoxy(32,22);
      Read(Drive);
      If (length(Drive) = 2) AND (Drive[2] = ':') then
      Begin
         Done := true;
      End
      Else
      Begin
         Write(chr(7));
         Gotoxy(40,22);
         Write('Bad Drive designator! ');
         Read(Kbd,Key);
         Gotoxy(32,22);
         Write('__');
         ClrEOL;
      End;
   Until Done;
   Drive[1] := upcase(Drive[1]);
   Gotoxy(32,22);
   Write(Drive);
   Gotoxy(1,24);
   Write('Now, enter an asterisk to continue...any other key to abort: ');
   Read(Kbd,Key);
   If Key <> '*' then
   Begin
      Clrscr;
      Halt;
   End;
   Clrscr;
End;

Procedure Initvar;
Begin
   For Row := 1 to 10 do
   Begin
      OldLine[Row] := '';
   End;
   For Row := 1 to 16 do
   Begin
      NewLine[Row] := '';
      For Column := 1 to 55 do
      Begin
         NewArray[Column,Row] := ' ';
      End;
   End;
   For Row := 1 to 4 do
   Begin
      OldTag[Row] := '';
      NewTag[Row] := '';
   End;
End;

Procedure HaltDisk;
Var
   Sysbyte:   Byte;

Begin
   SysByte := Port[20];
   SysByte := (SysByte AND $EF);  { XXX0 XXXX }
   Port[20] := SysByte;
End;

Procedure CopyFiles;
Begin
   {$I-}
   Gotoxy(1,4);
   Write('COPYING "KEYLIST"...');
   FileName := concat(Drive,'KEYLIST');
   Assign(Disk1,FileName);
   Reset(Disk1);
   IOError;
   FileName := 'KEYLIST';
   Assign(Disk3,FileName);
   Rewrite(Disk3);
   IOError;
   RecordCount := Filesize(Disk1);
   OldPointer := 0;
   NewPointer := 0;
   Used := true;
   Repeat
      For X := 1 to 4 do
      Begin
         Seek(Disk1,OldPointer);
         IOError;
         With Keyrec do
         Begin
            Read(Disk1,Keyrec);
            IOError;
            OldTag[X] := XOldKeyWord;
            Y := XOldPointer;
         End;
         OldPointer := (OldPointer + 1);
      End;
      For X := 1 to 4 do
      Begin
         Temp := OldTag[X];
         For Y := 1 to 55 do Temp[Y] := upcase(Temp[Y]);
         NewTag[X] := Temp;
         Gotoxy(1,(5+X));  Write('OLD: ',OldTag[X],'                ');
         Gotoxy(1,(11+X)); Write('New: ',NewTag[X],'                ');
      End;
      Seek(Disk3,Newpointer);
      IOError;
      Gotoxy(1,18); Write('Record#  ',NewPointer:4);
      With KKeyrec do
      Begin
         For X := 1 to 4 do
         Begin
            XTagArray[X] := NewTag[X];
         End;
         XUsed := Used;
         Write(Disk3,KKeyrec);
         IOError;
      End;
      NewPointer := (NewPointer + 1);
   Until OldPointer = RecordCount;
   Close(Disk1);
   IOError;
   Close(Disk3);
   IOError;
   Gotoxy(1,20);
   Write('COPYING "CARDFILE"...');
   FileName := concat(Drive,'CARDFILE');
   Assign(Disk2,FileName);
   Reset(Disk2);
   IOError;
   FileName := 'CARDFILE';
   Assign(Disk4,FileName);
   Rewrite(Disk4);
   IOError;
   RecordCount := Filesize(Disk2);
   For Y := 0 to (RecordCount-1) do
   Begin
      Gotoxy(1,22);
      Write('Record# ',Y:4);
      With Cardrec do
      Begin
         Read(Disk2,Cardrec);
         IOError;
         For Row := 1 to 4 do
         Begin
            OldTag[Row] := XOldtag[Row];
         End;
         For Row := 1 to 10 do
         Begin
            OldLine[Row] := XOldLine[Row];
         End;
      End;
      For Row := 1 to 10 do
      Begin
         Temp := OldLine[Row];
         For Column := 1 to 55 do
         Begin
            NewArray[Column,Row] := Temp[Column];
         End;
      End;
      Seek(Disk4,Y);
      IOError;
      With CCardrec do
      Begin
         For Row := 1 to 16 do
         Begin
            For Column := 1 to 55 do
            Begin
               XCardArray[Column,Row] := NewArray[Column,Row];
            End;
         End;
         Write(Disk4,CCardrec);
         IOError;
      End;
   End;
   Close(Disk2);
   IOError;
   Close(Disk4);
   IOError;
   {$I+}
End;

Begin
   Clrscr;
   Initvar;
   Screen;
   GetDrive;
   CopyFiles;
   Write(chr(7));
   Gotoxy(1,23);
   Write('DONE  ');
End.