ftp.wwiv.com/ftp.wwiv.com.zip/ftp.wwiv.com/pub/MISC/PBAPI10.ZIP/DEMO1.BAS

BASIC Source File | 1998-02-21 | 19KB | 498 lines

' ─────────────────────────────────────────────────────────────────────────
' Program Title: Demo Program to Show How to read messages from TriBBS
'     Copyright: 1997-98 By Freejack's Software
'        Author: Gary Price
' Last Modified: 02/21/98
' ─────────────────────────────────────────────────────────────────────────
'   Description: Program template for PowerBASIC programmers to control
'                exactly how PowerBASIC generates your executables.
' ─────────────────────────────────────────────────────────────────────────
'         Notes:
' ─────────────────────────────────────────────────────────────────────────
'       History:
' ─────────────────────────────────────────────────────────────────────────
$CPU 80386                    ' Requires a 386 system or faster

$OPTIMIZE SPEED             ' make fastest possible executable

$COMPILE EXE "DEMO1.EXE"   ' compile to an EXE

$DEBUG MAP      OFF         ' turn off map file generation
$DEBUG PBDEBUG  OFF         ' don't include pbdebug support in our executable

$LIB COM        OFF         ' turn off PowerBASIC's communications library.
$LIB CGA        OFF         ' turn off PowerBASIC's CGA graphics library.
$LIB EGA        OFF         ' turn off PowerBASIC's EGA graphics library.
$LIB VGA        OFF         ' turn off PowerBASIC's VGA graphics library.
$LIB LPT        OFF         ' turn off PowerBASIC's printer support library.
$LIB IPRINT     OFF         ' turn off PowerBASIC's interpreted print library.
$LIB FULLFLOAT  OFF         ' turn off PowerBASIC's floating point support.

$ERROR ALL                  ' Set for All Error checks

$COM    0                   ' set communications buffer to nothing
$STRING 32                  ' set largest string size at 32k
$STACK  8192                ' let's use a 8k stack
$SOUND  1                   ' smallest music buffer possible

$DIM ALL                    ' forces all Varibles and Arrays to be
                            ' pre-dementioned before use.

$DYNAMIC                    ' all arrays will be dynamic by default

$OPTION CNTLBREAK OFF       ' don't allow Ctrl-Break to exit program

DEFINT A-Z                  ' default all variables to integers for maximum
                            ' speed and minimum size
'============================================================================

'============================================================================
'                          DECLARATIONS SECTION
'============================================================================
' ** THIS SECTION IS FOR LINKS AND INCLUDES STATMENTS **

$LINK "G:\PB35\TBAPI10\PBAPI10.PBL"    ' ** SET THIS LINE TO YOUR PATH **
$INCLUDE "G:\PB35\TBAPI10\PBAPI10.INC" ' ** SET THIS LINE TO YOUR PATH **

'---------------------------------------------------------------------------
' ** DECLARE LOCAL SUB's BELOW THAT WILL BE USED IN THIS PROGRAM **
'
' Use this section for any declarations needed to be made other than the
' MNNNN.HDR API which are located in the MNNNN.INC file.

DECLARE SUB MENU()
DECLARE SUB OpenReadHeaderFiles()
DECLARE SUB OpenReadTextFiles()
DECLARE SUB DoMessageHeader()
DECLARE SUB MessPausePrompt()
DECLARE SUB MainMessPrompt()
DECLARE SUB CloseFiles()
DECLARE SUB GetYourMessages()

