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

Pascal/Delphi Source File | 1989-02-02 | 4.6 KB | 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.