home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Jason Aller Floppy Collection
/
276.img
/
FORUM21S.ZIP
/
MAINR2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-02-13
|
4KB
|
195 lines
{$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
{$M 65500,0,0 }
unit mainr2;
interface
uses gentypes,modem,subs1,subs2,statret,configrt,overret1,
textret,userret,mailret,lineedit,ansiedit,mainr1;
function reedit (var m:message; g:boolean):boolean;
function editor (var m:message; gettitle:boolean):integer;
procedure seekbdfile (n:integer);
procedure writebdfile (var bd:boardrec);
procedure writecurboard;
procedure addnews;
procedure sendmailto (uname:mstr; anon:boolean);
procedure addfeedback (var m:mailrec);
procedure hangupmodem;
procedure setupmodem;
procedure dialnumber (num:lstr);
procedure disconnect;
implementation
function reedit (var m:message; g:boolean):boolean;
begin
if fseditor in urec.config
then reedit:=ansireedit (m,g)
else reedit:=linereedit (m,g);
trimmessage (m)
end;
function editor (var m:message; gettitle:boolean):integer;
function getthetitle:boolean;
begin
m.anon:=false;
getthetitle:=true;
if gettitle then begin
buflen:=30;
writestr (^M^M'Title: &');
if length(input)=0 then begin
getthetitle:=false;
exit
end;
m.title:=input;
if ulvl>=anonymouslevel then begin
buflen:=1;
writestr ('Anonymous? *');
m.anon:=yes
end
end;
end;
begin
editor:=-1;
m.numlines:=0;
if getthetitle
then if reedit(m,gettitle)
then editor:=maketext(m)
end;
procedure seekbdfile (n:integer);
begin
seek (bdfile,n);
seek (bifile,n); che
end;
procedure writebdfile (var bd:boardrec);
begin
write (bdfile,bd);
write (bifile,bd.shortname)
end;
procedure writecurboard;
begin
seekbdfile (curboardnum);
writebdfile (curboard); che
end;
procedure addnews;
var newline,r:integer;
nfile:file of integer;
numnews,cnt:integer;
m:message;
begin
writehdr ('Adding to the news');
newline:=editor (m,false);
if newline<0 then exit;
r:=ioresult;
assign (nfile,'News');
reset (nfile);
r:=ioresult;
if r<>0
then
begin
if r<>1 then writeln ('Error ',r,' opening news file; recreating.');
rewrite (nfile);
write (nfile,newline);
numnews:=0
end
else
begin
numnews:=filesize(nfile);
for cnt:=numnews-1 downto 0 do
begin
seek (nfile,cnt);
read (nfile,r);
seek (nfile,cnt+1);
write (nfile,r)
end;
che;
seek (nfile,0);
write (nfile,newline)
end;
writeln ('News added. News items: ',numnews+1);
writelog (2,1,'');
close (nfile)
end;
procedure sendmailto (uname:mstr; anon:boolean);
var un:integer;
me:message;
line:integer;
u:userrec;
begin
if length(uname)=0 then exit;
un:=lookupuser (uname);
if un=0 then writeln ('User not found.') else begin
if anon and (ulvl<sysoplevel) then uname:=anonymousstr;
seek (ufile,un);
read (ufile,u);
if u.emailannounce>-1 then begin
writehdr (u.handle+'''s Announcement');
printtext (u.emailannounce)
end;
writehdr ('Sending mail to '+uname);
line:=editor(me,true);
if line>=0 then addmail (un,line,me)
end
end;
procedure addfeedback (var m:mailrec);
var ffile:file of mailrec;
begin
assign (ffile,'Feedback');
reset (ffile);
if ioresult<>0 then begin
close (ffile);
rewrite (ffile)
end;
seek (ffile,filesize(ffile));
write (ffile,m);
close (ffile);
newfeedback:=newfeedback+1;
end;
procedure hangupmodem;
var tries:integer;
begin
tries:=0;
while carrier and (tries<5) do begin
hangup;
sendmodemstr (modemhangupstr,false);
tries:=tries+1
end;
setparam (usecom,baudrate,parity)
end;
procedure setupmodem;
begin
if carrier then exit;
writeln (usr,^M^J'Setting up the modem...'^M^J^J);
sendmodemstr (modemsetupstr,true);
if hashayes then sendmodemstr ('|~~ATS0=0M0Q0V0X1|',true)
end;
procedure dialnumber (num:lstr);
begin
sendmodemstr (modemdialprefix+num+modemdialsuffix,true)
end;
procedure disconnect;
begin
if online then hangupmodem;
online:=true;
writelog (0,3,'');
if (unum>0) and not disconnected then updateuserstats (true);
disconnected:=true
end;
begin
end.