Delphi & Pascal (česká wiki)
{ SDV.PAS Copyright (c) TrSek alias Zdeno Sekerak } { Unit pre pracu s DBF subormi. } { } { Datum:19.06.1995 http://www.trsek.com } unit simply_view_DBF; interface uses crt,dos; const max_viet=100; { 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 opendbase; procedure vety(i:word); implementation 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; end.