Pascal source: ULES1801.PAS


unit ules1801;

interface
Procedure Generer1801;
implementation

uses SysUtils, bhushald, ugen1801;
const
      maxblokk = 20;                        // skal vera 20
      vkl =  123;
      hkl =  125;
type
     matrise          = array[1..4096] of byte;
     str15            = string[15];
     str12            = string[12];

     geotypeX         = array [1..7] of byte;
     geotype          = record
                         amtetG          : byte;
                         prestegjeldetG  : byte;
                         soknetG         : byte;
                         blokknrG, startnrG: ^smallint;
                        end;
     geotypeNY         = record
                         amtet,prestegjeldet,soknet:byte;
                         blokknr,startnr:integer;
                         end;

     geotype2         = record
                         amtnr,
                         prestegjeldnr,
                         soknnr,
                         prestegjeld    : integer;
                         blokknr        : integer;
                         startnr        : integer;
                         sisteblokk     : integer;
                         sluttnr        : integer
                        end;
     geotype3         = record
                         prestegjeldnr,
                         soknnr,
                         sokn           : integer;
                         blokknr        : integer;
                         startnr        : integer;
                         sisteblokk     : integer;
                         sluttnr        : integer;
                         einby          : byte
                        end;
     geotype4         = record
                         prestegjeld    : integer
                        end;
     geoteksttype     = array[1..26,0..7] of str15;

     amttype          = array[1..20]      of boolean;

     bytypeX          = array [1..5] of byte;
     bytype           = record
                          soknG:byte;
                          blokknrG,
                          startnrG: ^smallint;
                         end;
     bytypeNY           = record
                          sokn:byte;
                          blokknr,
                          startnr: integer;
                        end;

     vartype          = (slag,hushald,alder,alder_5,alder_10,sivil,sivil_10,
                        yrke,yrke2,kjonn,amt,pgj,sogn,slutt);

var
     log3fil:text;

     amtvari,prevari,sokvari,famvari,aldvari,sivvari,yrkvari,kjovari,yrk2vari
                   : matrise;

     datafil       : file;

     antblokker    : integer;
     amtvar,prevar,sokvar,famvar,aldvar,sivvar,yrkvar,kjovar,yr2var
                   : vartype;

     blokknr       : array[hushald..slutt] of integer;

     byen          : longint;

     AntallSokn,
     AntallPrestegjeld,
     ipgj,isokn,
     gpgj,gsokn,

     anthenting,
     hentestart,
     hentetal         : integer;
     geofil           : file of geotypeX;
     geolinjeX        : geotypeX;
     geolinje         : geotype;
     georec           : geotypeNY;
     byfil            : file of bytypeX;
     byrecX           : bytypeX;
     byrec           : bytype;
     byNY             : bytypeNY;
     KodeFilErOpna,
     GeoFilErOpna,
     PgjFilErOpna,

     forste,geolese   : boolean;
     pgjfil           : file of geoteksttype;
     geotekst         : geoteksttype;
     prestegjeldmat   : array[1..26] of geotype2;
     soknmat          : array[1..100] of geotype3;
     geomat           : array[1..26,0..7] of geotype4;
     nr,blokknor      : real;
     filnamn          : TSearchRec;
     ValgtAmt,
     AntAmt           : byte;
     AmtHer           : amttype;
     ValdeAmt         : array[1..17] of byte;

     filen            : str12;

     ArneSittTal      : Longint;
     ib,penr,nestebynr,nesteby : longint;

procedure hentdata(startnr,antall : integer;var lager : matrise;
                   variabel : vartype);

var  iso,ip,i,tal,start,slutt   : integer;

