Localize file www.TrSek.com/pas/sdv.pas{ 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.