home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
f
/
faq-s.zip
/
MAINR2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-25
|
7KB
|
291 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
{$M 65500,0,0 }
unit mainr2;
interface
uses crt,gensubs,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; tttitle:lstr):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; tttitle:lstr):integer;
var thetitle:lstr;
function getthetitle:boolean;
begin
m.anon:=false;
getthetitle:=true;
m.title:=tttitle;
thetitle:=tttitle;
if gettitle then begin
if (notitle=false) or (emailing=false) then begin
buflen:=30;
writestr (^M^M'Subject: &');
if (length(input)=0) and (notitle=false) then begin
getthetitle:=false;
exit
end;
if (notitle=false) then begin
m.title:=input;
thetitle:=m.title;
end;
if (emailing=false) and (nosendprompt=false) then begin
writestr ('To [CR/All]: &');
if length(input)=0 then m.leftto:='All' else
m.leftto:=input;
end;
with curboard do
if anony then begin
buflen:=1;
writestr ('Anonymous? [y/n]: *');
m.anon:=yes
end
end;
end;
if (not gettitle) or (emailing) or (notitle) then begin
m.title:=tttitle;
m.leftto:='All';
m.anon:=false;
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 addnewsold;
var newline,r:integer;
nfile:file of integer;
numnews,cnt:integer;
m:message;
begin
writehdr ('Adding to the News');
titlestr:='Adding to the News';
sendstr:='All';
newline:=editor (m,false,'Adding to the News');
if newline<0 then exit;
r:=ioresult;
assign (nfile,bbsdatadir+'News.dat');
reset (nfile);
r:=ioresult;
if r<>0
then
begin
if r<>1 then writeln ('Creating news file.');
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 addnews;
Var newline,r:Integer;
nfile:File Of newsrec;
Ntmp,atmp:newsrec;
numnews,cnt:Integer;
m:message;
Begin
writehdr('Adding to the news');
Writestr('Minimum Level to read news [1] :');
If Input='' Then Input:='1';
ntmp.level:=valu(Input);
Writestr('Maximum Level to read news [32767] :');
If Input='' Then Input:='32767';
ntmp.Maxlevel:=valu(Input);
newline:=editor(m,true,'');
Ntmp.when:=now;ntmp.from:=unam;Ntmp.title:=m.title;
ntmp.location:=newline;
If newline<0 Then exit;
r:=IOResult;
Assign(nfile,bbsdatadir+'News.dat');
Reset(nfile);
r:=IOResult;
If r<>0
Then
Begin
If r<>1 Then WriteLn('Error ',r,' opening news file; recreating.');
Rewrite(nfile);
Write(nfile,ntmp);
numnews:=0
End
Else
Begin
numnews:=FileSize(nfile);
For cnt:=numnews-1 Downto 0 Do
Begin
Seek(nfile,cnt);
Read(nfile,atmp);
Seek(nfile,cnt+1);
Write(nfile,atmp)
End;
che;
Seek(nfile,0);
Write(nfile,Ntmp)
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 E-Mail to '+uname);
titlestr:='Sending E-Mail to '+uname;
emailing:=true;
line:=editor (me,true,'E-Mail to '+uname);
emailing:=false;
if line>=0 then addmail (un,line,me)
end
end;
procedure addfeedback (var m:mailrec);
var ffile:file of mailrec;
begin
assign (ffile,bbsdatadir+'Feedback.dat');
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
hangup;
tries:=0;
while (carrier or local) and (tries<5) do begin
hangup;
sendmodemstr (modemhangupstr,false);
tries:=tries+1
end;
setparam (usecom,baudrate,parity)
end;
procedure setupmodem;
var s:string;
begin
clrscr;
if carrier then exit;
textcolor (normtopcolor);
write (usr,'Initializing Modem [Type: ',usrspeed);
writeln(usr,' - DTE Rate: '+strlong(defbaudrate)+']');
cursor (false);
if length(modemsetupstr)>0 then
sendmodemstr ('~~'+modemsetupstr+'|',true);
s:='~~ATS0='+strr(answerring)+'Q0M0V0X4';
if (usrspeed=1) or (usrspeed=3) then s:=s+'B0';
if usrspeed=2 then s:=s+'B1';
sendmodemstr (s+'|',true);
{if usrspeed=0 then sendmodemstr ('~~ATS0='+strr(answerring)+'Q0M0V0X4|',true);
if usrspeed=1 then sendmodemstr ('~~ATS0='+strr(answerring)+'Q0M0V0X4B0| ~~AT&A3&B0&D0&G0&H1&K1&L0&M4'+
'&N0&P0&R2&S0&X0&Y1|',true);
if usrspeed=2 then sendmodemstr ('~~ATS0='+strr(answerring)+'Q0M0V0X4B1| ~~AT&A3&B0&D0&G0&H1&K1&L0&M4'+
'&N0&P0&R2&S0&X0&Y1|',true);
if usrspeed=3 then sendmodemstr ('~~ATS0='+strr(answerring)+'Q0M0V0X4B0| ~~AT&A3&B0&D0&G0&H1&K1&L0&M4'+
'&N0&P0&R2&S0&X0&Y1|',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);
forcehangup:=true;
disconnected:=true;
hangup;
end;
begin
end.