{ 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.