begin
    if not (variabel in [amt,sogn,pgj]) then
    begin
     seek(datafil,startnr-1);
     blockread(datafil,lager,antall);
     if variabel in [hushald,alder,alder_10,alder_5,sivil_10,kjonn] then
     for i:=1 to antall*128 do if lager[i]<255 then
     begin
      tal:=lager[i];
      case variabel of
      hushald:   tal:=tal mod 128;
      alder:     tal:=tal mod 128;
      alder_5:   tal:=((tal mod 128)+4) div 5;
      alder_10:  tal:=((tal mod 128)+9) div 10;
      sivil_10:  tal:=tal div 10;
      kjonn:     tal:=tal div 128
      end;
      lager[i]:=tal
     end
    end
    else
    if variabel in [pgj,amt] then begin
    for ip:=1 to AntallPrestegjeld do
    with prestegjeldmat[ip] do if blokknr>0 then
    if anthenting in [blokknr..sisteblokk] then
    begin
     if anthenting=blokknr then start:=startnr else start:=1;
     if anthenting=sisteblokk then slutt:=sluttnr else slutt:=4096;

     if variabel=pgj then
     begin
      for i:=start to slutt do lager[i]:=prestegjeldnr;
      if slutt<4096 then for i:=slutt+1 to 4096 do lager[i]:=255
     end;
     if variabel=amt then
     begin
      for i:=start to slutt do lager[i]:=ValgtAmt;
      if slutt<4096 then for i:=slutt+1 to 4096 do lager[i]:=255
     end
    end
    end
    else
    for iso:=1 to AntallSokn do
    with soknmat[iso] do if blokknr>0 then
    if anthenting in [blokknr..sisteblokk] then
    begin
     if anthenting=blokknr then start:=startnr else start:=1;
     if anthenting=sisteblokk then slutt:=sluttnr else slutt:=4096;
     if variabel=sogn then
     begin
       for i:=start to slutt do lager[i]:=iso;
       if slutt<4096 then for i:=slutt+1 to 4096 do lager[i]:=255
     end;
    end;
end;

procedure telopp(hentetal,anthenting : integer);

var  siste,i : integer;
     bynr:byte;
begin
     siste:=hentetal*128;

     for i:=1 to siste do
     begin
      inc(penr);
      if penr=nestebynr then begin
         byen:=nesteby;
         if not eof(byfil) then begin
            read(byfil,byrecX);
            byrec.soknG:=byrecX[1];
            byrec.blokknrG:=@byrecX[2];
            byrec.startnrG:=@byrecX[4];
            byNY.sokn:=byrec.soknG;
            byNY.blokknr:=byrec.blokknrG^;
            byNY.startnr:=byrec.startnrG^;
            with byNY do begin
               nesteby:=sokn;
               if (nesteby>0) and (nesteby<99) then
                  bynr:=nesteby;
               ib:=blokknr;
               nestebynr:=ib*128+startnr;
            end
         end
      end;
      if (byen>0) and (byen<99) then
          jan.by:=byen
      else
          jan.by:=0;
      if (Form1.RadioGroup2.ItemIndex=0)
//    By og landsbygd
      or ((Form1.RadioGroup2.ItemIndex=2) and (jan.by>0) and (jan.by<99))
//    Berre by
      or ((Form1.RadioGroup2.ItemIndex=1) and (jan.by=0)) then begin
//    Berre landsbygd
       if (prevari[i]>0) and (prevari[i]<255)
       and (famvari[i]>0) and (famvari[i]<255) then begin
         with jan do begin
           pgj:=prestegjeldmat[prevari[i]].prestegjeld;
           pgjkode:=prevari[i];
           inc(jan.folketal);
           jan.stilling:=famvari[i];
         end;
         if jan.stilling<24 then begin
           with jan do begin
             amt:=amtvari[i];
             sokn:=soknmat[sokvari[i]].sokn;
             if Form1.RadioGroup1.ItemIndex=2 then
//         * Amt
               if pgj<100 then
                  pgj:=18
               else
                  pgj:=amt
             else
             if Form1.RadioGroup1.ItemIndex=0 then begin
//         * sokn
               if pgj>100 then
                  pgj:=sokn;
               if Form1.RadioGroup2.ItemIndex=2 then
//           * sokn og berre by
                  pgj:=byen;
             end;
//         default=prestegjeld
             alder:=aldvari[i];
             kjonn:=kjovari[i];
             sivstat:=sivvari[i];
             yrke:=yrkvari[i];
             yrk2:=yrk2vari[i];
//           Kallar hovudrutine i BHUSHALD
             Leggtil(jan);
             inc(ArneSittTal);
             if ArneSitttal mod 1000 = 0 then
                writeln(log3fil,ArneSittTal);
           end // with
         end // if
         else begin
            if jan.stilling=Anstalt then begin
               inc(Form1.anstalth);
               inc(Form1.anstaltp);
            end
            else if jan.stilling>Anstalt then
               inc(Form1.anstaltp);
         end;
       end // if prevari[i]...
      end  // Form.RadioGroup2.ItemIndex=0
     end // else
end;


procedure SetKonstantar;
begin
     KodeFilErOpna:=false;
     GeoFilErOpna:=false;
     PgjFilErOpna:=false;
     famvar:=hushald;
     aldvar:=alder;
     sivvar:=sivil;
     yrkvar:=yrke;
     yr2var:=yrke2;
     kjovar:=kjonn;
     amtvar:=amt;
     prevar:=pgj;
     sokvar:=sogn;


     blokknr[hushald]:=1;
     blokknr[alder]:=2;
     blokknr[alder_5]:=2;
     blokknr[alder_10]:=2;
     blokknr[sivil]:=3;
     blokknr[sivil_10]:=3;
     blokknr[yrke]:=5;
     blokknr[yrke2]:=4;
     blokknr[kjonn]:=2;
     geolese:=true;
     forste:=true;
     anthenting:=1;
