home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Jason Aller Floppy Collection
/
270.img
/
FORUM25C.ZIP
/
MAINR2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-02-02
|
5KB
|
218 lines
{$R-,S-,I-,D-,V-,B-,N-,L- }
{$O+}
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:INTEGER; 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 : INTEGER; anon : boolean);
VAR un:integer;
me:message;
line:integer;
u:userrec;
begin
if uname = 0 then exit;
un := 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 '+ LookUpUname(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)
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.