Jason Aller Floppy Collection/153.img/TELES.ZIP/FIX.PAS

Pascal/Delphi Source File | 1988-07-23 | 17KB | 606 lines

Uses
  Crt,
  Turbo3,
  DOS;

{$R-}                   {Range checking off}
{$B+}                   {Boolean complete evaluation on}
{$S+}                   {Stack checking on}
{$I+}                   {I/O checking on}
{$M 32150,1250,1250}          {Declared here suffices for all Units as well!}
{$V-}

type
  astr = String[160];  { generic string type for parameters      }
                       { note the change from Waynes str => Astr }

const
  buffer_max = 5120;


CONST strlen=160;
      maxusers=500;
      dsaves : Integer = 0;

TYPE restrictions=(rlogon,rchat,rvalidate,rbackspace,ramsg,rpostan,
                   rpost,remail,rvoting,rmsg);
     acrq='@'..'G';
     newtyp=(rp,lt,rm);
     str40=string[40];
     deflts=(spcsr,onekey,wordwrap,pause,mmnu,ansi,color,music);
     pnr=record name:string[40]; number:string[14]; hs:byte; end;
     anontyp=(no,yes,forced,dearabby);
     ansttype=(postn,emailn,pana,sanm,cosysop,lcosysop);
     opts=(alert,smw,nomail);
     dlnscan=set of 0..39;
     emary=array[1..20] of integer;
     clrs=array[false..true,1..8] of byte;
     clrs2=array[false..true,0..9] of byte;
     slr=record
           ttime:byte;
           mallowed:integer;
           emails,posts:byte;
           anst:set of ansttype;
         end;
     messages=record
                ltr:char;
                number:integer;
                ext:byte;
              end;
     smalrec=record
               name:string[25];
               number:integer;
             end;
     userrec=record
               name:string[21];
               realname:string[18];
               deleted:boolean;
               pw:string[8];
               ph:string[12];
               waiting:byte;
               laston:string[10];
               loggedon:integer;
               msgpost:integer;
               emailsent:integer;
               feedback:integer;
               linelen:byte;
               pagelen:byte;
               defaults:set of deflts;
               ontoday:byte;
               illegal:byte;
               ttimeon:real;
               dlnscn:dlnscan;
               sl:byte;
               ac:set of restrictions;
               ar:set of acrq;
               qscan:array[1..19] of messages;
               qscn:array[1..19] of boolean;
               macro:array[1..2] of string[79];
               comptype:byte;
               option:set of opts;
               vote:array[1..9] of byte;
               sbn:byte;
               dsl:byte;
               uploads,downloads:integer;
               uk,dk:integer;
               age:byte;
               sex:char;
               note:string[39];
               forusr:integer;
               cols:clrs;                (* Res[2] will be last file area *)
               res:array[1..72] of byte; (* Res[1] will be last msg base *)
               citystate:string[26];
               street:string[21];
               zipcode:string[10];
               occupation:string[40];
               wherebbs:string[40];
               lockedout:boolean;
               lockedfile:string[8];
               computer:string[14];
               cols2:clrs2;
             end;
      boardrec=record
                 name:string[30];
                 filename:string[12];
                 sl:byte;
                 maxmsgs:byte;
                 pw:string[10];
                 anonymous:anontyp;
                 ar:acrq;
                 key:char;
                 postsl:byte;
               end;
      msgstat=(validated,unvalidated,deleted);
      messagerec=record
                   title:string[30];
                   messagestat:msgstat;
                   message:messages;
                   owner:integer;
                   date:integer;
                   mage:byte;
                 end;
 SYSTATREC=RECORD
                  boardpw:string[20];
                  sysoppw:string[20];
                  hmsg:messages;
                  users:integer;
                  lastdate:string[8];
                  callernum:integer;
                  activetoday:integer;
                  callstoday:integer;
                  msgposttoday:integer;
                  emailtoday:integer;
                  fbacktoday:integer;
                  uptoday:integer;
                  closedsystem:boolean;
                  comport:byte;
                  maxbaud:integer;
                  msgpath:string[79];
                  gfiledate:string[8];
                  lowtime,hitime:integer;
                  res:array[1..185] of byte;
                  sysopcolor:byte;
                  usercolor:byte;
                  maxlines:byte;
                  special:boolean;
                  clearmsg:boolean;
                  bbspw:string[20];
                  matrix:boolean;
                  engage:string[79];
                  endchat:string[79];
                  alias:boolean;
                  echoc:char;
                  sysopin:string[79];
                  sysopout:string[79];
                  note:array[1..2] of string[79];
                  lprompt:string[40];
                  lansi:boolean;
                  init:string[40];
                  wait:string[79];
                  app:boolean;
                  fone:boolean;
                  sysopmacro:array[1..9] of string[72];
                  forcevoting:boolean;
                  multitask:boolean;
                  gfilepath:string[79];
                  pause:string[79];
                  hangup:string[40];
                  answer:string[40];
                  result300:integer;
                  result1200:integer;
                  result2400:integer;
                  nocarrier:integer;
                  tries:byte;
                  newsl:byte;
                  newdsl:byte;
                  newar:set of acrq;
                  newac:set of restrictions;
                  newfp:integer;
                  newuk:integer;
                  bwindow:boolean;
                  bsdelay:byte;
                  mcimsg:boolean;
                  b300lowtime,b300hitime:integer;
                  dllowtime,dlhitime:integer;
                  b300dllowtime,b300dlhitime:integer;
                  lock300:boolean;
                  result4800:integer;
                  result9600:integer;
                  SysopFirst:String[12];
                  SysopLast:String[16];
                  BBSName:String[40];
                  BBSPhone:String[12];
                  ANSIq:String[40];
                  WantQuote:Boolean;
                  Menupath:string[79];
                  autosl:byte;
                  autodsl:byte;
                  autoar:set of acrq;
                  autoac:set of restrictions;
        END;
      blk=array[1..255] of byte;
      mailrec=record
                title:string[30];
                from,destin:integer;
                msg:messages;
                date:integer;
                mage:byte;
              end;
      gft=record
            num:integer;
            title:string[40];
            filen:string[12];
          end;
      smr=record
            msg:astr;
            destin:integer;
          end;
      vdatar=record
               question:string[79];
               numa:integer;
               answ:array[0..9] of record
                      ans:string[25];
                      numres:integer;
                    end;
             end;
      ulrec=record
              name:string[25];
              filename:string[12];
              password:string[10];
              dsl:byte;
              maxfiles:integer;
              key:char;
              ulpath:string[39];
              dlpath:string[40];
              agereq:byte;
              ar:acrq;
            end;
      ulfrec=record
               filename:string[12];
               description:string[60];
               filepoints:byte;
               res:array[1..16] of byte;
               nacc:integer;
               ft:byte;
               blocks:integer;
               owner:integer;
               date:string[8];
               daten:integer;
             end;
      strptr=^strrec;
      strrec=record
               i:astr;
               next,last:strptr;
             end;
      zlogt=record
              date:string[8];
              active,calls,post,email,fback,up:integer;
            end;
{    expro=record
             descr:string[30];
             rcmd:string[50];
             scmd:string[50];
             xferok:integer;
           end;}