'---------------------------------------------------------------------------
'* DECLARE ALL LOCAL AND SHARED VARIABLES USED IN MAIN PROGRAM BETWEEN SUBS *
'
 DIM ACF                AS SHARED STRING
 DIM ConfName           AS SHARED STRING
 DIM ConfNum            AS SHARED INTEGER
 DIM CRASH              AS SHARED STRING
 DIM DEL                AS SHARED STRING
 DIM ECHO               AS SHARED STRING
 DIM Hashvalue          AS SHARED LONG
 DIM HeaderCounter      AS SHARED INTEGER
 DIM HighestMessage     AS SHARED LONG
 DIM MainMenuPrompt     AS SHARED STRING
 DIM MainPrompt         AS SHARED STRING
 DIM MenuHeaderText     AS SHARED STRING
 DIM MessageNumber      AS SHARED LONG
 DIM NETNAME            AS SHARED STRING
 DIM NewConfNum         AS SHARED INTEGER
 DIM PausePromptNonstop AS SHARED INTEGER
 DIM PausePromptStop    AS SHARED INTEGER
 DIM PER                AS SHARED STRING
 DIM PUB                AS SHARED STRING
 DIM REC                AS SHARED STRING
 DIM RecordNumber       AS SHARED LONG
 DIM REPLY              AS SHARED STRING
 DIM TestFileFlag       AS SHARED INTEGER
 DIM TotalMessConf      AS SHARED INTEGER
 DIM YourMessFlag       AS SHARED INTEGER

'----------------------------------------------------------------------------
' ** SET THIS LINE BELOW TO YOUR TRIBBS MAIN NODE's DIRECTORY **

TBNode1sMainDirectory = "E:\TRIBBS"
'============================================================================

'============================================================================
'                         ** MAIN PROGRAM BODY **
'============================================================================
ON ERROR GOTO DONE                 ' Set Error Trap to Exit on any Errors

Hashvalue = Hashit("Gary Price")   ' Converts name to Hash Value which is
                                   ' needed for "Your Messages"
                                   ' Change to "Your Name" for use with this
                                   ' example

ConfNum = 1                        ' Set & Begin Message Conference to #1

 MENU          ' Calls and prints Main Menu (SUB)

   DO          ' Main DO/LOOP to handle Main Menu Control
     MainMenuPrompt = UCASE$(INKEY$)
       SELECT CASE ASCII(MainMenuPrompt)
         CASE 67    ' For C
            COLOR 15,0:LOCATE 13,1:PRINT "Message Conferenc Range [1 -";STR$(TotalMessConf);"]"
            INPUT "Enter Conference Number: ",NewConfNum
              SELECT CASE NewConfNum
                CASE 1 TO TotalMessConf
                  ConfNum = NewConfNum
                  MENU
                CASE ELSE
                  MENU
              END SELECT
         CASE 82    ' For R
            LOCATE,,0                  ' Turn cursor off
            OpenReadHeaderFiles        ' Opens and Reads current Header File
             IF TestFileFlag <> 0 THEN
               OpenReadTextFiles       ' Opens and Start Reading Messages
             END IF
            CloseFiles
            MENU                      ' Calls Menu Sub
         CASE 78    ' For N           ' Needs Users.spm Unit for this Search
         CASE 89    ' For Y
            LOCATE,,0                 ' Turn cursor off
            YourMessFlag = 1          ' Sets Your Message Flag to 1/TRUE
            OpenReadHeaderFiles       ' Opens and Reads current Header File
             IF TestFileFlag <> 0 THEN
               OpenReadTextFiles      ' Opens and Start Reading Your Messages
             END IF
            CloseFiles
            MENU                      ' Calls Menu Sub
       END SELECT

   LOOP WHILE MainMenuPrompt <> "G"

'============================================================================
DONE:                               ' This label is only used for the exit
                                    ' if we get an ON ERROR
  COLOR 7, 0, 0                     ' Sets exit color to default gray
  CLS SCREEN                        ' Clears the entire screen, homes cursor
  LOCATE 25                         ' Positions Dos Prompt and Cursor on
                                    ' Line 25
END                                  ' End/Exit Program

'============================================================================
SUB CloseFiles()

 MNNNN_HDR_Close
 MNNNN_TXT_Close

END SUB

'============================================================================
SUB MENU()

RecordNumber   = 1           ' Set/Reset Record Number to 1
MainMenuPrompt = ""          ' Set Main Menu Varible to NULL/Empty
MessageNumber  = 0           ' Set/Reset MessageNumber to NULL/Empty
YourMessFlag   = 0           ' Set/Reset YourMessFlag to 0/FALSE
TestFileFlag   = 0           ' Set/Reset Test OpenHeaderFile Flag
                             ' to 0/False
CLS                             ' Clears the Screen