end;

procedure lagtabell;

var
     hentestart,hentetal  : integer;

begin
     reset(byfil);
     anthenting:=0;
     hentestart:=1;
     penr:=0;
     nesteby:=0;
     nestebynr:=1;
     repeat
      inc(AntHenting);
       if hentestart<antblokker-32 then hentetal:=32 else
       hentetal:=antblokker-hentestart+1;
       hentdata((blokknr[amtvar]-1)*antblokker+hentestart,hentetal,amtvari,amtvar);
       hentdata((blokknr[prevar]-1)*antblokker+hentestart,hentetal,prevari,prevar);
       hentdata((blokknr[sokvar]-1)*antblokker+hentestart,hentetal,sokvari,sokvar);
       hentdata((blokknr[famvar]-1)*antblokker+hentestart,hentetal,famvari,famvar);
       hentdata((blokknr[aldvar]-1)*antblokker+hentestart,hentetal,aldvari,aldvar);
       hentdata((blokknr[sivvar]-1)*antblokker+hentestart,hentetal,sivvari,sivvar);
       hentdata((blokknr[yrkvar]-1)*antblokker+hentestart,hentetal,yrkvari,yrkvar);
       hentdata((blokknr[kjovar]-1)*antblokker+hentestart,hentetal,kjovari,kjovar);
       hentdata((blokknr[yr2var]-1)*antblokker+hentestart,hentetal,yrk2vari,yr2var);

       telopp(hentetal,anthenting);
      hentestart:=hentestart+32;
      writeln(log3fil,'Lagtabell: hentestart',hentestart);
     until hentestart>antblokker;
end;


procedure HentDir(path : string; var AmtHer : amttype;var AntAmt : byte);

var  i,j,feil, DosError: integer;

begin
     AntAmt:=0;
     for i:=1 to 18 do AmtHer[i]:=false;
     DosError:=FindFirst(path,faarchive,filnamn);
     while DosError=0 do
     begin
      Inc(AntAmt);
      val(copy(filnamn.name,7,2),i,feil);
      AmtHer[i]:=true;
      DosError:=FindNext(filnamn)
     end;
     j:=1;
     for i:=1 to 17 do
       if AmtHer[i] then begin
          ValdeAmt[j]:=i;
          inc(j);
       end;
    AntAmt:=j-1;
end;

procedure HentFil(Valgtamt:integer);

begin
     if KodeFilErOpna then closefile(datafil);
     str(ValgtAmt:2,filen);
     if filen[1]=' ' then filen[1]:='0';
     filen:=string(chr(vkl))+'1801'+string(chr(hkl))+filen;
     assignfile(datafil,innkat+filen+'.kod');
     reset(datafil);
     KodeFilErOpna:=true
end;

procedure FiksPrestegjeld;