CONST dcols:clrs=((7,7,15,15,15,112,7,143),(3,1,11,9,14,31,4,140));
      dcols2:clrs2=((15,7,7,15,15,15,112,7,143,7),(15,3,1,11,9,14,31,4,140,10));

var sf:file of smalrec;
    uf:file of userrec;
    bf:file of boardrec;
{   xp:file of expro;}
    mailfile:file of mailrec;
    ulf:file of ulrec;
    uboards:array[0..39] of ulrec;
{   protocals:array [0..4] of expro;}
    maxulb:integer;
    sysopf:text{[1024]};
    slf:file of slr;
    seclev:array[0..255] of slr;
    systatf:file of systatrec;
    systat:systatrec;
    sr:smalrec;
    thisline,chatr,buf,spd,irt,lastname,ll,i:astr;
    thisuser,user:userrec;
    boards:array[1..19] of boardrec;
    fw,extramsgs,mread,board,numboards,t,usernum,numprotocals:integer;
    pap,lil,realsl,realdsl,ftoday,ptoday,etoday:integer;
    c,ID:char;
    rep,hungup,useron,next,chatcall,doneday,echo,hangup,incom,outcom:boolean;
    extratime,chattime,timeon:real;
    mailread,smread,macok,lan,enddayf,ch,quit,beepend:boolean;
    smf:file of smr;
    vqu:array[1..9] of boolean;
    ldate:integer;
    cmd:char;
    bread:byte;
    bchanged:boolean;
    cf:text; cfo,okt:boolean;
    elevel:byte;
    curco:byte;
    sll:astr;
    andwith:byte;
    checkit:boolean;
    geek:astr;
    lmain:boolean;
    lmsg:boolean;
    windowon,entry,wantfilename,nofile,nofeed:boolean;
    nopfile:boolean;
    reading_a_msg,write_msg:boolean;
    wantout:boolean;
    wcolor:boolean;
    Filv:Text;
    N:Astr;
    noc    : integer;
    found  : boolean;
    directive,menuprompt:astr;
    FILEBOARD:integer;
    first_time:boolean;
    ulff:file of ulfrec;
    crc:integer;
    doit:boolean;
    sortbd,doneft:boolean;
    ldat:astr;
    ix:array[1..9] of string[79];
    ymodem,ucrc,bnp:boolean;
    c1,c2,c3:integer;
    chksum:byte;
    lrn:integer;
    lfn:astr;
    all:boolean;
    ft:byte;
    ymbtt:real;
    ymodemfiles:integer;
    ymbindx:integer;
    ymbary:array[1..20] of record
      fn:string[80];
      tt:real;
    end;
    dta:string[44];
    filenamef,s1,s2,s3:astr;
    donedos,dld,d1,d2,done,abort:boolean;
    cd,cmdlist,start_dir:astr;
    returna,quitafterdone:boolean;
    answerbaud:integer;
    topheap:^byte;
    i1:astr;
    f,f1:file of byte;
    x:byte;
    lastvar:byte;