MCONF_DAT_OpenRead(ConfNum)  ' In this section we open Mconf.dat and grab the
ConfName = MCONF_DAT_GetMCN  ' info we need
TotalMessConf = INT(MCONF_DAT_Length)
HighestMessage = MCONF_DAT_GetHMN

  NETNAME = MCONF_DAT_GetNWCN   ' This gets all Network Names for this Conf.
   IF NETNAME <> "" THEN
     NETNAME = "<" + NETNAME + ">"
   END IF

  IF MCONF_DAT_GetACF = 0 THEN
    ACF = ""
  ELSE
    IF NETNAME = "" THEN
      ACF = "<ALIAS>"
    ELSE
      ACF = " <ALIAS>"
    END IF
  END IF
MCONF_DAT_Close              ' Now we are done with Mconf.dat and close it

MenuHeaderText = "Freejack's Place Message Menu"
MenuBox 1, 1, 8, 78, 2, 7, MenuHeaderText
COLOR 15,2: LOCATE  3,5: PRINT "<C>..Change Conference             ";"<R>..Read Messages"
COLOR 15,2: LOCATE  4,5: PRINT "<N>..New Messages                  ";"<Y>..Your Messages"
COLOR 15,2: LOCATE  5,5: PRINT "<G>..Goodye"
COLOR 15,0: LOCATE  9,5: PRINT
COLOR 10,0: LOCATE 10,1: PRINT "Current Conference: ";:COLOR 14,0: _
PRINT ConfName + " ";:COLOR 15,0: PRINT NETNAME + ACF

COLOR 15,0: LOCATE 12,1: PRINT "Enter Selection - [C R N Y G]? ";
LOCATE,,1

END SUB

'============================================================================
SUB OpenReadHeaderFiles()

 IF MNNNN_HDR_Open(ConfNum)  = 0 THEN ' Tests MNNNN.HDR File to see if it
                                      ' exists, if true, then open it
   COLOR 12,0:LOCATE 14, 1:PRINT "This Message Conference is Empty!"
   COLOR 15,0:
   DELAY 1
   TestFileFlag = 0
   EXIT SUB
 ELSE
   MNNNN_TXT_Open(ConfNum) ' Opens the Mnnnn.txt for testing
    IF MNNNN_TXT_Length = 0 THEN
      COLOR 12,0:LOCATE 14, 1:PRINT "This Message Conference is Empty!"
      COLOR 15,0:
      DELAY 1
      TestFileFlag = 0
      EXIT SUB
    ELSE
      TestFileFlag = 1
    END IF
 END IF
END SUB

'============================================================================
SUB OpenReadTextFiles()

DIM Char13Pointer   AS LOCAL INTEGER
DIM LineText        AS LOCAL STRING
DIM LineReturnCount AS LOCAL INTEGER
DIM MessLineCounter AS LOCAL INTEGER
DIM MessText        AS LOCAL STRING
DIM NewMessRecord   AS LOCAL LONG
DIM RecTest         AS LOCAL LONG
DIM ScreenCounter   AS LOCAL INTEGER
DIM TotalTextMess   AS LOCAL INTEGER

 MNNNN_TXT_Open(ConfNum)  ' Opens the Mnnnn.txt file for messages to read

'----------------------------------------------------------------------------
'*** Main Control Loop for reading Text part of the Messages ***

