home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPSEP90.ZIP / TESTWRIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-04  |  1.9 KB  |  83 lines
  1. PROGRAM TestWrit; {$R-}
  2.  
  3. {***************************************************************
  4. **   PROGRAM: TestWrit.PAS                                    **
  5. **   PURPOSE: Write records to dBASE III+/IV DBF files        **
  6. ****************************************************************}
  7.  
  8. {-------------------------------------------------
  9. - Define variables                               -
  10. -------------------------------------------------}
  11.  
  12.  
  13. USES Crt, WriteDBF;
  14.  
  15. VAR
  16.    DFile      : DbfFile;
  17.    ActionHdr  : Byte;
  18.    ActionFile : Boolean;
  19.    Response   : Char;
  20.    ActionRec  : Boolean;
  21.    BufferPtr  : CharPtr;
  22.    RereadHdr  : Byte;
  23.  
  24. PROCEDURE Beep;
  25.   BEGIN
  26.     Sound(1000);Delay(500);NoSound
  27.   END;
  28.  
  29. {-------------------------------------------------
  30. -          Main program                          -
  31. -------------------------------------------------}
  32.  
  33. BEGIN
  34.   ClrScr;
  35.   DFile := DbfOpen('PLANETS.DBF');
  36.   WriteLn;
  37.   ActionHdr := DbfReadHdr(DFile);
  38.   CASE ActionHdr OF
  39.   1 : BEGIN
  40.         Beep;
  41.         WriteLn('Not a dBASE III+ or IV file.')
  42.       END;
  43.   3 : BEGIN
  44.         Beep;
  45.         WriteLn('Error reading dBASE file.')
  46.       END
  47.   ELSE BEGIN
  48.     DbfDispHdr(DFile);
  49.     Pause;
  50.     ActionFile := DbfReadStru(DFile);
  51.     CASE ActionFile OF
  52.     TRUE : BEGIN
  53.       ClrScr;
  54.  
  55.       REPEAT
  56.  
  57.         Write('Append record to file (Y/N)? ');
  58.         ReadLn(Response);
  59.  
  60.         IF UpCase(Response) = 'Y' THEN BEGIN
  61.  
  62.           BufferPtr := DbfInputRec(DFile);
  63.  
  64.           IF BufferPtr <> NIL THEN BEGIN
  65.             DbfWriteRec(-1,DFile,BufferPtr);
  66.             RereadHdr := DbfReadHdr(DFile);
  67.             DbfDispHdr(DFile);
  68.             Pause
  69.             END
  70.         END
  71.         UNTIL UpCase(Response) <> 'Y'
  72.  
  73.       END;
  74.     FALSE : BEGIN
  75.       Beep;
  76.       WriteLn('Field information error')
  77.       END
  78.     END    {Case ActionFile}
  79.   END;     {Case ActionHdr}
  80.   ActionFile := DbfClose(DFile);
  81.   END
  82. END.
  83.