function tch(i:astr):astr;
begin
  if length(i)>2 then i:=copy(i,length(i)-1,2) else
    if length(i)=1 then i:='0'+i;
  tch:=i;
end;

function date:astr;
var reg:registers;
    m,d,y:string[4];
begin
  reg.ax:=$2a00; msdos(Dos.Registers(reg)); str(reg.cx,y); str(reg.dx mod 256,d);
  str(reg.dx shr 8,m);
  date:=tch(m)+'/'+tch(d)+'/'+tch(y);
end;

function checkpw:boolean;
begin
  checkpw:=true;
end;

procedure prompt(i:astr);
begin
  write(i);
end;

procedure print(i:astr);
begin
  writeln(i);
end;

procedure cl(i:integer);
begin
  textcolor(i);
end;

function okansi:boolean;
begin
  okansi:=true;
end;

procedure savesystat;  (* save systat *)
begin
  reset(systatf); write(systatf,systat); close(systatf);
end;

function cstr(i:integer):astr;
var c:astr;
begin
  str(i,c); cstr:=c;
end;

procedure prt(i:astr);
begin
  cl(9);
  write(i);
end;

procedure nl;
begin
  writeln;
end;

procedure onek(var c:char; ch:astr);    (* 1 Key example: onkey(c,'1234'); *)
var i1,i:astr; tf:boolean;
begin
  tf:=false;
  repeat
    c:=readkey;
    c:=upcase(c);
    tf:=true;
  until (pos(c,ch)>0);
  writeln(c);
end;


function mln(i:astr; l:integer):astr;
begin
  while length(i)<l do i:=i+' ';
  mln:=i;
end;

function mn(i,l:integer):astr;
begin
  mn:=mln(cstr(i),l);
end;

function value(I:astr):integer;
var n,n1:integer;
begin
  val(i,n,n1);
  if n1<>0 then begin
    i:=copy(i,1,n1-1);
    val(i,n,n1)
  end;
  value:=n;
  if i='' then value:=0;
end;

procedure cls;
begin
  clrscr;
end;

procedure checkhangup;
begin
end;

procedure local_input1(var i:astr; ml:integer; tf:boolean);
var cp:integer;
    cc:char;
    r:real;