DO

  MNNNN_HDR_Read RecordNumber         ' Read in Message Header
                                      ' for Record "n"
   IF YourMessFlag = 1 AND MainPrompt <> CHR$(78) THEN ' For "Your Messages" Control
      IF MainPrompt <> CHR$(45) THEN  ' Test to see if going backwards?
        NewMessRecord = MNNNN_HDR_GetYourNext(Hashvalue, MessageNumber)
         IF NewMessRecord <> -1 THEN  ' This block grabs next "Your Message"
           RecordNumber = NewMessRecord ' & tests to make sure, then puts it
         ELSE                           ' in the RecordNumber Counter
           EXIT DO              ' If No More Your Messages let's bail out
         END IF
      ELSE                      ' If going backwards, then this block handles
       RecTest = RecordNumber   ' a step back and then checks the Hash Values
         FOR RecTest = (RecordNumber -1) TO 1 STEP -1 ' This FOR/NEXT loop does the
          MNNNN_HDR_Read RecTest                 ' step back in messages and
           IF MNNNN_HDR_GetTH = Hashvalue THEN   ' compares hash values
             RecordNumber = RecTest   ' If we have a match, past the
             EXIT FOR                 ' Record Number and exit our loop
           EXIT IF
           ELSE
             MNNNN_HDR_Read RecordNumber ' No more messages backward?
           END IF                        ' Then we reread in current
        NEXT RecTest                     ' "Your Message" again
      END IF
   END IF

  MessageNumber = MNNNN_HDR_GetMN            ' Get Current Message Number

  DoMessageHeader                            ' Call and Create Message
                                             ' Header Sub

  MessText = MNNNN_TXT_Read()    ' Gets the Text Message for the
                                 ' MNNNN_HDR_Read RecordNumber that was
                                 ' called above


  LineReturnCount = TALLY(MessText, ANY CHR$(13)) ' Tally up the amount of
                                                  ' times CHR$(13) appears
                                                  ' in this message and set
                                                  ' it to a counter
  ScreenCounter = HeaderCounter                   ' Set Screen Counter to
                                                  ' equal lines in our
                                                  ' Header

  PausePromptNonstop = 0        ' Set/Reset to 0/FALSE

  FOR MessLineCounter = 1 TO LineReturnCount

    LineText = EXTRACT$(MessText, CHR$(13))  ' Here we extract each line of
    INCR ScreenCounter                       ' Text from the mainstring
    COLOR 11, 0: PRINT LineText
    Char13Pointer = INSTR(MessText, CHR$(13))
    MessText = MID$(MessText, Char13Pointer + 1)
    LineText = ""

    IF PausePromptNonstop = 0 THEN    ' This block controls were the
      IF ScreenCounter => 23 THEN     ' screen should stop during messages
        IF MessLineCounter = LineReturnCount THEN EXIT FOR
          MessPausePrompt
        IF PausePromptStop = 1 THEN EXIT FOR
        ScreenCounter = 0
      END IF
    END IF

  NEXT MessLineCounter

 MainMessPrompt

LOOP WHILE Mainprompt <> "Q"

END SUB

'============================================================================
SUB MainMessPrompt()  ' This sub handles the end of each message

DIM TempNumber       AS LOCAL LONG
DIM NewMessRecord    AS LOCAL LONG

 COLOR 12,0:PRINT "========================================================================"
 COLOR 15,0: PRINT "<N>umber, <-> Prev, <+/ENTER> Next, <Q>uit ";

   DO

     MainPrompt = UCASE$(INKEY$)
       SELECT CASE ASCII(MainPrompt)
         CASE 78      ' For N
            TempNumber = 0
            PRINT
            INPUT "Enter New Message Number";TempNumber
               IF YourMessFlag = 1 THEN
                 NewMessRecord = MNNNN_HDR_GetNext(TempNumber)
                   IF NewMessRecord <> -1 THEN
                    DO WHILE NewMessRecord < MNNNN_HDR_Length
                      MNNNN_HDR_Read NewMessRecord
                      IF MNNNN_HDR_GetTH = Hashvalue THEN ' compares hash values
                        RecordNumber = NewMessRecord
                        MessageNumber = TempNumber
                        EXIT SELECT
                      ELSE
                        NewMessRecord = NewMessRecord + 1
                      END IF
                    LOOP
                  ELSE
                    MainPrompt = "Q"
                   EXIT DO
                  END IF
               ELSE
                 NewMessRecord = MNNNN_HDR_Search(TempNumber)
                 IF NewMessRecord <> -1 THEN
                   RecordNumber = NewMessRecord
                   MessageNumber = TempNumber
                 ELSE
                   NewMessRecord = MNNNN_HDR_GetNext(TempNumber)
                   IF NewMessRecord <> -1 THEN
                     RecordNumber = NewMessRecord
                   END IF
                 END IF
               END IF
         CASE 45      ' For - Key
               IF YourMessFlag <> 1 THEN
                 IF RecordNumber > 1 THEN
                   DECR RecordNumber
                 ELSE
                  MainPrompt = ""
                 END IF
               END IF
         CASE 13, 43  ' For Enter/Return Key, + Key
             NewMessRecord = MNNNN_HDR_GetNext(MessageNumber)
             IF NewMessRecord <> -1 THEN
               RecordNumber = NewMessRecord
             ELSE
               MainPrompt = "Q"
               EXIT DO
             END IF
         CASE 81      ' For Q
             EXIT DO
         CASE ELSE
             MainPrompt = ""
       END SELECT

   LOOP WHILE MainPrompt = ""

  LOCATE 25,1: PRINT SPACE$(78): LOCATE 25,1

