home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / BBS / FDVP_092.ZIP / freedoor.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-25  |  17.8 KB  |  649 lines
  1. unit freedoor;
  2.  
  3. {
  4.         FreeDoor 0.9.2
  5.         Virtual Pascal Release
  6.         Creation Date: 07/25/2000
  7.         (C)opyright 2000, Mike Hodgson
  8.  
  9.         Revision History
  10.  
  11.         02.     Entire system re-written from scratch!
  12.                 *(excludes ANS unit and status bar code)
  13.                 Added support for door32.sys format
  14.                 Status bar code is really ugly, rewriting
  15.                 for revision 3.
  16.  
  17.         01.     initial version
  18.  
  19.         COMMAND LINE PARAMETERS
  20.  
  21.         doorname.exe /L                               -- for local mode
  22.         doorname.exe /Dc:\path\to\door.sys /P#        -- for normal FOSSIL mode, # = port number
  23.         doorname.exe /Dc:\path\to\door.sys /T /P#     -- Telnet mode, # = port handle
  24.  
  25.         NOTE: I have NO idea if CEXYZ_Send works, it is un-tested.
  26. }
  27.  
  28.  
  29. interface
  30.  
  31. uses Use32, crt, dos, sysutils, ans, extra, elenorm;
  32.  
  33. {$I FREEDOOR.INC}
  34.  
  35. function InitDoorDriver : boolean;
  36. Procedure DeInitDoorDriver;
  37. Procedure CClrScr;
  38. Procedure CClrEol;
  39. Procedure CursorSave;
  40. Procedure CursorRestore;
  41. Procedure CursorUp (Distance : Integer);
  42. Procedure CursorDown (Distance : Integer);
  43. Procedure CursorBack (Distance : Integer);
  44. Procedure CursorForward (Distance : Integer);
  45. Procedure CGotoXY (X,Y : Integer);
  46. Procedure ErrorWriteLn (S : String); {Prints message w/o calling statbar }
  47. Procedure CWriteLn (S : String);
  48. Procedure CWrite (S : String);
  49. Procedure CGetChar (var Ch: Char);  { From Manning's MDoor kit! }
  50. Procedure CReadLn (var S: String);  { From Manning's MDoor kit! }
  51. Procedure CWriteLong (I : LongInt);
  52. Procedure CGetByte (var B: Byte);
  53. Procedure CWriteLnLong (I : LongInt);
  54. Procedure CReadLnLong (var L: LongInt);
  55. Procedure CPause;
  56. Procedure CWriteFile (FN : String);
  57. Function CMaskInput (mask : String; StrLength : Byte) : String;
  58. Procedure CWindow (X1,Y1,X2,Y2 : Integer);
  59. Function CEXYZSend (FN : String) : Boolean;
  60.  
  61. implementation
  62.  
  63. (*************************************************************)
  64.  Procedure LocalLogin;
  65. (*************************************************************)
  66. var
  67.   tempusername : String;
  68. begin
  69.   clrscr;
  70.   textcolor(7);
  71.   textbackground(0);
  72.   WriteLn ('Enter your name or leave blank for SYSOP');
  73.   Write (':: ');
  74.   TextColor(15);
  75.   ReadLn (tempusername);
  76.   If (tempusername <> '') then UserInfo.RealName := tempusername;
  77.   UserInfo.Handle := UserInfo.RealName;
  78.   TextColor(7);
  79. end;
  80.  
  81. (*************************************************************)
  82.  function ReadDropFile (DropPath : String) : Boolean;
  83. (*************************************************************)
  84. var
  85.   f : text;           { Dropfile file variable }
  86.   s : string;         { Temporary String }
  87.   i : LongInt;        { Temporary Integer }
  88. begin
  89.   assign (f,DropPath);
  90.   if not (FileExists(DropPath)) then
  91.   begin
  92.     WriteLn ('ReadDropFile :: ERROR :: DropFile not found!');
  93.     ReadDropFile := False;
  94.   end
  95.   else
  96.   begin
  97.     reset(f);
  98.     UserInfo.DropFile := DropPath;
  99.     if (UserInfo.DropType = 1) then
  100.     begin
  101.       readln (f,s);
  102.       delete (s,1,3);
  103.       delete (s,2,1);
  104.       val(s,UserInfo.ComPort,i);
  105.       if UserInfo.ComPort <> 0 then UserInfo.ConnType := 1;
  106.       readln(f,s); { remote baud rate}
  107.       val(s,UserInfo.Baud,i);
  108.       readln(f,s); {dbits}
  109.       readln(f,s); {node num}
  110.       UserInfo.Node := s;
  111.       readln(f,s); {actual internal bbs}
  112.       readln(f,s); {screen on}
  113.       readln(f,s); {printer}
  114.       readln(f,s); {page bell}
  115.       readln(f,s); {caller bell}
  116.       readln(f,s); {user name}
  117.       UserInfo.RealName := s;
  118.       UserInfo.Handle := UserInfo.RealName;
  119.       readln(f,s); {city,state}
  120.       UserInfo.CityState := s;
  121.       readln(f,s); {home phone}
  122.       readln(f,s); {work phone}
  123.       readln(f,s); {password}
  124.       readln(f,s); {security}
  125.       val(s,UserInfo.ACS,i);
  126.       readln(f,s); {times on}
  127.       readln(f,s); {last called}
  128.       readln(f,s); {secs left}
  129.       readln(f,s); {time left}
  130.       val(s,UserInfo.TimeLeft,i);
  131.       UserInfo.TotalTime := UserInfo.TimeLeft;
  132.       readln(f,s); {graphics code}
  133.       if s='GR' then UserInfo.GraphMode:=ANSI_GRAPH
  134.       else if s='RIP' then UserInfo.GraphMode:=RIP_GRAPH
  135.       else UserInfo.GraphMode:=ASCII_GRAPH;
  136.       close(f);
  137.     end
  138.     else if (UserInfo.DropType = 2) then
  139.     begin
  140.       readln (f,s);
  141.       val(s,UserInfo.ConnType,i);
  142.       readln (f,s);
  143.       val(s,UserInfo.ComPort,i);
  144.       readln (f,s);
  145.       val(s,UserInfo.Baud,i);
  146.       readln (f,s);
  147.       UserInfo.BBSID := s;
  148.       readln (f,s);
  149.       val(s,UserInfo.RecPos,i);
  150.       readln (f,s);
  151.       UserInfo.RealName := s;
  152.       readln (f,s);
  153.       UserInfo.Handle := s;
  154.       readln (f,s);
  155.       val(s,UserInfo.ACS,i);
  156.       readln (f,s);
  157.       val(s,UserInfo.TimeLeft,i);
  158.       UserInfo.TotalTime := UserInfo.TimeLeft;
  159.       readln (f,s);
  160.       val (s,UserInfo.GraphMode,i);
  161.       readln (f,s);
  162.       UserInfo.Node := s;
  163.       close(f);
  164.     end;
  165.   end;
  166. end;
  167.  
  168. (*************************************************************)
  169.  function tl: word;
  170. (*************************************************************)
  171. var
  172.    hour, minute, second, sec100: LongInt;
  173.    el_hr, el_mn, el_sc: LongInt;
  174. begin;
  175.   gettime(hour, minute, second, sec100);
  176.   elapsed(hour, minute, second, STime.hours, STime.minutes, STime.sec, el_hr, el_mn, el_sc);
  177.   UserInfo.TimeLeft := UserInfo.TotalTime - ((el_hr*60)+el_mn);
  178.   tl := UserInfo.TimeLeft;
  179. end;
  180.  
  181. (*************************************************************)
  182.  procedure UpdateStatusBar;
  183. (*************************************************************)
  184. var
  185.   c,d: word;
  186.   x,y: integer;
  187.   hour, minute, second, sec100, el_mn, el_hr, el_sc: LongInt;
  188. begin
  189.   x:=wherex;
  190.   y:=wherey;
  191.   window(1,25,80,25);
  192.   textcolor(15);
  193.   textbackground(1);
  194.   if (FirstTime = True) then
  195.   begin
  196.     clreol;
  197.     gotoxy(1,1);
  198.     write(UserInfo.RealName);
  199.     LastTime := 30000;
  200.     FirstTime := False;
  201.   end;
  202.   gettime(hour,minute,second,sec100);
  203.   elapsed(hour,minute,second,STime.hours,STime.minutes,STime.sec,el_hr,el_mn,el_sc);
  204.   c:=(UserInfo.TimeLeft-1) - ((el_hr*60)+el_mn);
  205.   d:=60-el_sc;
  206.   if ((c -1 = -1) and (d-1 = 0)) then
  207.     begin
  208.       textcolor(7);
  209.       textbackground(0);
  210.       window(1,1,80,25-1);
  211.       gotoxy(x,y);
  212.       ErrorWriteLn('`0CTime limit exceeded');
  213.       delay(1);
  214.       halt(0);
  215.     end;
  216.     if d <= (LastTime - 5) then
  217.     begin
  218.       gotoxy(74,1);
  219.       write ('     ');
  220.       gotoxy(74,1);
  221.       write(c,':');
  222.       if d<10 then write('0');
  223.       write(d);
  224.       LastTime:=d;
  225.     end;
  226.     textcolor(7);
  227.     textbackground(0);
  228.     window(1,1,80,25-1);
  229.     gotoxy(x,y);
  230. end;
  231.  
  232. (*************************************************************)
  233.  function InitDoorDriver : boolean;
  234. (*************************************************************)
  235. var
  236.   TempInt  : LongInt;
  237.   TempStr  : String;
  238.   Code     : LongInt;
  239. begin
  240.   cursoroff;
  241.   UserInfo.ConnType := 0;
  242.   UserInfo.BBSID := 'Unknown';
  243.   UserInfo.Handle := 'Sysop';
  244.   UserInfo.RealName := 'Sysop';
  245.   UserInfo.CityState := 'Somewheresville';
  246.   UserInfo.ACS := 255;
  247.   UserInfo.TimeLeft := 3000;
  248.   UserInfo.TotalTime := 3000;
  249.   UserInfo.ComPort := 0;
  250.   UserInfo.Baud := 0;
  251.   UserInfo.Node := '0';
  252.   UserInfo.Graphmode := ANSI_GRAPH;
  253.   UserInfo.DropFile := '';
  254.   UserInfo.DropType := 0;
  255.   if (ParamCount = 0) then
  256.   begin
  257.     writeln ('InitDoorDriver :: ERROR :: You didn''t tell me what to do!');
  258.     writeln ('Exiting.');
  259.     InitDoorDriver := False;
  260.   end
  261.   else
  262.   begin
  263.     for TempInt := 1 to ParamCount do
  264.       begin
  265.         if (UpperCase(ParamStr(TempInt)) = '/L') then          {Local Only?}
  266.           isLocal := True;
  267.         if (pos('/D',UpperCase(ParamStr(TempInt))) <> 0) then  {Read Dropfile!}
  268.           begin
  269.             TempStr := '';
  270.             TempStr := ParamStr(TempInt);
  271.             delete(TempStr,1,2);
  272.             if (pos('DOOR.SYS',UpperCase(TempStr)) <> 0) then UserInfo.DropType := 1 else
  273.               if (pos('DOOR32.SYS',UpperCase(TempStr)) <> 0) then UserInfo.DropType := 2 else UserInfo.DropType := 0;
  274.             ReadDropFile (TempStr);
  275.           end;
  276.         if (pos('/T',UpperCase(ParamStr(TempInt))) <> 0) then UserInfo.ConnType := 02;
  277.         if (pos('/P',UpperCase(ParamStr(TempInt))) <> 0) then
  278.           begin
  279.             TempStr := '';
  280.             TempStr := ParamStr(TempInt);
  281.             delete (TempStr,1,2);
  282.             val(TempStr,UserInfo.ComPort,Code);
  283.           end;
  284.       end;
  285.     if (UserInfo.ConnType = 0) or (UserInfo.ComPort = 0) then isLocal := True;
  286.     if (not isLocal) then
  287.     begin
  288.       Com_StartUp(UserInfo.ConnType);
  289.       Com_SetDontClose(True);
  290.       Com_OpenQuick(UserInfo.ComPort);
  291.       Com_SendString(#27 + '[0;37m');
  292.     end;
  293.     if ((isLocal) and (UserInfo.DropType = 0)) then LocalLogin;
  294.     GetTime (STime.Hours,STime.Minutes,STime.Sec,STime.MSec);
  295.     UpdateStatusBar;
  296.     CWrite(#27 + '[0;37m');
  297.     InitDoorDriver := True;
  298.   end;
  299. end;
  300.  
  301. (*************************************************************)
  302.  Procedure DeInitDoorDriver;
  303. (*************************************************************)
  304. begin
  305.   cursoron;
  306.   if (not isLocal) then Com_Shutdown;
  307. end;
  308.  
  309. (*************************************************************)
  310.  Procedure CClrScr;
  311. (*************************************************************)
  312. begin
  313.   if (not isLocal) then
  314.     Com_SendString(#27 + '[2J');
  315.   ClrScr;
  316. end;
  317.  
  318. (*************************************************************)
  319.  Procedure CClrEol;
  320. (*************************************************************)
  321. begin
  322.   if (not isLocal) then
  323.     Com_SendString(#27 + '[K');
  324.   ClrEol;
  325. end;
  326.  
  327. (*************************************************************)
  328.  Procedure CursorSave;
  329. (*************************************************************)
  330. Begin
  331.   CWrite (#27 + '[s');
  332. End;
  333.  
  334. (*************************************************************)
  335.  Procedure CursorRestore;
  336. (*************************************************************)
  337. Begin
  338.   CWrite (#27 + '[u');
  339. End;
  340.  
  341. (*************************************************************)
  342.  Procedure CursorUp (Distance : Integer);
  343. (*************************************************************)
  344. Var
  345.   DummyVal : String;
  346. Begin
  347.   Str (Distance, DummyVal);
  348.   CWrite (#27 + '[' + DummyVal + 'A');
  349. End;
  350.  
  351. (*************************************************************)
  352.  Procedure CursorDown (Distance : Integer);
  353. (*************************************************************)
  354. Var
  355.   DummyVal : String;
  356. Begin
  357.   Str (Distance, DummyVal);
  358.   CWrite (#27 + '[' + DummyVal + 'B');
  359. End;
  360.  
  361. (*************************************************************)
  362.  Procedure CursorBack (Distance : Integer);
  363. (*************************************************************)
  364. Var
  365.   DummyVal : String;
  366. Begin
  367.   Str (Distance, DummyVal);
  368.   CWrite (#27 + '[' + DummyVal + 'D');
  369. End;
  370.  
  371. (*************************************************************)
  372.  Procedure CursorForward (Distance : Integer);
  373. (*************************************************************)
  374. Var
  375.   DummyVal : String;
  376. Begin
  377.   Str (Distance, DummyVal);
  378.   CWrite (#27 + '[' + DummyVal + 'C');
  379. End;
  380.  
  381. (*************************************************************)
  382.  Procedure CGotoXY (X,Y : Integer);
  383. (*************************************************************)
  384. var
  385.   TempX : String;
  386.   TempY : String;
  387. begin
  388.   Str(X,TempX);
  389.   Str(Y,TempY);
  390.   CWrite (#27 + '[' + TempY + ';' + TempX + 'H');
  391. end;
  392.  
  393. (*************************************************************)
  394.  Procedure ErrorWriteLn (S : String); {Prints message w/o calling statbar }
  395. (*************************************************************)
  396. begin
  397.   if not (isLocal) then
  398.     Com_SendString(S + #10#13);
  399.   WriteLn (S);
  400. end;
  401.  
  402. (*************************************************************)
  403.  Procedure CWrite (S : String);
  404. (*************************************************************)
  405. begin
  406.   if (pos('`',S) <> 0) then Convert_To_ANSI(S);
  407.   if (not isLocal) then
  408.     Com_SendString(S);
  409.   AnsiWriteN (S);
  410.   UpdateStatusBar;
  411. end;
  412.  
  413. (*************************************************************)
  414.  Procedure CWriteLn (S : String);
  415. (*************************************************************)
  416. begin
  417.   CWrite(S + #10#13);
  418. end;
  419.  
  420. (*************************************************************)
  421.   Procedure CWriteLnLong (I : LongInt);
  422. (*************************************************************)
  423. var
  424.   S : String;
  425. begin
  426.   str(I,S);
  427.   CWrite (S + #10#13);
  428. end;
  429.  
  430. (*************************************************************)
  431.   Procedure CWriteLong (I : LongInt);
  432. (*************************************************************)
  433. var
  434.   S : String;
  435. begin
  436.   str(I,S);
  437.   CWrite (S);
  438. end;
  439.  
  440. (*************************************************************)
  441.  Procedure CGetChar (var Ch : Char);  { From Manning's MDoor kit! }
  442. (*************************************************************)
  443. begin
  444.      Ch := #0;
  445.      if (isLocal) then
  446.      begin
  447.           repeat
  448.                 if (KeyPressed) then
  449.                    Ch := ReadKey;
  450.                 if Not(isLocal) then
  451.                 begin
  452.                      if (Com_CharAvail) then
  453.                         Ch := Com_GetChar;
  454.                 end;
  455.           UpdateStatusBar;
  456.           until (Ch <> #0);
  457.      end else
  458.      begin
  459.           repeat
  460.                 if (KeyPressed) then
  461.                    Ch := ReadKey;
  462.                 if Not(isLocal) then
  463.                 begin
  464.                      if (Com_CharAvail) then
  465.                         Ch := Com_GetChar;
  466.                 end;
  467.           UpdateStatusBar;
  468.           until (Ch <> #0) or (Not(Com_Carrier));
  469.      end;
  470. end;
  471.  
  472. (*************************************************************)
  473.   Procedure CGetByte (var B : Byte);
  474. (*************************************************************)
  475. var
  476.   C : Char;
  477.   Code : LongInt;
  478. begin
  479.   CGetChar(C);
  480.   val (C,B,Code);
  481. end;
  482.  
  483. (*************************************************************)
  484.  Procedure CReadLn (var S: String);  { From Manning's MDoor kit! }
  485. (*************************************************************)
  486. var
  487.    Ch: Char;
  488. begin
  489.      S := '';
  490.      Ch := #0;
  491.      if (isLocal) then
  492.      begin
  493.           repeat
  494.                 CGetChar(Ch);
  495.                 CWrite(Ch);
  496.                 if (Ch <> #13) and (Ch <> #10) then
  497.                    S := S + Ch;
  498.           until (Ch = #13);
  499.      end else
  500.      begin
  501.           repeat
  502.                 CGetChar(Ch);
  503.                 CWrite(Ch);
  504.                 if (Ch <> #13) and (Ch <> #10) then
  505.                    S := S + Ch;
  506.           until (Ch = #13) or (Not(Com_Carrier));
  507.      end;
  508.      if Not(isLocal) then
  509.         Com_SendChar(#10);
  510.      WriteLn;
  511. end;
  512.  
  513. (*************************************************************)
  514.   Procedure CReadLnLong (var L : LongInt);
  515. (*************************************************************)
  516. var
  517.   S : String;
  518.   Code : LongInt;
  519. begin
  520.   CReadLn(S);
  521.   val (S,L,Code);
  522. end;
  523.  
  524. (*************************************************************)
  525.  Procedure CPause;
  526. (*************************************************************)
  527. var
  528.   C : Char;
  529. begin
  530.   CWriteLn ('');
  531.   CWrite (PAUSE_STRING);
  532.   CGetChar(C);
  533. end;
  534.  
  535. (*************************************************************)
  536.  Procedure CWriteFile (FN : String);
  537. (*************************************************************)
  538. var
  539.   f: text;
  540.   c: char;
  541. begin
  542.   if not (FileExists(FN)) then
  543.     CWriteLn ('`0A*** FILE ' + FN + ' NOT FOUND ***')
  544.   else
  545.   begin
  546.     repeat
  547.       Read (f,c);
  548.       CWrite (c);
  549.     until (EOF(f));
  550.     close (f);
  551.   end;
  552. end;
  553.  
  554. (*************************************************************)
  555.  Function CMaskInput (mask : String; StrLength : Byte) : String;
  556. (*************************************************************)
  557. Var
  558.   ch : Char;
  559.   DummyByte : Byte;
  560.   s : String;
  561. begin
  562.  s:='';
  563.  CWrite ('`1F');
  564.  For DummyByte := 1 to StrLength + 2 do CWrite (' ');
  565.  CursorBack (StrLength + 1);
  566.  if s<>'' then CWrite(s) else begin;
  567.   repeat;
  568.    CGetChar(ch);
  569.    if (ch<>#8) and (ch<>^M) and (Pos(UpCase(Ch), mask) = 0) and (length(s) < StrLength) then begin;
  570.     s:=s+ch;
  571.     CWrite(ch);
  572.    end;
  573.    if (ch=chr(8)) and (length(s)>0) then begin;
  574.     delete(s,length(s),1);
  575.     CWrite(chr(8)+' '+chr(8));
  576.    end;
  577.   until (ch=^M);
  578.  end;
  579.  CWriteln('');
  580.  CMaskInput := s;
  581. end;
  582.  
  583. (*************************************************************)
  584.  Procedure CWindow (X1,Y1,X2,Y2 : Integer);
  585. (*************************************************************)
  586. var
  587.   TempInt : Integer;
  588.   StoredX : Integer;
  589.   StoredY : Integer;
  590. begin
  591.   StoredX := WhereX;
  592.   StoredY := WhereY;
  593.   CGotoXY (X1,Y1);
  594.   CWrite ('┌');
  595.   for TempInt := (X1 + 1) to (X2 - 1) do
  596.     CWrite ('─');
  597.   CWrite ('┐');
  598.   for TempInt := (Y1 + 1) to (Y2 - 1) do
  599.   begin
  600.     CGotoXY(X2,TempInt);
  601.     CWrite ('│');
  602.   end;
  603.   CGotoXY (X1,Y2);
  604.   CWrite ('└');
  605.   for TempInt := (X1 + 1) to (X2 - 1) do
  606.     CWrite ('─');
  607.   CWrite ('┘');
  608.   for TempInt := (Y1 + 1) to (Y2 - 1) do
  609.   begin
  610.     CGotoXY(X1,TempInt);
  611.     CWrite ('│');
  612.   end;
  613.   CGotoXY(StoredX,StoredY);
  614. end;
  615.  
  616. (*************************************************************)
  617.  Function CEXYZSend (FN : String) : Boolean;
  618. (*************************************************************)
  619. var
  620.   BaudStr : String;
  621.   PortStr : String;
  622. begin
  623.   if isLocal then
  624.   begin
  625.     CWriteLn ('`0DCannot send file, door is running in local only mode.');
  626.   end
  627.   else
  628.   begin
  629.     Str(UserInfo.Baud,BaudStr);
  630.     Str(UserInfo.ComPort,PortStr);
  631.     SwapVectors;
  632.     Exec ('CEXYZ.EXE',' /l' + BaudStr + ' /b' + BaudStr + ' /p' + PortStr + ' sz ' + FN);
  633.     SwapVectors;
  634.     if (DOSError <> 0) then
  635.     begin
  636.       CWriteLn ('`0DError sending file ' + FN);
  637.       CEXYZSend := False;
  638.     end
  639.     else
  640.     begin
  641.       CWriteLn ('`0DFile ' + FN + ' sent.');
  642.       CEXYZSend := True;
  643.     end;
  644.   end;
  645. end;
  646.  
  647. begin
  648. end.
  649.