home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WEDITS22.ZIP / WEINIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-15  |  9.8 KB  |  402 lines
  1. UNIT WEInit; {$O+}
  2. { -- This is the Initialization Module for WWIVEdit 2.2
  3.   -- Last Modified 8/15/91
  4.   -- Written By:
  5.   --   Adam Caldwell
  6.   --
  7.   -- This Code is limited Public Domain (see WWIVEDIT.PAS for details
  8.   --
  9.   -- Known Errors: None
  10.   --
  11.   -- Planned Enhancements: None
  12.   -- }
  13. {$R-,V-,S+,B-,E-,N-}   { These Optomize things as much as possible }
  14.  
  15. INTERFACE
  16.  
  17. PROCEDURE Initialize;
  18. PROCEDURE InitInfo;
  19. PROCEDURE FindTitle(VAR Title,Destination:string);
  20.  
  21.  
  22. IMPLEMENTATION
  23.  
  24. USES DOS,WEVars, WEString, WELine, WEKbd, WEOutput;
  25.  
  26. VAR
  27.   x : integer;
  28.   LastLine:integer;
  29.   sr:searchrec;
  30.   s,st: string;
  31.   ch, rs, re : char;
  32.  
  33. FUNCTION StripChar(VAR s:string):char;
  34. VAR s1:string;
  35. BEGIN
  36.   IF s[1]='#' THEN BEGIN
  37.     delete(s,1,1);
  38.     s1:='';
  39.     WHILE (s<>'') AND (s[1] IN ['0'..'9']) DO
  40.     BEGIN
  41.       s1:=s1+s[1];
  42.       delete(s,1,1);
  43.     END;
  44.     StripChar:=chr(value(s1));
  45.   END ELSE BEGIN
  46.     StripChar:=s[1];
  47.     delete(s,1,1);
  48.   END;
  49. END;
  50.  
  51.  
  52. PROCEDURE Initialize;
  53. BEGIN
  54.   UserNum:=0;
  55.   ParameterFileName:='CHAIN.TXT';
  56.   translate:=LeftS(GetEnv('BBS'),4)<>'WWIV';
  57.   InDos := Translate;
  58.   {$V-}
  59.   Fsplit(ParamStr(0),StartupDir,st,st);
  60.   {$V+}
  61.  
  62.   FillChar(info,SizeOf(Info),0);
  63.   Info.Tagline[1] := '';
  64.   Info.Tagline[2] := '';
  65.   info.Tagline[3] := '';
  66.   IgnoreName:=False;
  67.   assign(InfoFile,StartupDir+'TAGLINES.CMN');
  68.   AllowTitleChange:=False;
  69.   CurrentColor:='0';
  70.   AfterNext:=DoNothing;
  71.   BeforeNext:=DoNothing;
  72.   BlockStart:=0;
  73.   BlockEnd:=0;
  74.   LineLen:=79;
  75.   SearchString:=#1#2#3#4;
  76.   SearchOps:='';
  77.  
  78.   FileName:=ParamStr(1);
  79.  
  80.   LineLen:=value(ParamStr(2));
  81.   IF LineLen>79 THEN LineLen:=79;
  82.   IF LineLen=0 THEN LineLen:=79;
  83.  
  84.   ScreenHeight:=value(ParamStr(3));
  85.   IF (screenHeight<30) AND (ScreenHeight>25) THEN ScreenHeight:=25;
  86.   IF ScreenHeight=0 THEN ScreenHeight:=ScreenSize DIV 160;
  87.  
  88.   MaxLines:=value(ParamStr(4));
  89.   IF MaxLines>AbsoluteMaxLines THEN MaxLines:=AbsoluteMaxLines-1;
  90.   IF MaxLines>250 Then MaxLines:=AbsoluteMaxLines-1;
  91.   IF MaxLines=0 THEN MaxLines:=AbsoluteMaxLines-1;
  92.  
  93.   Local:=False;
  94.   OkTagLines := False;
  95.   AddBBSTag:=False;
  96.   AddSL:=30;
  97.   ColorRangeCheck := FALSE;
  98.   MCICommands:=FALSE;
  99.   KeyBIOS:=FALSE;
  100.   NoColor:=FALSE;
  101.   ForceAnsi:=FALSE;
  102.   FOR ch:=#0 TO #255 DO
  103.     IF ch IN ['0'..'7'] THEN CMap[ch]:=TRUE ELSE CMap[ch]:=FALSE;
  104.   FOR x:=1 TO ParamCount DO
  105.   BEGIN
  106.     s:=TransformString(ParamStr(x));
  107.     NoColor:=NoColor OR (cmpLeft(s,'/NOCOLOR'));
  108.     ForceAnsi:=ForceAnsi OR (cmpLeft(s,'/ANSI'));
  109.     Local:=Local OR cmpLeft(s,'/L');
  110.     OkTagLines:=OkTagLines OR cmpLeft(s,'/T');
  111.     AddBBSTag:=AddBBSTag OR cmpLeft(s,'/A');
  112.     MCICommands:=MCICommands OR cmpLeft(s,'/MCI');
  113.     KeyBIOS:=KeyBIOS OR cmpLeft(s,'/K');
  114.     IF cmpLeft(s,'/D:') THEN BEGIN
  115.       st:=Paramstr(x);
  116.       delete(st,1,3);
  117.       st:='#'+st;
  118.       AddSL:=ord(stripchar(st));
  119.     END;
  120.     IF cmpLeft(s,'/C:') THEN BEGIN
  121.       st:=ParamStr(x);
  122.       delete(st,1,3);
  123.       WHILE st<>'' DO
  124.       BEGIN
  125.         rs:=StripChar(st);
  126.         IF st[1]='-' THEN BEGIN
  127.           delete(st,1,1);
  128.           re:=StripChar(st)
  129.         END
  130.         ELSE
  131.           re:=rs;
  132.         FOR ch:=rs TO re DO
  133.           Cmap[ch]:=TRUE;
  134.         IF (st<>'') AND (st[1]=',') THEN
  135.           delete(st,1,1);
  136.       END;
  137.     END
  138.     ELSE ColorRangeCheck := ColorRangeCheck OR cmpLeft(s,'/C');
  139.   END;
  140.   OkTagLines := NOT OkTagLines; { By default, taglines are on. /T turns them off }
  141.   AddBBSTag := NOT AddBBSTag;   { Default Tagline is on }
  142.   ColorRangeCheck := NOT ColorRangeCheck; { default Range check is on }
  143.   KeyBIOS:=NOT KeyBIOS;  { Default is use the BIOS }
  144.   IF NOT ColorRangeCheck THEN
  145.     FOR ch:=#0 TO #255 DO
  146.       Cmap[ch]:=TRUE;
  147.  
  148.   IF Not Local THEN Local:=GetEnv('BBS')='';
  149.   IF Local THEN MaxLines:=AbsoluteMaxLines-1;
  150.  
  151.   cx:=1; cy:=1;
  152.   WindowTop := 5; ViewTop := cy;
  153.   WindowBottom := ScreenHeight-4;
  154.   WindowHeight := WindowBottom-WindowTop;
  155.   ViewBottom   := ViewTop + WindowHeight;
  156.  
  157.   new(Line[0]);
  158.   InitLine(Line[0]^);
  159.   LastLine:=0;
  160.   FOR x:=1 TO MaxLines+1 DO
  161.   IF MaxAvail> 2*sizeof(Linetype) THEN
  162.   BEGIN
  163.     new(Line[x]);
  164.     Line[x]^:=Line[0]^;
  165.   END
  166.   ELSE IF LastLine=0 THEN LastLine:=x-1;
  167.   IF LastLine>0 THEN MaxLines:=LastLine;
  168.   FOR x:=1 TO MaxPhyLines DO
  169.     initline(screen[x]);
  170.   InsertMode:=True;
  171.  
  172.   findfirst(StartupDir+'WWIVEDIT.KEY',0,sr); { Check if file exists }
  173.   OkLocalMacros:=DosError=0;
  174.   findfirst(StartupDir+'MACROS.LCL',0,sr);   { Check if file exists }
  175.   OkLocalMacros:=OkLocalMacros AND (dosError=0);
  176.   assign(transtable,StartupDir+'WWIVEDIT.KEY');
  177.   findfirst(StartupDir+'BBS*.TAG',0,sr);     { check if file exists }
  178.   AddBBSTag:=AddBBSTag AND (dosError=0);
  179.   FindFirst(FileName,0,sr);
  180.   FileThere:=DosError=0;
  181.   IF CmpLeftI(Filename,'BBS') AND
  182.      (RightS(TransformString(FileName),4)='.TAG') THEN
  183.     FileThere:=TRUE;
  184.   ScreenState:=0;
  185. END; { Initialize }
  186.  
  187. PROCEDURE iport;
  188. VAR
  189.   f : text;
  190.   i : string;
  191.   s : string;
  192.   n : integer;
  193.  
  194. BEGIN
  195.   IF InDos THEN
  196.   BEGIN
  197.     UserNum:=1;
  198.     thisuser.name:='';
  199.     thisuser.realname:='';
  200.     thisuser.sl:=255;
  201.     incom:=FALSE;
  202.     Local:=True;
  203.     TrueKeyboard:=True;
  204.   END
  205.   ELSE
  206.   BEGIN
  207.     assign(f,ParameterFileName);
  208.     {$I-} reset(f); {$I+}
  209.     IF IOResult<>0 THEN BEGIN
  210.       assign(f,StartupDir+ParameterFileName);
  211.       {$I-} reset(f); {$I+}
  212.     END;
  213.     IF IOResult = 0 THEN BEGIN
  214.       Drain;
  215.       readln(f,usernum);
  216.       readln(f,thisuser.name);
  217.       readln(f,thisuser.realname);
  218.       readln(f);
  219.       readln(f);
  220.       readln(f);
  221.       readln(f);
  222.       Drain;
  223.       readln(f);
  224.       readln(f);
  225.       readln(f);
  226.       readln(f,thisuser.sl);
  227.       readln(f);
  228.       readln(f);
  229.       readln(f);
  230.       readln(f,n);
  231.       incom  :=  (n = 1);
  232.       Drain;
  233.       close(f);
  234.     END
  235.     ELSE BEGIN
  236.       writeln('Could not find CHAIN.TXT.');
  237.       halt;
  238.     END;
  239.   END;
  240. END;
  241.  
  242. PROCEDURE InitInfo;
  243. VAR
  244.   i :integer;
  245. BEGIN
  246.   Randomize;
  247.   IF UserNum=0 THEN
  248.   BEGIN
  249.     IPort;
  250.     IF InCom AND Local THEN BEGIN
  251.       UserNum:=1;
  252.       ThisUser.sl:=255;
  253.       ThisUser.Name:='';
  254.       IgnoreName:=true;
  255.     END;
  256.   END;
  257.   {$I-} reset(InfoFile); {$I+}
  258.   IF IOResult<>0 THEN rewrite(InfoFile);
  259.   seek(InfoFile,usernum);
  260.   {$I-} read(InfoFile,Info); {$I+}
  261.   IF ((IOResult<>0) OR (ThisUser.RealName<>Info.UserName)) AND (NOT IgnoreName) THEN BEGIN
  262.     IF FileSize(InfoFile)<userNum THEN
  263.     BEGIN
  264.       fillchar(info,sizeof(inforec),0);
  265.       info.UserName:='No Name';
  266.       seek(InfoFile,FileSize(InfoFile));
  267.       FOR i:=FileSize(InfoFile) TO usernum-1 DO
  268.         write(InfoFile,Info);
  269.     END;
  270.     seek(InfoFile,usernum);
  271.     info.UserName:=ThisUser.RealName;
  272.     write(InfoFile,Info);
  273.   END;
  274.   Drain;
  275.   close(InfoFile);
  276.   i:=0;
  277.   IF info.method=6 THEN
  278.     info.method:=info.selected;
  279.   IF info.method=4 THEN
  280.   REPEAT
  281.     inc(info.selected);
  282.     IF info.selected>3 THEN info.selected:=1;
  283.     inc(i);
  284.   UNTIL (i>3) OR (info.tagline[info.selected]<>'')
  285.   ELSE WITH info DO
  286.     IF (method=5) AND ((Tagline[1]<>'') OR (Tagline[2]<>'') OR (Tagline[3]<>''))  THEN
  287.     REPEAT
  288.       selected:=random(3)+1;
  289.     UNTIL Tagline[selected]<>'';
  290. END;
  291.  
  292. TYPE
  293.   Buffer = ARRAY[1..25] OF String[80];
  294.  
  295. VAR
  296.   b:buffer;
  297.  
  298. PROCEDURE StripEndC(VAR s:string; ch:char);
  299. VAR
  300.   i:integer;
  301. BEGIN
  302.   i:=length(s);
  303.   WHILE (i>1) AND (s[i]<>ch) DO
  304.     dec(i);
  305.   Delete(s,i,length(s)-i+1);
  306. END;
  307.  
  308.  
  309. PROCEDURE FindTitle(VAR Title,Destination:string);
  310. VAR
  311.   i:integer;
  312.   t:text;
  313.   D: DirStr;
  314.   N: NameStr;
  315.   E: ExtStr;
  316. BEGIN
  317.   IF NOT InDos THEN
  318.   BEGIN
  319.     assign(t,'EDITOR.INF');
  320.     {$I-} reset(t); {$I+}
  321.     IF IOResult<>0 THEN
  322.     BEGIN
  323.       Title:='';
  324.       Destination:='';
  325.       FOR i:=1 TO 25 DO
  326.         b[i]:='';
  327.       {$V-}
  328.       FOR i:=1 TO WhereY-1 DO
  329.       BEGIN
  330.         Drain;
  331.         ReadScreen(B[i],1,wherey-i);
  332.         StripEndString(B[i]);
  333.       END;
  334.       {$V+}
  335.       FOR i:=25 DOWNTO 1 DO
  336.       BEGIN
  337.         IF CmpLeft(b[i],'Title') THEN title:=b[i];
  338.         IF cmpLeft(b[i],'E-mail') OR
  339.            cmpLeft(b[i],'Post')   OR
  340.            cmpLeft(b[i],'Multi')  OR
  341.            cmpLeft(b[i],'File')   OR
  342.            cmpLeft(b[i],'[')      OR
  343.            cmpLeft(b[i],'<')
  344.         THEN
  345.           Destination:=b[i];
  346.       END;
  347.       IF cmpLeft(Destination,'<') THEN
  348.       BEGIN
  349.         StripEndC(Destination,'>');
  350.         Delete(destination,1,1);
  351.         Destination:='E-mailing '+Destination;  { cheap trick }
  352.       END;
  353.       IF title='' THEN Title:=b[1];
  354.       IF cmpLeft(title,'Title') THEN delete(title,1,7);
  355.       IF      cmpLeft(Destination,'E-mail') THEN delete(Destination,1,10)
  356.       ELSE IF cmpLeft(Destination,'Multi')  THEN Destination:='Multi-Mail'
  357.       ELSE IF cmpLeft(Destination,'Post')   THEN
  358.            BEGIN
  359.              delete(Destination,1,8);
  360.              StripEndC(Destination,'?');
  361.            END
  362.       ELSE IF cmpLeft(Destination,'File')   THEN
  363.            BEGIN
  364.              delete(Destination,1,10);
  365.              Title:='Text File';
  366.            END
  367.       ELSE IF cmpLeft(Destination,'[') THEN
  368.            BEGIN
  369.              StripEndC(Destination,']');
  370.              delete(Destination,1,1);
  371.              i:=pos('[',Destination);
  372.              IF i>0 THEN delete(Destination,1,i);
  373.            END
  374.       ELSE Destination:='Message Base';
  375.     END
  376.     ELSE BEGIN
  377.       Drain;
  378.       readln(t,title);
  379.       readln(t,Destination);
  380.       readln(t,usernum);
  381.       readln(t,thisuser.name);
  382.       readln(t,thisuser.realname);
  383.       readln(t,thisuser.sl);
  384.       Drain;
  385.       close(t);
  386.       AllowTitleChange:=True;
  387.     END;
  388.   END ELSE
  389.   BEGIN
  390.     FSplit(TransformString(ParamStr(1)),D,N,E);
  391.     Title:=N+E;
  392.     IF D='' THEN
  393.       getdir(0,d);
  394.     Destination:=d;
  395.     IF Title='' THEN BEGIN
  396.       writeln('Error!  Need a Filename to startup.');
  397.       halt;
  398.     END;
  399.   END;
  400. END;
  401.  
  402. END.