home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l041 / 2.ddi / REFLEX.ARC / REFLEX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-31  |  45.0 KB  |  1,474 lines

  1. (****************************************************************)
  2. (*                     DATABASE TOOLBOX 4.0                     *)
  3. (*     Copyright (c) 1984, 87 by Borland International, Inc.    *)
  4. (*                                                              *)
  5. (*                     Reflex Unit                              *)
  6. (*  Routines to create Reflex files from Turbo Pascal Access    *)
  7. (*  files and vice versa.                                       *)
  8. (****************************************************************)
  9. unit Reflex;
  10.  
  11. interface
  12.  
  13. uses DOS,
  14.      CRT,
  15.      FileUtil,
  16.      MiscTool,
  17. {    If a compiler error occurs here, you need to unpack the source
  18.      to the MiscTool unit from the archived file Tools.arc.  See the
  19.      README file on disk 1 for detailed instructions. }
  20.  
  21.      FieldDef,
  22.      RealConv,
  23.      RefDate;
  24.  
  25. const
  26.   MaxSections = 44;     { Maximum number of sections in a Reflex file }
  27.   MaxField = 249;       { Maximum number of fields in Reflex record }
  28.  
  29. type
  30.   FileName = String[66];
  31.   ErrorStr = string[80];
  32.   { Information needed to access a particular logical section  in
  33.     a Reflex file }
  34.   SectionDesc = record
  35.                   SectionType : integer;
  36.                   SectionAddr,
  37.                   SectionLen : LongInt;
  38.                 end; { SectionDesc }
  39.  
  40.   { Fixed length Reflex file header.  We are mostly concerned with
  41.     Dfsection, which holds the information on the other, variable
  42.     length sections in the file where the actual data will be stored }
  43.   RefHeader = record
  44.                 HdrSz : integer;
  45.                 Stamp : array[1..12] of char;
  46.                 Dirty,
  47.                 VerViews,
  48.                 VerModels,
  49.                 VerData,
  50.                 fRecalc  : integer;
  51.                   { If error set fRecalc so that Reflex will recalculate }
  52.                 ScreenType,
  53.                 CheckSum : byte;
  54.                 Reserved : array[1..38] of byte;
  55.                 SectionCt : integer;
  56.                 DfSection : array[1..MaxSections] of SectionDesc;
  57.                 buffer : real;
  58.               end; { RefHeader }
  59.  
  60. { Besides the File Header, a reflex file is built out of variable length
  61.   structures.  Data records for example are variable size.  To represent
  62.   a variable sized record we will use the following structure }
  63.   VarLenBuf = record              { represents a variable length buffer }
  64.                 MaxAllocate,    { length initially allocated for buffer }
  65.                 Len : word;                   { length of the buffer }
  66.                 Buf : ^byte;        { pointer to the buffer, use GetMem }
  67.               end;
  68.  
  69.  
  70.   {  This is how the field names are actually stored in the Reflex file.
  71.      There are three variable length records.  FieldNamePool actually
  72.      contains the names of the record fields.  The FieldNameIndex is
  73.      a pointer into the FieldNamePointers.  FieldDescriptions contains
  74.      the information about each field name (pool ptr), type, offset in
  75.      record etc.  At this time a RepeatingTextPool will not be created.
  76.   }
  77.   ReflexFieldDirectory = record
  78.                            FieldNameIndex,
  79.                            FieldNamePool,
  80.                            FieldDescriptions,
  81.                            RepeatingTextPool : VarLenBuf;
  82.                          end;
  83.  
  84.   ETRec = record
  85.             Index,
  86.             Pool : LongInt;
  87.           end;
  88.   DescPtr = ^FieldDesc;
  89.   FieldDesc = record
  90.                 NameOffset : integer;
  91.                 DataType   : byte;
  92.                 PrecForm   : byte;
  93.                 FieldOffset : integer;
  94.                 Etr : ETRec;
  95.                 SortPos,
  96.                 Reserved : byte;
  97.               end;
  98.  
  99.     FieldDescTbl = array[0..MaxField] of DescPtr;
  100.  
  101.    RepTPool  =  ^TextPool;
  102.    TextPool = record
  103.                 FIDNum : byte;
  104.                 PoolIndex,
  105.                 Pool : VarLenBuf;
  106.                 Next : RepTPool;
  107.               end;
  108.  
  109.   ReflexRef = record
  110. { This record represents a Reflex Database file variables
  111.   of this type are used in almost every routine to indicate
  112.   which Reflex file is being manipulated and the record
  113.   structure of that file. }
  114.     RefFile : File;                      { Reflex file variable }
  115.     CurrentRecord,
  116.     NumberOfRecs : integer;
  117.     Modified : boolean;
  118.     LocalTextPool,                { used for the current record }
  119.     RepeatingTextPool   : VarLenBuf;
  120.     DataSectionAddr,                { start of the data section }
  121.     DataSectionLen : LongInt;         { length of the data section }
  122.     ReflexHeader : RefHeader;              { Reflex file header }
  123.     FieldsIncluded : integer;
  124.     FieldDir : ReflexFieldDirectory;
  125.     FieldDescriptors : FieldDescTbl;
  126.     RepTextPool : RepTPool;
  127.     FixedRecordLen : word;
  128.     TextFields : byte;
  129.     ReflexRec : VarLenBuf;
  130.     FDTable : FieldDirectory;
  131.   end;
  132.  
  133. procedure AddReflexRec(var ReflexF : ReflexRef;
  134.                        var TurboRec);
  135. { Converts the Pascal record TurboRec into a Reflex record
  136.   and adds it to the file specified by ReflexF.
  137. }
  138.  
  139. procedure CloseReflexFile(var ReflexF : ReflexRef);
  140. {  Saves important reflex file header information and closes the
  141.    file specified by ReflexF. Note: This routine is required! when
  142.    modifying reflex files. }
  143.  
  144. procedure GetReflexRec(var ReflexTable : ReflexRef;
  145.                        var TurboRec;
  146.                        RecordNum : integer);
  147. {  Gets a reflex variable length data record specified by
  148.    record num and translates it to a Turbo Pascal fixed length
  149.    record of the type specificed in the .DEF file. }
  150.  
  151. procedure MakeReflexFile(var ReflexF : ReflexRef;
  152.                          RefFileNm : FileName;
  153.                          var FD : FieldDirectory);
  154. { Creates a reflex file name RefFileNm, with a record
  155.   definition specified in FD.  ReflexF will be used to refer
  156.   to this file in all subsequent operation.
  157. }
  158.  
  159. function OpenReflexFile(var ReflexF : ReflexRef;
  160.                             RefFileNm : FileName): boolean;
  161. {  Opens the reflex file named RefFileNm, and generates
  162.    a defintion file which describes the structure
  163.    of the reflex record. ReflexF will be used to refer to
  164.    this file in all subsequent operations. }
  165.  
  166. function ReflexFileLen(var ReflexF : ReflexRef) : integer;
  167. {  Returns the number of Records in the Reflex file referenced
  168.    by ReflexF. }
  169.  
  170. function SetUpReflexFD(var ReflexF : ReflexRef;
  171.                        var FDFileNm : FileSpec;
  172.                        TAccessF,
  173.                        LoadFDFile : boolean) : boolean;
  174.  
  175. implementation
  176.  
  177. {$V-}
  178.  
  179. const
  180.   DataSectionNum = 1;
  181.   MasterSectionNum = 2;
  182.   FieldDirSectionNum = 3;
  183.   FieldDirSection  = 2;   { relevant sections in the reflex file }
  184.   MasterRecSection = 9;
  185.   DataRecSection   = 1;
  186.  
  187. type
  188.   {  We move through the records, one field at a time.  This record
  189.      is used to keep track of the offset into the records. }
  190.   TranslateRec = record
  191.                    ReflexOffset,
  192.                    TurboOffset : word;
  193.                  end;
  194.  
  195. var
  196.   Trans : TranslateRec;
  197.  
  198. procedure TranslateError(E : ErrorStr);
  199. { Tells the user the error and then halts }
  200. begin
  201.   Beep;
  202.   Window(1, 1, 80, 25);
  203.   GotoXY(1, 24);
  204.   Write('Translate Error: ');
  205.   GotoXY(1, 25);
  206.   Write(' ', E, ', terminating...');
  207.   Halt;
  208. end; { TranslateError }
  209.  
  210. procedure AllocateBuf(var V : VarLenBuf; Max : integer);
  211. { Allocates the space for a variable length buffer of Max
  212.   number of bytes }
  213. begin
  214.   FillChar(V, SizeOf(V), 0);
  215.   with V do
  216.   begin
  217.     MaxAllocate := Max;
  218.     GetMem(Buf, MaxAllocate);
  219.   end;
  220. end; { AllocateBuf }
  221.  
  222. procedure DeallocateBuf(var V : VarLenBuf);
  223. { Deallocates the space used by a variable length buffer }
  224. begin
  225.   with V do
  226.   begin
  227.     FreeMem(Buf, MaxAllocate);
  228.     Buf := nil;
  229.   end;
  230. end; { DeallocateBuf }
  231.  
  232. procedure WriteBuffer(var OutFile : File;
  233.                       var B : VarLenBuf);
  234. var
  235.   BlocksWritten : integer;
  236. begin
  237.   with B do
  238.   begin
  239.     BlockWrite(OutFile, Len, SizeOf(Len), BlocksWritten);
  240.     BlockWrite(OutFile, Buf^, Len, BlocksWritten);
  241.   end;
  242. end; { WriteBuffer }
  243.  
  244. procedure ReadBuffer(var InFile : File;
  245.                      var B : VarLenBuf);
  246. var
  247.   RecsRead : integer;
  248. begin
  249.   with B do
  250.   begin
  251.     BlockRead(InFile, Len, 2, RecsRead);
  252.     AllocateBuf(B, Len);
  253.     Len := MaxAllocate;
  254.     BlockRead(InFile, Buf^, Len, RecsRead);
  255.     if RecsRead <> Len then
  256.       TranslateError('In ReadBuffer the length is wrong, eof?...');
  257.   end;
  258. end; { ReadBuffer }
  259.  
  260. procedure GetText(FieldNameText : VarLenBuf;
  261.                   Offset : integer;
  262.                   var T : String);
  263. { Gets a null terminated string of text from the
  264.   at the specified offset in a variable length buffer }
  265. var
  266.   CurByte : byte;
  267. begin
  268.   T := '';
  269.   with FieldNameText do
  270.   repeat
  271.     CurByte := Mem[Seg(Buf^):Ofs(Buf^) + Offset];
  272.     if (CurByte <> 0) and (Length(T) < pred(SizeOf(t))) then
  273.     { temporary }
  274.       T := T + Chr(CurByte);
  275.      Offset := succ(Offset);
  276.   until (CurByte = 0) or (Offset > Len);
  277. end; { GetText }
  278.  
  279. procedure AddBlock(var V : VarLenBuf;
  280.                    var B;
  281.                    NumBytes : integer);
  282. { Copies Numbytes from B onto the end of the variable length
  283.   Buffer B }
  284. begin
  285.   with V do
  286.   begin
  287.     Move(B, Mem[Seg(Buf^):Ofs(Buf^) + Len], NumBytes);
  288.     Len := Len + NumBytes;
  289.   end;
  290. end; { AddBlock }
  291.  
  292. procedure AddTextToPool(var T : VarLenBuf;
  293.                             S : String;
  294.                         var TextOffset : word);
  295. { A text pool is a variable length buffer which contains a
  296.   number of AsciiZ strings.  This routine converts the
  297.   String to an Asccii Z string and copies it onto the
  298.   end of the pool. }
  299. var
  300.   MaxLen : byte;
  301. begin
  302.   if T.Buf = nil then
  303.     TranslateError('In AddTextToPool, the text pool is empty');
  304.   with T do
  305.   begin
  306.     TextOffset := Len;
  307.     MaxLen := Length(S);
  308.     if MaxLen = 255 then
  309.       MaxLen := MaxLen - 1;  { Longest string in Reflex }
  310.     Move(S[1], Mem[Seg(Buf^):Ofs(Buf^) + Len], MaxLen);
  311.     Len := Len + MaxLen;
  312.     Mem[Seg(Buf^):Ofs(Buf^) + Len] := 0;
  313.     Len := Succ(Len);
  314.   end;
  315. end; { AddTextToPool }
  316.  
  317. procedure InitReflexFields(var ReflexF : ReflexRef);
  318. const
  319.   MaxFieldNameLen = 74;
  320. begin
  321.   with ReflexF, FieldDir, FDTable do
  322.   begin
  323.     FillChar(FieldDir, SizeOf(FieldDir), 0);
  324.     FieldsIncluded := FieldTotals[ReflexFile] + FieldTotals[Translate];
  325.     AllocateBuf(FieldNameIndex, FieldsIncluded * 2);
  326.     AllocateBuf(FieldNamePool, FieldsIncluded * MaxFieldNameLen);
  327.     AllocateBuf(FieldDescriptions, FieldsIncluded * SizeOf(FieldDesc));
  328.   end;
  329. end; { InitReflexFields }
  330.  
  331. procedure MakeFieldEntry(var FieldDir : ReflexFieldDirectory;
  332.                          var CurField : FieldInfoPtr;
  333.                          var RecordOffset : integer);
  334. var
  335.   RefField : FieldDesc;
  336.   TextOffset : word;
  337.  
  338. begin
  339.   FillChar(RefField, SizeOf(RefField),  0);
  340.   with FieldDir, CurField^ , RefField do
  341.   begin
  342.     AddTextToPool(FieldNamePool, FieldName, TextOffset);
  343.     NameOffset := TextOffset;
  344.     AddBlock(FieldNameIndex, TextOffset, SizeOf(TextOffset));
  345.     TurboToRefType(CurField^);
  346.     DataType := Ord(ReflexType);
  347.     FieldOffset := RecordOffset;
  348.     AddBlock(FieldDescriptions, RefField, SizeOf(RefField));
  349.     Inc(RecordOffset, FieldDefaults[ReflexType].TypeSize);
  350.   end;
  351. end; { MakeFieldEntry }
  352.  
  353. procedure ConvertFDTable(var ReflexF : ReflexRef);
  354. {  Converts the Field Definition table into the Format that
  355.    Reflex expects for a field directory }
  356. var
  357.   RecordOffset : integer;
  358.   CurField :  byte;
  359. begin
  360.   RecordOffset := 4;
  361.   with ReflexF, FDTable, FieldDir do
  362.   begin
  363.     InitReflexFields(ReflexF);
  364.     for CurField := 0 to (TotalFields - 1) do
  365.       with FieldEntries[CurField]^ do
  366.       if (XLateStatus = Translate)
  367.      or (XLateStatus = ReflexFile) then
  368.       begin
  369.         MakeFieldEntry(FieldDir, FieldEntries[CurField], RecordOffset);
  370.         if FieldEntries[CurField]^.ReflexType = TextVal then
  371.           Inc(TextFields);
  372.       end;
  373.     FixedRecordLen := RecordOffset;
  374.   end;
  375. end; { ConvertFDTable }
  376.  
  377.  
  378. procedure CloseReflexFile(var ReflexF : ReflexRef);
  379. { Saves important reflex file header information and closes the
  380.   file specified by ReflexF. Note: This routine is required! when
  381.   modifying reflex files.
  382. }
  383.  
  384. procedure PutMasterRec(var ReflexF : ReflexRef);
  385. var
  386.   Master : record
  387.              Total,
  388.              Filtered : integer;
  389.            end;
  390.    BlocksWritten : integer;
  391. begin
  392.   with ReflexF, Master do
  393.   begin
  394.     with ReflexHeader.DfSection[MasterSectionNum] do
  395.     begin
  396.       SectionType := MasterRecSection;
  397.       SectionAddr := FilePos(RefFile);
  398.       SectionLen := SizeOf(Master);
  399.     end;
  400.     Total := CurrentRecord;
  401.     Filtered := CurrentRecord;
  402.     BlockWrite(RefFile, Master, SizeOf(Master), BlocksWritten);
  403.   end;
  404. end; { PutMasterRec }
  405.  
  406. procedure PutFieldDir(var ReflexF : ReflexRef);
  407. var
  408.   FieldDir : ReflexFieldDirectory;
  409.   SavedPosition : LongInt;
  410.  
  411. procedure WriteFieldDir(var RefFile : File;
  412.                         var FieldDir : ReflexFieldDirectory);
  413. const
  414.   FieldSortSpec : array[1..12] of byte =
  415.                     ($FF,0,0,0,0,0,0,0,0,0,0,0);
  416.   DefaultFormat : array[1..6] of byte =
  417.                     ($13,00,01,00,00,00);
  418. var
  419.   BlocksWritten : integer;
  420. begin
  421.   with FieldDir do
  422.   begin
  423.     BlockWrite(RefFile, FieldSortSpec, SizeOf(FieldSortSpec), BlocksWritten);
  424.     WriteBuffer(RefFile, FieldNameIndex);
  425.     DeallocateBuf(FieldNameIndex);
  426.     WriteBuffer(RefFile, FieldNamePool);
  427.     DeallocateBuf(FieldNamePool);
  428.     WriteBuffer(RefFile, FieldDescriptions);
  429.     DeallocateBuf(FieldDescriptions);
  430.     BlockWrite(RefFile, DefaultFormat, SizeOf(DefaultFormat), BlocksWritten);
  431.   end;
  432. end; { WriteFieldDir }
  433.  
  434. begin { PutFieldDir }
  435.   with ReflexF do
  436.   begin
  437.     with ReflexHeader.DfSection[FieldDirSectionNum] do
  438.     begin
  439.       SectionType := FieldDirSection;
  440.       SectionAddr := FilePos(RefFile);
  441.       SavedPosition := FilePos(RefFile);
  442.       WriteFieldDir(RefFile, FieldDir);
  443.       SectionLen := FilePos(RefFile) - SavedPosition;
  444.     end;
  445.   end;
  446. end; { PutFieldDir }
  447.  
  448. procedure UpdateReflexHeader(var ReflexF : ReflexRef);
  449. var
  450.   BlocksWritten : integer;
  451. begin
  452.   with ReflexF, ReflexHeader do
  453.   begin
  454.     Seek(RefFile, 0);
  455.     SectionCt := 3;
  456.     Dirty := 0;
  457.     with DfSection[DataSectionNum] do
  458.     begin
  459.       SectionType := DataRecSection;
  460.       SectionAddr := DataSectionAddr;
  461.       SectionLen := DataSectionLen;
  462.     end;
  463.     BlockWrite(RefFile, ReflexHeader, SizeOf(ReflexHeader), BlocksWritten);
  464.   end;
  465. end; { UpdateReflexHeader }
  466.  
  467. begin  { CloseReflexFile }
  468.   with ReflexF do
  469.   begin
  470.     if Modified then
  471.     begin
  472.       PutMasterRec(ReflexF);
  473.       PutFieldDir(ReflexF);
  474.       UpdateReflexHeader(ReflexF);
  475.     end;
  476.     Close(RefFile);
  477.   end;
  478. end; { CloseReflexFile }
  479.  
  480. function ReflexFileLen{(var ReflexF : ReflexRef) : integer};
  481. { Returns the number of Records in the Reflex file referenced
  482.   by ReflexF. }
  483. begin
  484.   ReflexFileLen := ReflexF.NumberOfRecs;
  485. end; { ReflexFileLen }
  486.  
  487. function GetReflexType(var DataType : byte) : ReflexTypes;
  488. var
  489.   found : boolean;
  490.   FieldType : FieldTypes;
  491.  
  492. begin
  493.   found := false;
  494.   FieldType := Untyped;
  495.   repeat
  496.     if ord(FieldType) = DataType then
  497.       found := true
  498.     else
  499.     begin
  500.       if (FieldType = IntegerVal) then
  501.         FieldType := Untyped
  502.       else
  503.         FieldType := Succ(FieldType);
  504.     end;
  505.   until found or (FieldType = Untyped);
  506.   GetReflexType := FieldType;
  507. end; { GetReflexType }
  508.  
  509. procedure GenerateFD(var ReflexF : ReflexRef;
  510.                          TAccessDef : boolean);
  511. var
  512.   CurField,
  513.   ExportField : integer;
  514.  
  515. begin
  516.   with ReflexF, FDTable, FieldDir do
  517.   begin
  518.     ExportField := 0;
  519.     if TAccessDef then
  520.     begin
  521.       new(FieldEntries[ExportField]);
  522.       FieldEntries[ExportField]^ := StatusField;
  523.       Inc(RecordSize, FieldEntries[ExportField]^.TFieldLength);
  524.       Inc(ExportField);
  525.       DataFileType := TAccessFile;
  526.     end
  527.     else
  528.       DataFileType := PascalFile;
  529.     for CurField := 0 to pred(FieldTotals[Translate]) do
  530.     begin
  531.       new(FieldEntries[ExportField]);
  532.       with FieldEntries[ExportField]^,
  533.            FieldDescriptors[CurField]^ do
  534.       begin
  535.         FillChar(FieldEntries[ExportField]^, SizeOf(FieldEntries[ExportField]^), 0);
  536.         GetText(FieldNamePool, NameOffset, FieldName);
  537.         ReflexType := GetReflexType(DataType);
  538.         XLateStatus := Translate;
  539.         RefToTurboType(FieldEntries[ExportField]^);
  540.         Inc(RecordSize, TFieldLength);
  541.         Inc(ExportField);
  542.       end; { with }
  543.     end; { for }
  544.     TotalFields := ExportField;
  545.    end;
  546. end; { GenerateFD }
  547.  
  548. function CheckFD(var ReflexFD,
  549.                      LoadedFD : FieldDirectory) : boolean;
  550. var
  551.   FDOk : boolean;
  552.   NewField,
  553.   RefField : integer;
  554.  
  555.  
  556. begin
  557.   with LoadedFD do
  558.   begin
  559.     FDOk := TotalFields >= ReflexFD.TotalFields;
  560.     if FDOK then
  561.       FDOk := (FieldTotals[Translate] + FieldTotals[ReflexFile]) =
  562.                ReflexFD.FieldTotals[Translate];
  563.     RefField := 0;
  564.     NewField := 0;
  565.     while FDOK and (NewField < TotalFields) do
  566.     begin
  567.       TurboToRefType(FieldEntries[NewField]^);
  568.       with FieldEntries[NewField]^ do
  569.       begin
  570.         if (XLateStatus = ReflexFile) or (XLateStatus = Translate) then
  571.         begin
  572.           FDOK := RefField < ReflexFD.TotalFields;
  573.           if FDOK then
  574.           begin
  575.             FDOK := ReflexFD.FieldEntries[RefField]^.ReflexType = ReflexType;
  576.             if not FDOK then
  577.               FDOK := (ReflexFD.FieldEntries[RefField]^.ReflexType = RepText)
  578.                       and (ReflexType = TextVal);
  579.           end;
  580.           Inc(RefField);
  581.          end
  582.          else
  583.            with ReflexFD.FieldEntries[RefField]^ do
  584.              if (XLateStatus = TAccessFile) then
  585.                Inc(RefField);
  586.          Inc(NewField);
  587.        end;
  588.     end;
  589.   end;
  590.   CheckFD := FDOk;
  591. end; { CheckFD }
  592.  
  593. var
  594.   LoadedFD : FieldDirectory;
  595.  
  596. function SetUpReflexFD(var ReflexF : ReflexRef;
  597.                        var FDFileNm : FileSpec;
  598.                        TAccessF,
  599.                        LoadFDFile : boolean) : boolean;
  600. var
  601.   Ok : boolean;
  602.  
  603. begin
  604.   Ok := true;
  605.   with ReflexF, FDTable, FDFileNm do
  606.   begin
  607.     GenerateFD(ReflexF, TAccessF);
  608.     RecordName := Name + 'Record';
  609.     if LoadFDFile and Exist(Path + Name + Ext) then
  610.     begin
  611.       FillChar(LoadedFD, SizeOf(LoadedFD), 0);
  612.       LoadFD(LoadedFD, Path + Name + Ext);
  613.       OK := CheckFD(FDTable, LoadedFD);
  614.       if OK then
  615.       begin
  616.         DisposeFD(FDTable);
  617.         CopyFD(LoadedFD, FDTable);
  618.       end
  619.       else
  620.         Abort(Path + Name + Ext + ' is inconsistent with the Reflex file');
  621.       DisposeFD(LoadedFD);
  622.     end;
  623.   end;
  624.   SetUpReflexFD := OK;
  625. end; { SetUpReflexFD }
  626.  
  627.  
  628. function OpenReflexFile(var ReflexF : ReflexRef;
  629.                             RefFileNm : FileName) : boolean;
  630. {   Opens the reflex file named RefFileNm, and generates
  631.     a field defintion file which describes the structure
  632.     of the reflex record. ReflexF will be used to refer to
  633.     this file in all subsequent operations. }
  634.  
  635. function GetSectionAddr(var Header : RefHeader;
  636.                         CurSection : integer) : LongInt;
  637. { Returns the start of the specified reflex file section }
  638.  
  639. var
  640.   SecAddr : LongInt;
  641.   i : integer;
  642.   SectionFound : boolean;
  643. begin
  644.   with Header do
  645.   begin
  646.     i := 1;
  647.     repeat
  648.       SectionFound := (DfSection[i].SectionType = CurSection);
  649.       SecAddr := DfSection[i].SectionAddr;
  650.       i := i + 1;
  651.     until (i > SectionCt) or SectionFound;
  652.     if SectionFound then
  653.       GetSectionAddr := SecAddr
  654.     else
  655.       GetSectionAddr := 0;
  656.   end;
  657. end; { GetSectionAddr }
  658.  
  659. function GetNumberOfRecs(var ReflexF : ReflexRef) : integer;
  660. var
  661.   SectionAddr : LongInt;
  662.   NumRecs, BlocksRead : integer;
  663. begin
  664.   with ReflexF do
  665.   begin
  666.     SectionAddr := GetSectionAddr(ReflexHeader, MasterRecSection);
  667.     if SectionAddr > FileSize(RefFile) then
  668.     begin
  669.       TranslateError('Seek past EOF in getting master record');
  670.       GetNumberOfRecs := 0;
  671.     end
  672.     else
  673.     begin
  674.       Seek(RefFile, SectionAddr);
  675.       BlockRead(RefFile, NumRecs, SizeOf(NumRecs), BlocksRead);
  676.       GetNumberOfRecs := NumRecs;
  677.     end;
  678.   end;
  679. end; { GetNumberOfRecs }
  680.  
  681.  
  682. procedure GetReflexHeader(var ReflexFile : File;
  683.                           var Header : RefHeader);
  684. { Reads in the fixed length Reflex file header of 512 bytes
  685.   note that the block size is 1 byte, set in OpenReflexFile }
  686. var
  687.   BlocksRead : integer;
  688. begin
  689.   Seek(ReflexFile, 0);
  690.   BlockRead(ReflexFile, Header, SizeOf(Header), BlocksRead);
  691.   if BlocksRead <> SizeOf(Header) then
  692.     TranslateError('The Reflex file is too small for a legal header');
  693. end; { GetReflexHeader }
  694.  
  695. procedure BuildFieldNameTables(var InFile : File;
  696.                                var FieldDir : ReflexFieldDirectory;
  697.                                var TotalFields : integer);
  698. const
  699.   SkipSize = 12; { Field sort }
  700.  
  701. begin { BuildFieldNameTables }
  702.   Seek(Infile, FilePos(InFile) + SkipSize);
  703.   with FieldDir do
  704.   begin
  705.     ReadBuffer(InFile, FieldNameIndex);
  706.     TotalFields := Lo(FieldNameIndex.Len div 2);
  707.     ReadBuffer(InFile, FieldNamePool);
  708.     ReadBuffer(InFile, FieldDescriptions);
  709.   end;
  710. end; { BuildFieldNameTables }
  711.  
  712. procedure GetFieldDesc(FieldDirectory : VarLenBuf;
  713.                            FieldNum : integer;
  714.                        var CurField : FieldDesc);
  715. var
  716.   Start, Offset : integer;
  717. begin
  718.   Start := FieldNum * SizeOf(CurField);
  719.   with FieldDirectory do
  720.     for OffSet := 0 to SizeOf(CurField) - 1 do
  721.     begin
  722.       Mem[Seg(CurField):Ofs(CurField) + Offset] :=
  723.       Mem[Seg(Buf^):Ofs(Buf^) + Start + Offset];
  724.     end; { for }
  725. end; { GetFieldDesc }
  726.  
  727. procedure AddPool(var RepTextPool : RepTPool;
  728.                   var T : TextPool);
  729. var
  730.   P : RepTPool;
  731. begin
  732.   New(P);
  733.   P^ := T;
  734.   if RepTextPool <> nil then
  735.     P^.next := RepTextPool;
  736.   RepTextPool := P;
  737. end; { AddPool }
  738.  
  739. procedure BuildRepTextPool(var ReflexF : ReflexRef;
  740.                            var InFile : File;
  741.                            FieldCount : byte);
  742. var
  743.   CurPool : TextPool;
  744. begin
  745.   for FieldCount := FieldCount downto 0 do
  746.     with ReflexF, FieldDescriptors[FieldCount]^, CurPool do
  747.       if FieldDescriptors[FieldCount]^.DataType = ord(RepText) then
  748.       begin
  749.         FIDNum := FieldCount;
  750.         ReadBuffer(InFile, PoolIndex);
  751.         ReadBuffer(InFile, Pool);
  752.         Next := nil;
  753.         AddPool(RepTextPool, CurPool);
  754.       end;
  755. end; { BuildRepTextPool }
  756.  
  757. procedure BuildFieldDescTbl(var ReflexF : ReflexRef;
  758.                             var InFile : File;
  759.                             var FieldDirectory : VarLenBuf;
  760.                             FieldCount : integer);
  761. var
  762.   CurDesc : 0..MaxField;
  763.   CurField : FieldDesc;
  764. begin
  765.   with ReflexF do
  766.     begin
  767.     for CurDesc := 0 to MaxField do
  768.       FieldDescriptors[CurDesc] := nil;
  769.     for CurDesc := 0 to (FieldCount - 1) do
  770.     begin
  771.       New(FieldDescriptors[CurDesc]);
  772.       GetFieldDesc(FieldDirectory, CurDesc, CurField);
  773.       FieldDescriptors[CurDesc]^ := CurField;
  774.     end;
  775.   end;
  776. end; { BuildFieldDescTbl }
  777.  
  778. procedure BuildFieldDir(var ReflexF : ReflexRef;
  779.                         var TotalFields : integer);
  780. const
  781.   SkipSize = 6;
  782. begin
  783.   with ReflexF, FieldDir do
  784.   begin
  785.     Seek(RefFile, GetSectionAddr(ReflexHeader, FieldDirSection));
  786.     BuildFieldNameTables(RefFile, FieldDir, TotalFields);
  787.     BuildFieldDescTbl(ReflexF, RefFile, FieldDescriptions, TotalFields);
  788.     Seek(RefFile, FilePos(RefFile) + SkipSize);
  789.     RepTextPool := nil;
  790.     BuildRepTextPool(ReflexF, RefFile, TotalFields - 1);
  791.   end;
  792. end; { BuildFieldDir }
  793.  
  794.  
  795. begin
  796.   OpenReflexFile := true;
  797.   with ReflexF, FDTable do
  798.   begin
  799.     if not Exist(RefFileNm) then
  800.     begin
  801.       OpenReflexFile := false;
  802.       Exit;
  803.     end;
  804.     Assign(RefFile, RefFileNm);
  805.     Reset(RefFile, 1);        { Open file with a block size of 1 }
  806.        { This allows us the flexibility of reading various sized }
  807.        { records and the ability to seek to any byte in the file }
  808.     GetReflexHeader(RefFile, ReflexHeader);
  809.     FillChar(FDTable, SizeOf(FDTable), 0);
  810.     BuildFieldDir(ReflexF, FDTable.FieldTotals[Translate]);
  811.     NumberOfRecs := GetNumberOfRecs(ReflexF);
  812.     CurrentRecord := 0;
  813.     DataSectionAddr := GetSectionAddr(ReflexHeader, DataSectionNum) + 2;
  814.     Seek(RefFile, DataSectionAddr);
  815.     Modified := false;  { Open for reading, Modified used in close proc. }
  816.   end;
  817. end; { OpenReflexFile }
  818.  
  819.  
  820. procedure GetReflexRec(var ReflexTable : ReflexRef;
  821.                           var TurboRec;
  822.                              RecordNum : integer);
  823. { Gets a reflex variable length data record specified by
  824.   record num and translates it to a Turbo Pascal fixed length
  825.   record of the type specificed in the .DEF file. }
  826.  
  827. procedure GetFieldCount(var RecBuf : VarLenBuf;
  828.                         var FieldCount : byte);
  829. { Returns the number of fields in the given data
  830.   record }
  831. type
  832.   RecHdr = record
  833.              temp : array[1..3] of byte;
  834.              CtFlds : integer;
  835.            end;
  836. var
  837.  CurRec : RecHdr;
  838. begin
  839.   with RecBuf, CurRec do
  840.   begin
  841.     Move(Buf^, CurRec, SizeOf(CurRec));
  842.     FieldCount := Lo(CtFlds);
  843.   end;
  844. end; { GetFieldCount }
  845.  
  846. procedure TranslateLocText(var ReflexF : ReflexRef;
  847.                            var ReflexRecord : VarLenBuf;
  848.                            var TurboRecord;
  849.                                FieldNum : integer;
  850.                            var Trans : TranslateRec);
  851. var
  852.   TextPos : word;
  853.   S : String;
  854. begin
  855. {$ifdef FlexDebug}
  856. Write('In TranslateLocText');
  857. Readln;
  858. {$endif}
  859.  
  860.   with ReflexF, ReflexRecord, Trans do
  861.   begin
  862.     TextPos := MemW[Seg(Buf^):Ofs(Buf^) + ReflexOffset];
  863.     Inc(ReflexOffset,2);    { Move the offset to the next field }
  864.     if (TextPos = 0) then
  865.       S := ''
  866.     else
  867.       if (TextPos = 1) then
  868.         S := 'ERROR'
  869.     else
  870.       if (TextPos >= 2) and (TextPos < Len) then
  871.         GetText(ReflexRecord, TextPos, S)
  872.       else
  873.         S := '';
  874.     {$ifdef FlexDebug}
  875.     Write('TextPos = ', TextPos, ' Text returned = ', S);
  876.     Readln;
  877.     {$endif}
  878.     with FDTable, FieldEntries[FieldNum]^ do
  879.     begin
  880.       Move(S, Mem[Seg(TurboRecord):Ofs(TurboRecord) + TurboOffset], TFieldLength);
  881.       Inc(TurboOffset, TFieldLength);
  882.     end;
  883.   end;
  884. end; { TranslateLocText }
  885.  
  886. function GetPool(var CurPool : RepTPool;
  887.                       FieldNum : byte) : boolean;
  888. var
  889.   found : boolean;
  890. begin
  891.   found := false;
  892.   while (CurPool <> nil) and not found do
  893.     with CurPool^ do
  894.     begin
  895.       found := (FIDNum = FieldNum);
  896.       if not found then
  897.         CurPool := CurPool^.Next
  898.     end;
  899.     {$ifdef FlexDebug}
  900.     Write('In GetPool, we found it = ', found);
  901.     Readln;
  902.     {$endif}
  903.     GetPool := Found;
  904. end; { GetPool }
  905.  
  906. procedure GetRepText(ReflexF : ReflexRef;
  907.                      FieldNum : byte;
  908.                      TextPos : word;
  909.                      var RepText : String);
  910. var
  911.   CurPool : RepTPool;
  912. begin
  913. {$ifdef FlexDebug}
  914. Write('In GetRepText');
  915. Readln;
  916. {$endif}
  917.   with ReflexF do
  918.   begin
  919.     CurPool := RepTextPool;
  920.     if GetPool(CurPool, FieldNum) then
  921.     begin
  922.       {$ifdef FlexDebug}
  923.       Write('Successfully got the text pool');
  924.       Readln;
  925.       {$endif}
  926.       if TextPos <= 1 then
  927.         RepText := ''
  928.       else
  929.         GetText(CurPool^.Pool, TextPos, RepText);
  930.       {$ifdef FlexDebug}
  931.       Write('String returned is *', RepText,'*');
  932.       Readln;
  933.       {$endif}
  934.       (*if RepText = '' then
  935.         TranslateError('The text was not returned from the text pool'); *)
  936.     end
  937.     else
  938.       RepText := '';
  939.   end;
  940. end; { GetRepText }
  941.  
  942. procedure TranslateRepText(var ReflexF : ReflexRef;
  943.                            var ReflexRecord : VarLenBuf;
  944.                            var TurboRecord;
  945.                                FieldNum : byte;
  946.                                ReflexFieldNum : byte;
  947.                            var Trans : TranslateRec);
  948. var
  949.   TextPos : integer;
  950.   RepText : String;
  951. begin
  952. {$ifdef FlexDebug}
  953. Write('In Translate RepText for field ', FieldNum);
  954. Readln;
  955. {$endif}
  956.  
  957.   with ReflexF, ReflexRecord, Trans do
  958.   begin
  959.     TextPos := MemW[Seg(Buf^):Ofs(Buf^) + ReflexOffset];
  960.     {$ifdef FlexDebug}
  961.     Write('TextPos = ', TextPos);
  962.     Readln;
  963.     {$endif}
  964.     Inc(ReflexOffset, 2);    { Move the offset to the next field }
  965.     GetRepText(ReflexF, ReflexFieldNum, TextPos, RepText);
  966.     with FDTable, FieldEntries[FieldNum]^ do
  967.     begin
  968.       Move(RepText, Mem[Seg(TurboRecord) : Ofs(TurboRecord) + TurboOffset], TFieldLength);
  969.       Inc(TurboOffset, TFieldLength);
  970.     end;
  971.   end;
  972. end; { TranslateRepText }
  973.  
  974.  
  975.  procedure TransferBytes(var ReflexRecord : VarLenBuf;
  976.                         var TurboRecord;
  977.                             NumBytes : byte;
  978.                         var Trans : TranslateRec);
  979. begin
  980.   with ReflexRecord, Trans do
  981.   begin
  982.     Move(Mem[Seg(Buf^) : Ofs(Buf^) + ReflexOffset],
  983.          Mem[Seg(TurboRecord) : Ofs(TurboRecord) + TurboOffset], NumBytes);
  984.     Inc(ReflexOffset, NumBytes);
  985.     Inc(TurboOffset, NumBytes);
  986.   end;
  987. end; { TransferBytes }
  988.  
  989. procedure TransRealNum(var ReflexRecord : VarLenBuf;
  990.                        var TurboRecord;
  991.                        FieldLength : byte;
  992.                        var Trans : TranslateRec);
  993.  
  994. var
  995.   EightByteReal : ieee;
  996.   r : real;
  997.  
  998. begin
  999.   with ReflexRecord, Trans do
  1000.     if (FieldLength = 6) then { Convert number }
  1001.     begin
  1002.       Move(Mem[Seg(Buf^):Ofs(Buf^) + ReflexOffset], EightByteReal, 8);
  1003.       IEEEToTurbo(EightByteReal, r);
  1004.       Inc(ReflexOffset, 8);
  1005.       Move(r, Mem[Seg(TurboRecord) : Ofs(TurboRecord) + TurboOffset], SizeOf(r));
  1006.       Inc(TurboOffset, 6);
  1007.     end
  1008.     else
  1009.       TransferBytes(ReflexRecord, TurboRecord, FieldLength, Trans);
  1010. end; { TransRealNum }
  1011.  
  1012. procedure TranslateDate(var ReflexRecord : VarLenBuf;
  1013.                         var TurboRecord;
  1014.                         var Trans : TranslateRec);
  1015. var
  1016.   D : RDate;
  1017.   S : Date;
  1018. begin
  1019.   with ReflexRecord, Trans do
  1020.   begin
  1021.     Move(Mem[Seg(Buf^):Ofs(Buf^) + ReflexOffset], D, 2);
  1022.     Inc(ReflexOffset, 2);
  1023.     DateToStr(D, S);
  1024.     Move(S, Mem[Seg(TurboRecord) : Ofs(TurboRecord) + TurboOffset],
  1025.          SizeOf(S));
  1026.     Inc(TurboOffset, SizeOf(S));
  1027.   end;
  1028. end; { TranslateDate }
  1029.  
  1030. function GetFieldNum(var FDTable : FieldDirectory;
  1031.                      CurField : byte) : byte;
  1032. var
  1033.   F, Total : byte;
  1034. begin
  1035.   F := 0;
  1036.   for CurField := 0 to  pred(CurField) do
  1037.   with FDTable, FieldEntries[CurField]^ do
  1038.   begin
  1039.     if (XLateStatus = Translate) or (XLateStatus = ReflexFile) then
  1040.        F := succ(F);
  1041.   end;
  1042.   GetFieldNum := F;
  1043. end; { GetFieldNum }
  1044.  
  1045. procedure TranslateField(var ReflexF : ReflexRef;
  1046.                          var ReflexRecord : VarLenBuf;
  1047.                          var TurboRecord;
  1048.                              FieldCount : byte; { needed for repeating text }
  1049.                          var Trans : TranslateRec);
  1050. begin
  1051.   with ReflexF, ReflexRecord, FDTable, FieldEntries[FieldCount]^, Trans do
  1052.    case XLateStatus of
  1053.     Translate :
  1054.       case ReflexType of
  1055.         Untyped : ;
  1056.         TextVal : TranslateLocText(ReflexF, ReflexRecord, TurboRecord,
  1057.                                        FieldCount, Trans);
  1058.         RepText : TranslateRepText(ReflexF, ReflexRecord, TurboRecord,
  1059.                                    FieldCount,
  1060.                                    GetFieldNum(FDTable, FieldCount), Trans);
  1061.         DoubleVal : TransRealNum(ReflexRecord, TurboRecord,
  1062.                                    TFieldLength, Trans);
  1063.         IntegerVal : TransferBytes(ReflexRecord, TurboRecord, 2, Trans);
  1064.         RDateVal : TranslateDate(ReflexRecord, TurboRecord, Trans);
  1065.       end;
  1066.     ReflexFile : Inc(ReflexOffset, FieldDefaults[ReflexType].TypeSize);
  1067.     TAccessFile,
  1068.     PascalFile : Inc(TurboOffset, TFieldLength);
  1069.   end;
  1070. end; { TranslateField }
  1071.  
  1072. procedure ReflexToTurbo(var ReflexTable : ReflexRef;
  1073.                         var ReflexRecord : VarLenBuf;
  1074.                         var TurboRecord);
  1075. var
  1076.   FieldCount : byte;
  1077.   Trans : TranslateRec;
  1078. begin
  1079.   GetFieldCount(ReflexRecord, FieldCount);
  1080.   {$ifdef FlexDebug}
  1081.   Write('In ReflexToTurbo FieldCount is ', succ(FieldCount));
  1082.   Readln;
  1083.   {$endif}
  1084.   with Trans, ReflexTable, FDTable do
  1085.   begin
  1086.     ReflexOffset := 4;
  1087.     TurboOffset := 0;
  1088.     for FieldCount := 0 to (TotalFields - 1) do
  1089.     begin
  1090.       {$ifdef FlexDebug}
  1091.       Writeln;
  1092.       Write('Translating field ', FieldCount,  ' ', FieldEntries[FieldCount]^.FieldName);
  1093.       Readln;
  1094.       {$endif}
  1095.       TranslateField(ReflexTable, ReflexRecord, TurboRecord, FieldCount, Trans);
  1096.     end;
  1097.   end;
  1098. end; { ReflexToTurbo }
  1099.  
  1100. procedure SkipRecord(var CurFile : File);
  1101. var
  1102.   RecLen,
  1103.   BlocksRead : integer;
  1104. begin
  1105.   BlockRead(CurFile, RecLen, SizeOf(RecLen), BlocksRead);
  1106.   Seek(CurFile, FilePos(CurFile) + RecLen);
  1107. end; { SkipRecord }
  1108.  
  1109. procedure ReflexRecSeek(var ReflexTable : ReflexRef;
  1110.                               RecordNum : word);
  1111. begin
  1112.   with ReflexTable do
  1113.   if RecordNum <= NumberOfRecs then
  1114.   begin
  1115.     if CurrentRecord > RecordNum then
  1116.     { If the pointer is past us set it back to the first record }
  1117.       CurrentRecord := 0;
  1118.     if CurrentRecord = 0 then
  1119.       Seek(RefFile, DataSectionAddr);
  1120.     while RecordNum > CurrentRecord do
  1121.     begin
  1122.       SkipRecord(RefFile);
  1123.       CurrentRecord := Succ(CurrentRecord);
  1124.     end;
  1125.   end
  1126.   else
  1127.     TranslateError('Seek past EOF, record number = ' + NumStr(RecordNum));
  1128. end; { ReflexRecSeek }
  1129.  
  1130. var
  1131.   ReflexRecord : VarLenBuf;
  1132. begin
  1133.   ReflexRecSeek(ReflexTable, RecordNum);
  1134.   with ReflexTable do
  1135.   begin
  1136.     ReadBuffer(RefFile, ReflexRecord);
  1137.     ReflexToTurbo(ReflexTable, ReflexRecord, TurboRec);
  1138.     DeallocateBuf(ReflexRecord);
  1139.     CurrentRecord := Succ(CurrentRecord);
  1140.   end;
  1141. end; { GetReflexRec }
  1142.  
  1143. { The following are routines allow you to create Reflex files. You can
  1144.   translate  Pascal  fixed  length  records  into Reflex variable
  1145.   length records and add these records to the Reflex files.
  1146. }
  1147.  
  1148. procedure MakeReflexFile(var ReflexF : ReflexRef;
  1149.                          RefFileNm : FileName;
  1150.                          var FD : FieldDirectory);
  1151. { Creates a reflex file name RefFileNm, with a record
  1152.   definition specified in FD.  ReflexF will be used to refer
  1153.   to this file in all subsequent operation.
  1154. }
  1155.  
  1156. type
  1157.   HeaderBlock = array[1..512] of byte;
  1158.  
  1159. const
  1160.   DefaultHdr : HeaderBlock =
  1161.     ($00,$02,$33,$51,$2E,$21,$26,$40,$23,$24,$21,$26,$26,$00,$FF,$FF,
  1162.      $07,$00,$04,$00,$03,$00,$00,$00,$01,$C2,$00,$00,$00,$00,$00,$00,
  1163.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1164.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1165.      $0C,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1166.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1167.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1168.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1169.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1170.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1171.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1172.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1173.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1174.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1175.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1176.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1177.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1178.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1179.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1180.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1181.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1182.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1183.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1184.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1185.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1186.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1187.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1188.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1189.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1190.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1191.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  1192.      $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
  1193.    );
  1194. var
  1195.   BlocksWritten : integer;
  1196. begin
  1197.   FillChar(ReflexF, SizeOf(ReflexF), 0);
  1198.   with ReflexF do
  1199.   begin
  1200.     Assign(RefFile, RefFileNm);
  1201.     Rewrite(RefFile, 1);               { Open and set the block size to 1 }
  1202.     ReflexHeader := RefHeader(DefaultHdr);
  1203.     BlockWrite(RefFile, ReflexHeader, SizeOf(ReflexHeader), BlocksWritten);
  1204.     FDTable := FD;
  1205.     ConvertFDTable(ReflexF);
  1206.     Modified := true;
  1207.   end;
  1208. end; { MakeReflexFile }
  1209.  
  1210. procedure AddReflexRec(var ReflexF : ReflexRef;
  1211.                        var TurboRec);
  1212. { Converts the Pascal record TurboRec into a Reflex record and
  1213.   adds it to the file specified by ReflexF. }
  1214.  
  1215. procedure SetFieldCount(var ReflexRec : VarLenBuf;
  1216.                         var NumFields : integer);
  1217. var
  1218.   RecHdr : record
  1219.              temp : array[1..3] of byte;
  1220.              CtFields : byte;
  1221.            end;
  1222. begin
  1223.   with RecHdr do
  1224.   begin
  1225.     FillChar(temp, SizeOf(Temp), 0);
  1226.     CtFields := NumFields;
  1227.   end;
  1228.   Move(RecHdr, Mem[Seg(ReflexRec.Buf^):Ofs(ReflexRec.Buf^)], SizeOf(RecHdr));
  1229.   ReflexRec.Len := SizeOf(RecHdr);
  1230. end; { SetFieldCount }
  1231.  
  1232. procedure TransTurboBytes(var TurboRec;
  1233.                           var ReflexRec : VarLenBuf;
  1234.                           NumBytes : byte;
  1235.                           var Trans : TranslateRec);
  1236. begin
  1237.   with ReflexRec, Trans do
  1238.   begin
  1239.     Move(Mem[Seg(TurboRec) : Ofs(TurboRec) + TurboOffset],
  1240.     Mem[Seg(Buf^) : Ofs(Buf^) + Len], NumBytes);
  1241.     Inc(Len, NumBytes);
  1242.     Inc(TurboOffset, NumBytes);
  1243.   end;
  1244. end; { TransTurboBytes }
  1245.  
  1246. procedure TransTurboByte(var TurboRec;
  1247.                          var ReflexRec : VarLenBuf;
  1248.                          var Trans : TranslateRec);
  1249. var
  1250.   b : byte;
  1251.   i : integer;
  1252. begin
  1253.   with ReflexRec, Trans do
  1254.   begin
  1255.     Move(Mem[Seg(TurboRec) : Ofs(TurboRec) + TurboOffset],
  1256.          b, SizeOf(byte));
  1257.     Inc(TurboOffset);
  1258.     i := b;
  1259.     Move(i, Mem[Seg(Buf^) : Ofs(Buf^) + Len], 2);
  1260.     Inc(Len, 2);
  1261.   end;
  1262. end; { TransTurboByte }
  1263.  
  1264. procedure TransTurboReal(var TurboRec;
  1265.                          var ReflexRec : VarLenBuf;
  1266.                          var Trans : TranslateRec);
  1267. var
  1268.   EightByteReal : ieee;
  1269.   r : real;
  1270. begin
  1271.   with ReflexRec, Trans do
  1272.   begin
  1273.     Move(Mem[Seg(TurboRec):Ofs(TurboRec) + TurboOffset], r, SizeOf(real));
  1274.     Inc(TurboOffset, SizeOf(Real));
  1275.     TurboToIEEE(r, EightByteReal);
  1276.     Move(EightByteReal, Mem[Seg(Buf^):Ofs(Buf^) + Len], SizeOf(EightByteReal));
  1277.     Inc(Len, SizeOf(EightByteReal));
  1278.   end;
  1279. end; { TransTurboReal }
  1280.  
  1281. procedure TransTurboLong(var TurboRec;
  1282.                          var ReflexRec : VarLenBuf;
  1283.                          var Trans : TranslateRec);
  1284. var
  1285.   l : LongInt;
  1286.   r : real;
  1287.   EightByteReal : ieee;
  1288. begin
  1289.   with ReflexRec, Trans do
  1290.   begin
  1291.     Move(Mem[Seg(TurboRec):Ofs(TurboRec) + TurboOffset], l, SizeOf(l));
  1292.     Inc(TurboOffset, SizeOf(l));
  1293.     r := l;
  1294.     TurboToIEEE(r, EightByteReal);
  1295.     Move(EightByteReal, Mem[Seg(Buf^):Ofs(Buf^) + Len], SizeOf(EightByteReal));
  1296.     Inc(Len, SizeOf(EightByteReal));
  1297.   end;
  1298. end; { TransTurboLong }
  1299.  
  1300. procedure MoveLocalText(var TurboRec;
  1301.                         Offset,
  1302.                         FieldLength : integer;
  1303.                         var S);
  1304. begin
  1305.   Move(Mem[Seg(TurboRec):Ofs(TurboRec) + Offset], S, FieldLength);
  1306. end;
  1307.  
  1308. procedure TransTurboDate(var TurboRec;
  1309.                          var ReflexRec : VarLenBuf;
  1310.                          var Trans : TranslateRec);
  1311. var
  1312.   S : string;
  1313.   D : RDate;
  1314. begin
  1315.   MoveLocalText(TurboRec, Trans.TurboOffset,
  1316.                 FieldDefaults[DateVal].TypeSize, S);
  1317.   Inc(Trans.TurboOffset, FieldDefaults[DateVal].TypeSize);
  1318.   if not StrToDate(S, D) then
  1319.     D := 0;
  1320.   AddBlock(ReflexRec, D, SizeOf(D));
  1321. end;
  1322.  
  1323. procedure TransTurboText(var ReflexF : ReflexRef;
  1324.                          var TurboRec;
  1325.                          var ReflexRec : VarLenBuf;
  1326.                          var LocalTextPool : VarLenBuf;
  1327.                          var Trans : TranslateRec;
  1328.                              FieldLength : integer);
  1329. var
  1330.   S : String;
  1331.   Offset : word;
  1332.  
  1333. begin
  1334.   MoveLocalText(TurboRec, Trans.TurboOffset, FieldLength, S);
  1335.   with ReflexF, ReflexRec, Trans do
  1336.   begin
  1337.     TurboOffset := TurboOffset + FieldLength;
  1338.     AddTextToPool(LocalTextPool, S, Offset);
  1339.     Inc(Offset, FixedRecordLen);
  1340.     AddBlock(ReflexRec, Offset, SizeOf(Offset));
  1341.   end;
  1342. end; { TransTurboText }
  1343.  
  1344. procedure TransTurboChar(var ReflexF : ReflexRef;
  1345.                          var TurboRec;
  1346.                          var ReflexRec : VarLenBuf;
  1347.                          var LocalTextPool : VarLenBuf;
  1348.                          var Trans : TranslateRec);
  1349. var
  1350.   S : String;
  1351.   Offset : word;
  1352.  
  1353. begin
  1354.   MoveLocalText(TurboRec, Trans.TurboOffset, 1, S[1]);
  1355.   S[0] := chr(1);
  1356.   with ReflexF, ReflexRec, Trans do
  1357.   begin
  1358.     Inc(TurboOffset);
  1359.     AddTextToPool(LocalTextPool, S, Offset);
  1360.     Inc(Offset, FixedRecordLen);
  1361.     AddBlock(ReflexRec, Offset, SizeOf(Offset));
  1362.   end;
  1363. end; { TransTurboChar }
  1364.  
  1365. procedure ConcatBuffers(var Buffer1, Buffer2 : VarLenBuf);
  1366. begin
  1367.   with Buffer1 do
  1368.   begin
  1369.     Move(Buffer2.Buf^,
  1370.         Mem[Seg(Buffer1.Buf^):Ofs(Buffer1.Buf^) + Len], Buffer2.Len);
  1371.     Len := Len + Buffer2.Len;
  1372.   end;
  1373. end; { ConcatBuffers }
  1374.  
  1375. procedure CreateField(var ReflexF : ReflexRef;
  1376.                       var ReflexRec : VarLenBuf;
  1377.                       ReflexType : ReflexTypes);
  1378. var
  1379.   D : RDate;
  1380.   i, Offset : word;
  1381. begin
  1382.  
  1383.   with ReflexF, ReflexRec do
  1384.     case
  1385.       ReflexType of
  1386.         TextVal : begin
  1387.                     AddTextToPool(LocalTextPool, '', Offset);
  1388.                     Inc(Offset, FixedRecordLen);
  1389.                     AddBlock(ReflexRec, Offset, SizeOf(Offset));
  1390.                   end;
  1391.         RDateVal : AddBlock(ReflexRec, NullIEEE, SizeOf(NullIEEE));
  1392.         DoubleVal : begin
  1393.                       D := DateNull;
  1394.                       AddBlock(ReflexRec, D, SizeOf(D));
  1395.                     end;
  1396.         IntegerVal : begin
  1397.                        i := 0;
  1398.                        AddBlock(ReflexRec, i, SizeOf(i));
  1399.                      end;
  1400.       else ;
  1401.     end;
  1402. end; { CreateField }
  1403.  
  1404. procedure TurboToReflex(var ReflexF : ReflexRef;
  1405.                         var TurboRec;
  1406.                         var ReflexRec : VarlenBuf);
  1407. var
  1408.   Trans : TranslateRec;
  1409.   CurField : byte;
  1410. begin
  1411.   FillChar(Trans, SizeOf(Trans), 0);
  1412.   with ReflexF, FDTable, Trans, ReflexRec do
  1413.   begin
  1414.     SetFieldCount(ReflexRec, FieldsIncluded);
  1415.     for CurField := 0 to TotalFields - 1 do
  1416.     begin
  1417.       with FieldEntries[CurField]^ do
  1418.       case XLateStatus of
  1419.         Translate :
  1420.           begin
  1421.             case TFieldType of
  1422.               IntegerVal,
  1423.               DoubleVal,
  1424.               RDateVal  : TransTurboBytes(TurboRec, ReflexRec, TFieldLength, Trans);
  1425.               RealVal : TransTurboReal(TurboRec, ReflexRec, Trans);
  1426.               StringVal : TransTurboText(ReflexF, TurboRec, ReflexRec,
  1427.                                        LocalTextPool, Trans, TFieldLength);
  1428.               CharVal : TransTurboChar(ReflexF, TurboRec, ReflexRec,
  1429.                                      LocalTextPool, Trans);
  1430.               ByteVal : TransTurboByte(TurboRec, ReflexRec, Trans);
  1431.               LongIntVal : TransTurboLong(TurboRec, ReflexRec, Trans);
  1432.               DateVal : TransTurboDate(TurboRec, ReflexRec, Trans);
  1433.             end;
  1434.           end;
  1435.           TAccessFile,
  1436.           PascalFile : Inc(TurboOffset, TFieldLength);
  1437.           ReflexFile : CreateField(ReflexF, ReflexRec, ReflexType);
  1438.         end; { case }
  1439.     end; { for }
  1440.     if TextFields > 0 then
  1441.     begin
  1442.       ConcatBuffers(ReflexRec, LocalTextPool);
  1443.       LocalTextPool.Len := 0;
  1444.     end;
  1445.   end;
  1446. end; { TurboToReflex }
  1447.  
  1448. const
  1449.   MaxText = 255;
  1450. var
  1451.   i, BlocksWritten : integer;
  1452.  
  1453. begin { AddReflexRec }
  1454.   i := 0;
  1455.   with ReflexF do
  1456.   begin
  1457.     ReflexRec.Len := 0;
  1458.     LocalTextPool.Len := 0;
  1459.     if (CurrentRecord = 0) then
  1460.     begin
  1461.       AllocateBuf(ReflexRec, FixedRecordLen + (MaxText * TextFields));
  1462.       if (TextFields > 0) then
  1463.         AllocateBuf(LocalTextPool, MaxText * TextFields);
  1464.       DataSectionAddr := FilePos(RefFile);
  1465.       BlockWrite(RefFile, i, SizeOf(i), BlocksWritten);
  1466.     end;
  1467.     CurrentRecord := Succ(CurrentRecord);
  1468.     TurboToReflex(ReflexF, TurboRec, ReflexRec);
  1469.     WriteBuffer(RefFile, ReflexRec);
  1470.     DataSectionLen := FilePos(RefFile) - DataSectionAddr;
  1471.   end;
  1472. end; { AddReflexRec }
  1473.  
  1474. end.