Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ 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.