var  i,j : integer;
//     tf:textfile;
begin
     if GeoFilErOpna then begin
        closefile(geofil);
        closefile(byfil);
     end;
     GeoFilErOpna :=true;
     assignfile(geofil,innkat+filen+'.geo');
     reset(geofil);
     assignfile(byfil,innkat+filen+'.by');
     AntallSokn:=0;
     AntallPrestegjeld:=0;
     for i:=1 to 26 do
     for j:=0 to 7 do
     with geomat[i,j] do prestegjeld:=0;
     while not eof(geofil) do
     begin
      read(geofil,geolinjeX);
      geolinje.amtetG:=geolinjeX[1];
      geolinje.prestegjeldetG:=geolinjeX[2];
      geolinje.soknetG:=geolinjeX[3];
      geolinje.blokknrG:=@geolinjeX[4];
      geolinje.startnrG:=@geolinjeX[6];
      georec.amtet:=geolinje.amtetG;
      georec.prestegjeldet:=geolinje.prestegjeldetG;
      georec.soknet:=geolinje.soknetG;
      georec.blokknr:=geolinje.blokknrG^;
      georec.startnr:=geolinje.startnrG^;
      with georec do
      begin
       amtet:=amtet-128;
       ipgj:=100*amtet+prestegjeldet;
       isokn:=ipgj*10+soknet;
       nr:=int(startnr)+int(blokknr)*128;
       blokknor:=trunc(nr/4096)+1;
       startnr:=trunc(nr-(blokknor-1)*4096);
       blokknr:=trunc(blokknor);
       if (isokn<>gsokn) or (ipgj<>gpgj) then
       begin
        if antallSokn>0 then
        begin
         if startnr>1 then
         soknmat[AntallSokn].sisteblokk:=blokknr else
         soknmat[AntallSokn].sisteblokk:=blokknr+1;
         if startnr>1 then
         soknmat[AntallSokn].sluttnr:=startnr-1 else
         soknmat[AntallSokn].sluttnr:=4096
        end;
        if prestegjeldet<99 then
        begin
         inc(AntallSokn);
         soknmat[AntallSokn].einby:=byen;
         soknmat[AntallSokn].sokn:=isokn;
         soknmat[AntallSokn].blokknr:=blokknr;
         soknmat[AntallSokn].startnr:=startnr
        end
       end;
       if ipgj<>gpgj then
       begin
        if AntallPrestegjeld>0 then
        begin
         if AntallPrestegjeld>0 then
         prestegjeldmat[AntallPrestegjeld].sisteblokk:=blokknr else
         prestegjeldmat[AntallPrestegjeld].sisteblokk:=blokknr+1;
         if AntallPrestegjeld>0 then
         prestegjeldmat[AntallPrestegjeld].sluttnr:=startnr-1 else
         prestegjeldmat[AntallPrestegjeld].sluttnr:=4096
        end;
        if prestegjeldet<99 then
        begin
         inc(AntallPrestegjeld);
         prestegjeldmat[AntallPrestegjeld].prestegjeld:=ipgj;
         prestegjeldmat[AntallPrestegjeld].blokknr:=blokknr;
         prestegjeldmat[AntallPrestegjeld].startnr:=startnr
        end
       end;
       gsokn:=isokn;
       gpgj:=ipgj
      end
     end;
     with prestegjeldmat[1] do prestegjeldnr:=1;
     ipgj:=1;
     for i:=2 to AntallPrestegjeld do with prestegjeldmat[i] do
     begin
      prestegjeldnr:=0;
      soknnr:=0;
      for j:=1 to i-1 do
      if prestegjeldmat[j].prestegjeld=prestegjeld then
      prestegjeldnr:=prestegjeldmat[j].prestegjeldnr;
      if prestegjeldnr=0 then
      begin
       inc(ipgj);
       prestegjeldnr:=ipgj
      end
     end;
     for i:=1 to AntallPrestegjeld do
     with prestegjeldmat[i] do
     geomat[prestegjeldnr,0].prestegjeld:=prestegjeld;
     for i:=1 to AntallSokn do with soknmat[i] do
     begin
      soknnr:=sokn mod 10;
      for j:=1 to AntallPrestegjeld do
      if prestegjeldmat[j].prestegjeld=sokn div 10 then
      prestegjeldnr:=prestegjeldmat[j].prestegjeldnr;
      geomat[prestegjeldnr,soknnr].prestegjeld:=sokn div 10
     end;
     if PgjFilErOpna then closefile(pgjfil);
     PgjFilErOpna :=true;
     assign(pgjfil,innkat+filen+'.pgj');
     reset(pgjfil);
     read(pgjfil,geotekst);
     antblokker:=filesize(datafil) div 5;
{     assignfile(tf,'d:\wutemp\test.txt');
     append(tf);
     for i:=1 to AntallPrestegjeld do begin
       for j:=1 to 7 do
          if geotekst[i,j]<>'' then
             writeln(tf,prestegjeldmat[i].prestegjeld,';',geotekst[i,0],';',j,';',geotekst[i,j]);
     end;
     closefile(tf);}
end;


Procedure Generer1801;
var iamt:smallint;
begin
     assignfile(log3fil,utkat+'log3.txt');
     rewrite(log3fil);
     Hinit('ArneSitt.txt');
     ArneSittTal:=0;
     jan.folketal:=0;
     SetKonstantar;
     HentDir(innkat+string(chr(vkl))+'1801'+string(chr(hkl))+'*.KOD',AmtHer,AntAmt);
     for iamt:=1 to AntAmt do
     begin
      ValgtAmt:=ValdeAmt[iamt];
      HentFil(ValgtAmt);
      FiksPrestegjeld;
      lagtabell;
     end;
     if GeoFilErOpna then begin
        closefile(geofil);
        closefile(byfil);
     end;
     if PgjFilErOpna then closefile(pgjfil);
     closefile(log3fil);
     HDone;
end;


end.

Generated by PAS2HTML, copyrights © 1996,97 by COAS, All rights reserved.