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.