program voter;
uses dos, crt;
type
booth = record
question : array[1..3] of string[75];
choices : array[1..20,1..3] of string[50];
votes : array[1..20] of word;
creator : string[35];
created : longint;
available : byte;
totalvotes : word;
responseto : integer;
track, killed, addons, titleit, multi : boolean;
end;
linestring = string[80];
pollplace = record
addsec, syssec : integer;
atrack, aaddons, amulti : boolean;
booths : byte;
lmessage : string[78];
end;
user = record
name : string[35];
seclvl : integer;
bbsname : string[78];
end;
var
pplace : file of pollplace;
pp : pollplace;
booths, tbfile : file of booth;
bb,tb : booth;
doorinfo, logfile, trackfile, textfile : text;
i, j, k, linecount, code : integer;
ch, cr, bs, del, ctlx, tab : char;
buflen, chn : byte;
aline : linestring;
abort, letemout : boolean;
vfilename : string[6];
whoson : user;
commands : string[9];
procedure beep;
begin
write(chr(7));
end;
procedure YesNo(default:char);
begin
write(default+chr(8));
repeat
ch := upcase(readkey);
if ch = cr then ch := default;
until ch in ['Y','N'];
if ch = 'Y' then writeln('Yes') else writeln('No');
end;
function ucase(tempstr:linestring):linestring;
var
i : integer;
begin
for i := 1 to length(tempstr) do tempstr[i] := upcase(tempstr[i]);
ucase := tempstr;
end;
function qowner:boolean;
begin
if (ucase(bb.creator) = ucase(whoson.name)) or (whoson.seclvl >= pp.syssec) then
qowner := true else qowner := false;
end;
function uplow(tempstr:linestring):linestring;
var
i : integer;
begin
for i := 1 to length(tempstr) do
if (ord(tempstr[i]) > 64) and (ord(tempstr[i]) < 91) then
tempstr[i] := chr(ord(tempstr[i])+32);
tempstr[1] := upcase(tempstr[1]);
uplow := tempstr;
end;
function exist(filename:linestring) : boolean;
var
sample : text;
begin
assign(textfile,filename);
{$I-}
reset(textfile);
{$I+}
if ioresult = 0 then
begin
exist := true;
close(textfile);
end
else
exist := false;
end;
function instring:linestring;
var
instr : linestring;
j : integer;
const
blanks : linestring = ' ';
begin
instr := blanks;
j := 0;
repeat
ch := readkey;
if (ch > chr(31)) and (ch < chr(127)) then
begin
if j < buflen then
begin
j := succ(j);
instr[j] := ch;
write(ch);
end
else
beep;
end
else
begin
if ch = cr then
begin
mem[seg(instr):ofs(instr)] := j;
writeln;
end
else
begin
if (ch = bs) or (ch = del) then
begin
if j >= 1 then
begin
j := pred(j);
write(bs+' '+bs);
end
else
begin
beep;
end;
end
else
begin
if ch = ctlx then
begin
while j > 0 do
begin
j := pred(j);
write(bs+' '+bs);
end;
end
else
if ch = tab then
begin
if j < (buflen - 5) then
begin
repeat
write(' ');
j := succ(j);
until (j mod 5) = 0;
end
else
beep;
end
else
beep;
end;
end;
end;
until (ch = cr);
instring := instr;
if j = 0 then instring := '';
end;
function startstop:boolean;
begin
startstop := false;
abort := false;
ch := chr(0);
chn := 0;
if keypressed then
begin
ch := readkey;
chn := ord(ch);
end;
if ((chn = 83) or (chn = 115)) then
abort := true
else
if (chn = 80) or (chn = 112) or (linecount = 22) then
begin
startstop := true;
write(' any key to go on; S to stop',cr);
repeat until keypressed;
ch := readkey;
chn := ord(ch);
if ((chn = 83) or (chn = 115)) then abort := true;
linecount := 0;
end;
end;
procedure showfile(filnam:linestring);
var
filvar : text;
fillin : linestring;
begin
assign(textfile,filnam);
reset(textfile);
writeln('P to pause; any key to go on; S to stop');
repeat
linecount := 0;
repeat
linecount := succ(linecount);
readln(textfile,aline);
writeln(aline);
until (startstop or abort) or eof(textfile);
until abort or eof(textfile);
writeln;
close(textfile);
abort := false;
end;
procedure createnewsurvey;
begin
writeln;
writeln('Fine, I will create a new polling place called ',vfilename,'.');
writeln('Remember, the following files are created for each survey:');
writeln;
writeln(' o ',vfilename:8,'.VB - contains all questions and results');
writeln(' o ',vfilename:8,'.LOG - log of all activity in survey');
writeln(' o ',vfilename:8,'.U1 ...');
writeln(' ',vfilename:8,'.Uxx - names of voters for fixed booths');
writeln;
writeln('And you should create ',vfilename,'.WEL as a welcome file for this');
writeln('polling place.');
assign(pplace,vfilename+'.pp');
rewrite(pplace);
with pp do
begin
writeln;
write('Only allow people to vote once?');
yesno('N');
if ch = 'N' then atrack := false else atrack := true;
write('Allow users to add responses (more choices)?');
yesno('Y');
if ch = 'N' then aaddons := false else aaddons := true;
write('Allow multi-line choices?');
yesno('N');
if ch = 'N' then amulti := false else amulti := true;
booths := 0;
lmessage := '';
write('Minimum security to create a booth?');
buflen := 8;
val(instring,addsec,code);
write('Minimum sysop security?');
val(instring,syssec,code);
end;
seek(pplace,0);
write(pplace,pp);
assign(booths,vfilename+'.VB');
rewrite(booths);
close(booths);
writeln;
writeln('New polling place ',vfilename,' created...');
close(pplace);
end;
function checkforuser:boolean;
var
number : string[2];
track : boolean;
temp : string[36];
begin
str(j,number);
assign(trackfile,vfilename+'.U'+number);
reset(trackfile);
track := false;
repeat
readln(trackfile,temp);
if ucase(temp) = ucase(whoson.name) then track := true;
until eof(trackfile) or track;
close(trackfile);
checkforuser := track;
end;
procedure appenduser;
var
number : string[2];
begin
str(j,number);
assign(trackfile,vfilename+'.U'+number);
append(trackfile);
writeln(trackfile,whoson.name);
close(trackfile);
end;
procedure displayquestion;
var
i : integer;
begin
writeln;
if bb.responseto > 0 then
begin
writeln('In response to Question ',bb.responseto);
writeln;
seek(booths,bb.responseto-1);
read(booths,tb);
writeln('>',tb.question[1]);
if pp.amulti then
begin
if tb.question[2] <> '' then writeln('>',tb.question[2]);
if tb.question[3] <> '' then writeln('>',tb.question[3]);
end;
writeln;
end;
if bb.titleit then
begin
writeln(' ',bb.creator,' wants to know:');
writeln;
end;
writeln(bb.question[1]);
if pp.amulti then
begin
if bb.question[2] <> '' then writeln(bb.question[2]);
if bb.question[3] <> '' then writeln(bb.question[3]);
end;
writeln;
for i := 1 to bb.available do
begin
writeln(i:2,'. ',bb.choices[i,1]);
if bb.multi then
begin
if bb.choices[i,2] <> '' then
begin
writeln(' ',bb.choices[i,2]);
if bb.choices[i,3] <> '' then writeln(' ',bb.choices[i,3]);
end;
end;
end;
if bb.addons and (bb.available < 21) then writeln('99. Other (add your own)');
writeln;
end;
procedure getstats;
begin
if exist('dorinfo1.def') then
begin
assign(doorinfo,'dorinfo1.def');
reset(doorinfo);
readln(doorinfo,whoson.bbsname);
for i := 1 to 6 do readln(doorinfo,aline);
whoson.name := aline;
readln(doorinfo,aline);
whoson.name := uplow(whoson.name) + ' ' + uplow(aline);
for i := 1 to 3 do readln(doorinfo,aline);
val(aline,whoson.seclvl,code);
close(doorinfo);
end
else
begin
writeln('LOCAL mode...');
writeln;
buflen := 35;
write('What name would you like to use: ');
whoson.name := instring;
whoson.seclvl := pp.syssec;
whoson.bbsname := 'LOCAL TEST';
end;
writeln;
writeln('User name: ',whoson.name);
writeln(' Security: ',whoson.seclvl);
writeln;
end;
procedure viewlog;
var
temp : string[79];
begin
close(logfile);
reset(logfile);
writeln('Log of recent voter activity...');
writeln;
writeln('P to pause; A to abort');
writeln;
linecount := 0;
repeat
repeat
readln(logfile,temp);
writeln(temp);
linecount := succ(linecount);
until eof(logfile) or startstop or abort;
until eof(logfile) or abort;
close(logfile);
append(logfile);
writeln(logfile,'Viewed log file');
end;
procedure killlog;
begin
close(logfile);
rewrite(logfile);
writeln(logfile,'----------------------------------------');
writeln(logfile,whoson.name,' killed log ');
writeln;
writeln('It''s dead, Jim.');
writeln;
end;
procedure getresponse;
begin
buflen := 50;
write(k:2,'. ');
bb.choices[k,1] := instring;
if (bb.choices[k,1] <> '') and bb.multi then
begin
write(' ');
bb.choices[k,2] := instring;
if bb.choices[k,2] <> '' then
begin
write(' ');
bb.choices[k,3] := instring;
end;
end;
end;
procedure newbooth;
var
q : integer;
number : string[2];
begin
if i = 51 then bb.responseto := j else bb.responseto := 0;
writeln;
if pp.booths = 99 then
begin
writeln('Sorry, there are already 99 booths...');
exit;
end;
writeln('This will be booth #',pp.booths+1);
write('What''s the survey question? ');
if pp.amulti then write('(Up to 3 lines)');
writeln;
writeln('[---------------------------------------------------------------------------]');
write('>');
buflen := 75;
aline := instring;
if aline = '' then
begin
writeln('Okay, never mind ...');
exit;
end;
bb.question[1] := aline;
if pp.amulti then
begin
write('>');
bb.question[2] := instring;
write('>');
bb.question[3] := instring;
end
else
begin
bb.question[2] := '';
bb.question[3] := '';
end;
writeln;
write('Would you like your name associated with this question?');
yesno('Y');
if ch = 'N' then bb.titleit := false else bb.titleit := true;
if pp.atrack then
begin
write('Should people only be allowed to vote once?');
yesno('Y');
if ch = 'N' then bb.track := false else bb.track := true;
end
else
bb.track := false;
if pp.aaddons then
begin
write('Can users add additional responses (choices) to your question?');
yesno('Y');
if ch = 'N' then bb.addons := false else bb.addons := true;
end
else
bb.addons := false;
if pp.amulti then
begin
write('Do you want any of your answers to be more than one line?');
yesno('N');
if ch = 'N' then bb.multi := false else bb.multi :=true
end
else
bb.multi := false;
writeln;
write('Okay, now you can enter up to 20 possible responses. ');
if bb.multi then write('(Up to 3 lines)');
k := 0;
writeln;
writeln(' [--------------------------------------------------]');
buflen := 50;
repeat
k := succ(k);
getresponse;
until (bb.choices[k,1] = '') or (k = 20);
if (bb.choices[1,1] = '') or (k < 3) then
begin
writeln;
writeln('You need more than one choice!');
exit;
end;
bb.available := k - 1;
bb.killed := false;
bb.creator := whoson.name;
bb.created := 0;
bb.totalvotes := 0;
pp.booths := succ(pp.booths);
for q := 1 to 20 do bb.votes[q] := 0;
seek(pplace,0);
write(pplace,pp);
seek(booths,pp.booths-1);
write(booths,bb);
writeln('New booth added! Thank You!');
if bb.track then
begin
str(pp.booths,number);
assign(trackfile,vfilename+'.U'+number);
rewrite(trackfile);
close(trackfile);
end;
writeln(logfile,'Created new booth #',pp.booths,' with ',bb.available,' choices.');
writeln(logfile,' Question: ',bb.question[1]);
if bb.multi then
begin
if bb.question[2] <> '' then
writeln(logfile,' ',bb.question[2]);
if bb.question[3] <> '' then
writeln(logfile,' ',bb.question[3]);
end;
end;
procedure goodbye;
begin
write('Are you sure you want to leave?');
yesno('Y');
if ch = 'Y' then
begin
writeln;
letemout := true;
writeln('Enter a one line message for the next voter:');
write('>');
buflen := 78;
pp.lmessage := instring;
seek(pplace,0);
write(pplace,pp);
if pp.lmessage <> '' then
begin
writeln(logfile,'Left log off message:');
writeln(logfile,' ',pp.lmessage);
end;
end
else
writeln('Okay, we will stay!');
end;
procedure help;
begin
if exist (vfilename+'.hlp') then
showfile(vfilename+'.hlp')
else
begin
writeln;
writeln('Sorry, file ',vfilename,'.HLP is missing!');
writeln;
end;
end;
procedure showresults;
var
stuff : string[50];
begin
writeln;
if bb.totalvotes = 0 then
begin
writeln('Sorry, no one has voted on that topic yet. Why don''t you?');
exit;
end;
writeln('Results of Booth #',j:2);
writeln('--------------------');
writeln(bb.question[1]);
if pp.amulti then
begin
if bb.question[2] <> '' then writeln(bb.question[2]);
if bb.question[3] <> '' then writeln(bb.question[3]);
end;
for i := 1 to bb.available do
begin
write(' (',bb.votes[i]:3,' votes');
write(' ',((bb.votes[i] * 100) div bb.totalvotes):3,'%) ');
writeln(bb.choices[i,1]);
if bb.multi then
begin
if bb.choices[i,2] <> '' then
begin
writeln(' ',bb.choices[i,2]);
if bb.choices[i,3] <> '' then
writeln(' ',bb.choices[i,3]);
end;
end;
end;
write('press any key to continue');
repeat until keypressed;
ctlx := readkey;
writeln;
end;
procedure listbooths;
begin
if pp.booths > 0 then
begin
writeln;
writeln('Current voting booth questions:');
for i := 0 to (pp.booths-1) do
begin
seek(booths,i);
read(booths,bb);
if pp.amulti then
begin
writeln((i+1):2,'. ',bb.question[1]);
if bb.question[2] <> '' then writeln(' ',bb.question[2]);
if bb.question[3] <> '' then writeln(' ',bb.question[3]);
if bb.responseto > 0 then writeln(' *** Response to Question ',bb.responseto,' ***');
end
else
begin
writeln(i,'. ',bb.question[1]);
if bb.responseto > 0 then writeln(' *** Response to Question ',bb.responseto,' ***');
end;
end;
end
else
begin
writeln;
write('There are currently no voting booths. ');
if whoson.seclvl >= pp.addsec then write('Why not create one.');
writeln;
writeln;
end;
end;
procedure displayrec;
begin
writeln('Record #',j,' of ',pp.booths-1);
writeln('[1] ',bb.question[1]);
writeln(' ',bb.question[2]);
writeln(' ',bb.question[3]);
writeln('[2] Created by: ',bb.creator,' (',bb.created,')');
writeln('[3] Response to Question: ',bb.responseto);
writeln('[4] Track: ',bb.track,' [5] Killed: ',bb.killed,' [6] Addons: ',bb.addons);
writeln('[7] Titleit: ',bb.titleit,' [8] Multi: ',bb.multi);
writeln('[9] Alter votes (',bb.totalvotes,' total) [0] Alter responses (',bb.available,' total)');
writeln('[Q] Quit [~] Pack file [+] Next record [-] Previous record [J] Jump');
end;
procedure updatebooth;
begin
seek(booths,j);
write(booths,bb);
end;
procedure revisebooth;
var
q, r, s : integer;
begin
q := 0;
j := 0;
repeat
seek(booths,j);
read(booths,bb);
displayrec;
write('Choice [0..9,Q,J,+,-]: +',bs);
repeat
ch := upcase(readkey);
if ch = chr(13) then ch := '+';
until pos(ch,'0123456789QJ+-~') > 0;
writeln(ch);
q := ord(ch);
case q of
43 : {+} begin
j := succ(j);
if j > (pp.booths-1) then
begin
writeln('You are at the last record!');
j := pp.booths-1;
end;
end;
45 : {-} begin
j := pred(j);
if j < 0 then
begin
writeln('You are at the first record!');
j := 0;
end;
end;
74 : {J} begin
write('Question # to jump to: ');
readln(s);
if (s > -1) and (s < pp.booths) then
j := s
else
writeln('Invalid number');
end;
81 : {Q} exit;
126 : {~} begin
write('Are you sure you want to pack file (y/N)?');
yesno('N');
if ch = 'N' then
writeln('Fine, we will not!')
else
begin
assign(tbfile,'0000000.XXX');
rewrite(tbfile);
s := 0;
for r := 1 to pp.booths do
begin
seek(booths,r-1);
read(booths,bb);
if bb.killed = false then
begin
write(tbfile,bb);
s := succ(s);
end;
end;
close(tbfile);
close(booths);
erase(booths);
rename(tbfile,vfilename+'.vb');
assign(booths,vfilename+'.vb');
reset(booths);
seek(pplace,0);
pp.booths := s;
write(pplace,pp);
j := 0;
end;
end;
48 : {0} begin
for r := 1 to bb.available do
begin
write('Question #',r:2,': ');
buflen := 50;
aline := instring;
if aline <> '' then
begin
bb.choices[r,1] := aline;
if bb.multi then
begin
write(' : ');
bb.choices[r,2] := instring;
if bb.choices[r,2] <> '' then
begin
write(' : ');
bb.choices[r,3] := instring;
end;
end;
end;
end;
updatebooth;
end;
49 : {1} begin
writeln('Enter new survey question (up to three lines):');
write('>');
buflen := 75;
aline := instring;
if aline = '' then
writeln('Okay, we will leave it the same!')
else
begin
bb.question[1] := aline;
if pp.amulti then
begin
write('>');
bb.question[2] := instring;
write('>');
bb.question[3] := instring;
end;
updatebooth;
end;
end;
50 : {2} begin
write('Created by: ');
buflen := 35;
aline := instring;
if aline <> '' then bb.creator := aline;
updatebooth;
end;
51 : {3} begin
write('Make this a response to question #');
buflen := 5;
aline := instring;
val(instring,r,code);
if r > (pp.booths -1) then
writeln('There is no booth ',r,'.!')
else
begin
bb.responseto := r;
updatebooth;
end;
end;
52 : {4} begin
bb.track := not bb.track;
updatebooth;
end;
53 : {5} begin
bb.killed := not bb.killed;
updatebooth;
end;
54 : {6} begin
bb.addons := not bb.addons;
updatebooth;
end;
55 : {7} begin
bb.titleit := not bb.titleit;
updatebooth;
end;
56 : {8} begin
bb.multi := not bb.multi;
updatebooth;
end;
57 : {9} begin
for r := 1 to bb.available do
begin
write('Resp to #',r:2,' "',bb.choices[r,1],'" (',bb.votes[r],'): ');
buflen := 5;
aline := instring;
if aline <> '' then val(aline,bb.votes[r],code);
end;
bb.totalvotes := 0;
for r := 1 to bb.available do bb.totalvotes := bb.totalvotes + bb.votes[r];
updatebooth;
end;
end;
until q = 81;
end;
procedure killbooth;
begin
writeln('It is now marked for deletion!');
end;
procedure voterchoice;
begin
if bb.track then
if checkforuser then
begin
writeln('Sorry, you have already voted in this booth!');
exit;
end
else
appenduser;
if i = 97 then
displayquestion
else
if i = 98 then
begin
killbooth;
i := 0;
end
else
if (i > 0) and (i <= bb.available) then
begin
bb.votes[i] := succ(bb.votes[i]);
bb.totalvotes := succ(bb.totalvotes);
seek(booths,j-1);
write(booths,bb);
writeln(logfile,'Voted response #',i,' to question #',j);
writeln;
writeln('Thank you for voting!');
write('See results (Y/n)?');
yesno('Y');
if ch = 'Y' then showresults;
i := 0;
end
else
if i = 99 then
begin
k := succ(bb.available);
getresponse;
if bb.choices[k,1] = '' then
writeln('Okay, never mind!')
else
begin
seek(booths,j-1);
bb.available := k;
bb.votes[k] := 1;
bb.totalvotes := succ(bb.totalvotes);
write(booths,bb);
writeln(logfile,'Added response #',k,' to question #',j);
writeln(logfile,' Response: ',bb.choices[k,1]);
writeln;
writeln('Thank you for voting');
write('See the results?');
yesno('Y');
if ch = 'Y' then showresults;
i := 0;
end;
end
else
if i = 51 then
begin
writeln;
writeln('This will be a response to the question:');
writeln(bb.question[1]);
if bb.multi then
begin
if bb.question[2] <> '' then writeln(bb.question[2]);
if bb.question[3] <> '' then writeln(bb.question[3]);
end;
newbooth;
i := 0;
end;
end;
procedure ccpick;
begin
write('Your choice? [1-',bb.available,',');
if bb.addons and (bb.available < 21) then write('99,');
write('L=list,');
if qowner then write('K=kill,');
write('R=reply,[RETURN]=skip,0=quit] ');
buflen := 2;
aline := ucase(instring);
if aline = '' then aline := '52';
if aline = 'L' then aline := '97';
if aline = 'R' then aline := '51';
if qowner and (aline = 'K') then
aline := '98'
else
if aline = 'K' then aline := '50';
if not bb.addons and (aline = '99') then aline := '-1';
val(aline,i,code);
end;
procedure scanbooths;
begin
for j := pp.booths downto 1 do
begin
seek(booths,j-1);
read(booths,bb);
writeln;
writeln('Question #',j);
displayquestion;
buflen := 2;
repeat
repeat
ccpick;
until (i >= 0) and (i < 100);
if i = 0 then
exit
else
if i <> 52 then voterchoice;
until i <> 97;
end;
writeln;
writeln('That''s all folks...');
if whoson.seclvl >= pp.addsec then
begin
write('Would you like to add a booth (y/N)?');
yesno('N');
if ch = 'Y' then newbooth;
end;
end;
procedure vpick;
var
q : string[2];
begin
repeat
writeln;
write('Which One? [1-',pp.booths,',L=list] ');
buflen := 2;
q := instring;
if ucase(q) = 'L' then
listbooths;
val(q,j,code);
until ucase(q) <> 'L';
end;
procedure vcpick;
begin
write('Your choice? [1-',bb.available,',');
if bb.addons and (bb.available < 21) then write('99,');
write('L=list,');
if qowner then write('K=kill,');
write('R=reply,0=quit] ');
buflen := 2;
aline := ucase(instring);
if aline = '' then aline := '-1';
if aline = 'L' then aline := '97';
if aline = 'R' then aline := '51';
if qowner and (aline = 'K') then
aline := '98'
else
if aline = 'K' then aline := '50';
if not bb.addons and (aline = '99') then aline := '-1';
val(aline,i,code);
end;
procedure voteinbooth;
begin
listbooths;
repeat
repeat
vpick;
until (j >= 0) or (j <= pp.booths);
if j = 0 then
exit
else
begin
seek(booths,j-1);
read(booths,bb);
displayquestion;
end;
buflen := 2;
repeat
repeat
vcpick;
until (i >= 0) and (i < 100);
voterchoice;
until i = 0;
until j = 0;
end;
procedure viewresults;
begin
listbooths;
repeat
repeat
vpick;
until (j >= 0) or (j <= pp.booths);
if j = 0 then
exit
else
begin
seek(booths,j-1);
read(booths,bb);
writeln;
showresults;
end;
until j = 0;
end;
function getcommand(default:char):integer;
begin
write(default,bs);
repeat
ch := upcase(readkey);
if ch=cr then ch := default;
until pos(ch,commands) > 0;
writeln(ch);
getcommand := ord(ch);
end;
procedure menu;
begin
writeln;
writeln(whoson.bbsname,' polling place ',vfilename);
writeln;
writeln('[L] List booths and results [V] Vote in booths');
writeln('[S] Scan booths newest to oldest [G] Goodbye');
if whoson.seclvl >= pp.addsec then
begin
write('[E] Enter a new booth ');
if whoson.seclvl >= pp.syssec then
begin
writeln('[R] Revise a booth');
writeln('[1] View booth logs [2] Kill booth logs');
commands := 'LVSGER12H';
end
else
begin
writeln;
commands := 'LVSGEH';
end;
end
else
commands := 'LVSGH';
writeln('[H] Help');
writeln;
write('What would you like to do? [',commands,'] ');
j := getcommand('H');
case j of
49 : {1} viewlog;
50 : {2} killlog;
69 : {E} newbooth;
71 : {G} goodbye;
72 : {H} help;
76 : {L} viewresults;
82 : {R} revisebooth;
83 : {S} scanbooths;
86 : {V} voteinbooth;
end;
end;
begin
directvideo := false;
cr := chr(13);
bs := chr(8);
del := chr(127);
ctlx := chr(124);
tab := chr(9);
writeln;
writeln('Welcome to BVote 0.1');
writeln('by Chris Rowley (c) 1989 Bogusware');
writeln('modifications by a more polite, anonymous programmer.');
writeln;
letemout := false;
if paramcount < 1 then
begin
writeln('useage: bvote [filename]');
writeln('Nothing for me to do!');
exit;
end;
vfilename := paramstr(1);
if not exist(vfilename+'.pp') then
begin
write(vfilename,'.PP not present!');
write(' Do you want to create a new polling place?');
yesno('N');
if ch = 'N' then
begin
writeln;
writeln('See you later, then!');
exit
end
else
createnewsurvey;
end;
assign(pplace,vfilename+'.pp');
reset(pplace);
assign(booths,vfilename+'.vb');
reset(booths);
seek(pplace,0);
read(pplace,pp);
getstats;
if not exist(vfilename+'.log') then
begin
assign(logfile,vfilename+'.log');
rewrite(logfile);
close(logfile);
end;
assign(logfile,vfilename+'.log');
append(logfile);
writeln(logfile,'----------------------------------------');
writeln(logfile,whoson.name+' logged on ');
if exist(vfilename+'.wel') then showfile(vfilename+'.wel');
if pp.lmessage <> '' then
begin
writeln;
writeln('The last voter says:');
writeln('"',pp.lmessage,'"');
writeln;
end;
repeat
menu;
until letemout;
close(pplace);
close(booths);
writeln(logfile,'Logged off ');
close(logfile);
writeln;
writeln('Thank you for using BVote...');
writeln('Now returning you to the bulletin board...');
end.