begin
  cp:=1;
  repeat
    cc:=readkey;
    if not tf then cc:=upcase(cc);
    if (cc>=' ') and (cc<chr(127)) then
      if cp<=ml then begin
      i[cp]:=cc;
      cp:=cp+1;
      write(cc);
    end else else case ord(cc) of
      8:if cp>1 then begin
               cc:=chr(8);
               write(cc);write(' '); write(cc);
               cp:=cp-1;
             end;
      21,24:while cp<>1 do begin
               cp:=cp-1;
               write(#8);write(' ');write(#8);
             end;
      end;
  until (cc=#13) or (cc=#14);
  i[0]:=chr(cp-1);
  writeln;
end;

procedure getkey(c:Char);
begin
  c:=readkey;
end;

procedure local_input(var i:astr; ml:integer);  (* Input uppercase only *)
begin
  local_input1(i,ml,false);
end;

procedure local_inputl(var i:astr; ml:integer);   (* Local_Input lower & upper case *)
begin
  local_input1(i,ml,true);
end;

Procedure Tcenter(Z:Astr);
Var Y,P:Integer;
Begin
  P:=40-(length(z) div 2);
  y:=wherey;
  gotoxy(p,y);
  writeln(z);
End;

Procedure Tcenter2(Z:Astr);
Var Y,P:Integer;
Begin
  P:=40-(length(z) div 2);
  y:=wherey;
  gotoxy(p,y);
  write(z);
End;

var a:integer; s:astr;
Begin
  hangup:=false;
  assign(systatf,'status.dat');
  reset(systatf); read(systatf,systat);close(systatf);
  repeat
  window(1,1,80,25);
  clrscr;
  gotoxy(1,1);
  textbackground(1);
  cl(15);clreol;Tcenter('STATUS.DAT -- Crash Recovery By Carl Mueller');
  textbackground(0); gotoxy(1,10);
  textcolor(14);
  Writeln('<< Crash Recovery for STATUS.DAT >>');  Writeln;
  cl(15);
  Writeln('1) # of users     5) Gfiles Drive/Path');
  Writeln('2) # of callers   6) Message Drive/Path');
  Writeln('3) Com port       7) Menus drive/Path');
  Writeln('4) Maximum Baud   Q) Quit to DOS');
  cl(10); writeln;
  Write('Selection: '); cl(9);
  onek(c,'12Q34567');
  case c of
    '1':begin
          textcolor(15);
          writeln('Current number of users is ',systat.users,'.');
          textcolor(12);
          write('Please enter new number: '); textcolor(10);
          local_input(s,3);
          systat.users:=value(s);
        end;
    '2':begin
          textcolor(15);
          Writeln('Current number of callers is ',systat.callernum,'.');
          textcolor(12);
          write('Please enter new number: '); textcolor(10);
          local_input(s,5);
          systat.callernum:=value(s);
        end;
    '3':begin
          textcolor(15);
          writeln('Current comport is ',systat.comport,'.');
          textcolor(12);
          writeln('Enter new comport #: '); textcolor(10);
          local_input(s,1);
          systat.comport:=value(s);
        end;
    '4':begin
          textcolor(15);
          writeln('Maximum baud is ',systat.maxbaud,'.');
          textcolor(12);
          write('Enter new maximum baud: '); textcolor(10);
          local_input(s,4);
          systat.maxbaud:=value(s);
        end;
    '5':begin
          textcolor(15);
          writeln('Gfiles drive/path is ',systat.gfilepath,'.');
          textcolor(12);
          write('Enter new drive/path: '); textcolor(10);
          local_input(s,79);
          systat.gfilepath:=s;
        end;
    '6':begin
          textcolor(15);
          writeln('Message drive/path is ',systat.msgpath,'.');
          textcolor(12);
          write('Enter new drive/path: '); textcolor(10);
          local_input(s,79);
          systat.msgpath:=s;
        end;
     '7':begin
          textcolor(15);
          writeln('Menus drive/path is ',systat.menupath,'.');
          textcolor(12);
          write('Enter new drive/path: '); textcolor(10);
          local_input(s,79);
          systat.menupath:=s;
        end;
   end;
   until (c='Q');
   savesystat;
end.