home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / database / dbf / cat2db.pas next >
Encoding:
Pascal/Delphi Source File  |  1990-01-01  |  17.7 KB  |  601 lines
  1. (*
  2.    This program makes a DBASE  data base from the catalog files found
  3.    in The Borland LIBs. It will create a DBF and DBT file with user
  4.    supplied name. It will also append new records if an existing file
  5.    name is specified, this will allow updating with the BP???.NEW files.
  6.    The newest files will come last but DBASE can fix that for you.
  7.  
  8.    The program was written in the discovery fashion as I had no information
  9.    on the internal structure of DBASE files when I started. Apoligies aside
  10.    here it is:
  11.    TITLE                60    characters
  12.    KEY_WDS              80    characters
  13.    F_NAME               6     characters
  14.    EXT                  3     characters
  15.    BIN                  1     logical      /binary after file name = true
  16.    USER_ID              10    characters
  17.    DATE                 8     Date
  18.    SIZE                 6     number
  19.    COUNT                4     number
  20.    INFO                 10    memo        has pointer to the file description
  21.                                           in the *.DBT file.
  22.  
  23.    This is written to the header with an array constant and could be
  24.    modified fairly easy. The output files are type ARRAY OF CHAR (read slow)
  25.    because the header for the DBF file is not the same size as the records.
  26.  
  27.    I used the '[' Char followed by {0..9} for the input record seperator
  28.    which causes a problem when a guy puts his user-id in the file description
  29.    (his name is Michael Day ), you'll have to edit the input file to solve
  30.    this. The only other problem I know of is one file had the date followed
  31.    by another date in '()'. If the program crashes it will probably be a
  32.    range check error, the program outputs the record number and date(DBASE
  33.    style ie. YYYYMMDD) the offending entry will most likely be the one just
  34.    after the last listed.
  35.    IF the description is more than 510 chars it will be truncated.
  36.    IF there is no 'Title', the first sentence or first 60 chars of the
  37.    description will go in the TITLE field.
  38.  
  39.    This DBASE prog. works a little like BROWSE.
  40.      * BP_FIND.PRG
  41.      * Searches for key word in KEY_WDS Field
  42.      set talk off
  43.      Set MemoWidth TO 60
  44.      CLEAR
  45.      @ 0,0
  46.      ACCEPT "Enter Key Word " TO Sword
  47.      LOCATE FOR UPPER(Sword)$Key_Wds
  48.      DO WHILE .NOT. EOF()
  49.        @ 3,0 CLEAR
  50.        Disp F_Name,Ext,USER_ID,Size,Count,date
  51.        Disp Title OFF
  52.        Disp INFO  OFF
  53.        WAIT
  54.        CONT
  55.      LOOP
  56.      ENDDO
  57.      SET TALK ON
  58.      Set MemoWidth TO 50
  59.      RETURN
  60. *)
  61.  
  62.  
  63.  Program Cat2Db; (* By Bill Drummond 1990 *)
  64.  
  65.  (*$R+*) (* Crashes ugly without Range Check *)
  66.  USES CRT;
  67.  (*****************************************)
  68.  VAR
  69.    InPutArray : ARRAY[0..2000] OF CHAR;
  70.    OutPutArray : ARRAY[0..288] OF CHAR;
  71.    MemoArray   : ARRAY[0..511] OF CHAR;
  72.    InFile,OutFile,MemoFile : FILE OF CHAR;
  73.    InSize : INTEGER;
  74.    StartOfRec,UserIdEnd,KWEnd,MemoEnd : Integer;
  75.    MemoCtr,OutCtr : INTEGER;
  76.    DownLoad: BOOLEAN; (* sometimes nobody has downloaded a file *)
  77.    NoTitle : BOOLEAN; (* so we know to fake a title *)
  78.    Done    : BOOLEAN;
  79.    HiByte,LoByte : CHAR;(* so we can read 2 byte values from file *)
  80.    OutFileIndex,MemoFileIndex : LONGINT;
  81.    InFileName  :STRING;
  82.    OutFileName :STRING;
  83.    MemoFileName:STRING;
  84.    OverWrite,Cancel : BOOLEAN;
  85.  CONST
  86.                      (* try to make it easy to change field lengths.
  87.                       See procedure WriteDBFHeader *)
  88.    OutRecSize = 189;
  89.    MemoSize   = $200;
  90.          (* first char of first field is actually the deleted record flag *)
  91.    LenTitle = 61; LenKeyWd = 80; LenFname = 6; LenBin = 1;
  92.    LenUserId = 10; LenExt = 3;LenDate = 8; LenSize = 6; LenCount = 4;
  93.    LenMemo = 10;
  94.    TitleSt  = 1;
  95.    KeyWdSt  = LenTitle;
  96.    FNameSt  = LenTitle+LenKeyWd;
  97.    ExtSt    = LenTitle+LenKeyWd+LenFname;
  98.    BinSt    = LenTitle+LenKeyWd+LenFname+LenExt;
  99.    UserIdSt = LenTitle+LenKeyWd+LenFname+LenExt+LenBin;
  100.    DateSt   = LenTitle+LenKeyWd+LenFname+LenExt+LenBin+LenUserId;
  101.    SizeSt   = LenTitle+LenKeyWd+LenFname+LenExt+LenBin+LenUserId+LenDate;
  102.    countSt  = LenTitle+LenKeyWd+LenFname+LenExt+LenBin+LenUserId+LenDate+LenSize;
  103.    MemoSt   = LenTitle+LenKeyWd+LenFname+LenExt+LenBin+LenUserId+LenDate+LenSize+LenCount;
  104.    LeftBracket = '[';
  105.    RightBracket = ']';
  106.    CR = CHR($0D);
  107.    Space = CHR($20);
  108.    Term = CHR($1A);
  109.  (*****************************************)
  110.  PROCEDURE InitDbaseArray;
  111.  VAR I : INTEGER;
  112.  BEGIN
  113.    FOR I := 0 TO OutRecSize-1 DO
  114.      BEGIN
  115.         OutPutArray[I] := Space;
  116.      END;
  117.  END;
  118.  (*****************************************)
  119.  Function FindWord(FWord : String;Position : INTEGER): INTEGER;
  120.    (* used to find where sub-string starts in the input array,
  121.       Position gives it a head start *)
  122.  VAR x : INTEGER;
  123.      TestStr : String;
  124.  BEGIN
  125.    TestStr[0] := FWord[0];
  126.    REPEAT
  127.      IF InPutArray[Position] = FWord[1] THEN
  128.       BEGIN
  129.         FOR x := 1 to Length(FWord) DO
  130.          BEGIN
  131.            TestStr[x] := InputArray[Position+x-1];
  132.          END;
  133.         IF Fword = TestStr THEN
  134.           BEGIN
  135.            FindWord := Position;
  136.            Exit;
  137.           END;
  138.         INC(Position);
  139.       END;
  140.       INC(Position);
  141.    UNTIL Position >= InSize;
  142.    FindWord := 0;
  143.  END;
  144.  (*****************************************)
  145.  PROCEDURE Title;
  146.  VAR I,J,x : INTEGER;
  147.  
  148.  BEGIN
  149.      I := TitleSt;
  150.      NoTitle := False;
  151.      x := FindWord('Title',0);
  152.      IF x = 0 THEN
  153.       BEGIN
  154.        Notitle := TRUE;
  155.        EXIT;
  156.       END;
  157.      J :=  x+10;
  158.      REPEAT
  159.       OutPutArray[I] := InputArray[J];
  160.       INC(I); INC(J);
  161.      UNTIL (OutPutArray[I-1] = CR);
  162.  
  163.      OutputArray[I-1] := Space;
  164.  END;
  165.   (*****************************************)
  166.  PROCEDURE KeyWords;
  167.  VAR I,J,K,S : INTEGER;
  168.  CONST
  169.  CrLfSpSpSpSp : String =(#$0d+#$0a+'    ');
  170.  CrLFCrLf : String =(#$0d+#$0a+#$0d+#$0a);
  171.  BEGIN
  172.      I := KeyWdSt;
  173.      S := FindWord('Keywords',0);
  174.      J := S+10;
  175.      REPEAT
  176.       OutPutArray[I] := InputArray[J];
  177.       INC(I); INC(J);
  178.      UNTIL (OutPutArray[I-1] = CR);
  179.      OutputArray[I-1] := ' ';
  180.      KWEnd := J-1;
  181.      J := FindWord(CrLfSpSpSpSp,j-20)+6;
  182.      K := FindWord(CrLfCrLf,j-20)+6;
  183.      IF K < J THEN EXIT;
  184.      REPEAT
  185.       OutPutArray[I] := InputArray[J];
  186.       INC(I); INC(J);
  187.      UNTIL (OutPutArray[I-1] = #$0d);
  188.      OutputArray[I-1] := Space;
  189.      KWEnd := J-1;
  190.  END;
  191.   (*****************************************)
  192.  PROCEDURE UserId;
  193.  VAR I,J : INTEGER;
  194.      ID : String[9];
  195.  BEGIN
  196.      I := UserIdSt;
  197.      J := StartOfRec;
  198.      REPEAT
  199.       OutPutArray[I] := InputArray[J];
  200.       INC(I); INC(J);
  201.      UNTIL (OutPutArray[I-1] = ']');
  202.      OutputArray[I-1] := ' ';
  203.      UserIdEnd := J;
  204.  END;
  205.  (*****************************************)
  206.  PROCEDURE Date;
  207.  CONST
  208.        Month : STRING =
  209.              'Jan01Feb02Mar03Apr04May05Jun06Jul07Aug08Sep09Oct10Nov11Dec12';
  210.  VAR I,J : INTEGER;
  211.      M,D : STRING[2]; Y : STRING[4];
  212.      DATE : STRING[8];
  213.  BEGIN
  214.      Y := '   ';M := '  ';
  215.      I := DateSt;
  216.      J := UserIdEnd+28;
  217.       D[1] := InputArray[J];
  218.       INC(J);
  219.       D[2] := InputArray[J];
  220.       INC(J,2);
  221.       Y[1] := InputArray[J];
  222.       INC(J);
  223.       Y[2] := InputArray[J];
  224.       INC(J);
  225.       Y[3] := InputArray[J];
  226.       INC(J,2);
  227.       M[1] := MONTH[Pos(Y,Month)+3];
  228.       M[2] := MONTH[Pos(Y,Month)+4];
  229.       Y := '    ';
  230.       Y[3] := InputArray[J];
  231.       INC(J);
  232.       Y[4] := InputArray[J];
  233.       Y[1] := '1'; Y[2] := '9';
  234.       DATE := Y+M+D;
  235.       Write(OutCtr);
  236.       WriteLn(' ',Date);
  237.       I := 1;
  238.       FOR J := DateSt TO DateSt+7 DO
  239.        BEGIN
  240.          OutputArray[J] := DATE[I];
  241.          INC(I);
  242.        END;
  243.  END;
  244.  (*****************************************)
  245.  PROCEDURE Count;
  246.  VAR I,J : INTEGER;
  247.       St : STRING[8];
  248.  BEGIN
  249.      I := 1;
  250.      J := UserIdEnd+57;
  251.      REPEAT
  252.       St[0] := CHR(I-1);
  253.       ST[I] := InputArray[J];
  254.       INC(I); INC(J);
  255.      UNTIL (ST[I-1] = Space) OR (ST[I-1] = CR);
  256.      FOR J := 1 TO ORD(ST[0]) DO
  257.        Outputarray[CountSt+ (LenCount-Length(ST))+J-1] := ST[J];
  258.  END;
  259.  
  260.   (*****************************************)
  261.  PROCEDURE Size;
  262.  VAR I,J,O : INTEGER;
  263.      St : STRING[8];
  264.  BEGIN
  265.      I := 1;
  266.      J := UserIdEnd+38;
  267.      REPEAT
  268.       St[0] := CHR(I-1);
  269.       ST[I] := InputArray[J];
  270.       INC(I); INC(J);
  271.      UNTIL (ST[I-1] = Space) OR (ST[I-1] = CR);
  272.      IF (ST[I-1] <> CR) THEN
  273.          Count;
  274.      FOR J := 1 TO ORD(ST[0]) DO
  275.        Outputarray[SizeSt+ (LenSize-Length(ST))+J-1] := ST[J];
  276.  END;
  277.  
  278.  (*****************************************)
  279.  PROCEDURE FName;
  280.  VAR I,J,x : INTEGER;
  281.  BEGIN
  282.      I := FnameSt;
  283.      J := UserIdEnd+2;
  284.      REPEAT
  285.       OutPutArray[I] := InputArray[J];
  286.       INC(I); INC(J);
  287.      UNTIL (OutPutArray[I-1] = '.');
  288.      OutPutArray[I-1] := ' ';
  289.      I := ExtSt;
  290.      FOR x := 1 to 3 DO
  291.      BEGIN
  292.       OutPutArray[I] := InputArray[J];
  293.       INC(I); INC(J);
  294.      END;
  295.      IF (FindWord('binary',0) <> 0) THEN
  296.        OutputArray[BinSt] := 'T'
  297.      Else
  298.        OutputArray[BinSt] := 'F';
  299.  END;
  300.  
  301.  (*****************************************)
  302.  PROCEDURE ReadFile; (* get data till we have 2 left brackets *)
  303.  VAR
  304.      CH,CX : CHAR;
  305.      BrackCnt : INTEGER;
  306. CONST
  307.     Number : SET OF '0'..'9' = ['0'..'9'];
  308.  BEGIN
  309.    BrackCnt := 0;
  310.    InSize := 0;
  311.    READ(InFile,CH);
  312.    WHILE (BrackCnt < 2) AND (CH <> Term) DO
  313.    BEGIN
  314.      READ(InFile,CH);
  315.      IF (CX = LeftBracket) AND  NOT (CH IN Number) THEN
  316.       DEC(BrackCnt);
  317.      CX := CH;
  318.      InPutArray[InSize] := CH;
  319.      INC(InSize);
  320.      IF CH = LeftBracket THEN
  321.       BEGIN
  322.        IF BrackCnt = 0 THEN
  323.          StartOfRec := InSize;
  324.        INC(BrackCnt);
  325.       END;
  326.    END;
  327.    Done :=  EOF(InFile);
  328.    SEEK(InFile,FilePos(InFile)-2); (* back up to before left bracket *)
  329.    DEC(InSize,2);
  330.  END;
  331.  (******************************************)
  332.  PROCEDURE Memo;
  333.  VAR St : STRING[10];
  334.      I,J: INTEGER;
  335.  CONST
  336.      CrLfSpSpSpSp : String =(#$0d+#$0a+'    ');
  337.  BEGIN
  338.      Str(MemoCtr,St);
  339.      For I := 1 TO Length(St) DO
  340.        OutputArray[MemoSt +(LenMemo-Length(St))+I-1] := St[I];
  341.     J := FindWord(CrLfSpSpSpSp,KWEND);
  342.     I := 0;
  343.     REPEAT
  344.       MemoArray[I] := InputArray[J];
  345.       INC(I); INC(J);
  346.     UNTIL (J = InSize) OR (I = 509);
  347.     MemoEnd := I-1;
  348.  
  349.  END;
  350.  (******************************************)
  351.  PROCEDURE WriteFile;
  352.  CONST
  353.     AlphaNum : SET OF '0'..'z' = ['0'..'9','A'..'Z','a'..'z'];
  354.     DEOF :CHAR = #$1a;
  355.     CR   :CHAR = #$0d;
  356.     LF   :CHAR = #$0a;
  357.  VAR I,J : INTEGER;
  358.     Key : CHAR;
  359.  BEGIN
  360.      InitDbaseArray; (* erase to spaces *)
  361.      INC(OutCtr);
  362.      ReadFile;
  363.       Title;      (* put em in right order so if we step to far *)
  364.       KeyWords;   (* the next guy will fix it *)
  365.       UserId;
  366.       Date;
  367.       FName;    (* fname.ext/binary *)
  368.       Size;     (* this will get count too. easy to see if it's missing here *)
  369.       Memo;     (* this will write memo field pointer in DBF file
  370.                    and stuff memo array  *)
  371.  
  372.       IF   NoTitle THEN (* make one any way *)
  373.       BEGIN
  374.          J := 0;
  375.          I := TitleSt;
  376.          REPEAT
  377.           INC(J);
  378.          UNTIL MemoArray[J] IN AlphaNum; (* zap spaces and blank lines *)
  379.          REPEAT
  380.            OutputArray[I] := MemoArray[J];
  381.            INC(I); INC(J);
  382.          UNTIL ((MemoArray[J-1] = '.') AND (MEMOArray[J] = Space)) OR
  383.                                        (MemoArray[J] = CR) OR
  384.                                        (I = LenTitle);
  385.       END;
  386.  
  387.  (* write assembled record to DBF file *)
  388.       FOR I := 0 TO OutRecSize-1 DO
  389.        BEGIN
  390.         Write(OutFile,OutputArray[I]);
  391.        END;
  392.  
  393.  (* Now write to the memo file
  394.     memo records are up to 510 bytes + 2 eofs
  395.     DBASE will let you make them multiples of 512
  396.     but I did't make the effort.
  397.  *)
  398.       INC(MemoCtr);
  399.       Seek(MemoFile,MemoFileIndex);  (* always start on 512 byte boundry *)
  400.       FOR I := 0 TO MemoEnd-1 DO
  401.        BEGIN
  402.         IF MemoArray[I] = CR THEN
  403.             MemoArray[I] := #$8d;      (* CR with hi bit set for word wrap *)
  404.         Write(MemoFile,MemoArray[I]);
  405.        END;
  406.        Write(MemoFile,CR);
  407.        Write(MemoFile,LF);
  408.        Write(MemoFile,DEOF);
  409.        Write(MemoFile,DEOF);
  410.       INC(MemoFileIndex,MemoSize);
  411.  END;
  412.  (*****************************************)
  413.  PROCEDURE WriteDBFHeader;
  414.  CONST
  415.    (* header loc 4,5 = record pointer
  416.       header loc 8,9 = header size
  417.       header loc 8,9 = Record size *)
  418.    DBFHeader : ARRAY[0..$160] OF CHAR = (
  419.    #$83,#$59,#$0c,#$1d,#0,#0,#0,#0,#$61,#$01,#$bd,#0,#0,#0,#0,#0,
  420.    #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  421.    'T','I','T','L','E',        #0,#0,#0,#0,#0,#0,      'C',#0,#0,#0,#0,
  422.    #60,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  423.    'K','E','Y','_','W','D','S',#0,#0,#0,#0,            'C',#0,#0,#0,#0,
  424.    #80,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  425.    'F','_','N','A','M','E',    #0,#0,#0,#0,#0,         'C',#0,#0,#0,#0,
  426.    #6,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  427.    'E','X','T',                #0,#0,#0,#0,#0,#0,#0,#0,'C',#0,#0,#0,#0,
  428.    #3,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  429.    'B','I','N',                #0,#0,#0,#0,#0,#0,#0,#0,'L',#0,#0,#0,#0,
  430.    #1,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  431.    'U','S','E','R','_','I','D',#0,#0,#0,#0,            'C',#0,#0,#0,#0,
  432.    #10,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  433.    'D','A','T','E',            #0,#0,#0,#0,#0,#0,#0,   'D',#0,#0,#0,#0,
  434.    #8,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  435.    'S','I','Z','E',            #0,#0,#0,#0,#0,#0,#0,   'N',#0,#0,#0,#0,
  436.    #6,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  437.    'C','O','U','N','T',        #0,#0,#0,#0,#0,#0,      'C',#0,#0,#0,#0,
  438.    #4,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,
  439.    'I','N','F','O',            #0,#0,#0,#0,#0,#0,#0,   'M',#0,#0,#0,#0,
  440.    #10,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#$0D);
  441.  VAR I : INTEGER;
  442.  BEGIN
  443.   ASSIGN(OutFile,OutFileName);
  444.   ReWrite(OutFile);
  445.   FOR I := 0 TO $160 DO
  446.    Write(OutFile,DBFHeader[I]);
  447.   Seek(OutFile,$161);
  448.  END;
  449.  (*****************************************)
  450.  PROCEDURE WriteDBTHeader; 
  451.  (* the only thing in memo file header we care about is loc 0,1 and we do
  452.     that after we're done *)
  453.  VAR I : INTEGER;
  454.      N : CHAR;
  455.  BEGIN
  456.     N := #0;
  457.     Assign(MemoFile,MemoFileName);
  458.     ReWrite(MemoFile);
  459.     FOR I := 0 TO $1FF DO
  460.      Write(MemoFile,N);
  461.  END;
  462.  (*****************************************)
  463.  PROCEDURE Query;
  464.  VAR  Name : STRING;
  465.       C    : CHAR;
  466.       Good : BOOLEAN;
  467.  BEGIN
  468.    OverWrite := TRUE;
  469.    Cancel := FALSE;
  470.    REPEAT
  471.      Write('ENTER CATALOG FILE [\Path\Name.Ext] ');
  472.      READLN(InFileName);
  473.      IF InFileName = '' THEN (* clean get away if stumped *)
  474.       Begin
  475.         Cancel := TRUE;
  476.         EXIT;
  477.       END;
  478.      ASSIGN(InFile,InFileName);
  479.      (*$I-*)
  480.      Reset(InFile);
  481.      (*$I+*)
  482.      IF IORESULT = 0 THEN
  483.       Good := TRUE
  484.      ELSE
  485.       Begin
  486.         WriteLn('File Not Found, Re-Enter (hit enter to quit) ');
  487.         Good := FALSE;
  488.       END;
  489.    UNTIL Good;
  490.    Write('ENTER DBASE FILE [\Path\Name] ');
  491.    READLN(Name);
  492.    OutFileName := Name + '.DBF';
  493.    MemoFileName:= Name + '.DBT';
  494.    ASSIGN(MemoFile,MemoFileName);
  495.    ASSIGN(OutFile,OutFileName);
  496.    (*$I-*)
  497.    Reset(OutFile);
  498.    (*$I+*)
  499.    IF IORESULT = 0 THEN
  500.    BEGIN
  501.        WriteLn('That DBASE File Already Exist.');
  502.        REPEAT
  503.         Write('Overwrite, Append or Cancel : [ O A C ] ');
  504.         C := ReadKey;
  505.         CASE C OF
  506.          'O','o':Begin
  507.                   OverWrite := TRUE;
  508.                   Good := TRUE;
  509.                  END;
  510.          'A','a':Begin
  511.                   OverWrite := FALSE;
  512.                   Good := TRUE;
  513.                  END;
  514.          'C','c':Begin
  515.                   Cancel := TRUE;
  516.                   Good := TRUE;
  517.                  END;
  518.         ELSE
  519.             Begin
  520.               Good := FALSE;
  521.               WriteLn('??');
  522.             END;
  523.         END;
  524.        UNTIL GOOD;
  525.     END;
  526.     WriteLn;
  527.  END;
  528. (*****************************************)
  529. PROCEDURE DbaseAppend;
  530. VAR
  531.     a0,a1,a4,a5,a8,a9,a10,a11 : char;
  532.     RC,RS,HS : LONGINT;
  533.  BEGIN
  534.       Seek(OutFile,4);        (*Header Address 4,5 Has Rec Count*)
  535.       Read(OutFile,a4);
  536.       Read(OutFile,a5);
  537.       Seek(OutFile,8);        (*Header Address 8,9 Has Rec Size*)
  538.       Read(OutFile,a8);
  539.       Read(OutFile,a9);
  540.       Read(OutFile,a10);      (*Header Address 10,11 Has Header Size*)
  541.       Read(OutFile,a11);
  542.       OutCtr := ORD(a4) + (256*ORD(a5));
  543.       RS := ORD(a10) + (256*ORD(a11));
  544.       HS := ORD(a8) + (256*ORD(a9));
  545.       SEEK(OutFile,(OutCtr*RS)+HS);
  546.       Reset(MemoFile);       (*Header Address 0,1 Has Memo Count*)
  547.       Read(MemoFile,A0);
  548.       Read(MemoFile,A1);
  549.       MemoCtr := ORD(a0) + (256*ORD(a1));
  550.       MemoFileIndex := MemoCtr; (* put in wide place for multiply *)
  551.       MemoFileIndex := MemoFileIndex*MemoSize;
  552. END;
  553.  (*****************************************)
  554. VAR KEY : CHAR;
  555.  
  556. BEGIN
  557.   ClrScr;
  558.   Query;
  559.   IF Cancel THEN
  560.    Begin
  561.     WriteLn;
  562.     WriteLn('Operation Canceled',#7);
  563.     EXIT;
  564.    END;
  565.   Done := FALSE;
  566.   MemoCtr := 1;
  567.   OutCtr  := 0;
  568.   MemoFileIndex := MemoSize;
  569.   ASSIGN(InFile,InFileName);
  570.   RESET(InFile);
  571.   IF OverWrite THEN    (* or a new file *)
  572.    Begin
  573.      WriteDBFHeader;
  574.      WriteDbtHeader;
  575.    END
  576.    ELSE
  577.      Begin
  578.        DbaseAppend;
  579.      END;
  580.   REPEAT
  581.    WriteFile;
  582.   UNTIL Done;
  583.  
  584.   (* Now fix up the headers *)
  585.  
  586.   LoByte := CHR(LO(OutCtr));
  587.   HiByte := CHR(Hi(OutCtr));
  588.   SEEK(outFile,4);
  589.   Write(OutFile,LoByte);
  590.   Write(OutFile,HiByte);
  591.   INC(MemoCtr);  (* point to next memo *)
  592.   LoByte := CHR(LO(MemoCtr));
  593.   HiByte := CHR(Hi(MemoCtr));
  594.   Reset(MemoFile);
  595.   Write(MemoFile,LoByte);
  596.   Write(MemoFile,HiByte);
  597.  
  598.   CLOSE(InFile);
  599.   CLOSE(OutFile);
  600.   Close(MemoFile);
  601. END.