END SUB

'============================================================================
SUB DoMessageHeader()  ' This sub creates our header for each Message

  IF MNNNN_HDR_GetPriMF = 0 THEN
    PUB = "<PUBLIC>"
  ELSE
    PUB = "<PRIVATE>"
  END IF

  IF MNNNN_HDR_GetEMF = 0 THEN
    ECHO = ""
  ELSE
    ECHO ="<ECHO>"
  END IF

  IF MNNNN_HDR_GetTMF = 0 THEN
    REPLY = ""
  ELSE
    REPLY = "<HAS REPLIES>"
  END IF

  IF MNNNN_HDR_GetRMF = 0 THEN
    REC = ""
  ELSE
    REC = "<RECEIVED>"
  END IF

  IF MNNNN_HDR_GetDMF = 0 THEN
    DEL = ""
  ELSE
    DEL = "<DELETED>"
  END IF

  IF MNNNN_HDR_GetPerMF = 0 THEN
    PER = ""
  ELSE
    PER = "<PERMANENT>"
  END IF

  IF MNNNN_HDR_GetCMF = 0 THEN
    CRASH = ""
  ELSE
    CRASH = "<CRASH>"
  END IF

HeaderCounter = 8
COLOR 12,0:PRINT "========================================================================"
COLOR 15,0:PRINT PUB + ECHO + REPLY + REC + DEL + PER + CRASH
COLOR 10,0:PRINT "Number  :"; : COLOR 14,0:PRINT MessageNumber;"  of  "; _
HighestMessage; : COLOR 10,0:PRINT "      Date: ";: COLOR 14,0:PRINT MNNNN_HDR_GetDAT
IF MNNNN_HDR_GetNOMTRT <> 0 THEN
 HeaderCounter = 9
 COLOR 10,0: PRINT "Reply To:";:COLOR 14,0:PRINT MNNNN_HDR_GetNOMTRT
END IF
COLOR 10,0:PRINT "Confer  : ";:COLOR 14,0: PRINT ConfName + " ";:COLOR 15,0: PRINT _
NETNAME + LTRIM$(ACF)
COLOR 10,0:PRINT "From    : ";:COLOR 14,0:PRINT MNNNN_HDR_GetFU
COLOR 10,0:PRINT "To      : ";:COLOR 14,0:PRINT MNNNN_HDR_GetTU
COLOR 10,0:PRINT "Subject : ";:COLOR 14,0:PRINT MNNNN_HDR_GetMS
COLOR 12,0:PRINT "------------------------------------------------------------------------"
END SUB

'============================================================================
SUB MessPausePrompt() 'If the message is => 23 lines, then this sub is called

DIM PausePrompt AS LOCAL STRING

PausePromptStop    = 0
PausePromptNonstop = 0

 COLOR 15,0: PRINT "<S>top, <N>onstop, <ENTER> for more "

   DO

     PausePrompt = UCASE$(INKEY$)
       SELECT CASE ASCII(PausePrompt)
         CASE 13      ' For Enter/Return Key
         CASE 83      ' For S
           PausePromptStop = 1
         CASE 78      ' For N
           PausePromptNonstop = 1
         CASE ELSE
           PausePrompt = ""
       END SELECT

   LOOP WHILE PausePrompt = ""

  LOCATE 24,1: PRINT SPACE$(78): LOCATE 24,1

END SUB