Pro Pascal Compiler - Version zz 2.1 Compilation of: M:LPCONV.PAS Options: LNIAP 1 0000 program LPDBC(input,output); 2 0000 3 0000 {Convert a Register type file into a data base file for} 4 0000 {for the pascal suite} 5 0000 6 0000 {Brian Gilmore May 1987} 7 0000 8 0000 9 0000 LABEL 1,999; 10 0000 11 0000 TYPE 12 0000 {$I lptype.ins} 13 0000 adulta = ARRAY[1..10] OF integer; 14 0000 fsa = ARRAY[1..4] OF integer; 15 0000 fparty = ARRAY[0..8] OF string[3]; 16 0000 fattrn = ARRAY[0..15] OF string[15]; 17 0000 fsname = PACKED ARRAY[1..19] OF char; 18 0000 ffname = PACKED ARRAY[1..25] OF char; 19 0000 fhname = PACKED ARRAY[1..5] OF char; 20 0000 fstne = PACKED ARRAY[1..34] OF char; 21 0000 fpcode = PACKED ARRAY[1..8] OF char; 22 0000 s_integer = 0..60000; 23 0000 byte = 0..255; 24 0000 xattr = (sa, sb, sc, sd, se, sf, sg, sh, si, sj, sk, sl, sm, sn, so, sp); 25 0000 sattr = SET OF xattr; 26 0000 27 0000 vf = RECORD 28 0000 sname: fsname; 29 0000 fname: ffname; 30 0000 hname: fhname; 31 0000 street: s_integer; 32 0000 r_no: s_integer; 33 0000 cvote: byte; 34 0000 pvote: byte; 35 0000 attr: sattr; 36 0000 spare1, spare2: byte; 37 0000 END; 38 0000 39 0000 vfp = ^vf; 40 0000 ntfile = FILE of vf; 41 0000 42 0000 rf = RECORD 43 0000 street: fstne; 44 0000 postcode: fpcode; 45 0000 END; 46 0000 47 0000 rfp = ^rf; 48 0000 rffile = FILE of rf; 49 0000 50 0000 51 0000 52 0000 VAR 53 0000 vv: vfp; 54 0000 dbfile: ntfile; 55 0000 rv: rfp; 56 0000 rdfile: rffile; 57 0000 source,nat,temp, outfile: text; {source file} 58 0000 reg, filename, ofn, rfn, name: string[14]; 59 0000 line,rname, snr, r2name, sname, padd, add, this_add, code, initial, 60 0000 last_line, house, regn, ad1, ad2: string[120]; 61 0000 target, count, p1, p2, lno,vkey,row,col,spt,i,flag,dstart,rlen,lflag: integer; 62 0000 p3, labels, addno: integer; 63 0000 adult: adulta; 64 0000 field_size, field_max: fsa; 65 0000 key: char; 66 0000 67 0000 PROCEDURE cursor(x,y: integer); 68 0000 BEGIN 69 0000 write(chr(1bh), 'Y', chr(y+20h), chr(x+20h)); 70 0053 END; 71 0059 72 0059 PROCEDURE clearscreen; 73 0059 BEGIN 74 0059 write(chr(1bH)); write('E'); cursor(0, 1); 75 0097 END; 76 009D 77 009D 78 009D BEGIN 79 009D clearscreen; 80 00AE writeln('Convert Register file to Database format.'); 81 00EF writeln; writeln; 82 0100 write('Register File?'); readln(name); 83 0136 assign(source, name); reset (source); 84 0157 write('Database file base?'); readln(ofn); 85 0192 rfn := concat(ofn,'.str'); ofn := concat(ofn,'.dat'); 86 01CF clearscreen; 87 01D7 88 01D7 cursor(0,1); lno := 0; row := 1; col := 1; vkey:=0; dstart:=0; 89 0226 assign(nat, 'KBD:'); reset(nat); {get at keyboard directly} 90 024C assign(dbfile, ofn); rewrite(dbfile); seek(dbfile, 0); 91 027C assign(rdfile, rfn); rewrite(rdfile); seek(rdfile, 0); 92 02AC put(rdfile); {1st entry dummy} 93 02B8 flag := 0; count := 0; labels := 0; 94 02DE 95 02DE WHILE flag = 0 DO BEGIN 96 02EF readln(source, line); 97 030B key := line[1]; 98 0319 if key = 'P' then begin 99 0322 reg := copy(line, 3, length(line)-2); 100 0347 writeln('Register ',reg); 101 0374 GOTO 999; 102 037C end; 103 037C 104 037C if key = 'A' then begin 105 0389 add := copy(line, 3, length(line)-2); 106 03AE i := pos('!', add); 107 03C5 if i>2 then begin 108 03D8 ad1 := copy(add, 1, i-1); 109 03FB if i+2 < length(add) then begin 110 0420 add := copy(add, i+1, length(add)-i); 111 0456 i := pos('!', add); 112 046D if (i>0) and (i+2 copy(add, 1, i-1) then begin} 115 04E9 {padd := copy(add, 1, i-1);} 116 04E9 writeln(' Street:',ad1,': Postcode:',ad2,':'); 117 0543 p1 := length(ad1); p2 := length(ad2); 118 0562 for i := 1 to p1 do rdfile^.street[i] := ad1[i]; 119 05E6 for i := 1 to p2 do rdfile^.postcode[i] := ad2[i]; 120 066E for i := p1+1 to 25 do rdfile^.street[i] := ' '; 121 06D5 if p2+1 <= 8 then for i := p2+1 to 8 do rdfile^.postcode[i] := ' '; 122 0756 put(rdfile); 123 0762 addno := addno+1; {Index to Address number} 124 0774 end; 125 0774 end; 126 0774 end; 127 0774 if eoln(nat) then flag := 1 else begin 128 0790 read(nat, key); 129 07AF 130 07AF if ord(key)<>0 then flag :=2; 131 07C5 end; 132 07C5 end else begin 133 07CD lno := lno+1; 134 07DF snr := ''; 135 07E9 p1 := pos('!', line); 136 0800 if p1 > 1 then begin 137 0813 regn := copy(line, 1, p1-1); {get out the register number} 138 0836 if (regn = '0000') and (lno>1) then goto 999; 139 086F {problem in register sy - gash name on the top!} 140 086F end; 141 086F 142 086F rname := copy(line, p1+1, length(line)-p1); r2name := rname; 143 08B3 p2 := pos('!', rname); p3 := p2; 144 08CF 1:; 145 08CF if p2 = 0 then goto 999; 146 08E2 spt := 0; i := p2; 147 08FC REPEAT 148 0901 IF rname[i] = ' ' THEN BEGIN 149 0921 spt := i; 150 0930 END; 151 0930 i := i-1; 152 0942 UNTIL (spt>0) OR (i=1); 153 096F IF spt > 0 THEN BEGIN 154 0987 sname := copy(rname, spt+1, p2-spt-1); 155 09BB if length(sname) < 4 then begin 156 09C8 if (sname='JR.') OR (sname='SR.') then begin 157 0A00 rname := copy(rname, 1, spt); rname[spt] := '!'; 158 0A38 snr := sname; p2 := spt; goto 1; 159 0A58 end; 160 0A58 end; 161 0A58 field_size[1] := length(sname); 162 0A6A field_size[2] := p3-length(sname)-2; 163 0A91 if field_size[2] <> 0 then initial := copy(rname, 1, field_size[2]); 164 0ABC i := length(rname)-p3; 165 0ADA this_add := ''; 166 0AE4 if i > 1 then 167 0AFC this_add := copy(rname, p3+2, i-1) else writeln('ADR?',rname); 168 0B53 field_size[3] := i; 169 0B62 initial := concat(initial, snr); 170 0B7E field_size[2] := length(initial); 171 0B90 for i := 1 to 3 do begin 172 0BA7 if field_size[i] > field_max[i] then begin 173 0BE7 field_max[i] := field_size[i]; 174 0C27 cursor(0,1); 175 0C3F writeln('name:',field_max[1],' first:',field_max[2], 176 0C8C ' add:', field_max[3],' '); 177 0CC4 end; 178 0CC4 end; 179 0CD5 { writeln(outfile, sname,',',initial,',',this_add,',',addno:3);} 180 0CD5 p1 := length(sname); p2 := length(initial); p3 := length(this_add); 181 0D01 for i := 1 to p1 do dbfile^.sname[i] := sname[i]; 182 0D85 for i := 1 to p2 do dbfile^.fname[i] := initial[i]; 183 0E0D if p3 > 4 then p3 := 4; 184 0E30 if p3 > 0 then for i := 1 to p3 do dbfile^.hname[i] := this_add[i]; 185 0ECB for i := p1+1 to 17 do dbfile^.sname[i] := ' '; 186 0F32 for i := p2+1 to 25 do dbfile^.fname[i] := ' '; 187 0F9D for i := p3+1 to 5 do dbfile^.hname[i] := ' '; 188 1008 dbfile^.street := addno; 189 1029 dbfile^.pvote := 0; 190 103B dbfile^.cvote := 0; 191 104D dbfile^.attr := []; 192 1069 dbfile^.r_no := count; 193 108A put(dbfile); count := count+1 194 109B 195 109B END; 196 10A3 end; 197 10A3 198 10A3 999: if eof(source) then flag := 1; 199 10BD 200 10BD END; 201 10C0 202 10C0 END.