home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
mailit.zip
/
MAILMERG.INC
< prev
next >
Wrap
Text File
|
1980-01-01
|
14KB
|
407 lines
{ File = MAILMERG.INC -- Include file for Reliance Mailing List
Copyright (c) 1986 William Meacham, All Rights Reserved
Revised: 3/9/86 }
overlay procedure make_mailmerge_file ;
label 99 ; { to exit prematurely }
var
which_ones : prt_criterion ;
how_to_sort : sort_criterion ;
stop : boolean ; { whether to stop before done }
prt_num : num_str_typ ; { for printing dollar amounts }
prt_date : datestring ;
prt_zip : string[10] ;
field : array [1..15] of boolean ; { which field to include in output }
out_file : text ;
out_fname : str14 ;
num_out,
num_bad : integer ;
overwrite : boolean ;
i : integer ;
{ ==================== }
procedure get_a_rec ;
{ get the next record to print }
begin
if how_to_sort = name then
begin
nextkey (ix1_file,rec_num,key1) ;
if OK then
getrec (mf_file,rec_num,master)
end
else { how_to_sort := szip }
begin
nextkey (ix2_file,rec_num,key2) ;
if OK then
getrec (mf_file,rec_num,master)
end
end ; { proc get_a_rec }
{ ==================== }
procedure pick_fields ;
const
file_msg = 'OUTPUT FILE ALREADY EXISTS -- DO YOU WISH TO WRITE OVER IT? (Y/N)' ;
var
i : integer ;
some_chosen : boolean ;
{ ~~~~~~~~~~~~~~~~~~~~ }
procedure check_file ;
label 50 ;
var
bad,
overwrite : boolean ;
i, { loop counter }
l, { length }
c, { position of colon }
p : integer ; { position of period }
begin
bad := false ;
if out_fname = '' then { no entry }
begin bad := true ; goto 50 end ;
l := length(out_fname) ;
c := pos(':',out_fname) ;
p := pos('.',out_fname) ;
if (c <> 0) and (c <> 2) then { colon not in right place }
begin bad := true ; goto 50 end ;
if (c = 2) and not (out_fname[1] in ['A'..'P']) then
begin bad := true ; goto 50 end ; { drive designation no good }
if p <> 0 then
begin
if (p - c) > 9 then { more than 8 chars in name }
begin bad := true ; goto 50 end ;
for i := c+1 to p-1 do { bad char in name }
if not(out_fname[i] in ['A'..'Z','0'..'9']) then
begin bad := true ; goto 50 end ;
if (l - p) > 3 then { more than 3 chars in ext }
begin bad := true ; goto 50 end ;
for i := p+1 to l do { bad char in ext }
if not(out_fname[i] in ['A'..'Z','0'..'9']) then
begin bad := true ; goto 50 end ;
end
else { p = 0 }
begin
if (l - c) > 8 then { more than 8 chars in name }
begin bad := true ; goto 50 end ;
for i := c+1 to l do { bad char in name }
if not(out_fname[i] in ['A'..'Z','0'..'9']) then
begin bad := true ; goto 50 end ;
end ;
50:
if bad then
begin
show_msg ('INVALID FILENAME') ;
fld := 16
end
else if exists (out_fname) then
begin
write_str (file_msg,1,21) ;
beep ;
read_yn (overwrite,67,21) ;
if overwrite then
fld := 17
else
fld := 16 ;
clrline(1,21)
end
end ; { proc check_file }
{ ~~~~~~~~~~~~~~~~~~~~ }
begin
clrscr ;
write_str ('CHOOSE FIELDS FOR MAILMERGE FILE',24,1) ;
paint_screen(1) ;
write_str ('Output file:',1,18) ;
write_str ('(Note -- you must make sure there is enough space for the file!)',1,19) ;
for i := 1 to 15 do
field[i] := false ;
out_fname := '' ;
write_bool(field[1],14,3) ; { frst_name }
write_bool(field[2],14,4) ; { last_name }
write_bool(field[3],14,6) ; { title }
write_bool(field[4],14,7) ; { salutation }
write_bool(field[5],14,9) ; { addr1 }
write_bool(field[6],14,10) ; { addr2 }
write_bool(field[7],14,11) ; { city }
write_bool(field[8],14,12) ; { state }
write_bool(field[9],28,12) ; { zip }
write_bool(field[10],14,14) ; { home_phon }
write_bool(field[11],14,15) ; { work_phon }
write_bool(field[12],41,14) ; { precinct }
write_bool(field[13],65,4) ; { last_amt }
write_bool(field[14],65,5) ; { last_date }
write_bool(field[15],65,6) ; { tot_amt }
fld := 1 ;
repeat
case fld of
1 : read_bool(field[1],14,3) ; { frst_name }
2 : read_bool(field[2],14,4) ; { last_name }
3 : read_bool(field[3],14,6) ; { title }
4 : read_bool(field[4],14,7) ; { salutation }
5 : read_bool(field[5],14,9) ; { addr1 }
6 : read_bool(field[6],14,10) ; { addr2 }
7 : read_bool(field[7],14,11) ; { city }
8 : read_bool(field[8],14,12) ; { state }
9 : read_bool(field[9],28,12) ; { zip }
10 : read_bool(field[10],14,14) ; { home_phon }
11 : read_bool(field[11],14,15) ; { work_phon }
12 : read_bool(field[12],41,14) ; { precinct }
13 : read_bool(field[13],65,4) ; { last_amt }
14 : read_bool(field[14],65,5) ; { last_date }
15 : read_bool(field[15],65,6) ; { tot_amt }
16 : begin { output file name }
read_str (out_fname,14,14,18) ;
out_fname := purgech (out_fname,' ') ;
for i := 1 to length (out_fname) do
out_fname[i] := upcase(out_fname[i]) ;
write_str (out_fname,14,18) ;
for i := length(out_fname) + 1 to 14 do
write(' ') ;
if (fld > 16) and (fld < maxint) then
check_file
end ; { 16 }
17 : pause
end ; { case }
if fld < 1 then
fld := 1
else if (fld > 99) and (fld < maxint) then { page forward }
begin
check_file ; { do edit checks }
if fld > 17 then { if OK, stick on the Pause }
fld := 17
end ;
until fld > 17 ;
some_chosen := false ;
for i := 1 to 15 do
some_chosen := some_chosen or field[i] ;
if not some_chosen then
fld := maxint ;
end ; { proc pick_fields }
{ ==================== }
procedure write_a_record ;
label 99 ;
var
st : string[255] ;
i : integer ;
ch : char ;
begin
if keypressed then
begin
keyin (ch) ;
if ch = #$1B then
begin
write_str ('STOP NOW? (Y/N)',9,7) ;
beep ;
read_yn (stop,25,7) ;
OK := not stop ;
if OK then clrline(9,7) ;
end
end ;
if OK then
begin
st := '' ;
with master do
begin
if field[1] then
if pos(',',frst_name) <> 0 then
st := concat(st,'"',frst_name,'"',',')
else
st := concat(st,frst_name,',') ;
if field[2] then
if pos(',',last_name) <> 0 then
st := concat(st,'"',last_name,'"',',')
else
st := concat(st,last_name,',') ;
if field[3] then
if pos(',',title) <> 0 then
st := concat(st,'"',title,'"',',')
else
st := concat(st,title,',') ;
if field[4] then
if pos(',',salutation) <> 0 then
st := concat(st,'"',salutation,'"',',')
else
st := concat(st,salutation,',') ;
if field[5] then
if pos(',',addr1) <> 0 then
st := concat(st,'"',addr1,'"',',')
else
st := concat(st,addr1,',') ;
if field[6] then
if pos(',',addr2) <> 0 then
st := concat(st,'"',addr2,'"',',')
else
st := concat(st,addr2,',') ;
if field[7] then
if pos(',',city) <> 0 then
st := concat(st,'"',city,'"',',')
else
st := concat(st,city,',') ;
if field[8] then
if pos(',',state) <> 0 then
st := concat(st,'"',state,'"',',')
else
st := concat(st,state,',') ;
if field[9] then
begin
prt_zip := zip ;
if length(prt_zip) > 5 then
insert('-',prt_zip,6) ;
if pos(',',prt_zip) <> 0 then
st := concat(st,'"',prt_zip,'"',',')
else
st := concat(st,prt_zip,',')
end ;
if field[10] then
if pos(',',home_phon) <> 0 then
st := concat(st,'"',home_phon,'"',',')
else
st := concat(st,home_phon,',') ;
if field[11] then
if pos(',',work_phon) <> 0 then
st := concat(st,'"',work_phon,'"',',')
else
st := concat(st,work_phon,',') ;
if field[12] then
if pos(',',precinct) <> 0 then
st := concat(st,'"',precinct,'"',',')
else
st := concat(st,precinct,',') ;
if field[13] then
begin
editnum(last_amt,wid,frac,prt_num) ;
prt_num := stripch(prt_num,' ') ;
if pos(',',prt_num) <> 0 then
st := concat(st,'"',prt_num,'"',',')
else
st := concat(st,prt_num,',') ;
if length(st) > 240 then goto 99
end ;
if field[14] then
begin
prt_date := mk_dt_st(last_date) ;
prt_date := purgech(prt_date,' ') ;
st := concat(st,prt_date,',') ;
if length(st) > 240 then goto 99
end ;
if field[15] then
begin
editnum(tot_amt,wid,frac,prt_num) ;
prt_num := stripch(prt_num,' ') ;
if pos(',',prt_num) <> 0 then
begin
if length(st) + length(prt_num) + 3 < 256 then
st := concat(st,'"',prt_num,'"',',')
else
st[0] := #242 { make it too long }
end
else { no comma }
begin
if length(st) + length(prt_num) + 1 < 256 then
st := concat(st,prt_num,',')
else
st[0] := #242 { make it too long }
end { else, no comma }
end { if field[15] }
end ; { with }
delete(st,length(st),1) ; { delete trailing comma }
99:
if length(st) > 240 then
num_bad := succ(num_bad)
else
begin
writeln (out_file,st) ;
num_out := succ(num_out)
end
end { if OK }
end ; { procedure write_a_record }
{ ==================== }
procedure create_file ;
begin
clrscr ;
write_str ('Creating ',9,3) ;
write (out_fname,' . . .') ;
write_str ('Press ESC to stop ',9,5) ;
num_out := 0 ;
num_bad := 0 ;
assign(out_file,out_fname) ;
rewrite(out_file) ;
open_database ;
if how_to_sort = name then
clearkey (ix1_file)
else { how_to_sort = szip }
clearkey (ix2_file) ;
repeat
get_a_rec ;
if OK then
case which_ones of
all : write_a_record ;
pcat : if (master.flags and mask) > 0 then
write_a_record ;
pct : if master.precinct = pcinct then
write_a_record ;
pzip : if copy(master.zip,1,5) = copy(zipcode,1,5) then
write_a_record ;
dt : if not (greater_date(lastdt,master.last_date) = 1) then
write_a_record ;
amt : if not (greater(contrib,master.tot_amt)) then
write_a_record ;
end { case }
until not OK ;
close_database ;
close(out_file) ;
gotoxy(9,9) ;
write(num_out,' records written') ;
if num_bad > 0 then
write ('. ',num_bad,' not written -- too long.') ;
beep ;
hard_pause ;
if num_out = 0 then
erase(out_file) ;
fld := 1 ;
end ; { proc create_file }
{ ==================== }
begin { ---- procedure make_mailmerge_file ---- }
select (which_ones, how_to_sort, mailmerge) ;
if not (fld = maxint) then
pick_fields ;
if not (fld = maxint) then
create_file ;
fld := 1
end ; { proc make_mailmerge_file }
{ ---- EOF FILE MAILMERG.INC -------------------------------- }
= copy(zipcode,1,5) then
write_a_record ;
dt : if not (greater_date(lastdt,master.last_date) = 1) then
write_a_record ;
amt : if not (greater(contrib,master.tot_amt)) then
write_a_record ;
end { case }
until not OK ;
close_database ;
close(out_file) ;
gotoxy(9,9) ;
write(num_out,' records written') ;
if num_bad > 0 then
write ('. ',num_bad,' not written -- too long.') ;
beep ;
hard_pause ;
if num_out = 0 then