home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / refrecov.zip / FLEXREC.PAS < prev    next >
Pascal/Delphi Source File  |  1986-06-20  |  23KB  |  851 lines

  1. { FLEXREC.PAS
  2.   Preliminary version of a program that recovers good records from
  3.   a bad reflex file and sends them to a .PRN file.  Lots of room
  4.   for improvement but it may some people some head.
  5.                       6/20/86    written by Joe Schrader }
  6.  
  7. const
  8.   NameLength = 66;
  9.   MessageLen = 80;
  10.   FirstError : boolean = true;
  11.   Debug : boolean = false;
  12.  
  13. type
  14.   Message  = String[MessageLen];
  15.   Address  = ^byte;
  16.  
  17.   long = record
  18.            LoWord,
  19.            HiWord : integer;
  20.          end;
  21.  
  22.   SectionDesc = record
  23.                   SectionType : integer;
  24.                   SectionAddr,
  25.                   SectionLen : long;
  26.                end; { SectionDesc }
  27.  
  28.   { Fixed size Reflex file header we are mainly interested in the
  29.     DfSection field which has the addresses for the other sections
  30.     of the file }
  31.   RefHeader = record
  32.                 HdrSz : integer;
  33.                 Stamp : array[1..12] of char;
  34.                 Dirty,
  35.                 VerViews,
  36.                 VerModels,
  37.                 VerData,
  38.                 fRecalc  : integer;
  39.                   { If error set fRecalc so that Reflex will recalculate }
  40.                 ScreenType,
  41.                 CheckSum : byte;
  42.                 Reserved : array[1..38] of byte;
  43.                 SectionCt : integer;
  44.                 DfSection : array[1..44] of SectionDesc;
  45.                 buffer : real;
  46.               end; { RefHeader }
  47.  
  48. type
  49.   VarLenBuf = record            { represents a variable length buffer }
  50.                 Len : integer;                 { length of the buffer }
  51.                 Buf : ^byte;      { pointer to the buffer, use GetMem }
  52.               end;
  53.   FileName = String[66];
  54.   Str255 = String[255];
  55.   ErrorStr = String[80];
  56.  
  57. const
  58.   DataOk : boolean = true;
  59.   DataReals : boolean = true;
  60.  
  61. var
  62.   DataErrorStr : ErrorStr;
  63.   InFile : file;
  64.   OutFile, ErrorFile : text;
  65.  
  66. procedure DataError(Error : ErrorStr);
  67. begin
  68.   DataOk := false;
  69.   DataErrorStr := Error;
  70. end; { DataError }
  71.  
  72. procedure LongToReal(L : Long; var R : real);
  73. begin
  74.   with L do
  75.   begin
  76.     R := (65536.0 * HiWord);
  77.     if LoWord < 0 then
  78.       R := R + 65536.0 + LoWord
  79.     else
  80.       R := R + LoWord;
  81.   end;
  82. end; { LongToReal }
  83.  
  84. procedure QuitProgram(M : Message);
  85. begin
  86.   Write(^G, M );
  87.   Close(OutFile);
  88.   Close(ErrorFile);
  89.   Halt;
  90. end; { QuitProgram }
  91.  
  92. procedure ReadBuffer(var InFile : File;
  93.                      var B : VarLenBuf);
  94. var
  95.   RecsRead : integer;
  96. begin
  97.   with B do
  98.   begin
  99.     BlockRead(InFile, Len, 2, RecsRead);
  100.     GetMem(Buf, Len);
  101.     BlockRead(InFile, Buf^, Len, RecsRead);
  102.     if RecsRead <> Len then
  103.       if LongFileSize(InFile) = LongFilePos(InFile) then
  104.         QuitProgram('We are prematurely at the the end of the file');
  105.   end;
  106. end; { ReadBuffer }
  107.  
  108. procedure GetText(FieldNameText : VarLenBuf;
  109.                   Offset : integer;
  110.                   var T : Str255);
  111. { Gets a null terminated string of text from the
  112.   at the specified offset in a variable length buffer }
  113. var
  114.   CurByte : byte;
  115. begin
  116.   T := '';
  117.   with FieldNameText do
  118.   repeat
  119.     CurByte := Mem[Seg(Buf^):Ofs(Buf^) + Offset];
  120.     if CurByte <> 0 then
  121.       T := T + Chr(CurByte);
  122.      Offset := Offset + 1;
  123.   until (CurByte = 0) or (Offset > Len) or (Length(T) = 255);
  124. end; { GetText }
  125.  
  126. procedure NameError(StartX, Width : integer);
  127. begin
  128.   Write( ^G);
  129.   GotoXY(StartX, WhereY);
  130.   Write(' ':Width);
  131.   GotoXY(StartX, WhereY);
  132. end; { NameError }
  133.  
  134. procedure StripExt(var F : FileName);
  135. { Strips of the file extension, including the '.' }
  136. var
  137.   Dot : byte;
  138. begin
  139.   Dot := Pos('.', F);
  140.   if Dot > 0 then
  141.     Delete(F, Dot, Length(F) - Dot + 1);
  142.   for Dot := 1 to Length(F) do
  143.     F[Dot] := UpCase(F[Dot]);
  144. end; { StripExt }
  145.  
  146. procedure OpenReflexFile(var ReflexFile : file; var OutFile : text);
  147. var
  148.   StartX : byte;
  149.   Ok : boolean;
  150.   RefFileNm : FileName;
  151. begin
  152.   Write('Enter the name of the Reflex data file: ');
  153.   StartX := WhereX;
  154.   repeat
  155.     BufLen := NameLength;
  156.     Read(RefFileNm);
  157.     Ok := Length(RefFileNm) > 0;
  158.     if Ok then
  159.     begin
  160.       Assign(ReflexFile, RefFileNm);
  161.       {$I-}
  162.       Reset(ReflexFile, 1);
  163.       Ok := (IOresult = 0);
  164.     end;
  165.     if not Ok then
  166.       NameError(StartX, Length(RefFileNm));
  167.   until Ok;
  168.   {$I+}
  169.   StripExt(RefFileNm);
  170.   Assign(OutFile, RefFileNm + '.PRN');
  171.   Writeln;
  172.   Writeln('Outputting to file ', RefFileNm + '.PRN');
  173.   Rewrite(OutFile);
  174.   Writeln('Outputting errors to ', RefFileNm + '.ERR');
  175.   Assign(ErrorFile, RefFileNm + '.ERR');
  176.   Rewrite(ErrorFile);
  177.   Writeln(ErrorFile, 'Diagnostic Summary of ', RefFileNm + '.RXD');
  178.   Writeln(ErrorFile);
  179. end; { OpenReflexFile }
  180.  
  181.  
  182. type
  183.   SectionNames = (FieldDir, MasterRec, DataRecs, GFilter, GMode,
  184.                   OverVec, ViewState, ViewScale, FormView, ListView,
  185.                   CrossTab, GraphView);
  186. const
  187.   Sections : array[SectionNames] of byte =
  188.                (2,9,1,17,11,21,5,24,12,13,14,15);
  189.  
  190. procedure ReadHeader(var InFile : File;
  191.                      var Header : RefHeader);
  192. var
  193.   BlocksRead : integer;
  194. begin
  195.   FillChar(Header,SizeOf(Header),0);
  196.   BlockRead(InFile, Header, SizeOf(Header), BlocksRead);
  197.   if BlocksRead <> SizeOf(Header) then
  198.     QuitProgram('The Reflex File Header is the wrong size');
  199. end; { ReadHeader }
  200.  
  201. procedure GetSectionAddr(var Header : RefHeader;
  202.                          CurSection : SectionNames;
  203.                          var SecAddr,
  204.                              SecLen : real);
  205. var
  206.   i : integer;
  207.   SectionFound : boolean;
  208. begin
  209.   with Header do
  210.   begin
  211.     i := 1;
  212.     repeat
  213.       SectionFound := (DfSection[i].SectionType = Sections[CurSection]);
  214.       if SectionFound then
  215.       begin
  216.         LongToReal(DfSection[i].SectionAddr, SecAddr);
  217.         LongToReal(DfSection[i].SectionLen, SecLen);
  218.       end;
  219.       i := i + 1;
  220.     until (i > SectionCt) or SectionFound;
  221.     if not SectionFound then
  222.       QuitProgram('No section found');
  223.   end;
  224. end; { CheckSectionDesc }
  225.  
  226. var
  227.   NumRecs : integer;
  228.   Header : RefHeader;
  229.   FieldNameIndex,
  230.   FieldNameText,
  231.   FieldDirectory : VarLenBuf;
  232.   DataAddr : real;
  233.  
  234. procedure SkipSortInfo(var InFile : File);
  235. const
  236.   SortSize = 12;
  237. var
  238.   SortInfo : array[1..SortSize] of byte;
  239.   RecsRead : integer;
  240. begin
  241.   BlockRead(InFile, SortInfo, SizeOf(SortInfo), RecsRead);
  242. end; { SkipSortInfo }
  243.  
  244. procedure BuildFieldNameTbls(var InFile : File);
  245. begin
  246.   SkipSortInfo(InFile);
  247.   ReadBuffer(InFile, FieldNameIndex);
  248.   ReadBuffer(InFile, FieldNameText);
  249.   ReadBuffer(InFile, FieldDirectory);
  250. end; { BuildFieldNameTbls }
  251.  
  252. const
  253.   MaxField  = 249;
  254.   Untyped   = 0; { Temporary }
  255.   LocalText = 1;
  256.   RepText   = 2;
  257.   Date      = 3;
  258.   Numeric   = 4;
  259.   IntVal    = 5;
  260.  
  261. type
  262.   ETRec = record
  263.             Index,
  264.             Pool : long;
  265.           end;
  266.   DescPtr = ^FieldDesc;
  267.   FieldDesc = record
  268.                 NameOffset : integer;
  269.                 DataType   : byte;
  270.                 PrecForm   : byte;
  271.                 FieldOffset : integer;
  272.                 Etr : ETRec;
  273.                 (* IsDescending, *)
  274.                 SortPos,
  275.                 Reserved : byte;
  276.               end;
  277.     FieldDescTbl = array[0..MaxField] of DescPtr;
  278.     RepTPool  =  ^TextPool;
  279.     TextPool = record
  280.                  FIDNum : byte;
  281.                  PoolIndex,
  282.                  Pool : VarLenBuf;
  283.                  Next : RepTPool;
  284.                end;
  285.  
  286.   const
  287.     DataFields : array[UnTyped..IntVal] of String[20] =
  288.                       ('Untyped', 'Text', 'Repeating Text',
  289.                        'Date', 'Numeric', 'Integer');
  290.  
  291. var
  292.   FieldDescriptors : FieldDescTbl;
  293.   RepTextPool : RepTPool;
  294.  
  295.  
  296. procedure GetFieldDesc(FieldDirectory : VarLenBuf;
  297.                            FieldNum : integer;
  298.                        var CurField : FieldDesc);
  299. var
  300.   Start, Offset : integer;
  301. begin
  302.   Start := FieldNum * SizeOf(CurField);
  303.   with FieldDirectory do
  304.     for OffSet := 0 to SizeOf(CurField) - 1 do
  305.     begin
  306.       Mem[Seg(CurField):Ofs(CurField) + Offset] :=
  307.       Mem[Seg(Buf^):Ofs(Buf^) + Start + Offset];
  308.     end; { for }
  309. end; { GetFieldDesc }
  310.  
  311. procedure AddPool(var RepTextPool : RepTPool;
  312.                   var T : TextPool);
  313. var
  314.   P : RepTPool;
  315. begin
  316.   New(P);
  317.   P^ := T;
  318.   if RepTextPool <> nil then
  319.     P^.next := RepTextPool;
  320.   RepTextPool := P;
  321. end; { AddPool }
  322.  
  323.  
  324.  
  325. procedure BuildRepTextPool(var InFile : File;
  326.                            var FieldDescriptors : FieldDescTbl;
  327.                            FieldCount : byte);
  328. var
  329.   CurPool : TextPool;
  330. begin
  331.   for FieldCount := FieldCount downto 0 do
  332.     with FieldDescriptors[FieldCount]^, CurPool do
  333.       if FieldDescriptors[FieldCount]^.DataType = RepText then
  334.       begin
  335.         FIDNum := FieldCount;
  336.         ReadBuffer(InFile, PoolIndex);
  337.         ReadBuffer(InFile, Pool);
  338.         Next := nil;
  339.         AddPool(RepTextPool, CurPool);
  340.       end;
  341. end; { BuildRepTextPool }
  342.  
  343. procedure BuildFieldDescTbl(var InFile : File;
  344.                             var FieldDirectory : VarLenBuf;
  345.                             FieldCount : byte);
  346. const
  347.   SkipSize = 6;
  348. var
  349.   CurDesc : 0..MaxField;
  350.   CurField : FieldDesc;
  351. begin
  352.   for CurDesc := 0 to MaxField do
  353.     FieldDescriptors[CurDesc] := nil;
  354.   for CurDesc := 0 to (FieldCount - 1) do
  355.   begin
  356.     New(FieldDescriptors[CurDesc]);
  357.     GetFieldDesc(FieldDirectory, CurDesc, CurField);
  358.     FieldDescriptors[CurDesc]^ := CurField;
  359.   end;
  360.   LongSeek(InFile, FilePos(InFile) + SkipSize);
  361.   BuildRepTextPool(InFile, FieldDescriptors, FieldCount - 1);
  362. end; { BuildFieldDescTbl }
  363.  
  364. procedure OutputFieldNames(var OutFile : text;
  365.                            FieldCount : integer;
  366.                            var FieldNameText : VarLenBuf);
  367. var
  368.   NmFields,
  369.   StartText : integer;
  370.   FieldName : Str255;
  371. begin
  372.   if Debug then
  373.   begin
  374.     Writeln;
  375.     Writeln( 'The number of fields is ', FieldCount);
  376.   end;
  377.   for NmFields := 0 to FieldCount - 1 do
  378.     with FieldDescriptors[NmFields]^ do
  379.     begin
  380.       GetText(FieldNameText, NameOffset, FieldName);
  381.       Write(OutFile, '"',FieldName, '",');
  382.     end;
  383.     Writeln(OutFile);
  384. end; { OutputFieldNames }
  385.  
  386.  
  387. procedure OutputFieldTypes(var ErrorFile : text;
  388.                            FieldCount : integer;
  389.                            var FieldNameText : VarLenBuf);
  390. var
  391.   NmFields,
  392.   StartText : integer;
  393.   FieldName : Str255;
  394. begin
  395.   Writeln(ErrorFile);
  396.   Writeln(ErrorFile, 'The number of fields is ', FieldCount);
  397.   for NmFields := 0 to FieldCount - 1 do
  398.     with FieldDescriptors[NmFields]^ do
  399.     begin
  400.       GetText(FieldNameText, NameOffset, FieldName);
  401.       Writeln(ErrorFile, '"',FieldName, '" : ', DataFields[DataType]);
  402.     end;
  403. end; { OutputFieldTypes }
  404.  
  405. procedure LoadFieldDir(var InFile : File; var OutFile : text;
  406.                        var Header : RefHeader);
  407. var
  408.   FieldDirAddr, FieldDirLen : real;
  409. begin
  410.   GetSectionAddr(Header, FieldDir, FieldDirAddr, FieldDirLen);
  411.   Writeln(ErrorFile, 'The address of the field directory is ', FieldDirAddr:1:0);
  412.   Writeln(ErrorFile, 'Field directory length is ', FieldDirLen:1:0);
  413.   LongSeek(InFile, FieldDirAddr);
  414.   BuildFieldNameTbls(InFile);
  415.   BuildFieldDescTbl(InFile, FieldDirectory, Lo(FieldNameIndex.Len div 2));
  416.   OutputFieldNames(OutFile, FieldNameIndex.Len div 2, FieldNameText);
  417.   OutputFieldTypes(ErrorFile, FieldNameIndex.Len div 2, FieldNameText);
  418. end;
  419.  
  420. type
  421.   ieee       = array[1..8] of byte;
  422.   turbo_real = array[1..6] of byte;
  423.   mant       = array[1..5] of byte;
  424.  
  425. procedure IEEEtoTurbo(long : ieee; var r : real);
  426.      { Convert from IEEE to Turbo Pascal's 6-byte real format }
  427. var
  428.   i : integer;
  429.   e : byte;
  430.   t : turbo_real absolute r;
  431.   sign : byte;
  432.  
  433. begin
  434.   { initialize variables }
  435.  
  436.   r := 0.0;
  437.   for i := 2 to 5 do
  438.     t[i] := 0;
  439.  
  440.   i := (long[8] and $7f) shl 4;       { get 7 highest bits of exponent }
  441.   i := i or ((long[7] and $f0) shr 4);{ get rest of exponent }
  442.  
  443. (*
  444.   if (i < 985) or (i > 1061) then     { check to make sure exponent }
  445.   begin                               { is in legal range }
  446.     Writeln(ErrorFile);
  447.     Writeln(ErrorFile, 'exponent too large');
  448.     exit;
  449.   end;
  450. *)
  451.  
  452.   i := i - 1023;                         { take out bias }
  453.   t[1] := i + $81;                       { put in new bias }
  454.   sign := long[8] and $80;               { get sign bit }
  455.  
  456.      { build up most significant byte }
  457.  
  458.   t[6] := sign + ((long[7] and $0f) shl 3) or ((long[6] and $e0) shr 5);
  459.  
  460.   {make rest of real number in groups of 5 and 3 }
  461.  
  462.   for i := 5 downto 2 do
  463.     t[i] := ((long[i+1] and $1f) shl 3) or ((long[i] and $e0) shr 5);
  464.  
  465. end; { IEEEtoTurbo }
  466.  
  467. function floor(x : real): real;
  468. begin
  469.   if (x < 0) and (frac(x) <> 0) then
  470.     floor := int(X) - 1.0
  471.   else
  472.     floor := int(X);
  473. end; { floor }
  474.  
  475. procedure CalDate(date : real; var year, month, day : integer);
  476. var
  477.   a,aa,b,c,d,e,z : real;
  478.   y : integer;
  479. begin
  480.   z := int(date + 2444239.0);
  481.   if date < -145078.0 then
  482.     a := z
  483.   else
  484.   begin
  485.     aa := floor((z-1867216.25)/36524.25);
  486.     a := z + 1 + aa - floor(aa/4.0);
  487.   end;
  488.   b := a + 1524.0;
  489.   c := int((b - 122.1)/365.25);
  490.   d := int(365.25*c);
  491.   e := int((b-d)/30.6001);
  492.   day := trunc(b - d - int(30.6001 * e));
  493.   if e > 13.5 then month := trunc(e - 13.0)
  494.   else month := trunc(e - 1.0);
  495.   if month > 2 then y := trunc(c - 4716.0)
  496.   else y := trunc(c - 4715.0);
  497.   if y < 1 then year := y - 1
  498.   else year := y;
  499. end; { CalDate }
  500.  
  501. const
  502.   MonthNames : array[1..12] of string[20] =
  503.     ('January', 'Febuary', 'March', 'April', 'May', 'June', 'July',
  504.      'August', 'September', 'October', 'November', 'December');
  505.  
  506. procedure WriteDate(var OutFile : text; Date : real);
  507. var
  508.   Year, Month, Day : integer;
  509. begin
  510.   CalDate(Date, Year, Month, Day);
  511.   Write(OutFile, Month, '/',Day + 1, '/',Year - 80);
  512. end; { WriteDate }
  513.  
  514. procedure WriteMonthYear(var OutFile : text; Date : real);
  515. var
  516.   Year, Month, Day : integer;
  517. begin
  518.   Date := Date + 1;
  519.   CalDate(Date, Year, Month, Day);
  520.   Write(OutFile, Month, '/',Day + 1, '/', Year - 80);
  521. end; { WriteMonthYear }
  522.  
  523. procedure GetNumRecs(var InFile : File; var NumRecs : integer);
  524. var
  525.   MasterRecord : record
  526.                    Num,
  527.                    Filter : integer;
  528.                  end;
  529.   MasterAddr, MasterLen : real;
  530. begin
  531.   GetSectionAddr(Header, MasterRec, MasterAddr, MasterLen);
  532.   Writeln(ErrorFile);
  533.   Writeln(ErrorFile, 'Master record address: ', MasterAddr:1:0);
  534.   LongSeek(InFile, MasterAddr);
  535.   BlockRead(InFile, MasterRecord, SizeOf(MasterRecord), NumRecs);
  536.   NumRecs := MasterRecord.Num;
  537.   Writeln(ErrorFile);
  538.   Writeln(ErrorFile, 'The number of records is ', NumRecs);
  539. end; { GetNumRecs }
  540.  
  541. type
  542.   RecHdr = record
  543.              temp : array[1..3] of byte;
  544.              CtFlds : byte;
  545.            end;
  546.  
  547. procedure GetFieldCount(var RecBuf : VarLenBuf;
  548.                         var FieldCount : byte);
  549. var
  550.  CurRec : RecHdr;
  551. begin
  552.   with RecBuf, CurRec do
  553.   begin
  554.     Move(Buf^, CurRec, SizeOf(CurRec));
  555.     FieldCount := CtFlds;
  556.   end;
  557. end; { GetFieldCount }
  558.  
  559. procedure DisplayLocText(var OutFile : text;
  560.                          var RecBuf : VarLenBuf;
  561.                          var Offset : integer);
  562. var
  563.   TextPos : integer;
  564.   LocalText : Str255;
  565.   temp : byte;
  566. begin
  567.   with RecBuf do
  568.   begin
  569.     TextPos := MemW[Seg(Buf^):Ofs(Buf^) + Offset];
  570.     Offset := Offset + 2;             { Move the offset to the next field }
  571.     GetText(RecBuf, TextPos, LocalText);
  572.     for temp := 1 to length(LocalText) do  (* temporary *)
  573.     begin
  574.       if not (ord(LocalText[temp]) in [32..127]) then
  575.         LocalText[temp] := ' ';
  576.     end;
  577.     if Length(LocalText) > 0 then
  578.       Write(OutFile, '"',LocalText, '"')
  579.     else
  580.       Write(OutFile, '""');
  581.   end;
  582. end; { DisplayLocText }
  583.  
  584. procedure GetPool(var CurPool : RepTPool;
  585.                       FieldNum : integer;
  586.                   var PoolFound : boolean);
  587. begin
  588.   PoolFound := false;
  589.   while (CurPool <> nil) and not PoolFound do
  590.     with CurPool^ do
  591.     begin
  592.       PoolFound := (FIDNum = FieldNum);
  593.       if not PoolFound then
  594.         CurPool := CurPool^.Next
  595.     end;
  596. end; { GetPool }
  597.  
  598. procedure GetRepText(FieldNum, TextPos : integer;
  599.                      var RepText : Str255);
  600. var
  601.   CurPool : RepTPool;
  602.   PoolFound : boolean;
  603.   i : integer;
  604.  
  605. begin
  606.   CurPool := RepTextPool;
  607.   GetPool(CurPool, FieldNum, PoolFound);
  608.   if PoolFound then
  609.   begin
  610.     GetText(CurPool^.Pool, TextPos, RepText);
  611.     for i := 1 to Length(RepText) do           { temporary }
  612.       if not (ord(RepText[i]) in [32..127]) then
  613.       begin
  614.         RepText := '';
  615.         Exit;
  616.       end;
  617.   end
  618.   else
  619.     RepText := '';
  620. end; { GetRepText }
  621.  
  622. procedure OutputRepTextpool(var ErrorFile : Text;
  623.                             var RepTextPool : RepTPool);
  624. var
  625.   Traverse : RepTPool;
  626.   Offset, i, temp : integer;
  627.   RepText : Str255;
  628.  
  629. begin
  630.   Traverse := RepTextPool;
  631.   Writeln(ErrorFile);
  632.   Writeln(ErrorFile, 'The repeating text pool: ');
  633.   Writeln(ErrorFile);
  634.   while Traverse <> nil do
  635.     with Traverse^ do
  636.     begin
  637.       Writeln(ErrorFile, 'Field number ', FIDNum);
  638.       Offset := 0;
  639.       for i := 1 to PoolIndex.Len do
  640.       begin
  641.         temp := MemW[Seg(PoolIndex.Buf^):Ofs(PoolIndex.Buf^) + Offset];
  642.         Write(ErrorFile, 'Text offset: ', temp);
  643.         GetRepText(FIDNum, temp, RepText);
  644.         Offset := Offset + 2;
  645.         Writeln(ErrorFile, ' "',RepText,'"');
  646.       end;
  647.       Writeln(ErrorFile);
  648.       Traverse := next;
  649.     end;
  650. end; { OutputRepTextPool }
  651.  
  652. {$I VERIFY.INC}
  653.  
  654. procedure DisplayRepText(var OutFile : text;
  655.                          var RecBuf : VarLenBuf;
  656.                          FieldNum : byte;
  657.                          var Offset : integer);
  658. var
  659.   TextPos : integer;
  660.   RepText : Str255;
  661. begin
  662.   with RecBuf do
  663.   begin
  664.     TextPos := MemW[Seg(Buf^):Ofs(Buf^) + Offset];
  665.     Offset := Offset + 2;    { Move the offset to the next field }
  666.     GetRepText(FieldNum, TextPos, RepText);
  667.     if Length(RepText) > 0 then
  668.       Write(OutFile, '"',RepText,'"')
  669.     else
  670.       Write(OutFile, '""');
  671.   end;
  672. end; { DisplayRepText }
  673.  
  674. procedure DisplayInteger(var OutFile : text;
  675.                          var RecBuf : VarLenBuf;
  676.                          var Offset : integer);
  677. begin
  678.   with RecBuf do
  679.     Write(OutFile, MemW[Seg(Buf^):Ofs(Buf^) + Offset]);
  680.   Offset := Offset + 2;
  681. end; { DisplayInteger }
  682.  
  683. procedure DisplayDate(var OutFile : text;
  684.                       var RecBuf : VarLenBuf;
  685.                       var Offset : integer;
  686.                             form : byte);
  687. var
  688.   r : real;
  689.   i : integer;
  690. begin
  691.   with RecBuf do
  692.   begin
  693.      i := MemW[Seg(Buf^):Ofs(Buf^) + Offset];
  694.      r := abs(i);
  695.      if Form = 4 then
  696.        WriteMonthYear(OutFile, r)
  697.      else
  698.        WriteDate(OutFile, r);
  699.   end;
  700.   Offset := Offset + 2;
  701. end; { DisplayDate }
  702.  
  703. procedure DisplayReal(var OutFile : text;
  704.                       var RecBuf : VarLenBuf;
  705.                       var Offset : integer);
  706. const
  707.   Prec = 4;
  708. var
  709.   TempReal : real;  { temporary representation of real number }
  710.   TempIEEE : IEEE;
  711.  
  712. begin
  713.   with RecBuf do
  714.   begin
  715.     Move(Mem[Seg(Buf^) : Ofs(Buf^) + Offset], TempIEEE, SizeOf(TempIEEE));
  716.     IEEEtoTurbo(TempIEEE, TempReal);
  717.     Write(OutFile,TempReal:1:Prec);
  718.     Offset := Offset + 8;
  719.   end;
  720. end; { DisplayReal }
  721.  
  722.  
  723. procedure DisplayField(var OutFile : text;
  724.                        var RecBuf : VarLenBuf;
  725.                           FieldCount : byte;
  726.                       var Offset : integer);
  727. var
  728.   Form : byte;
  729.   FieldName : Str255;
  730. begin
  731.   with RecBuf, FieldDescriptors[FieldCount]^ do
  732.   begin
  733.     GetText(FieldNameText, NameOffset, FieldName);
  734.     case DataType of
  735.       UnTyped   : Writeln(OutFile, '""');  { Add change of offset }
  736.       LocalText : DisplayLocText(OutFile, RecBuf, Offset);
  737.       RepText   : DisplayRepText(OutFile, RecBuf, FieldCount, Offset);
  738.       Date      : begin
  739.                     Form := lo(PrecForm) and $07;
  740.                     DisplayDate(OutFile, RecBuf, Offset, Form);
  741.                   end;
  742.       IntVal    : DisplayInteger(OutFile, RecBuf, Offset);
  743.       Numeric   : DisplayReal(OutFile, RecBuf, Offset);
  744.     end;
  745.   end;
  746. end; { DisplayField }
  747.  
  748. procedure DisplayDataRecord(var OutFile : text;
  749.                             var RecBuf : VarLenBuf);
  750. var
  751.   FieldCount : byte;
  752.   Offset : integer;
  753. begin
  754.   GetFieldCount(RecBuf, FieldCount);
  755.   Offset := 4;
  756.   for FieldCount := 0 to (FieldCount - 1) do
  757.   begin
  758.     DisplayField(OutFile, RecBuf, FieldCount, Offset);
  759.     Write(OutFile, ',');
  760.   end;
  761.   Writeln(OutFile);
  762. end; { DisplayDataRecord }
  763.  
  764. procedure ReadDataRec(var InFile : File; var OutFile : text;
  765.                       CurRec : integer);
  766. var
  767.   RecBuf : VarLenBuf;
  768.   Verified : TestRec;
  769.   Abort : boolean;
  770.  
  771. begin
  772.   ReadBuffer(InFile, RecBuf);
  773.   with RecBuf, Verified do
  774.   begin
  775.     failed := false;
  776.     VerifyDataRecord(RecBuf, Verified);
  777.     if Failed then
  778.     begin
  779.       Writeln(ErrorFile, 'Recovery ERROR in record ',CurRec, ' : ', Reason);
  780.       Write(ErrorFile, 'Portion recoverd...');
  781.       DisplayDataRecord(ErrorFile, RecBuf);
  782.       if FirstError then
  783.       begin
  784.         FirstError := false;
  785.         ErrorPrompt(CurRec, Abort);
  786.         if Abort then
  787.           QuitProgram('User interrupt');
  788.       end;
  789.     end
  790.     else
  791.       DisplayDataRecord(OutFile, RecBuf);
  792.     FreeMem(Buf, Len);
  793.   end;
  794. end; { ReadDataRec }
  795.  
  796. procedure SeekFirstRec(var InFile : File; var DataAddr : real);
  797. var
  798.   First : integer;
  799.   DataLen : real;
  800. begin
  801.   GetSectionAddr(Header, DataRecs, DataAddr, DataLen);
  802.   Writeln(ErrorFile, 'The address of the data records section is: ', DataAddr:1:0);
  803.   Writeln(ErrorFile, 'The length of the section is: ', DataLen:1:0);
  804.   Writeln(ErrorFile);
  805.   Writeln(ErrorFile, 'ERRORS to follow');
  806.   Writeln(ErrorFile);
  807.   LongSeek(InFile, DataAddr);
  808.   BlockRead(InFile, First, SizeOf(First));
  809. end; { SeekFirstRec }
  810.  
  811.  
  812. procedure ReadDataRecords(var InFile : File;
  813.                           var OutFile : text;
  814.                           var DataAddr : real;
  815.                               NumRecs : integer);
  816. var
  817.   RecsRead,
  818.   CurRec : integer;
  819. begin
  820.   GetNumRecs(InFile, NumRecs);
  821.   Writeln;
  822.   Writeln;
  823.   Writeln('The number of records is ', NumRecs);
  824.   Writeln;
  825.   SeekFirstRec(InFile, DataAddr);
  826.   for CurRec := 1 to NumRecs do
  827.   begin
  828.     Write('Current record ', CurRec , #13);
  829.     ReadDataRec(InFile, OutFile, CurRec);
  830.   end;
  831. end; { ReadDataRecords }
  832.  
  833. procedure SetUp(var InFile : File; var OutFile : text);
  834. begin
  835.   RepTextPool := nil;
  836.   OpenReflexFile(InFile, OutFile);
  837.   ReadHeader(InFile, Header);
  838.   LoadFieldDir(InFile, OutFile, Header);
  839. end; { SetUp }
  840.  
  841. begin
  842.   SetUp(InFile, OutFile);
  843.   ReadDataRecords(InFile, OutFile, DataAddr, NumRecs);
  844.   Close(OutFile);
  845.   Close(ErrorFile);
  846.   if FirstError then   { if no errors occurred we can delete the error file }
  847.   begin
  848.     Writeln;
  849.     Writeln('No errors detected');
  850.   end
  851. end.