Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SYSPC22.ZIP/MAINR2.PAS

Pascal/Delphi Source File | 1988-04-13 | 5.0 KB | 237 lines

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'Subject: &');
      if length(input)=0 then begin
        getthetitle:=false;
        exit
      end;
      m.title:=input;
senttol:='ALL';
IF sendTOISTRU THEN Writestr ('To [Return=All]: &');
if sendtoistru then if length(input)>0 then   senttol:=input;

      if (ulvl>=anonymouslevel) and (not feed) then begin
        buflen:=5;
        writestr ('Anonymous Message? *');
        if yes then m.anon:=true;
      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 assignbdfile;
begin
  assign (bdfile,boarddir+'boarddir');
  assign (bifile,boarddir+'bdindex')
end;

procedure openbdfile; { FORWARD }
var i:integer;
begin
  closebdfile;
  assignbdfile;
  reset (bdfile);
  i:=ioresult;
  reset (bifile);
  i:=i or ioresult;
  if i<>0 then formatbdfile
end;

procedure formatbdfile; { FORWARD }
begin
  close (bdfile);
  close (bifile);
  assignbdfile;
  rewrite (bdfile);
  rewrite (bifile)
end;

procedure closebdfile; { FORWARD }
begin
  close (bdfile);
  close (bifile)
end;

overlay procedure addnews;
var newline:newsrec;
    r:integer;
    k:newsrec;
    nfile:file of newsrec;
    numnews,cnt:integer;
    m:message;
begin
  writehdr ('Adding to the news');
  Writestr ('Title: *');
  newline.title:=input;
  Writestr ('Level: *');
  newline.level:=valu(input);
  newline.date:=datestr;
  newline.time:=timestr;
  newline.where:=editor (m,false);
  if newline.where<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,k);
            seek (nfile,cnt+1);
            write (nfile,k)
          end;
        che;
        seek (nfile,0);
        write (nfile,newline)
      end;
  writeln ('News added.  News items: ',numnews+1);
  writelog (2,1,'');
  close (nfile)
end;

overlay 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;

overlay 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;

overlay procedure ensureclosed;
var cnt:integer;
    r:regs;
begin
  stoptimer (numminsidle);
  stoptimer (numminsused);
  writestatus;
  textclose (ttfile)
end;

overlay procedure offhook;
begin
  sendmodemstr (offhookmodem,true);
end;

overlay procedure answer;
begin
  sendmodemstr (answermodem,true);
end;

overlay procedure resetit;
begin
  sendmodemstr (resetmodem,true);
  end;

overlay procedure hangupmodem;
var tries:integer;
begin
  tries:=0;
  while carrier and (tries<5) do begin
    hangup;
    if match(modemhangupstr,'DTR') then async_close else
    sendmodemstr (modemhangupstr,false);
    tries:=tries+1
  end;
  setparam (usecom,baudrate,parity)
end;

overlay procedure setupmodem;
begin
  if carrier then exit;
  Writeln (usr,^M^J'*> Modem Set-Up <*');
  Writeln (usr,^M^J'*> Resetting Parameters <*'^M);
  sendmodemstr (resetmodem,true);
  writeln (usr,^M^J'*> Setting up the modem <*'^M^J^J);
  sendmodemstr (modemsetupstr,true)
end;

procedure disconnect;
begin
  if online then hangupmodem;
  online:=true;
  writelog (0,3,'');
  if unum>0 then updateuserstats;
  disconnected:=true
end;