home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / XTALK1.ZIP / LEARN.XWS < prev    next >
Encoding:
Text File  |  1990-04-30  |  14.8 KB  |  490 lines
  1. /*
  2.     Crosstalk for Windows "Learn to Login"
  3.  
  4.     Copyright (C) 1989,1990 Digital Communications Associates, Inc.
  5.     All Rights Reserved.
  6.  
  7.     Version 1.00 07-06-89 PJL
  8.     Version 1.01 12-03-89 PJL
  9.     Version 1.1  04-09-90 PJL
  10. */
  11.  
  12.  
  13. -- Global variables:
  14.         string net_name, user_name, pword
  15.         string xws_name, xwp_name, ans
  16.         string inchar, outchars, in_str, outstr
  17.         string  outfile, scr_file, main_msg, user_key
  18.         integer not_ready, fsize
  19.  
  20.         main_msg = " Use Shift F1-F5 to send, Shift F6 to quit"
  21.         scr_file = "learn.scr"
  22.  
  23.         cr  = chr(13)
  24.         lf  = chr(10)
  25.         qt  = chr(34)
  26.         qt1 = chr(39)
  27.  
  28.  
  29. -- Are we online yet?
  30.         not_ready = not Online
  31.         while not_ready
  32.                 gosub NOT_ONLINE
  33.         wend
  34.  
  35.  
  36. -- Use entry name as script name if it's there.
  37.         if length(Name) then {
  38.                 xwp_name = Name
  39.                 save Name
  40.                 xws_name = Name
  41.                 outfile = Name + ".xws"
  42.         }
  43.         else {
  44.                 xwp_name = ""
  45.                 gosub GET_FNAME
  46.         }
  47.         xws_name = upcase(xws_name)
  48.  
  49. label CHECK_FNAME
  50.         if instr(outfile,"\") <> 0 then {
  51.                 i = 1
  52.                 while i < 4
  53.                         if mid(outfile,i,1) = "\" then i = 5
  54.                         else i = i + 1
  55.                 wend
  56.         } else i = 5
  57.         if i = 5 then outfile = DirXws + "\" + outfile
  58.  
  59.         outfile = upcase(outfile)
  60.         while exists(outfile)
  61.               Radio1 = 1 : Radio2 = 0
  62.               DialogBox 45, 30, 228, 94
  63.                  LText 6, 6, 216, 8, "A script named "+xws_name+".XWS already exists."
  64.                  LText 6, 22, 64, 8, "Do you wish to:"
  65.                  RadioButton 20, 40, 122, 10, "Create a new "+xws_name+" script", Radio1, TABSTOP GROUP
  66.                  RadioButton 20, 54, 130, 10, "Choose a different script name", Radio2
  67.                  DefPushButton 53, 74, 36, 14, "Ok", TABSTOP GROUP
  68.                  PushButton   139, 74, 36, 14, "Cancel", CANCEL TABSTOP
  69.               EndDialog
  70.               if choice = 2 then end
  71.               if Radio1 then delete outfile
  72.               else gosub GET_FNAME : goto CHECK_FNAME
  73.         wend
  74.  
  75.  
  76. -- Open the script file.
  77.         f = freefile
  78.         open output outfile as #f
  79.         write #f, '/*'
  80.         write #f, '    Login Script ';
  81.         if length(xwp_name) then ...
  82.                 write #f, 'for '+upcase(Name)+".XWP"
  83.         else write #f, xws_name
  84.         write #f, '    Created '+date+' by LEARN.XWS'
  85.         write #f, '*/'
  86.         write #f, ''
  87.         close #f
  88.         fsize = filesize(outfile)
  89.  
  90.  
  91. -- Go online?
  92.         if not Online then {
  93.                 Script = ''
  94.                 trap on
  95.                 if Local = On then go
  96.                 else dial Number
  97.                 e = error
  98.                 if not Online then {
  99.                         alert "Unable to establish connection - try again later.", OK
  100.                         end
  101.                 }
  102.                 trap off
  103.          }
  104.  
  105.  
  106. -- Program function keys with LEARN options.
  107.         kclear
  108.         if Newline then estr = "ENTER (`^M`^J)"
  109.         else estr = "ENTER (`^M)"
  110.         fkey 1, " ", "NETID"
  111.         fkey 2, " ", "USERID"
  112.         fkey 3, " ", "PASSWORD"
  113.         fkey 4, " ", estr
  114.         fkey 5, " ", "a string"
  115.         fkey 6, " ", "End Learn"
  116.         ShowActive = On
  117.         ShowKeyBar = On
  118.         Message main_msg
  119.  
  120.  
  121. -- Setup login value variables.
  122.         net_name = NetID
  123.         user_name = UserID
  124.         pword = Password
  125.  
  126.  
  127. -- Loop on user's keystrokes.
  128.         user_key = 0
  129.         while Online
  130.                 gosub CHECK_PORT
  131.                 user_key = inkey
  132.                 if user_key <> 0 then gosub CHECK_KEY
  133.         wend
  134.         end
  135.  
  136.  
  137. label CHECK_KEY
  138.         if user_key = 1041 then gosub SEND_NETID
  139.         else if user_key = 1042 then gosub SEND_USERID
  140.         else if user_key = 1043 then gosub SEND_PASSWORD
  141.         else if user_key = 1044 then gosub SEND_ENTER
  142.         else if user_key = 1045 then gosub SEND_STRING
  143.         else if user_key = 1046 then goto SAVE_AND_QUIT
  144.         else if user_key = 13 then gosub USER_KEYSTROKE
  145.         else if user_key = 8 or user_key = 127 then {
  146.                 i = length(outchars)
  147.                 if i > 0 then outchars = left(outchars,i-1)
  148.                 reply chr(user_key);
  149.         }
  150.         else {
  151.                 if length(outchars) >= 80 then ...
  152.                         gosub USER_KEYSTROKE
  153.                 outchars = outchars + chr(user_key)
  154.                 reply chr(user_key);
  155.         }
  156.         return
  157.  
  158.  
  159. label CHECK_PORT
  160.         inchar = bitstrip(nextchar)
  161.         if not null(inchar) then {
  162.                 print inchar;
  163.                 in_str = right(in_str,40) + inchar
  164.         }
  165.         return
  166.  
  167.  
  168. -- Send NetID value and add "reply NetID" command to script.
  169. LABEL SEND_NETID
  170.         gosub WAIT_FOR_LINE
  171.         if null(net_name) then {
  172.                 cur_msg = " Please type in your NetID."
  173.                 gosub INPUT_STRING
  174.                 net_name = user_string
  175.         }
  176.         outstr = net_name
  177.         gosub SEND_REPLY
  178.         code_line = "reply NetID"
  179.         gosub ADD_LINE
  180.         return
  181.  
  182.  
  183. -- Send UserID value and add "reply UserID" command to script.
  184. LABEL SEND_USERID
  185.         gosub WAIT_FOR_LINE
  186.         if null(user_name) then {
  187.                 cur_msg = " Please type in your UserID."
  188.                 gosub INPUT_STRING
  189.                 user_name = user_string
  190.         }
  191.         outstr = user_name
  192.         gosub SEND_REPLY
  193.         code_line = "reply UserID"
  194.         gosub ADD_LINE
  195.         return
  196.  
  197.  
  198. -- Send Password value and add "reply Password" command to script.
  199. LABEL SEND_PASSWORD
  200.         gosub WAIT_FOR_LINE
  201.         if null(pword) then {
  202.                 cur_msg = " Please type in your Password."
  203.                 gosub INPUT_STRING
  204.                 pword = user_string
  205.         }
  206.         outstr = pword
  207.         gosub SEND_REPLY
  208.         code_line = "reply Password"
  209.         gosub ADD_LINE
  210.         return
  211.  
  212.  
  213. -- Send a carriage return to the host.
  214. LABEL SEND_ENTER
  215.         gosub WAIT_FOR_LINE
  216.         if length(code_line) and outstr <> in_str then gosub ADD_LINE
  217.         reply
  218.         wait 2 ticks
  219.         code_line = "reply"
  220.         gosub ADD_LINE
  221.         return
  222.  
  223.  
  224. -- Ask the user to enter a string, and send the string to the host.
  225. LABEL SEND_STRING
  226.         gosub WAIT_FOR_LINE
  227.         cur_msg = " Enter the string to send."
  228.         gosub INPUT_STRING
  229.         outstr = destore(user_string)
  230.         gosub SEND_REPLY
  231.         code_line = "reply " + qt + user_string + qt
  232.         gosub ADD_LINE
  233.         return
  234.  
  235.  
  236. -- Send user's typed keystrokes to the host.
  237. LABEL USER_KEYSTROKE
  238.         gosub WAIT_FOR_LINE
  239.         gosub ADD_LINE
  240.         reply
  241.         if null(outchars) then code_line = "reply"
  242.         else if upcase(outchars) = upcase(net_name) then ...
  243.                 code_line = "reply NetID"
  244.         else if upcase(outchars) = upcase(user_name) then ...
  245.                 code_line = "reply UserID"
  246.         else if upcase(outchars) = upcase(pword) then ...
  247.                 code_line = "reply Password"
  248.         else code_line = "reply " + qt + outchars + qt
  249.         gosub ADD_LINE
  250.         outchars = ""
  251.         return
  252.  
  253.  
  254. -- Build WAIT command using last line of text from host.
  255. -- Strip leading/trailing whitespace and limit to 20 chars.
  256. -- ENSTORE control chars so they're easier to read.
  257. LABEL WAIT_FOR_LINE
  258.         code_line = ""
  259.         in_str = strip(in_str, 1, 3)
  260.         if null(in_str) then return
  261.  
  262.         i = instr(in_str, cr)
  263.         while i
  264.                 in_str = mid(in_str, i + 1)
  265.                 i = instr(in_str, cr)
  266.         wend
  267.         i = instr(in_str, lf)
  268.         while i
  269.                 in_str = mid(in_str, i + 1)
  270.                 i = instr(in_str, lf)
  271.         wend
  272.  
  273.         if right(in_str) = right(outchars) then ...
  274.                 in_str = left(in_str,length(in_str)-length(outchars))
  275.         if null(in_str) then return
  276.  
  277.         if instr(in_str, qt) then ...
  278.                 code_line = "wait for " + qt1 + enstore(in_str) + qt1
  279.         else code_line = "wait for " + qt + enstore(in_str) + qt
  280.  
  281.         return
  282.  
  283.  
  284. -- Send a reply to host.
  285. LABEL SEND_REPLY
  286.         reply outstr
  287.         if in_str = outstr then in_str = "" : return
  288.  
  289.  
  290. -- Add a line to the new script.
  291. LABEL ADD_LINE
  292.         f = freefile
  293.         open append outfile as #f
  294.         if length(code_line) then {
  295.                 write line #f, code_line
  296.                 if left(code_line,5) = "reply" then write line #f, ""
  297.         }
  298.         close #f
  299.         in_str = ""
  300.         return
  301.  
  302.  
  303. -- Input a string.
  304. LABEL INPUT_STRING
  305.         user_string = ""
  306.         alert cur_msg, OK, CANCEL, user_string
  307.         if choice = 2 then pop
  308.         return
  309.  
  310.  
  311. -- Put up an alert box.
  312. LABEL ALERT_DIALOG
  313.         ans = ""
  314.         while null(ans)
  315.                 alert alert_msg, OK, CANCEL, ans
  316.                 if choice = 2 then end
  317.         wend
  318.         return
  319.  
  320.  
  321. -- Get a phone book entry for the call.
  322. LABEL NOT_ONLINE
  323.         if length(Name) then {
  324.                 t1 = "Place a call to " + Name + "."
  325.                 t2 = "Call a different phone book entry."
  326.         }
  327.         else {
  328.                 t1 = "Dial a number using the current setup."
  329.                 t2 = "Call an existing phone book entry."
  330.         }
  331.         tl1 = length(t1)*4 + 10
  332.         tl2 = length(t2)*4 + 10
  333.         Radio1 = 1 : Radio2 = 0 : Radio3 = 0
  334.         DialogBox 45, 30, 228, 108
  335.            LText 6,  6, 216, 8, "You must be connected to a host computer to use LEARN."
  336.            LText 6, 22, 64,  8, "Do you wish to:"
  337.            RadioButton 20, 40, tl1, 10, t1, Radio1, TABSTOP GROUP
  338.            RadioButton 20, 54, tl2, 10, t2, Radio2
  339.            RadioButton 20, 68, 162, 10, "Create a new phone book entry to call.", Radio3
  340.            DefPushButton 53, 88, 36, 14, "Ok", TABSTOP GROUP
  341.            PushButton   139, 88, 36, 14, "Cancel", CANCEL TABSTOP
  342.         EndDialog
  343.         if choice = 2 then end
  344.         if Radio1 then goto CHECK_NUMBER
  345.         if Radio2 then goto WHICH_ENTRY
  346.  
  347.  
  348. -- User wants to create a new entry.
  349. LABEL CHAIN_NEWCALL
  350.         DialogBox 55, 30, 208, 70
  351.            LText 6,  6, 196, 8, "Control will now be passed to the NEWCALL script."
  352.            LText 6, 18, 192, 8, "Re-run Learn when you are finished creating your"
  353.            LText 6, 30,  84, 8, "new phone book entry."
  354.            DefPushButton 52, 50, 36, 14, "Ok", TABSTOP
  355.            PushButton   120, 50, 36, 14, "Cancel", TABSTOP
  356.         EndDialog
  357.         if choice = 2 then end
  358.         chain "NEWCALL"
  359.  
  360.  
  361. -- User wants to call a different entry.
  362. LABEL WHICH_ENTRY
  363.         alert_msg = "Please enter a phone book entry name:"
  364.         gosub ALERT_DIALOG
  365.         if inbook(ans) then load ans
  366.         else {
  367.                 alert "Error: No such entry.", OK
  368.                 return
  369.         }
  370.  
  371.  
  372. -- Get number to dial if we need one.
  373. LABEL CHECK_NUMBER
  374.         if null(Number) and Local = Off then {
  375.                 alert_msg = "Please enter a phone number:"
  376.                 gosub ALERT_DIALOG
  377.                 Number = ans
  378.         }
  379.         not_ready = false
  380.         return
  381.  
  382.  
  383. -- Get a name for the script.
  384. label GET_FNAME
  385.         alert_msg =  "Please enter a script name, 1 to 8 letters in length:"
  386.         gosub ALERT_DIALOG
  387.         if length(ans) > 8 then ans = left(ans,8)
  388.         i = instr(ans,".")
  389.         if i = 0 then {
  390.                 outfile = ans + ".xws"
  391.                 xws_name = ans
  392.         }
  393.         else {
  394.                 outfile = ans
  395.                 xws_name = mid(outfile,i-1)
  396.         }
  397.         xws_name = upcase(xws_name)
  398.         return
  399.  
  400.  
  401. -- Save phone book entry?
  402. LABEL SAVE_AND_QUIT
  403.         if filesize(outfile) <= fsize then {
  404.                 delete outfile
  405.                 end
  406.         }
  407.  
  408.         -- save screen contents first
  409.         row = ypos
  410.         col = xpos
  411.         f = freefile
  412.         open output scr_file as #f
  413.         i = 1
  414.         while i <= 24
  415.                 write line #f, winstring(i,1,Columns)
  416.                 i = i + 1
  417.         wend
  418.         close #f
  419.  
  420.         if not null(xwp_name) then load xwp_name
  421.         else new
  422.         NetID = net_name
  423.         UserID = user_name
  424.         Password = pword
  425.  
  426.         s1 = "Do you wish your " + xws_name + " script to disconnect,"
  427.         s2 = "or leave you online, when the script ends?"
  428.         Check1 = Off
  429.         DialogBox 52, 20, 216, 58
  430.            LText           6,  6, 188, 8, s1
  431.            Ltext           6, 18, 208, 8, s2
  432.            CheckBox       19, 38, 118, 14, "Disconnect at end of script", Check1, TABSTOP
  433.            DefPushButton 168, 38,  32, 14, "Ok", OK TABSTOP
  434.         EndDialog
  435.         if Check1 then {
  436.                 code_line = "bye"
  437.                 gosub ADD_LINE
  438.                 alert "Do you wish to disconnect now?", "Yes", "No"
  439.                 if choice = 1 then bye
  440.                 code_line = "end"
  441.                 gosub ADD_LINE
  442.         }
  443.  
  444.         s1 = "Do you wish to make " + xws_name + ".XWS the Login script"
  445.         s2 = "this phone book entry?"
  446.         DialogBox 52, 20, 218, 58
  447.            LText           6,  8, 212, 8, s1
  448.            LText           6, 20,  88, 8, s2
  449.            DefPushButton 134, 38,  32, 14, 'Yes', OK TABSTOP
  450.            PushButton    176, 38,  32, 14, 'No', CANCEL TABSTOP
  451.         EndDialog
  452.         if choice = 1 then Script = xws_name
  453.         else Script = ''
  454.  
  455.         if not null(xwp_name) then save xwp_name
  456.         else {
  457.                s1 = "Please enter a phone book name if you wish"
  458.                s2 = "LEARN to save this phone book entry."
  459.                if inbook(xws_name) then xws_name = ''
  460.                DialogBox 52, 20, 214, 78
  461.                   LText           6,  6, 168, 8, s1
  462.                   LText           6, 18, 144, 8, s2
  463.                   LText           6, 40, 56,  8, "Save entry as:"
  464.                   EditText       66, 38, 36, 12, xws_name, in_str, TABSTOP
  465.                   DefPushButton 134, 58, 32, 14, 'Ok', OK TABSTOP
  466.                   PushButton    176, 58, 32, 14, 'Cancel', CANCEL TABSTOP
  467.                EndDialog
  468.                if choice = 1 and length(in_str) then save in_str
  469.         }
  470.          
  471.         -- restore screen contents
  472.         if exists(scr_file) then {
  473.                 f = freefile
  474.                 open input scr_file as #f
  475.                 in_str = ''
  476.                 blank_str = pad('',Columns,' ',2)
  477.                 i = 1
  478.                 while i <= 24
  479.                         read line #f, in_str
  480.                         if in_str <> blank_str then ...
  481.                                 ? at i,1, in_str;
  482.                         i = i + 1
  483.                 wend
  484.                 ? at row,col, '';
  485.                 close #f
  486.                 delete scr_file
  487.         }
  488.  
  489.         end
  490.