home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / DWDOOR23.ZIP / DEMODOOR.ZIP / DEMO.BAS next >
BASIC Source File  |  1993-08-25  |  11KB  |  239 lines
  1. $IF 0
  2.  
  3. This demo door was written by James R. Davis for use with DWDoor 2.3!
  4.  
  5. Change the DoorName$, DoorHelp$, and ErrorFile$ variables in the DWDOOR.INC
  6. file to personalize your door.
  7.  
  8. NOTE:  If you ever open a file, use FREEFILE and set it to a variable before
  9.        proceeded.  Here's the syntax for using a variable with files:
  10.  
  11.        A% = FREEFILE
  12.        OPEN "I", A%, FileName$
  13.        LINE INPUT #A%, A$
  14.        PRINT #A%, A$
  15.        GET$  #A%, A$
  16.        PUT$  #A%, A$
  17.  
  18.        You get the idea.  Have fun with this program and read the docs for
  19.        more information on the commands not used here!
  20.  
  21. This demonstration door will allow you to see the kind of things that this
  22. program can do.  It will allow the user who runs this on a BBS to download
  23. library using ZModem download only.  The DSZ.EXE program must exist within
  24. the current directory.  The library file should be the only ZIP file located
  25. within the directory as well.
  26.  
  27. $ENDIF
  28.  
  29. $INCLUDE "DWDOOR.INC"                  'Starts program rolling,
  30.                                        'sets all variables
  31. Start:
  32.   CALL CLR                             'Clear the screen
  33.   A$ = Center$(DoorName$, 79)          'Center the name of door in 79 spaces.
  34.   CALL OutComm(Attr%(0, 7), 1, A$)     'Print A$ to screen/com in black on white
  35.   CALL OutComm(Attr%(14,0), 1, "")     'Blank space
  36.   CALL OutComm(Attr%(9, 0), 1, Center$("Written by James R. Davis", 79))
  37.   CALL OutComm(Attr%(14, 0), 1, "")
  38.   A$ = "(C) Copyright 1993 - All Rights Reserved"
  39.   CALL DVPrint(25, 17, A$, Attr%(0, 7))'Print A$ on line 25 in the status box
  40.   CALL OutComm(Attr%(14, 0), 1, Center$(A$, 79))
  41.   CALL OutComm(Attr%(14, 0), 1, Center$(Extra$, 79))
  42.   CALL OutComm(Attr%(14, 0), 1, "")
  43.   CALL OutComm(Attr%(15, 0), 1, Center$("Demonstration supplied by " + BBS$, 79))
  44.   CALL OutComm(Attr%(14, 0), 1, "")
  45.   CALL Pause                           'Wait for a key to be pressed
  46.  
  47.   CALL CLR
  48.   A$ = "Hello " + FirstName$ + ","
  49.   CALL OutComm(Attr%(14, 0), 1, A$)
  50.   A$ = "You are connected to COM" + Trim$(STR$(ComPort%)) + " at " + _
  51.      Trim$(STR$(Baud&)) + " baud, parity of " + Trim$(STR$(ComParity%)) + "."
  52.   CALL OutComm(Attr%(14, 0), 1, A$)
  53.   A$ = "You currently have " + Trim$(STR$(TimeLeft& \ 60)) + " minutes remaining."
  54.   CALL OutComm(Attr%(14, 0), 1, A$)
  55.   A$ = "The current connect string is: " + CHR$(34) + ComInit$ + CHR$(34)
  56.   CALL OutComm(Attr%(14, 0), 1, A$)
  57.   IF KBLocal% = True% THEN             'Determine if user is local or remote
  58.     A$ = "LOCAL mode."
  59.   ELSE
  60.     A$ = "REMOTE mode."
  61.   END IF
  62.   A$ = "You are currently playing in " + A$
  63.   CALL OutComm(Attr%(14, 0), 1, A$)
  64.   CALL OutComm(Attr%(14, 0), 1, "")    'Blank line
  65.   CALL Pause                           'Wait for a key to be pressed
  66.  
  67.   Row% = DCSRLIN%                      'Get current cursor location
  68.   Col% = DPOS%
  69.   A$ = AnsiLocate$(1, 7) + UserName$ + ","'Reposition cursor to 1,7 and print
  70.   CALL OutComm(Attr%(15, 0), 1, A$)    'the user's full name.
  71.   A$ = AnsiLocate$(Row% + 1, Col%) + NormalColor$ + "You can separate commands with a " + _
  72.      AnsiColor$(Attr%(15, 1)) + " ; (Semi-colon) " + NormalColor$ + "."
  73.   CALL OutComm(Attr%(7, 0), 1, A$)     'Put cursor back where you found it
  74.                                        '+1 and continue.
  75.  
  76.   'The following demonstrates the use of fixed length input of 20 characters
  77.   'The user must press return to end input.  A semi-colon can be used to
  78.   'separate input.  Try it using the following input:
  79.   '
  80.   '                          Name;Address;Phone
  81.   '
  82.   'You'll notice that Name is extracted for input #1, Address is automatically
  83.   'returned for input #2, and Phone is automatically given to input #3.
  84.  
  85.   A1$ = InComm$(Attr%(10, 0), 20, 0, "", 0, "", "Enter the 1st of 3 fields: ")
  86.   A2$ = InComm$(Attr%(10, 0), 20, 0, "", 0, "", "Enter the 2nd of 3 fields: ")
  87.   A3$ = InComm$(Attr%(10, 0), 20, 0, "", 0, "", "Enter the 3rd of 3 fields: ")
  88.   CALL OutComm(Attr%(14, 0), 1, "")
  89.   CALL Pause
  90.   CALL CLR
  91.   A$ = AnsiColor$(Attr%(14, 0)) + "You entered: " + AnsiColor$(Attr%(15, 1)) + A1$ +_
  92.      NormalColor$ + " for field #1."
  93.   CALL OutComm(Attr%(14, 0), 1, A$)
  94.   A$ = AnsiColor$(Attr%(14, 0)) + "You entered: " + AnsiColor$(Attr%(15, 1)) + A2$ +_
  95.      NormalColor$ + " for field #2."
  96.   CALL OutComm(Attr%(14, 0), 1, A$)
  97.   A$ = AnsiColor$(Attr%(14, 0)) + "You entered: " + AnsiColor$(Attr%(15, 1)) + A3$ +_
  98.      NormalColor$ + " for field #3."
  99.   CALL OutComm(Attr%(14, 0), 1, A$)
  100.   CALL OutComm(Attr%(14, 0), 1, "")
  101.   CALL Pause
  102.  
  103.   'The next few lines demostrate how word wrapping can be accomplished with
  104.   'the InComm$() command.  Note: The last line of this routine will not word-
  105.   'wrap, but wait for the user to end their input.
  106.  
  107.   CALL CLR
  108.   A$ = "You can also do word wrapping!"
  109.   CALL OutComm(Attr%(14, 0), 1, A$)
  110.   CALL OutComm(Attr%(14, 0), 1, "")
  111.   A$ = "Enter up to 3 lines of text, 77 characters long:"
  112.   CALL OutComm(Attr%(14, 0), 1, A$)
  113.   A1$ = InComm$(Attr%(10, 0),  0, 0, "", 0, "", "1:")
  114.   A2$ = InComm$(Attr%(10, 0),  0, 0, "", 0, "", "2:")
  115.   A3$ = InComm$(Attr%(10, 0), 77, 0, "", 0, "", "3:") 'This command does not word-wrap
  116.   CALL OutComm(Attr%(14, 0), 1, "")
  117.   CALL Pause
  118.   A$ = "You entered:"
  119.   CALL OutComm(Attr%(14, 0), 1, A$)
  120.   A$ = AnsiColor$(Attr%(15,  1)) + A1$
  121.   CALL OutComm(Attr%(14, 0), 1, A$)
  122.   A$ = AnsiColor$(Attr%(15, 1)) + A2$
  123.   CALL OutComm(Attr%(14, 0), 1, A$)
  124.   A$ = AnsiColor$(Attr%(15, 1)) + A3$
  125.   CALL OutComm(Attr%(14, 0), 1, A$)
  126.   CALL OutComm(Attr%(14, 0), 1, "")
  127.   CALL Pause
  128.  
  129.   'The following is an example of how you can mask input without displaying
  130.   'the actual characters, but substituting a "." in place of every key typed.
  131.  
  132.   CALL CLR
  133.   A$ = "You can also hide input and replace it with a character!"
  134.   CALL OutComm(Attr%(14, 0), 1, A$)
  135.   CALL OutComm(Attr%(14, 0), 1, "")
  136.   A$ = InComm$(Attr%(10, 0), -15, 0, ".", 0, "", "Enter a password (Dots will echo): ")
  137.   CALL OutComm(Attr%(14, 0), 1, "")
  138.   A$ = AnsiColor$(Attr%(14, 0)) + "You entered: " + AnsiColor$(Attr%(15, 1)) + A$ +_
  139.      NormalColor$ + " for a password."
  140.   CALL OutComm(Attr%(14, 0), 1, A$)
  141.   CALL OutComm(Attr%(14, 0), 1, "")
  142.   CALL Pause
  143.  
  144.   'The next routine give an example of how to use the PrintFile() routine.
  145.   'It will display the DEMO.BAS source file with More: prompting.
  146.  
  147.   CALL CLR
  148.   A$ = "You can display an entire file, with the PrintFile() subroutine."
  149.   CALL OutComm(Attr%(14, 0), 1, A$)
  150.   A$ = "Here is the source to the program running right now.  See how easy"
  151.   CALL OutComm(Attr%(14, 0), 1, A$)
  152.   A$ = "it can be to program with this library of commands..."
  153.   CALL OutComm(Attr%(14, 0), 1, A$)
  154.   CALL OutComm(Attr%(14, 0), 1, "")
  155.   CALL PrintFile(0, "DEMO.BAS")
  156.   CALL Pause
  157.  
  158.   ' This routine will demonstrate the new Scrn2Str$() function!
  159.  
  160.   Scrn$ = Scrn2Ansi$(9, 10, 13, 40)
  161.   CALL OutComm(Attr%(14, 1), 1,AnsiLocate$(9, 10) + "┌──────────────────────────┐")
  162.   CALL OutComm(Attr%(14, 1), 1,AnsiLocate$(10,10) + "│  Now we can do WINDOWS!  │" + AnsiColor$(7) + "░░")
  163.   CALL OutComm(Attr%(14, 1), 1,AnsiLocate$(11,10) + "│ Press a key to clear it! │" + AnsiColor$(7) + "░░")
  164.   CALL OutComm(Attr%(14, 1), 1,AnsiLocate$(12,10) + "└──────────────────────────┘" + AnsiColor$(7) + "░░")
  165.   CALL OutComm(Attr%(7,  0), 1,AnsiLocate$(13,10) + "  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░")
  166.   A$ = InComm$(0, -1, -1, "", 0, "", "")
  167.   CALL OutComm(0, 0, Scrn$ + AnsiLocate$(23, 1) + SPACE$(79) + AnsiLocate$(23, 1))
  168.   CALL Pause
  169.  
  170.   'This routine demonstrates how to use the InComm$() for specific input.
  171.   'It also shows how to SHELL to Dos to perform other functions.
  172.  
  173.   CALL CLR
  174.   D$ = DIR$("DW*.ZIP")
  175.  
  176.   A$ = "At this point you have an option.  If you think that this demo has fullfilled"
  177.   CALL OutComm(Attr%(14, 0), 1, A$)
  178.   A$ = "your needs as a door programmer or you have thought about writting a door"
  179.   CALL OutComm(Attr%(14, 0), 1, A$)
  180.   A$ = "yourself, but just didn't have the opportunity to do so, well now is your"
  181.   CALL OutComm(Attr%(14, 0), 1, A$)
  182.   A$ ="chance.  If you can download using Z-Modem protocol, you can at this time,"
  183.   CALL OutComm(Attr%(14, 0), 1, A$)
  184.   A$ ="download the library used to make this demo.  Just hit "+AnsiColor$(Attr%(31,0))+"Y"+AnsiColor$(Attr%(14,0))+" at the following"
  185.   CALL OutComm(Attr%(14, 0), 1, A$)
  186.   A$ ="prompt to begin Z-Modem transfer!"
  187.   CALL OutComm(Attr%(14, 0), 1, A$)
  188.   CALL OutComm(Attr%(14, 0), 1, "")
  189.   IF D$ = "" THEN
  190.     A$ = "NOTICE:  The sysop has not put DWDOORxx.ZIP in the current directory."
  191.     CALL OutComm(Attr%(12, 0), 1, A$)
  192.     A$ = "         Please inform " + SysopF$ + " of this.  You may not download now!"
  193.     CALL OutComm(Attr%(12, 0), 1, A$)
  194.     A$ = "         Check on the main board's download directory, you may find it there!"
  195.     CALL OutComm(Attr%(12, 0), 1, A$)
  196.     CALL OutComm(Attr%(14, 0), 1, "")
  197.   END IF
  198.   IF KBLocal% = True% THEN
  199.     A$ = "I hope you don't expect to download the file in local mode!  GIVE ME A BREAK!"
  200.     CALL OutComm(Attr%(15, 0), 1, A$)
  201.     CALL OutComm(Attr%(14, 0), 1, "")
  202.   END IF
  203.   A$ = "Do you wish to download " + D$ + "? (y/N): "
  204.   A$ = InComm$(Attr%(14, 0), 1, -1, "N", Attr%(7, 0), "YNyn", A$)
  205.  
  206.   'The following is an example of how to use the ErrLevel% function to
  207.   'determine whether or not an error occured after a program was run in
  208.   'shell mode.  It also shows how to use the WriteDoorERR() routine to
  209.   'write custom error messages to your error file set in the ErrorFile$
  210.   'variable.  Note the use of CALL Script().
  211.  
  212.   CALL OutComm(Attr%(14, 0), 1, "")
  213.   IF UCASE$(A$) = "Y" THEN
  214.     IF D$ <> "" OR KBLocal% <> True% THEN
  215.       CALL OutComm(Attr%(14, 0), 1, "Sending " + D$ + "... prepare to receive...")
  216.       SHELL "dsz.com handshake both pB4096 z sz " + D$
  217.       Er% = ErrLevel%                      'Get the errorlevel if one exists
  218.  
  219.       'After a shell, you must redisplay the last 2 lines on the screen.
  220.  
  221.       CALL Line25
  222.       IF Er% <> 0 THEN CALL WriteDoorERR(Er%, "File transfer of " + D$ + " did not go smoothly!")
  223.     ELSE
  224.       CALL OutComm(Attr%(14, 0), 1, "")
  225.       A$ = "Well, either you can't read.. or you're a moron... <GRIN!>"
  226.       CALL OutComm(Attr%(15, 0), 1, A$)
  227.       CALL OutComm(Attr%(14, 0), 1, "")
  228.       CALL Script("Pause", "", "")
  229.     END IF
  230.   END IF
  231.  
  232.   'This last routine gives you an example of how to end a program correctly.
  233.  
  234.   COLOR 7, 0
  235.   CALL CLR
  236.   A$ = NormalColor$ + CHR$(12) + "Thanks for trying DWDoor Demo v2.3!"
  237.   CALL OutComm(Attr%(14, 0), 1, A$)
  238.   CALL ExitDoor(0)
  239.