home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / BASIC / QBDBAS / QBDBASE.BAS < prev    next >
BASIC Source File  |  1991-10-21  |  24KB  |  695 lines
  1. ' DEMONSTRATIE PROGRAMMA.
  2. '
  3. ' LEES dBaseIII en dBaseIV DataBase- en Memobestanden met QuickBasic
  4. '
  5. ' -----------------------------------------------------------------------
  6. '
  7. ' Doel:    Het lezen van dBase III en IV bestanden.
  8. '
  9. ' Werking: Dit voorbeeld programma toont de header structuur, de records
  10. '          en de memo's van een dBase file op het scherm. Dezelfde
  11. '          routines kunnen worden gebruikt om dBase records in uw eigen
  12. '          database programma binnen te halen en ze verder te bewerken.
  13. '          Het rechstreeks wijzigen van een dBase bestand is natuurlijk
  14. '          ook mogelijk; pas echter op bij het veranderen van de
  15. '          sleutelvelden van een dBase bestand. Eventuele indexen kunnen
  16. '          daardoor corrupt worden.
  17. '
  18. ' -----------------------------------------------------------------------
  19.  
  20. DEFINT A-Z
  21.  
  22. ' de lay-out van het eerste blok van 32 bytes van een dBase bestand.
  23. '
  24. TYPE dbHeader
  25.   Versie AS STRING * 1                  ' versie nummer (3 of 4)
  26.   LaatsteDatum AS STRING * 3            ' laatste update datum
  27.   AantalRecords AS LONG                 ' aantal records
  28.   HeaderLengte AS INTEGER               ' lengte van het header blok.
  29.   RecordLengte AS INTEGER               ' recordlengte (incl Deleted Byte)
  30.   Ongebruikt AS STRING * 20             '
  31. END TYPE
  32.  
  33. ' de lay-out van de volgende blokken van 32 bytes van de header.
  34. '
  35. TYPE VeldBeschrijving
  36.   VeldNaam AS STRING * 11               ' naam van het veld
  37.   VeldType AS STRING * 1                ' type
  38.   DataAdres AS STRING * 4               ' niet gebruikt in dit programma.
  39.   VeldLengte AS STRING * 1              ' lengte van een veld
  40.   Decimalen AS STRING * 1               ' aantal decimalen, indien numeriek
  41.   Ongebruikt AS STRING * 14             '
  42. END TYPE
  43.  
  44. ' -----------------------------------------------------------------------
  45. DECLARE SUB Invoer ()
  46. DECLARE SUB OpendBFile ()
  47. DECLARE SUB BekijkHeader ()
  48. DECLARE SUB BekijkLayout ()
  49. DECLARE SUB BekijkRecords ()
  50. DECLARE SUB BekijkMemo (Buffer$)
  51. DECLARE FUNCTION BestandAanwezig% (Bestand$)
  52. ' -----------------------------------------------------------------------
  53. DIM SHARED Header AS dbHeader           ' 1e blok van 32 bytes
  54. DIM SHARED dBFile$                      ' dBase file naam
  55. DIM SHARED dBHandle%                    ' dbase file handle
  56. DIM SHARED MemoHandle%                  ' memo file handle
  57. DIM SHARED Versie%                      ' versie nummer
  58. DIM SHARED MemoAanwezig%                ' Boolean.
  59. DIM SHARED AantalVelden%                ' aantal velden.
  60. DIM SHARED DiskFout%                    ' Boolean ON ERROR var.
  61. DIM SHARED MemoryFout%                  ' Boolean ON ERROR var.
  62. REDIM SHARED Veld(1 TO 2) AS VeldBeschrijving  ' (wordt ge-REDIM-ed)
  63. ' -----------------------------------------------------------------------
  64. CLS
  65. ON ERROR GOTO Foutje                              ' Algemene fout afhandeling.
  66.  
  67. CALL Invoer                                       ' Vraag .DBF naam
  68. CALL OpendBFile                                   ' file openen
  69. CALL BekijkHeader                                 ' bekijk header
  70. CALL BekijkLayout                                 ' bekijk record layout
  71. CALL BekijkRecords                                ' toon records en memo's
  72. CLOSE
  73.  
  74. PRINT
  75. PRINT SPC(17); "Vriendelijke groeten van BLOKKER+BLOKKER"
  76. PRINT SPC(17); "  Postbus 71992 - 1008 ED  Amsterdam"
  77. PRINT SPC(17); "          020 - 6.42.32.75"
  78. PRINT
  79. PRINT SPC(9); "TurboFlow! is onmisbaar voor elke QuickBasic programmeur !"
  80. PRINT SPC(9); STRING$(58, "─")
  81. END
  82.  
  83. ' -----------------------------------------------------------------------
  84. ' Fouten afhandeling:
  85. '
  86. Foutje:
  87. CLOSE
  88. PRINT "Error :"; ERR
  89. RESUME StopProgramma
  90.  
  91. StopProgramma:
  92. END
  93.  
  94. ' -----------------------------------------------------------------------
  95. ' Speciale foutroutine. Wordt aangeroepen in de funktie BestandAanwezig.
  96. '
  97. FoutBestand:
  98. DiskFout% = -1
  99. RESUME NEXT
  100.  
  101. ' -----------------------------------------------------------------------
  102. ' Speciale foutroutine. Wordt aangeroepen in de SUB BekijkMemo()
  103. '
  104. OutOfStringSpace:
  105. MemoryFout% = -1
  106. RESUME NEXT
  107.  
  108. '
  109. ' That's all, Folks!
  110. ' ------------------------------------------------------------------------
  111.  
  112. SUB BekijkHeader
  113.  
  114. ' --------------------------------------------------------------------
  115. ' Funktie   : Analyseer de inhoud van het eerste blok van 32 bytes
  116. '             van een dBase file. OPEN .DBT MemoFile indien aanwezig.
  117. '
  118. ' Gebruikt  : FUNCTION BestandAanwezig%(File$)
  119. '
  120. ' Shared    : Header        - type dBHeader
  121. '             Versie%       - 3 = dBaseIII, 4 = dBase IV.
  122. '             MemoAanwezig% - Boolean.
  123. ' --------------------------------------------------------------------
  124.  
  125. ' Locale variabelen:
  126. ' ------------------
  127. DIM Jaar%                                         ' datum laatste update
  128. DIM Maand%                                        ' -
  129. DIM Dag%                                          ' -
  130. DIM MemoFile$                                     ' naam van het .DBT bestand
  131.  
  132.  
  133. ' De header van een dBase III bestand heeft de volgende inhoud:
  134. ' ----------------------------------------------------------------------
  135. ' Versie         -  STRING * 1          ' Ascii waarde is versie nummer.
  136. ' LaatsteDatum   -  STRING * 3          ' Ascii waarde jaar/maand/dag
  137. ' AantalRecords  -  LONG INTEGER        ' aantal records in het bestand
  138. ' HeaderLengte   -  INTEGER             ' lengte van de header
  139. ' RecordLengte   -  INTEGER             ' lengte van elk record
  140. '
  141.  
  142. ' Bepaal het versie nummer en kijk of er memovelden aanwezig zijn.
  143. '
  144. SELECT CASE Header.Versie
  145.   CASE CHR$(&H3)                                   ' 3
  146.     Versie% = 3
  147.     MemoAanwezig% = 0
  148.   CASE CHR$(&H83)                                  ' 131
  149.     Versie% = 3
  150.     MemoAanwezig% = -1
  151.   CASE CHR$(&H63)                                  ' 99
  152.     Versie% = 4
  153.     MemoAanwezig% = 0
  154.   CASE CHR$(&H8B)                                  ' 139
  155.     Versie% = 4
  156.     MemoAanwezig% = -1
  157.   CASE ELSE
  158.     PRINT "Geen dBase III of dBase IV bestand"
  159.     CLOSE
  160.     END
  161. END SELECT
  162.  
  163. ' Toon de informatie uit de header.
  164. '
  165. Dag% = ASC(MID$(Header.LaatsteDatum, 3, 1))
  166. Maand% = ASC(MID$(Header.LaatsteDatum, 2, 1))
  167. Jaar% = ASC(MID$(Header.LaatsteDatum, 1, 1))
  168.  
  169. PRINT "Versie ...........:"; Versie%
  170. PRINT "Laatste wijziging.:"; STR$(Dag%); "-"; MID$(STR$(Maand%), 2); "-"; MID$(STR$(Jaar%), 2)
  171. PRINT "Header lengte ....:"; Header.HeaderLengte; "bytes"
  172. PRINT "Aantal records ...:"; Header.AantalRecords
  173. PRINT "Record lengte ....:"; Header.RecordLengte; "bytes"
  174.  
  175. IF MemoAanwezig% THEN
  176.   PRINT "Memo velden ......: aanwezig."
  177.   MemoFile$ = LEFT$(dBFile$, INSTR(dBFile$, ".")) + "DBT"
  178.   IF NOT BestandAanwezig(MemoFile$) THEN
  179.     PRINT "Memo file ........: niet aanwezig !"
  180.     MemoAanwezig% = 0
  181.   ELSE
  182.     MemoHandle% = FREEFILE
  183.     OPEN MemoFile$ FOR BINARY AS #MemoHandle%
  184.     PRINT "Memo file ........: "; MemoFile$; " geopend. Lengte :"; LOF(MemoHandle%); "bytes."
  185.   END IF
  186. ELSE
  187.   PRINT "Memo velden ......: niet aanwezig."
  188. END IF
  189.  
  190. END SUB
  191.  
  192. SUB BekijkLayout
  193.  
  194. ' Funktie : Analyseer de header van een dBase file vanaf
  195. '           het tweede blok van 32 bytes. Toon de record layout.
  196. '
  197. ' shared  : AantalVelden%
  198. '           VELD - type VeldBeschrijving.
  199. '           HEADER - type dBHeader
  200. '           AantalVelden%
  201. ' --------------------------------------------------------------
  202.  
  203. ' locale variabelen:
  204. ' ------------------
  205. DIM I%           ' loop teller
  206. DIM I$           ' toets opvang.
  207. DIM ChrSNul%     ' plaats van chr$(0) in veldnaam.
  208.  
  209.  
  210. AantalVelden% = (Header.HeaderLengte \ 32) - 1
  211.  
  212. ' In de hoofdroutine is de TYPE variabele "Veld" al voorlopig
  213. ' ge-DIM'd met twee elementen. Zet het aantal elementen nu
  214. ' met een REDIM commando op het juiste aantal velden.
  215.  
  216. REDIM Veld(1 TO AantalVelden%) AS VeldBeschrijving
  217.  
  218. FOR I% = 1 TO AantalVelden%                    ' lees blokken van 32 bytes.
  219.   SEEK #dBHandle%, (32 * I%) + 1                       ' file pointer.
  220.   GET #dBHandle%, , Veld(I%)                           ' en plaats deze in Veld().
  221.  
  222.   ' zoek naar Ascii 0 in de veldnaam. Indien gevonden, vervang dan
  223.   ' alle tekens vanaf die plaats tot het einde van het veld door spaties.
  224.   '
  225.   ChrSNul% = INSTR(Veld(I%).VeldNaam, CHR$(0))
  226.   IF ChrSNul > 0 THEN
  227.     FOR ChrSNul% = ChrSNul% TO LEN(Veld(I%).VeldNaam)
  228.       MID$(Veld(I%).VeldNaam, ChrSNul, 1) = " "
  229.     NEXT ChrSNul
  230.   END IF
  231. NEXT I%
  232.  
  233. PRINT
  234. PRINT " Nr  Veldnaam---    Type------------- Lengte Decimalen"
  235. FOR I% = 1 TO AantalVelden%
  236.   PRINT USING "###  "; I%;
  237.   PRINT Veld(I%).VeldNaam; TAB(20); " ";
  238.  
  239.   COLOR 15, 0
  240.   PRINT Veld(I%).VeldType;
  241.   COLOR 7, 0
  242.  
  243.   SELECT CASE Veld(I%).VeldType
  244.     CASE "C"
  245.       PRINT "haracter (Tekst)  ";
  246.     CASE "N"
  247.       PRINT "umeric   (Getal)  ";
  248.     CASE "L"
  249.       PRINT "ogic     (Ja/Nee) ";
  250.     CASE "D"
  251.       PRINT "ate      (Datum)  ";
  252.     CASE "M"
  253.       PRINT "emo      (Notitie)";
  254.     CASE ELSE
  255.       PRINT SPACE$(18);
  256.   END SELECT
  257.  
  258.   PRINT USING "#####"; ASC(Veld(I%).VeldLengte);
  259.  
  260.   SELECT CASE Veld(I%).VeldType
  261.     CASE "N"
  262.       PRINT USING "#####"; ASC(Veld(I%).Decimalen)
  263.     CASE "M"
  264.       PRINT SPACE$(8); "(Pointer naar .DBT file)"
  265.     CASE "D"
  266.       PRINT SPACE$(8); "(Formaat JJJJMMDD)"
  267.     CASE ELSE
  268.       PRINT
  269.   END SELECT
  270. NEXT I%
  271. PRINT
  272. PRINT "Druk op de spatiebalk...";
  273.  
  274. I$ = ""
  275. DO
  276.   I$ = INKEY$
  277. LOOP UNTIL I$ = CHR$(32)
  278.  
  279. END SUB
  280.  
  281. SUB BekijkMemo (Buffer$)
  282.  
  283. DIM Positie%                       ' Plaats in string
  284. DIM EindeRegel$                    ' Einde regel aanduiding in memo tekst
  285. DIM CR$                            ' Carriage Return
  286. DIM LF$                            ' Line Feed
  287. DIM TB$                            ' Tab
  288.  
  289. EindeRegel$ = "ì" + CHR$(10)                                ' memo einde regel
  290. CRLF$ = CHR$(13) + CHR$(10)
  291. CR$ = CHR$(13)
  292. LF$ = CHR$(10)
  293. TB$ = CHR$(9)
  294.  
  295. ' In de memo's staan een aantal besturings tekens.
  296. ' Verwijder die tekens voor meer leesbaarheid.
  297. '
  298. PRINT
  299. PRINT
  300.  
  301. LOCATE 16, 20: PRINT "Verwijderen Einde Regel tekens...";
  302. Strip$ = EindeRegel$
  303. GOSUB StripBuffer
  304.  
  305. LOCATE , 20: PRINT "Verwijderen CR/LF's...           ";
  306. Strip$ = CRLF$
  307. GOSUB StripBuffer
  308.  
  309. LOCATE , 20: PRINT "Verwijderen Carriage Returns...  ";
  310. Strip$ = CR$
  311. GOSUB StripBuffer
  312.  
  313. LOCATE , 20: PRINT "Verwijderen Line Feeds...        ";
  314. Strip$ = LF$
  315. GOSUB StripBuffer
  316.  
  317. LOCATE , 20: PRINT "Verwijderen Tabs...              ";
  318. Positie% = INSTR(Buffer$, TB$)                        ' zoek Tabs
  319. WHILE Positie% > 0                                    ' zet om in spatie...
  320.   MID$(Buffer$, Positie%, 1) = " "
  321.   Positie% = INSTR(Buffer$, TB$)
  322. WEND
  323.  
  324. MemoryFout% = 0
  325. ON ERROR GOTO OutOfStringSpace
  326.  
  327. LOCATE , 20: PRINT "Verwijderen dubbele spaties...   ";
  328.  
  329. FOR X% = 20 TO 2 STEP -1
  330.   Positie% = INSTR(Buffer$, SPACE$(X%))
  331.   DO WHILE Positie% > 0
  332.     Buffer$ = LEFT$(Buffer$, Positie%) + MID$(Buffer$, Positie% + X%)
  333.     IF MemoryFout% THEN
  334.       SOUND 350, .5
  335.       LOCATE , 20: PRINT "Out of String space...         "
  336.       LOCATE , 20: PRINT "Memo te groot om in te delen"
  337.       SLEEP 3
  338.       ON ERROR GOTO Foutje
  339.       GOTO ToonMemo                                  ' Nooduitgang.
  340.     END IF
  341.     Positie% = INSTR(Buffer$, SPACE$(X%))
  342.   LOOP
  343. NEXT X%
  344.  
  345. LOCATE , 20: PRINT "Woordomslag organiseren...       ";
  346. FOR Positie% = 78 TO LEN(Buffer$) STEP 78
  347.   FOR X% = Positie% TO 1 STEP -1
  348.     IF MID$(Buffer$, X%, 1) = " " THEN
  349.       EXIT FOR
  350.      END IF
  351.   NEXT X%
  352.   Buffer$ = LEFT$(Buffer$, X%) + SPACE$(Positie% - X%) + MID$(Buffer$, X% + 1)
  353. NEXT Positie%
  354.  
  355. ToonMemo:
  356.  
  357. LOCATE 12, 1
  358. PRINT "┌"; STRING$(78, "─"); "┐";
  359. FOR X% = 13 TO 23
  360.   PRINT "│"; SPACE$(78); "│";
  361. NEXT X%
  362. PRINT "└"; STRING$(78, "─"); "┘";
  363.  
  364. Regel% = 13
  365. FOR Positie% = 1 TO LEN(Buffer$) STEP 78
  366.   LOCATE Regel%, 2
  367.   PRINT MID$(Buffer$, Positie%, 78);
  368.   Regel% = Regel% + 1
  369.   IF Regel = 24 THEN
  370.     WHILE I$ = ""
  371.       I$ = INKEY$
  372.     WEND
  373.     IF I$ = CHR$(27) THEN
  374.       EXIT SUB
  375.     END IF
  376.     I$ = ""
  377.     FOR X% = 13 TO 23
  378.       LOCATE X%, 2
  379.       PRINT SPACE$(78);
  380.     NEXT X%
  381.     Regel% = 13
  382.   END IF
  383. NEXT Positie%
  384. EXIT SUB
  385.  
  386.  
  387. StripBuffer:
  388. Positie% = INSTR(Buffer$, Strip$)                  ' zoek te verwijderen
  389. WHILE Positie% > 0                                 ' teken(s) en verander
  390.   MID$(Buffer$, Positie%, LEN(Strip$)) = SPACE$(LEN(Strip$))
  391.   Positie% = INSTR(Buffer$, Strip$)
  392. WEND
  393. RETURN
  394.  
  395. END SUB
  396.  
  397. SUB BekijkRecords
  398.  
  399. ' Funktie : Bekijk de records in een dBase III of IV bestand.
  400. '           Toon ook de memo's, indien aanwezig.
  401. '
  402. ' shared  : AantalVelden%
  403. '           MemoAanwezig%
  404. '
  405.  
  406. ' locale variabelen:
  407. ' ------------------
  408. DIM Rec$                           ' Record inlees buffer.
  409. DIM A$                             ' Veld inlees buffer.
  410. DIM Form$                          ' Masker voor PRINT USING van een bedrag.
  411. DIM MemoPointer&                   ' Pointer naar blok in memo file.
  412. DIM MemoLengte&                    ' Lengte van een dBase IV memo.
  413. DIM EersteBlok%                    ' Boolean, bezig met eerste blok van memo.
  414. DIM Blok$                          ' Blok tekst van 512 bytes.
  415. DIM Buffer$                        ' Buffer voor totale memo tekst.
  416. DIM SeekPosition&                  ' File pointer in dBase file.
  417. DIM MemoIngelezen%                 ' Boolean. Gereed met inlezen van memo.
  418. DIM Record&                        ' Loop teller.
  419. DIM J%                             ' Loop teller.
  420.  
  421.  
  422. ' Toon nu de records.
  423. '
  424. CLS
  425. SeekPosition& = Header.HeaderLengte + 1           ' start van 1e record
  426. SEEK #dBHandle%, SeekPosition&                    ' plaats leeskop
  427.  
  428. FOR Record& = 1 TO Header.AantalRecords           ' toon alle records
  429.   Rec$ = SPACE$(Header.RecordLengte)              ' init string
  430.   GET #dBHandle%, , Rec$                          ' lees string uit file
  431.  
  432.   PRINT "Record nr.  :";
  433.   PRINT USING "###_."; Record&;     ' toon recordnummer
  434.  
  435.   IF LEFT$(Rec$, 1) = "*" THEN                    ' 1e pos een ster:
  436.     COLOR 15, 0
  437.     PRINT " Record is gewist."                   ' .. record is deleted.
  438.     COLOR 7, 0
  439.   ELSE
  440.     PRINT " Record is geldig."
  441.   END IF
  442.  
  443.   StartPos% = 2
  444.   FOR J% = 1 TO AantalVelden%                      ' toon de velden
  445.     PRINT Veld(J%).VeldNaam; " : ";                ' .. veld naam.
  446.                                                    ' lees veld in A$
  447.     A$ = MID$(Rec$, StartPos%, ASC(Veld(J%).VeldLengte))
  448.    
  449.     SELECT CASE Veld(J%).VeldType                 ' welk type ?
  450.    
  451.       CASE "C"                                      ' tekst
  452.         PRINT A$
  453.      
  454.       CASE "D"                                      ' datumveld
  455.         PRINT MID$(A$, 7, 2); "/"; MID$(A$, 5, 2); "/"; MID$(A$, 1, 4)
  456.      
  457.       CASE "N"                                      ' numeriek
  458.        
  459.         ' stel het masker samen, waarmee een getal moet worden afgedrukt.
  460.         '
  461.         IF ASC(Veld(J%).Decimalen) > 0 THEN
  462.           Form$ = STRING$(ASC(Veld(J%).VeldLengte) - ASC(Veld(J%).Decimalen), "#") + "." + STRING$(ASC(Veld(J%).Decimalen), "#")
  463.         ELSE
  464.           Form$ = STRING$(ASC(Veld(J%).VeldLengte), "#")
  465.         END IF
  466.         A# = VAL(A$)
  467.         PRINT USING Form$; A#
  468.      
  469.       CASE "L"                                       ' logisch veld.
  470.         IF A$ = "T" OR A$ = "Y" THEN                 ' T of Y ?
  471.           PRINT "Waar"                               ' .. waar.
  472.         ELSE                                         ' anders..
  473.           PRINT "Niet waar"                          ' .. niet waar.
  474.         END IF
  475.         
  476.       
  477.       ' De memo velden in dBase3 en dBase4 zijn verschillend ge-
  478.       ' organiseerd. In dBase3 zijn het eenvoudig aaneengesloten blokken
  479.       ' tekst van 512 bytes. Elk memo wordt afgesloten met 1Ah 1Ah
  480.       '
  481.       ' In dBase4 begint een memoblok FFh FFh 08h 00h met daarachter de
  482.       ' lengte van de memo als LONG INTEGER in 4 bytes.
  483.       '
  484.       ' Als echter in dBase4 een bestand met memo's wordt ingelezen dat
  485.       ' in dBase3 is aangemaakt, dan blijft de oude structuur gehandhaafd
  486.       ' tot het moment dat een memo in dBase IV wordt bijgewerkt.
  487.       '
  488.       ' Er kunnen dus in een en hetzelfde .DBT bestand memo's met
  489.       ' verschillende formaten voorkomen !!!
  490.       '
  491.       CASE "M"
  492.         MemoIngelezen% = 0
  493.         MemoPointer& = VAL(A$)                       ' pointer naar 512 bytes
  494.                                                      ' blok in memofile
  495.        
  496.         PRINT A$; " <- pointer naar memo file. Formaat : ";
  497.         IF MemoPointer& > 0 AND MemoAanwezig% THEN   ' Memo ingevuld?
  498.           Buffer$ = ""
  499.           EersteBlok% = -1
  500.           DO
  501.             Blok$ = SPACE$(512)                                ' init string
  502.             GET #MemoHandle%, (MemoPointer& * 512) + 1, Blok$  ' lees 512 bytes
  503.            
  504.             IF EersteBlok% THEN
  505.               EersteBlok% = 0
  506.              
  507.               ' In dBaseIV bevatten de eerste 8 bytes van een memo blok
  508.               ' FF FF 08 00 plus LONG INTEGER met het aantal bytes.
  509.               '
  510.               ' Maar... het is mogelijk, dat in dBase4 een databestand met
  511.               ' memo's wordt bewerkt, dat onder dBase3 is aangemaakt. In dat
  512.               ' geval behandelt dBase4 zonder meer een memo-bestand volgens
  513.               ' de "oude" dBase3 methode en schrijft het memo in de nieuwe
  514.               ' vorm terug! In hetzelfde .DBT memobestand kunnen dus
  515.               ' memo's voorkomen in het oude en het nieuwe formaat...
  516.               '
  517.               IF LEFT$(Blok$, 2) = CHR$(255) + CHR$(255) THEN
  518.                 '
  519.                 ' nieuwe structuur van dBase IV
  520.                 '
  521.                 MemoLengte& = CVL(MID$(Blok$, 5, 4)) - 8&
  522.                 Blok$ = MID$(Blok$, 9)
  523.                 Versie% = 4
  524.                 PRINT "dBase IV.";
  525.               ELSE
  526.                 '
  527.                 ' memo met oude structuur van dBase III
  528.                 '
  529.                 Versie% = 3
  530.                 PRINT "dBase III.";
  531.               END IF
  532.            
  533.             END IF 'EersteBlok%
  534.            
  535.             Buffer$ = Buffer$ + Blok$                  ' vul Buffer$.
  536.                         
  537.             ' Is memo nu geheel ingelezen?
  538.             '
  539.             SELECT CASE Versie%
  540.               CASE 4
  541.                 IF LEN(Buffer$) >= MemoLengte& THEN
  542.                   Buffer$ = LEFT$(Buffer$, MemoLengte&)
  543.                   MemoIngelezen% = -1
  544.                 END IF
  545.                          
  546.               CASE 3
  547.                 ' het einde van een memo wordt
  548.                 ' in dBaseIII aangegeven met &H1A &H1A
  549.                 '
  550.                 Einde% = INSTR(Buffer$, CHR$(&H1A) + CHR$(&H1A))
  551.                 IF Einde% > 0 THEN
  552.                   Buffer$ = LEFT$(Buffer$, Einde% - 1)
  553.                   MemoIngelezen% = -1
  554.                 END IF
  555.                          
  556.             END SELECT
  557.                        
  558.             MemoPointer& = MemoPointer& + 1              ' volgende blok.
  559.          
  560.           LOOP UNTIL MemoIngelezen%
  561.          
  562.           CALL BekijkMemo(Buffer$)
  563.          
  564.  
  565.         ELSEIF MemoPointer& > 0 THEN       ' wel memo-pointer, geen .DBT bestand
  566.           LOCATE 16, 25
  567.           PRINT "Geen Memobestand aanwezig!";
  568.         ELSEIF MemoPointer& = 0 THEN
  569.           LOCATE 16, 25
  570.           PRINT "Geen memo voor dit record...";
  571.         END IF
  572.      
  573.     END SELECT
  574.    
  575.     StartPos% = StartPos% + ASC(Veld(J%).VeldLengte)       ' volgende veld.
  576.  
  577.   NEXT J%
  578.  
  579.   SLEEP                                         ' wacht
  580.   I$ = INKEY$                                   ' [Esc] = Stop
  581.   IF I$ = CHR$(27) THEN
  582.     CLS
  583.     EXIT SUB
  584.   END IF
  585.   CLS
  586.  
  587. NEXT Record&
  588.  
  589. END SUB
  590.  
  591. FUNCTION BestandAanwezig% (Bestand$)
  592.  
  593. ' --------------------------------------------------------------------
  594. ' Funktie : kontroleer of een bestand aanwezig is.
  595. '
  596. ' De werking is als volgt. Eerst wordt de opdracht gegeven om
  597. ' bij een volgende fout niet naar het label "Foutje:" te springen
  598. ' maar naar het label "FoutBestand:"
  599. ' Daarna wordt de SHARED variabele DiskFout% in deze routine op nul gezet.
  600. ' Er wordt dus aangenomen dat er geen fout zal optreden.
  601. '
  602. ' Als het bestand niet aanwezig is dan zal de ON ERROR routine naar
  603. ' het label "FoutBestand:" springen. Op die plaats wordt de SHARED
  604. ' variabele DiskFout% op -1 gezet en er wordt met RESUME NEXT voor
  605. ' gezorgd dat met de volgende programmaregel in deze routine wordt
  606. ' verder gegaan. Dan wordt de variabele DiskFout% getest. Als DiskFout%
  607. ' nog steeds 0 is, dan is er geen fout opgetreden. Als DiskFout%
  608. ' in de error trap routine op -1 is gezet, dan is het bestand niet
  609. ' gevonden of het kon niet worden geopend.
  610. '
  611. ' In de Hoofdroutine moet u de variabale Diskfout% SHARED verklaren met:
  612. '   DIM SHARED DiskFout%
  613. '
  614. ' --------------------------------------------------------------------
  615.  
  616. DiskFout% = 0                          ' reset SHARED variabele DiskFout%
  617. FileNr% = FREEFILE                     ' file handle.
  618.  
  619. ON ERROR GOTO FoutBestand              ' tijdelijk omleiden van ON ERROR
  620. OPEN Bestand$ FOR INPUT AS #FileNr%    ' probeer te openen
  621. CLOSE #FileNr%                         ' en weer sluiten
  622.  
  623. IF DiskFout% THEN                      ' Ai! niet gelukt...
  624.   BestandAanwezig% = 0                 ' .. geef False terug
  625. ELSE                                   ' anders
  626.   BestandAanwezig% = -1                ' ..Bingo! bestand aanwezig.
  627. END IF
  628. ON ERROR GOTO Foutje                   ' reset Algemene fouten opvang.
  629.  
  630.  
  631. ' Onderaan in de Hoofdroutine de volgende regels plaatsen:
  632. '
  633. ' FoutBestand:
  634. '   DiskFout% = -1
  635. '   RESUME NEXT
  636.  
  637. END FUNCTION
  638.  
  639. SUB Invoer
  640.  
  641. ' Funktie: Vraag de naam van het te bekijken dBase bestand.
  642. '          Voeg zo nodig de extensie .DBF toe.
  643. '
  644. ' Shared : dBFile$ - naam van het database bestand.
  645. '
  646. ' --------------------------------------------------------
  647.  
  648. INPUT "dBase file [.DBF] : ", dBFile$             ' vraag de naam
  649.  
  650. IF dBFile$ = "" THEN                              ' alleen [Enter] gedrukt.
  651.   PRINT "<break>"
  652.   END
  653. END IF
  654.  
  655. dBFile$ = UCASE$(dBFile$)                         ' hoofdletters
  656.  
  657. IF INSTR(dBFile$, ".") = 0 THEN                   ' geen extensie ?
  658.   dBFile$ = dBFile$ + ".DBF"                      '   plaats .DBF er achter
  659. END IF
  660.  
  661. IF RIGHT$(dBFile$, 4) <> ".DBF" THEN              ' .DBF verplicht
  662.   PRINT "Dit is geen dBase bestand"               '   anders: bye...
  663.   END
  664. END IF
  665.  
  666. LOCATE 1, 21
  667. PRINT dBFile$;
  668. END SUB ' Invoer
  669.  
  670. SUB OpendBFile
  671.  
  672. ' Funktie  : Kontroleer of dBase bestand aanwezig is.
  673. '            Zo ja, OPEN de file FOR BINARY en lees het
  674. '            het eerste blok van 32 bytes in.
  675. '
  676. ' Gebruikt : FUNCTION BestandAanwezig%(File$)
  677. '
  678. ' Shared   : dBFile$     - naam van het database bestand.
  679. '            Header      - lay-out van het eerste blok van 32 bytes.
  680. ' ------------------------------------------------------------------
  681.  
  682. IF BestandAanwezig%(dBFile$) THEN
  683.   dBHandle% = FREEFILE
  684.   OPEN dBFile$ FOR BINARY AS #dBHandle%             ' o.k.
  685.   GET #dBHandle%, , Header                          ' lees header string.
  686.   PRINT " geopend. Lengte :"; LOF(dBHandle%); " bytes."
  687. ELSE
  688.   PRINT
  689.   PRINT "Bestand "; dBFile$; " niet gevonden ..."
  690.   END
  691. END IF
  692.  
  693. END SUB
  694.  
  695.