*/
Looking for work? Check out our jobs area.
*/

View \MAINR2.PAS

Full Source Code To Vision Bbs System

Submitted By: WEBMASTER
Rating: (Not rated) (Rate It)


{$R-,S-,I-,D-,F+,V-,B-,N-,L+ }

unit mainr2;

interface

uses Dos,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; sendto,gettitle:boolean; sent,bs:mstr):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 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;

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;

function uploadmsg:integer;
  var f:text;
      b:bulrec;
      tu:mstr;
      me:message;
      sub,ls:lstr;
      lne:integer;

  begin
    uploadmsg:=-2;
    If yes then Begin
    If local then Begin
      buflen:=80;
      writestr ('Enter Name and Path to Text File:');
      if length(input)<1 then exit;
      assign (f,input);
      reset (f);
      if ioresult <> 0 then begin
        writeln ('Cannot find Specified File!');
        exit
      end;
    end else begin
      writeln(^M^S'Ready to receive via Z-Modem Upload!');
      assign(f,configset.forumdi+'Message.Xyz');
      if exist(configset.forumdi+'Message.Xyz') then erase(f);
      delay(500);
      exec('DSZ.COM',' port '+strr(configset.useco)+' speed '+strlong(baudrate)+' rz '+configset.forumdi+'Message.Xyz');
      if dosexitcode<>0 then begin
        writeln(^G^G'Aborted!');
        if exist(configset.forumdi+'Message.Xyz') then erase(f);
        exit;
      end;
    end;
    lne:=0;
    reset(f);
    while not eof(f) do begin
      readln(f,ls);
      inc(lne);
      if lne>100 then begin
        Writeln(^G^G^S'You may NOT have more then 100 lines in a message!');
        textclose(f);
        if not local then erase(f);
        exit;
      end;
      me.text[lne]:=ls;
    end;
    me.anon:=false;
    me.numlines:=lne;
    me.note:=urec.usernote;
    if me.numlines < 1 then begin
      writeln (^R'Message not saved!');
      exit;
    end;
    b.line:=maketext(me);
    uploadmsg:=b.line;
    b.anon:=false;
    B.Where:=Configset.origin1;
    B.Where2:=Configset.origin2;
    B.Version:=NetMailVer;
    B.Cnet:=False;
    B.FidoNet:=False;
    B.Flag3:=False;
    B.Flag4:=False;
    B.Flag5:=False;
    B.Flag6:=False;
    B.Flag7:=False;
    B.Flag8:=False;
    B.RealName:=Urec.RealName;
    b.when:=now;
    b.leftby:=unam;
    b.status:='[ ha ]';
    b.recieved:=false;
    b.leftto:=tu;
    b.line:=lne;
    b.plevel:=ulvl;
(*    addbul(b);
    inc(newposts);
    inc(gnup);
    with curboard do if autodel<=numbuls then autodelete; *)

    writeln(^M^S'Message has been saved');
  end;
 End;

function editor (var m:message; sendto,gettitle:boolean; sent,bs:mstr):integer;
var post:boolean;

  function getthetitle:boolean;
  begin
    post:=true;
    m.anon:=false;
    getthetitle:=true;
    If okfortitle then begin
    buflen:=40;
    writestr (^M^P'Title'^R':');
      if length(input)=0 then begin
        getthetitle:=false;
        exit
      end;
      m.title:=input;
      End;
    okfortitle:=True;
    if gettitle then begin
      buflen:=30;
     if sendto and (length(sent)=1) then begin
        writestr(^M^M^P'Send to ['^R'CR/All'^P']:');
        if length(input)=0 then m.sendto:='All'
          else
        m.sendto:=input;
     end else m.sendto:='The SysOp''s';
      if bs='EMAIL' then begin
          m.title:='Announcement';
          m.sendto:=urec.handle;
          exit;
      end;
      if sent<>'0' then m.sendto:=sent;
     if bs<>'0' then begin
        m.title:=bs;
        exit;
     end;
      if ulvl>=configset.anonymousleve then begin
        buflen:=1;
        writestr ('Anonymous? *');
        m.anon:=yes
      end;
      writestr ('Upload a Prepared Message? *');
      if yes then begin
        editor:=uploadmsg;
        post:=false;
      end;
    end;
  end;

var b:boolean;
begin
{ If useansiup then Begin }
    editor:=-1;
    m.numlines:=0;
    m.note:=urec.usernote;
    if not sendto then begin
      m.sendto:='All';
      m.title:='Message to next user';
    end;
    if match(bs,'EMAIL') then m.title:='Announcement';
    b:=getthetitle;
    if not post then exit;
    if b then if
     reedit(m,gettitle) then
      editor:=maketext(m)
{ end;
  useansiup:=false; }

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<configset.sysopleve) then uname:=configset.anonymousst;
    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,false,true,uname,'0');
    if line>=0 then addmail (un,line,me)
  end
end;

procedure addfeedback (var m:mailrec);
var ffile:file of mailrec;
begin
  assign (ffile,configset.forumdi+'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
     delay(500);
     hangup;
    tries:=tries+1
  end;
  setparam (configset.useco,baudrate,parity)
end;

procedure setupmodem;
begin
  write(direct,#27,'[0m');
        if carrier then exit;
  writeln (usr,^M^J'Setting up the modem...'^M^J^J);
  sendmodemstr (configset.modemsetupst,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;
    forcehangup:=true;
  writestatus;
  hangup
end;

begin
end.

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.