Jednoduchý DBF Viewer v pascale

{ SDV.PAS                   Copyright (c) TrSek alias Zdeno Sekerak }
{ Program urceny len pre potreby vyucby na hodinach programovania.  }
{ Uloha: Precitat databazu typu DBF                                 }
{ Riesenie: Program moze citat DBF z databazi dBase III, a moze byt }
{           spusteny s parametrom mena suboru                       }
{                                                                   }
{ Datum:21.03.1994                             http://www.trsek.com }
 
program simply_view_DBF;
uses crt,dos;
 
const max_viet=200;   { max - kolko moze byt maximalne premennych v 1 vete }
 
type premenna=(C,L,N,D);
                       { typ premennej C-retazec, L-logicka, N-numericka }
                       {               D-datum }
   hlava=record                     { typ tzv. hlavy DBF blizie informacie }
     nazov: array[1..11] of char;   { na horeuvedenej adrese }
     typep: char;
       zac: word;
     none2: array[1..2] of byte;
      size: byte;
     desat: byte;
     none3: array[1..14] of byte;
     end;
 
var  base: array[1..max_viet] of string;   { polozky jednej vety                  }
    hlavy: array[1..max_viet] of hlava;    { hlavy (popisy) kazdej z poloziek     }
        f: file of char;                   { nacitava jednotlive vety DBF         }
       ff: file of hlava;                  { nacitava hlavy DBF                   }
    poc,dtab,dvet: word;                   { poc-pocet viet, dtab-dlzka tabulky   }
                                           { hlavy, dvet-velkost jednej vety v kB }
      den,mes,rok: byte;                   { den,mesiac,rok z DBF                 }
           typdbf: byte;                   { typ dBase, prvy byt DBF              }
           pp,rpp: integer;                { pp-pocet premennych vo vete          }
                                           { rpp-kolko premennych vypisat z vety  }
          nothing: string;
          AllSize: LongInt;                { celkova velkost suboru DBF }
             meno: string;                 { meno suboru                          }
              i,x: integer;                { pomocne premenne }
               ch: char;
 
procedure writexy(x,y:integer;s:string);   { vypis na poziciu x,y text s          }
begin
 gotoxy(x,y);
 write(s);
end;
 
procedure tabulka;                         { vypis tabulku viewera  }
var x,y:integer;
begin
 textcolor(white);textbackground(blue);
 clrscr;
 for x:=2 to 78 do writexy(x, 1,'Í');
 for x:=2 to 78 do writexy(x,24,'Í');
 for y:=2 to 23 do writexy( 1,y,'ş');
 for y:=2 to 23 do writexy(79,y,'ş');
 writexy( 1, 1,'É');
 writexy( 1,24,'Č');
 writexy(79, 1,'ť');
 writexy(79,24,'ź');
 writexy(9, 1,' Simply DBF viewer ÍÍ dBase');
 write(typdbf,' Í File:'+meno+' Í datum:',den:2,'.',mes:2,'.',rok:2,' ');
 writexy(5,24,' Pocet viet:');write(poc,' ');write(' velkost vety:',dvet:4,' B ');
 write('Í ESC-Koniec Í PgUp-Hore Í PgDn-Dole ');
 textcolor(yellow);textbackground(black);
 writexy(1,25,'                              Software by TRSEK alias Zdeno Sekerak, 25.12.1994');
 window(3,2,78,23);
end;
 
procedure opendbase;                    { otvor DBF a precitaj z nej hlavy }
var sub:SearchRec;
begin
 
 assign(f,meno);
 {$I-}
 reset(f);
 {$I+}                                  { ak DBF nejestvuje }
 if ioresult<>0 then begin
    writeln('Subor bud nejestvuje, alebo nieje spravna cesta.');
    halt(1);
    end;
 
 findfirst(meno,Archive,Sub);           { zisti jeho velkost }
 AllSize:=Sub.Size;
 read(f,ch);typdbf:=ord(ch);            { precitaj uvodne info typ dBase      }
 read(f,ch);rok:=ord(ch);               { den, mesiac, rok poslednej editacie }
 read(f,ch);mes:=ord(ch);
 read(f,ch);den:=ord(ch);
 
 read(f,ch);poc:=ord(ch);
 read(f,ch);poc:=poc+256*ord(ch);
 for i:=1 to 3 do read(f,ch);
                                        { zisti velkost tabulky hlav }
 dtab:=ord(ch);read(f,ch);dtab:=dtab+256*ord(ch);
 pp:=round(dtab/32)-1;                  { dtab/32-1= pocet premennych }
 if pp>20 then rpp:=20                  { v jednej vete               }
          else rpp:=pp;
                                        { ale vypisuje najviac 20 z jednej vety }
 read(f,ch);dvet:=ord(ch);
 read(f,ch);dvet:=dvet+256*ord(ch);     { zisti dlzku jednej vety }
 close(f);
 
 assign(ff,meno);
 reset(ff);
 read(ff,hlavy[1]);                     { toto precita hlavu hlav }
                                        { pekne sprosto som to nazval }
 for i:=1 to pp do
  read(ff,hlavy[i]);                    { toto cita hlavu kazdej premennej }
 close(ff);                             { co vsetko obsahuje ??? }
                                        { kontakt na programatora je v zahlavy }
 for i:=1 to pp do
  case hlavy[i].typep of                { nastavi velkost premennych pre jednotlive }
                                        { premenne podla hlavy }
   'C':base[i]:=copy(nothing,1,hlavy[i].size);
   'L':base[i]:=copy(nothing,1,1);
   'N':if hlavy[i].desat>0 then base[i]:=copy(nothing,1,hlavy[i].size)
                           else base[i]:=copy(nothing,1,hlavy[i].size+hlavy[i].desat);
   'D':base[i]:=copy(nothing,1,8);
   end;
 
end;
 
procedure vety(i:word);
begin
 
 assign(f,meno);
 reset(f);
 if ((dtab+1+i*dvet)>AllSize) or
    ((dtab+(i+1)*dvet)>AllSize) then begin close(f); exit; end;
                                        { veta nejestvuje skonci          }
 seek(f,dtab+1+i*dvet);                 { nastavi poziciu kde zacina veta }
 
 for x:=1 to pp do                      { nastrka to do premennych }
  for i:=1 to length(base[x]) do read(f,base[x][i]);
 
 close(f);                              { po kazdom precitani pre istotu }
                                        { zavrie subor. }
                                        { Co ak by sa mu nieco stalo !!! }
end;
 
procedure vypis;
var veta: integer;
    f:text;
begin
 veta:=0;                               { Pociatocna veta je nula }
 repeat
   vety(veta);                          { Precita vetu z DBF }
   textbackground(blue); textcolor(yellow);
   clrscr;
   writeln('Veta:',veta+1);
                                        { Zobrazi vetu na obrazovku }
   assign(f,'poh_dbf.txt');
   rewrite(f);
   for i:=1 to pp do writeln(f,hlavy[i].nazov+'  '+hlavy[i].typep+'  ',hlavy[i].size,'  ',hlavy[i].desat);
   close(f);
   for i:=1 to rpp do begin
     textbackground(blue); textcolor(yellow);
     write(hlavy[i].nazov,' = ');
     textbackground(magenta); textcolor(white);
     writeln(base[i]);
     end;
 
  ch:=readkey;                          { Podla toho aky klaves bol stlaceny }
  if ch=#0 then begin                   { taku vetu nastavi                  }
     ch:=readkey;
     if (ch=#81) then begin
                      veta:=veta+1;
                      if veta>poc-1 then veta:=poc-1;
                      if poc=0 then veta:=0;
                      end;
     if (ch=#73) then begin
                      veta:=veta-1;
                      if veta<0 then veta:=0;
                      end;
     end;
 until (ch=#27);                        { Koniec na ESC=#27     }
end;
 
begin                                   { Naplni premennu nothing }
 nothing:='';for i:=1 to 255 do nothing:=nothing+' ';
 clrscr;
 writeln('Simply DBF viewer.');
 writeln('Software by TRSEK alias Zdeno Sekerak, www.trsek.com.');
 writeln('-----------------------------------------------------');
                                        { Bud zada uzivatel meno, alebo je menom }
                                        { parameter z prikazoveho riadku }
 if paramcount<1 then begin write('Zadaj meno DBF:');readln(meno);end
                 else meno:=paramstr(1);
 opendbase;                             { otvori DBF a precita hlavy     }
 tabulka;                               { nakresli ramceky+info o subore }
 vypis;                                 { pohyb po DBF databaze          }
 window(1,1,80,25);
 textbackground(black);textcolor(white);{ Koniec }
 lowvideo;
 clrscr;
 write('Simply DBF viewer. Software by TRSEK. Copyright (c) TRSEK 1994.');
end.