Jason Aller Floppy Collection/189.img/TCS120S.ZIP/MAINR2.PAS

Pascal/Delphi Source File | 1989-04-04 | 5KB | 218 lines

{$R-,S-,I-,D-,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; 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;
      if ulvl>=anonymouslevel 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 addnews;
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:='No one';
  newline:=editor (m,false,'Adding to the News');
  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 E-Mail to '+uname);
    titlestr:='Sending E-Mail to '+uname;
    emailing:=true;
    line:=editor (me,true,'Sending 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,'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]'^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.