home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DBBROW20.ZIP / DBASEBRO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-03  |  3.7 KB  |  150 lines
  1. Program dbasebrowse;
  2.  
  3. { Dbasebrowse written by Mark Winkler 5/22/88 - Public Domain }
  4. { Dirselect was obtained from Borlands DL on CIS and modified to allow
  5.   scrolling of entries when more than 120}
  6.  
  7. { Downloaded 7/2/88 from a bbs and modified by Mike Shunfenthal CIS 76320,122
  8.    with the following changes:
  9.       1. file DBASE.PAS renamed DBASEBRO.PAS and
  10.          unit DBF.PAS renamed to DBFINFO.PAS.
  11.       2. Added option to look for the non-default directory to look for
  12.          a DBF file: either a command line parameter or a prompt
  13.  
  14.   Suggested future enhancements:
  15.       1. Read index file
  16.       2. Read memo file
  17.       3. Convert stored, encoded date type into standard type: MM/DD/YYYY
  18. }
  19.  
  20. uses
  21.   crt,dos,dbfinfo,dirsel;
  22.  
  23.  
  24. { open DBase file }
  25. { dberr = ioresult }
  26.  
  27. procedure dbopen(filename : string);
  28. begin
  29.     dbfilename := filename;
  30.     assign(dbfile,filename);
  31.     {$I-}
  32.     reset(dbfile,1);
  33.     {$I+}
  34.     dberr := ioresult;
  35.     dbfileok := (dberr=0);
  36. end; { dbopen }
  37.  
  38. procedure getfile;
  39.  
  40. var filemask : string [64];
  41.  
  42. procedure readcmdline;
  43. begin
  44.    if ParamCount = 0 then
  45.    begin
  46.       Write( 'Enter directory or <Return>: ');
  47.       gotoxy(26,14);
  48.       Readln( filemask)
  49.    end
  50.    else
  51.       filemask := ParamStr(1);
  52.    if (filemask <> '') and (copy (filemask, length( filemask), 1) <> '\')
  53.       then filemask := filemask + '\'
  54. end {readcmdline};
  55.  
  56. begin
  57.    readcmdline;
  58.     dbfilename := dirselect( filemask + '*.dbf', directory);
  59.     if dbfilename = '' then
  60.     begin
  61.          dbfileok := false;
  62.          exit;
  63.     end;
  64.     dbopen( filemask + dbfilename);
  65.     if not dbfileok then
  66.     begin
  67.        writeln ('Unable to open ', dbfilename);
  68.        exit
  69.     end;
  70.     dbhdrd;
  71.     if not dbfileok then
  72.     begin
  73.          if dberr < 256 then
  74.          begin
  75.               writeln;
  76.               writeln('Error - Short Blockread on Header ',dberr,chr(7));
  77.               exit;
  78.          end else
  79.          begin
  80.               writeln;
  81.               writeln('Error - Not DBASE III file ',dberr,chr(7));
  82.               exit;
  83.          end;
  84.      end;
  85.  
  86. end; { getfile }
  87.  
  88. procedure browse;
  89. var
  90.    choice : char;
  91.  
  92. begin
  93.      currentrec := 0;
  94.      repeat
  95.           clrscr;
  96.           gotoxy(30,1);
  97.           write('DBASE III File Browser');
  98.           gotoxy(34,8);
  99.           write('Menu Options');
  100.           gotoxy(26,10);
  101.           write('H = Display Header Information');
  102.           gotoxy(26,11);
  103.           write('R = Display Record');
  104.           gotoxy(26,12);
  105.           write('X = Exit to Main Menu');
  106.           gotoxy(26,14);
  107.           write('Enter Choice ');
  108.           choice := readkey;
  109.           case choice of
  110.                'H','h' : dbwrthd;
  111.                'R','r' : disprec;
  112.                'X','x' : exit;
  113.           else
  114.           write(chr(7));
  115.           end;
  116.           if keypressed then choice := readkey;
  117.     until false;
  118. end; { browse }
  119.  
  120.  
  121. var
  122.    choice : char;
  123.  
  124. begin
  125.      repeat
  126.           clrscr;
  127.           gotoxy(25,1);
  128.           write('DBASE III File Browser   Ver 1.0');
  129.           gotoxy(34,8);
  130.           write('Menu Options');
  131.           gotoxy(26,10);
  132.           write('D = Display Files');
  133.           gotoxy(26,11);
  134.           write('X = Exit Program');
  135.           gotoxy(26,13);
  136.           write('Enter Choice ');
  137.           choice := readkey;
  138.           case choice of
  139.                'D','d' : begin
  140.                               getfile;
  141.                               if dbfileok then browse;
  142.                          end;
  143.                'X','x' : exit;
  144.           else
  145.           write(chr(7));
  146.           end;
  147.           if keypressed then choice := readkey;
  148.     until false;
  149. end. { dbasebrowse }
  150.