.net 1999 December/netCD65.iso/pc/Software/VirtualA/32bit/vasetup.exe/%MYDIR%/BASIC.EBS

Text File | 1999-10-06 | 29.4 KB | 1,108 lines

'T:BASIC.EBS for CompuServe
' VA 4.52 release

Global Const IM_DELETE    = 2048

Declare Function UniqueFileName$
Declare Function QueueFile(service As String, sfilename As String, queueflags As Long) As Boolean
Declare Sub ReportSuccess(id As String)
Declare Function StartCapture(pseudo As String)
Declare Function NoSpaces(s As String) As String
Declare Function GoForum(ByVal forum As String) As Boolean
Declare Sub ResetForum
Declare Sub UsenetOptions(id As String, realname As String, organisation As String, limit As String)
Declare Function ParseString(args As String, delim As String) As String
Declare Function ForumName(forum As String) As String
Declare Function ToSpaces(s As String) As String
Declare Function GetNumMessages() As Integer
Declare Sub SetNumMessages(num As Integer)
Declare Sub TimedWaitForPrompt(prefix As String, timeout As Integer)
Declare Function FileUrl(fn As String) As String

Public MailName As String      'My name for mail purposes
Public DownloadDir As String    'where downloads go

Dim numpages As Integer  ' Number of pages recieved used by CapturePages()
Dim pseudo As String     ' "conf/topic from" used by CapturePages()
Dim cleanup As Boolean     ' Workaround bug in CIS Euro What's New
Dim search As String     ' Used for search (dictionary etc) scripts
Dim HasFailed As Boolean ' A failure has been detected (eg No records found)
Dim Submenu As Boolean     ' Send a '2\r' at the next prompt
Dim SetPagedOutputToNO As Boolean
Dim SetEditorToNO As Boolean

'T:SetFailed (subroutine) (CompuServe)
Sub SetFailed(t As Tracker)
    HasFailed = True
    t.reset
End Sub

'T:PageSplitter (subroutine) (CompuServe)
' Split message stream up
Sub PageSplitter(t As Tracker)
    ' End of previous message
    CaptureRewind Len(t.match)
    CaptureText Basic.Eoln$+"!end"

    ' Start of next message
    CaptureText Basic.Eoln$+"!start "+pseudo+Basic.Eoln$

    ' Tell user we've got another message
    numpages = numpages + 1
    Terminal.CaptureStatus numpages
    t.reset
End Sub

'T:SendSearch (subroutine) (CompuServe)
' Sends the 'search' string and then just sends a '\r' next time.
Sub SendSearch(t As Tracker)
    If search="" Then
        CaptureRewind Len(t.match)
        CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
        If HasFailed Then
            Capture CAPTURE_OFF
        End If
    End If
    t.reset
    Comms.Send search+"\r"
    search = ""
End Sub

'T:Rewind (subroutine) (CompuServe)
' Removes the match from the capture file
Sub Rewind(t As Tracker)
    CaptureRewind Len(t.match)
    t.reset
End Sub

'T:SetSubmenu (subroutine) (CompuServe)
' Sets flag to choose item 2 at the next menu prompt.
Sub SetSubmenu(t As Tracker)
    t.reset
    Submenu = True
End Sub

Function ContainsWildCard(pattern As String) As Boolean
    ContainsWildCard = False
    If instr(pattern, "*") Then ContainsWildCard = True
    If instr(pattern, "?") Then ContainsWildCard = True
    If instr(pattern, "[") Then ContainsWildCard = True
End Function

'T:CapturePages (subroutine) (CompuServe)
' Generic routine for getting 'all' news articles
Sub CapturePages(id As String, forum As String, menuid As String, _
    ppseudo As String, endofmsg As String, pcleanup As Boolean, _
    prompt As String, psearch As String, notfound As String, _
    morestr As String, doall As Boolean)

    Dim tSearch As Tracker, tStart As Tracker, tRewind As Tracker
    Dim tNotFound As Tracker, tSubmenu As Tracker, tEnd1 As Tracker
    Dim tEnd2 As Tracker, tEnd3 As Tracker, filename As String

    ' Go to main page
    If Not GoForum(forum) Then
        LogResult "Failed trying to GO "+forum
        Exit Sub
    End If

    ' Store in a global
    pseudo = ppseudo
    cleanup = pcleanup
    search = psearch
    HasFailed = False
    Submenu = False

    ' Setup tracker for answering the search request
    If prompt<>"" Then
        Set tSearch = CreateTracker("SearchPrompt", prompt, "SendSearch", False, ContainsWildCard(prompt))
    End If
    If notfound<>"" Then
        Set tNotFound = CreateTracker("NotFound", notfound, "SetFailed", False, ContainsWildCard(notfound))
    End If

    ' Start capturing
    numpages = 0
    filename = UniqueFilename$()
    Capture CAPTURE_ON, filename
    Set tStart = CreateTracker("MessageStart", endofmsg, "PageSplitter", True, ContainsWildCard(endofmsg))
    Set tRewind = CreateTracker("Rewind", "\nChoice*is not available for download", "Rewind", False, True)
    If morestr<>"" Then
        Set tSubmenu = CreateTracker("Submenu", morestr, "SetSubmenu", False, ContainsWildCard(morestr))
    End If
    Set tEnd1 = CreateTracker("PromptLastEnd1", "\nNo next page. Key M for menu or T for top!", "", False, True)
    Set tEnd2 = CreateTracker("PromptLastEnd2", "\nMenu Choices currently invalid. Enter M for Menu.!", "", False, True)
    Set tEnd3 = CreateTracker("PromptLastPrompt", "\n!", "", False, True)

    ' Go to submenu item if there is one
    If menuid<>"" Then
        Comms.Send menuid+"\r"
        WaitForPrompt "Prompt"
        CaptureRewind 1
    End If

    ' Go to submenu item if there is one
    If Submenu Then
        numpages = 0
        Comms.Send "2\r"
        WaitFor "2"
        CaptureRewind 1
        WaitForPrompt "Prompt"
        CaptureRewind 1
    End If

    ' Get all messages
    If HasFailed Then
        Comms.Send "\r"
        WaitForPrompt "Prompt"
    Else
        If numpages<>1 Or doall Then
            numpages = 0
            Terminal.CaptureStatus CAPTURE_ON
            Terminal.Enabled = False
            Comms.Send "all\r"
            WaitFor "all"
            CaptureRewind 3
            WaitForPrompt "PromptLast"

            If PromptMatches("PromptLastEnd1") Then CaptureRewind 42
            If PromptMatches("PromptLastEnd2") Then CaptureRewind 50
            If PromptMatches("PromptLastPage") Then CaptureRewind 10
            If PromptMatches("PromptLastPrompt") Then CaptureRewind 1
            Terminal.CaptureStatus CAPTURE_OFF
        End If
    End If
    CaptureText Basic.Eoln$+"!end"+Basic.Eoln$

    ' Clean up
    tStart.delete
    tRewind.delete
    tEnd1.delete
    tEnd2.delete
    tEnd3.delete
    If prompt<>"" Then tSearch.delete
    If notfound<>"" Then tNotFound.delete
    If morestr<>"" Then tSubmenu.delete
    Capture CAPTURE_OFF
    If cleanup Then
        Comms.Send "m\rgo top\r"
        WaitForPrompt "Prompt"
        On Error Goto Timeout_Error
        TimedWaitForPrompt "Prompt", 1 ' catch an extra prompt if there is one
Timeout_Error:
        On Error Goto 0
    End If
    If prompt<>"" Then
        GoTop
    Else
        ResetForum
    End If
    Terminal.Enabled = True
    ' Add to import queue
    If QueueFile(Session.Service, filename, IM_DELETE) Then
        ReportSuccess id & " : Information from " & forum & " collected "
    End If
End Sub

'T:Eberts (subroutine) (CompuServe)
Sub Eberts(id As String)
    CapturePages id, "cis:ebert", "1", "Ebert/Recent_Reviews Roger_Ebert", _
        "\nMovies/Roger Ebert\r", False, "", "", "", "", True
End Sub

'T:Groliers (subroutine) (CompuServe)
Sub Groliers(id As String, txt As String)
    CapturePages id, "cis:aae", "1", "Encyclopedia/Groliers "+NoSpaces(txt), _
        "\nGrolier's", False, "\nSearch term: ", txt, _
        "\nNo listings were found", "\nArticles selected:*that begin", True
End Sub

'T:Hutchinson (subroutine) (CompuServe)
Sub Hutchinson(id As String, txt As String)
    Dim t As Tracker

    ' Install handler for images
    Set t = CreateTracker("StartDownload", "\nEnter ""DOWN"" to download!", "SendCR")

    CapturePages id, "cis:hutchinson", "1", _
        "Encyclopedia/Hutchinsons "+NoSpaces(txt), "\nHutchinson", _
        False, "\nEnter*Search Term: ", txt, "\nNo records found", _
        "\nArticles Found:*that begin", True

    t.delete
End Sub

'T:Dictionary (subroutine) (CompuServe)
Sub Dictionary(id As String, txt As String)
    CapturePages id, "cis:dictionary", "4", _
        "Dictionary/Words "+NoSpaces(txt), "\nCompuServe", _
        False, "\nSearch term: ", txt, "\nNo listings were found", _
        "\nDefinitions found:*that begin", False
End Sub

'T:Drugs (subroutine) (CompuServe)
Sub Drugs(id As String, txt As String)
    CapturePages id, "cis:drugs", "6", _
        "Drugs/Reference "+NoSpaces(txt), "\nDrug Reference", _
        False, "\nSearch term (or /HELP): ", txt, "\nNo listings were found", _
        "\nDrug names found:*that begin", True
End Sub

'T:Lexikon (subroutine) (CompuServe)
Sub Lexikon(id As String, txt As String)
    CapturePages id, "cis:beplexikon", "4", _
        "Bertelsmann/Lexikon "+NoSpaces(txt), _
        "\nBertelsmann Lexikon*BRT-*\r", False, "\nSuchbegriff: ", _
        txt, "\nKein Eintrag gefunden", "\nEs wurden*Artikel gefunden, die mit", False
End Sub

'T:SendB (subroutine) (global)
'Sends a "b" to the service
Sub SendB(t As Tracker)
    Comms.Send "b\r"
    t.reset
End Sub

'T:MSL (subroutine) (CompuServe)
Sub MSL(id As String, remote As String, filename As String)
    Dim t As Tracker, tProt As Tracker

    If Not GoForum("cis:msl") Then
        LogResult "Unable to enter MS Library."
        Exit Sub
    End If

    Set t = CreateTracker("PromptNoRecords", "no records found")
    Comms.Send "2\r"
    WaitForPrompt "Prompt"
    Comms.Send "4\r"
    WaitFor "ame:"
    Comms.Send remote+"\r"
    WaitForPrompt "Prompt"
    t.delete

    ' Any matches?
    If PromptMatches("PromptNoRecords") Then
        LogResult "No matches for ["+remote+"] from MSL."
        WaitForPrompt "Prompt"
        GoTop
        ReportSuccess id & " : No matches for " & remote & " found in MSL "
        Exit Sub
    End If

    ' Go and download it
    Comms.Send "5\r"
    Set t = CreateTracker("PromptDownload", "download!")
    WaitForPrompt "Prompt"
    t.delete

    ' Only download if there is exactly one match
    If PromptMatches("PromptDownload") Then
        Set tProt = CreateTracker("SendProtocol", "Y) :", "SendB", False, False)
        Comms.Send "down\r"
        WaitFor "computer :"
        Comms.SendLiteral DownloadDir+filename
        Comms.Send "\r"
        WaitForPrompt "Prompt"
    Else
        LogResult "Error while trying to download "+remote+" from MSL."
    End If

    ' Clean up
    GoTop
    ReportSuccess id & " : " & FileUrl(DownloadDir+filename) & " downloaded from MSL "
End Sub

'T:MSKB (subroutine) (CompuServe)
Sub MSKB(id As String, keywords As String)
    Dim tEnd1 As Tracker, tEnd2 As Tracker, tStart As Tracker
    Dim tNotFound As Tracker
    Dim filename As String, tmp As String

    ' Go to main page
    If Not GoForum("cis:mskb") Then
        LogResult "Failed trying to GO MSKB"
        Exit Sub
    End If

    If UCase$(Mid(keywords,1,1))="Q" Or IsNumeric(keywords) Then
        ' Old style MSKB
        Comms.Send "6\r"
        WaitFor ":"
        Comms.Send keywords+"\r"

        Set tEnd1 = CreateTracker("PromptEnd1", "\nLast page. Enter ""DOWN"" to download!")
        Set tEnd2 = CreateTracker("PromptEnd2", "\nPress <CR> for more, or ""DOWN"" to download!")
        filename = UniqueFilename$()
        WaitFor keywords
        Capture CAPTURE_ON, filename
        CaptureText "!start Mskb/Download Microsoft "+Basic.Eoln$+keywords+Basic.Eoln$
        WaitForPrompt "Prompt"

        ' Clear up
        If PromptMatches("PromptEnd2") Then
            CaptureRewind 43
        Else
            CaptureRewind 36
        End If
        CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
        Capture CAPTURE_OFF
        tEnd1.delete
        tEnd2.delete
        GoTop

        ' Add to import queue
        If QueueFile(Session.Service, filename, IM_DELETE) Then
            ReportSuccess id & " : Document : " & keywords & " collected from MSKB "
        End If
    Else
        HasFailed = False
        pseudo = "Mskb/Download Microsoft"

        Comms.Send "4\r"
        WaitForPrompt "Prompt"

        Set tNotFound = CreateTracker("NotFound", "no documents found that match", "SetFailed")

        If Mid$(keywords, 1, 1)="!" Then
            Comms.Send "6\r"
            tmp = Mid$(keywords, 2)
        Else
            Comms.Send "7\r"
            tmp = keywords
        End If
        WaitFor "1:"
        Comms.Send ParseString(tmp, " ")+"\r"

        WaitFor "2:"
        If tmp<>"" Then
            Comms.Send ParseString(tmp, " ")+"\r"

            WaitFor "3:"
            Comms.Send ParseString(tmp, " ")+"\r"
        Else
            Comms.Send "\r"
        End If

        WaitForPrompt "PromptMain"
        tNotFound.delete

        ' Has it failed ?
        If HasFailed Then
            Comms.Send "\r"
            WaitForPrompt "PromptMain"
            ResetForum

            ' Report an error
            ReportSuccess id & " : MSKB search : no matches."
            Exit Sub
        End If

        ' Start capturing
        Comms.Send "8\r"
        WaitFor "8\r"
        Terminal.Enabled = False
        numpages = 0
        filename = UniqueFilename$()
        Capture CAPTURE_ON, filename
        Set tStart = CreateTracker("MessageStart", "\nKnowledge Base", "PageSplitter")
        Set tEnd1  = CreateTracker("PromptEnd1", "\nLast page. Enter ""DOWN"" to download!")
        Set tEnd2  = CreateTracker("PromptEnd2", "\nPress <CR> for more, or ""DOWN"" to download!")

        WaitForPrompt "Prompt"
        If PromptMatches("PromptMain") Then
            Comms.Send "all\r"
            WaitForPrompt "Prompt"
        End If

        ' The End
        If PromptMatches("PromptEnd2") Then
            CaptureRewind 43
        Else
            CaptureRewind 36
        End If
        CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
        Terminal.CaptureStatus CAPTURE_OFF
        Capture CAPTURE_OFF

        ' Clean up
        tStart.delete
        tEnd1.delete
        tEnd2.delete
        Comms.Send "\r"
        WaitForPrompt "Prompt"
        ResetForum
        Terminal.Enabled = True

        ' Add to import queue
        If QueueFile(Session.Service, filename, IM_DELETE) Then
            ReportSuccess id & " : Information from Mskb collected"
        End If
    End If
End Sub

'T:CountSelection(t As Tracker)
Sub CountSelection(t As Tracker)
    Dim s As String
    Dim i As Integer

    If HasFailed=False Then
        s = ""
        For i = 1 To Len(t.match)
            If IsNumeric(Mid(t.match, i, 1)) Then
                s = Mid(t.match, i)
                Exit For
            End If
        Next
        If InStr(s, " ")>0 Then
            s = Mid(s, 1, InStr(s, " ")-1)
            If Len(s) >= 5 Then
                numpages = 32760
            Else
                numpages = Val(s)
            End If
        End If
    End If
    t.reset
End Sub

'T:FileFinder (subroutine) (CompuServe)
Sub FileFinder(id As String, goWord As String, keywords As String, ftype As String, _
    fext As String, filename As String, limit As String, getdetail As String)
    Dim tmp As String, fname As String, finder As String
    Dim i As Integer
    Dim t1 As Tracker, t2 As Tracker, t3 As Tracker, t4 As Tracker
    Dim t5 As Tracker, t6 As Tracker, t7 As Tracker, t8 As Tracker

    ' Extract the GO word
    finder = Mid$(goWord, InStr(goWord, "(")+1)
    finder = Mid$(finder, 1, Len(finder)-1)
    goWord = ParseString(goWord, " ")

    ' default to 100 limit
    If limit="" Then limit="100"
    If goWord="GAMEFF" Then goWord = "GMF-10"

    If Not GoForum(goWord) Then
        LogResult finder+" unavailable."
        Exit Sub
    End If

    If goWord="GMF-10" Then
        Comms.Send "9\r"
    Else
        Comms.Send "1\r"
    End If
    WaitForPrompt "PromptMain"

    ' Install error handler
    HasFailed = False
    numpages = 0
    Set t1 = CreateTracker("Failed", "\nThere were no articles located that match your search criteria.", "SetFailed")
    Set t2 = CreateTracker("Selection", "\nCurrent selection*file", "CountSelection", False, True)

    ' (1) Request keyword search.
    If keywords<>"" Then
        tmp = keywords
        Comms.Send "1\r"

        WaitFor "1:"
        Comms.Send ParseString(tmp, " ")+"\r"

        WaitFor "2:"
        If tmp<>"" Then
            Comms.Send ParseString(tmp, " ")+"\r"

            WaitFor "3:"
            Comms.Send ParseString(tmp, " ")+"\r"
        Else
            Comms.Send "\r"
        End If

        WaitForPrompt "PromptMain"
    End If

    ' (2) We don't do date since it seems to hang CIS rather a lot.

    ' (3) We don't do forum search since we'd have to pick from a list
    ' which is slow and a pain.

    ' (4) File type - accepts number or text
    If HasFailed=False And ftype<>"" And UCase(Mid(ftype, 1, 2))<>"AN" Then
        ' Validate the type
        tmp = UCase(Mid(ftype, 1, 1))
        i = InStr("ABIRNGJ", tmp)
        If i<>0 Then tmp = Str$(i+1)
        If InStr("12345678", tmp) Then
            Comms.Send "4\r"
            WaitForPrompt "PromptMain"
            Comms.Send tmp+"\r"
            WaitForPrompt "PromptMain"
        End If
    End If

    ' (5) File Extension
    If HasFailed=False And fext<>"" Then
        Comms.Send "5\r"
        WaitFor "):"
        Comms.Send fext+"\r"
        WaitForPrompt "PromptMain"
    End If

    ' (6) File Name
    If HasFailed=False And filename<>"" Then
        Comms.Send "6\r"
        WaitFor "):"
        Comms.Send filename+"\r"
        WaitForPrompt "PromptMain"
    End If

    ' (7) Submitter isn't handled because it causes loads of problems
    ' Submitter ID:

    ' If too many matches then don't bother
    If limit<>"" And numpages > Val(limit) Then
        HasFailed = True
    End If

    ' Display it
    t1.delete
    t2.delete
    tmp = finder
    pseudo = "File_Finder/"+ParseString(tmp, " ")+" CompuServe"
    If HasFailed Then
        fname = StartCapture(pseudo)
        CaptureText keywords+", "+ftype+", "+fext+", "+filename+", " _
            +limit+", "+getdetail+Basic.Eoln$
        If limit<>"" And numpages > Val(limit) Then
            CaptureText "There were too many articles located that match your search criteria."
        Else
            CaptureText "There were no articles located that match your search criteria."
        End If
        CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
    Else
        Comms.Send "8\r"
        WaitFor "8\r"

        ' Start capturing
        fname = StartCapture(pseudo)
        CaptureText keywords+", "+ftype+", "+fext+", "+filename+", " _
            +limit+", "+getdetail+Basic.Eoln$

        WaitForPrompt "Prompt"
        CaptureRewind 1
        CaptureText Basic.Eoln$+"!end"+Basic.Eoln$

        If UCase(Mid(getdetail,1,1))="Y" And numpages>1 Then
            numpages = 0
            Set t1 = CreateTracker("MessageStart1", "\nPC File Finder", "PageSplitter")
            Set t2 = CreateTracker("MessageStart2", "\nGraphics File Finder", "PageSplitter")
            Set t3 = CreateTracker("MessageStart3", "\nGames File Finder", "PageSplitter")
            Set t4 = CreateTracker("MessageStart4", "\nMS File Finder", "PageSplitter")
            Set t5 = CreateTracker("MessageStart5", "\nAmiga File Finder", "PageSplitter")
            Set t6 = CreateTracker("MessageStart6", "\nAtari File Finder", "PageSplitter")
            Set t7 = CreateTracker("MessageStart7", "\nMAC File Finder", "PageSplitter")
            Set t8 = CreateTracker("MessageStart8", "\nWindows File Finder", "PageSplitter")
            Terminal.CaptureStatus CAPTURE_ON
            Terminal.Enabled = False

            ' Get all messages
            Comms.Send "all\r"
            WaitForPrompt "PromptLastPage"
            CaptureRewind 10
            CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
            Terminal.CaptureStatus CAPTURE_OFF
            Terminal.Enabled = True
            If NoSpaces(finder)="WINFF" Then
                Comms.Send "go top\r"
            Else
                Comms.Send "\r"
            End If
            WaitForPrompt "PromptMain"
            t1.delete
            t2.delete
            t3.delete
            t4.delete
            t5.delete
            t6.delete
            t7.delete
            t8.delete
        Else
            CaptureRewind 1
            CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
        End If
    End If

    ' Clean up
    Capture CAPTURE_OFF
    GoTop

    ' Add to import queue
    If QueueFile(Session.Service, fname, IM_DELETE) Then
        ReportSuccess id & " : Search for " & keywords & ";" & ftype  & ";" & fext    & ";" &  filename & " "
    End If
End Sub

'T:SetupOptions (subroutine) (CompuServe)
Sub SetupOptions(id As String)
    Dim tYN As Tracker, tNew As Tracker
    Dim HitCR1 As Tracker, HitCR2 As Tracker, tName As Tracker
    Dim t1 As Tracker, t2 As Tracker, tInvalid As Tracker

    ' Handle the odd CIS query automatically
    Set tYN = CreateTracker("IsYN", "(Y or N) !")
    Set tNew = CreateTracker("IsNew", "New:")
    Set HitCR1 = CreateTracker("PromptMore1", "<CR> for more !", "SendCR")
    Set HitCR2 = CreateTracker("PromptMore2", "Press <CR>!", "SendCR")
    Set tName = CreateTracker("IsName", "name:")

    Comms.Bitmask = True
    ' Set mail name
    Comms.Send "go home:mail\r"
    WaitForPrompt "Prompt"
    Comms.Send "go home:mail\r"
    WaitForPrompt "Prompt"
    Comms.Send "address name\r"
    WaitForPrompt "Is"
    If PromptMatches("IsYN") Then
        Comms.Send "y\r"
        WaitForPrompt "Prompt"
    Else
        Comms.SendLiteral MailName
        Comms.Send "\r"
        Set tNew = CreateTracker("IsNew", "New:", "SendCR")
        WaitFor "N) !"
        Comms.Send "n\r"
        WaitForPrompt "Prompt"
        tNew.delete
    End If
    tYN.delete
    tName.delete
    Comms.Send "set retain yes\r"
    WaitForPrompt "Prompt"
    SetEditorToNO = False
    SetPagedOutputToNO = False
    Set t1 = CreateTracker("EdLineNum", "EDITOR uses line numbers [YES]", "EditorLineNum")
    Set t2 = CreateTracker("PgOutput", "Output is PAGED [YES]", "PagedOutput")
    Comms.Send "set\r"
    WaitForPrompt "Prompt"
    t1.Delete
    t2.Delete
    If SetEditorToNO = True then
        Comms.Send "1\r"
        WaitForPrompt "Prompt"
    End If
    If SetPagedOutputToNO = True then
        Comms.Send "3\r"
        WaitForPrompt "Prompt"
    End If
    Comms.Send "mode\r"
    WaitForPrompt "Prompt"
    Comms.Send "3\r"
    WaitForPrompt "Prompt"
    Comms.Send "\r"
    WaitFor "!"
    Comms.Send "y\r"
    WaitForPrompt "Prompt"
    tName.Delete

    Comms.Send "go default\r"

    ' Set options
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "4\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "4\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "5\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "6\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "3\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor ".)"
    WaitFor ".)"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "!"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "6\r" ' set english
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "7\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor ":"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "4\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"

    'This handles the CIS Screw Up of making Term Type = 8 invalid
    'even though it is on the menu!!!!!!!!!!!
    Set tInvalid=CreateTracker("CIS_Screw_Up", "\nEnter WIDTH \[10-255\] : ", "SendCR")

    Comms.Send "8\r"
    WaitFor "!"

    Comms.Send "\r"

    tInvalid.Delete

    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor ":"
    Comms.Send "79\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "3\r"
    WaitFor "page:"
    Comms.Send "0\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "6\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "7\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "10\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "11\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "5\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "2\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "\r"
    WaitFor "Enter"
    WaitFor "!"
    Comms.Send "1\r"
    WaitFor "!"
    Comms.Send "\r"  ' Taz fix
    HitCR1.Delete
    HitCR2.Delete

    WriteIni "Service "+Session.Service, "Set Options", "YES", Session.IniFilename
    If id<>"" Then
        ReportSuccess id & " : CompuServe has been successfully configured for use with Virtual Access"
    Else
        LogResult "CompuServe has been successfully configured for use with Virtual Access"
    End If
End Sub

'T:Directory (subroutine) (CompuServe)
Sub Directory(id As String, lastname As String, forename As String, city As String, country As String, state As String)
    Dim fname As String
    Dim t1 As Tracker, t2 As Tracker, t3 As Tracker

    If Not GoForum("cis:directory") Then
        LogResult "Membership Directory Failed."
        Exit Sub
    End If

    Comms.Send "2\r"
    WaitFor "help)"

    ' Lastname
    WaitFor ":"
    Comms.Send lastname+"\r"

    ' Forename
    WaitFor ":"
    Comms.Send forename+"\r"

    WaitFor ":"
    If Len(city)>0 Then
        Comms.Send city+"\r"
    Else
        Comms.Send "\r"
        WaitFor ":"
        Comms.Send country+"\r"

        If StrComp(country, "USA", 1)=0 Or StrComp(country, "US", 1)=0 Then
            WaitFor ":"
            Comms.Send state+"\r"
        End If
    End If

    WaitFor "\nSearching..."

    ' Install some error traps
    Set t1 = CreateTracker("DirBadCity", "\nCity : ")
    Set t2 = CreateTracker("DirBadCountry", "\nCountry \[*\] : ", "", False, True)
    Set t3 = CreateTracker("DirOK", "\nEnter search crit")

    ' Start capturing
    fname = StartCapture("Directory/Members CompuServe")
    CaptureText lastname+", "+forename+", "+city+", "+country+", " _
        +state+Basic.Eoln$+Basic.Eoln$
    CaptureText "Surname, Firstname                 Location, Country                    User Id"
    WaitForPrompt "Dir"
    If PromptMatches("DirOK") Then
        CaptureRewind 17
    End If
    CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
    t1.delete
    t2.delete
    t3.delete

    ' Clean up
    Capture CAPTURE_OFF
    If PromptMatches("DirOK") Then
        WaitFor ") :"
    End If
    Comms.Send "/exit\r"
    WaitForPrompt "Prompt"

    ' Add to import queue
    If QueueFile(Session.Service, fname, IM_DELETE) Then
        ReportSuccess id & " : Search for " & lastname & ";" & forename & ";" & city & ";" & country & ";" & state & " "
    End If
End Sub

'T:SetSearch (subroutine) (CompuServe)
Sub SetSearch(menuid As String, prompt As String, txt As String)
    If HasFailed=False And txt<>"" And txt<>"0" And txt<>"1" Then
        Comms.Send menuid+"\r"

        WaitFor prompt
        Comms.Send txt+"\r"

        WaitForPrompt "PromptMain"
    End If
End Sub

'T:SupportForum (subroutine) (CompuServe)
Sub SupportForum(id As String, searchtype As String, prodname As String)
    Dim fname As String

    ' Only search by one parameter
    If Mid$(searchtype, 1, 1)<>"1" And Mid$(searchtype, 1, 1)<>"2" Then
        LogResult "Support Forum Finder Failed due to invalid parameters."
        Exit Sub
    End If

    If Not GoForum("cis:support") Then
        LogResult "Support Forum Finder Failed."
        Exit Sub
    End If

    ' Tell CIS what to search for
    Comms.Send Mid$(searchtype, 1, 1)+"\r"
    WaitFor ":  :"
    Comms.SendLiteral prodname
    Comms.Send "\r"
    WaitFor "\r"

    ' Capture it
    fname = StartCapture("Support/Forums CompuServe")
    WaitForPrompt "PromptMain"
    CaptureRewind 1
    CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
    Capture CAPTURE_OFF
    ResetForum

    ' Add to import queue
    If QueueFile(Session.Service, fname, IM_DELETE) Then
        ReportSuccess id & " : Search for " & prodname
    End If
End Sub

'T:APOnline (subroutine) (CompuServe)
Sub APOnline(id As String, subj As String)
    Dim filename As String
    Dim i As Integer
    Dim section As String
    Dim t As Tracker, tErr As Tracker

    If Not GoForum("cis:apo-1") Then
        LogResult "Associated Press Online is not available; Please try later."
        Exit Sub
    End If

    filename = UniqueFilename$()
    Capture CAPTURE_ON, filename
    Terminal.CaptureStatus CAPTURE_ON
    Terminal.Enabled = False
    numpages = 0
    section = Mid(subj, InStr(subj, " ")+1)
    pseudo = "AP_Online/"+NoSpaces(section)+" Assoc_Press"
    If Mid(subj, 1, 2)="1 " Then
        Set t = CreateTracker("MessageStart", "\nAP Top News*E?T*\r", "PageSplitter", False, True)
    Else
        Set t = CreateTracker("MessageStart", "\nAP*E?T*\r", "PageSplitter", False, True)
    End If
    Set tErr = CreateTracker("PromptInvalid", "\n* is an invalid choice !", "", False, True)

    Comms.Send Mid(subj, 1, 2)+"\r"
    WaitForPrompt "PromptMain"

    If numpages = 0 Then
        i = 1
        Do
            Comms.Send Str$(i)+"\r"
            WaitFor Str$(i)+"\r"
            CaptureRewind 1+Len(Str$(i))
            Do
                WaitForPrompt "Prompt"
            Loop Until PromptMatches("PromptMain") Or _
                       PromptMatches("PromptInvalid")
            i = i + 1
        Loop Until PromptMatches("PromptInvalid")
        CaptureRewind 24
    End If

    ' Clear up
    t.delete
    tErr.delete
    CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
    Capture CAPTURE_OFF
    Terminal.CaptureStatus CAPTURE_OFF
    Terminal.Enabled = True
    Comms.Send "\r"
    WaitForPrompt "PromptMain"

    ' Add to import queue
    If QueueFile(Session.Service, filename, IM_DELETE) Then
        ReportSuccess id & " : Search for " & subj & " in APOnline "
    End If
    GoTop
End Sub

'T:SetupWizard (subroutine) (CompuServe)
Sub SetupWizard(mailname As String, organisation As String)
    WaitForPrompt "Prompt"
    SetupOptions ""
End Sub

'T:CreateAccount (subroutine) (CompuServe)
Sub CreateAccount
    WaitFor "Choice :"
    Comms.Send "1\r"
    WaitFor "#:"
    Comms.Send "ASHMOUNT\r"
    WaitFor "#:"
    Comms.Send "93006\r"
    ManualTerminal
End Sub

Sub EditorLineNum(t as tracker)
    SetEditorToNO = True
End Sub

Sub PagedOutput(t as tracker)
    SetPagedOutputToNO = True
End Sub

'T:AsciiUserLog (subroutine) (CompuServe)
Sub AsciiUserLog(id As String, forum As String)
    Dim filename As String

    If Not GoForum(forum) Then
        LogResult "Unable to access " + forum + " to get user log"
        Exit Sub
    End If

    filename = StartCapture(forum + "/Sysop_Logs User_Log")
    CaptureText "Who Accessed Forum"+Basic.Eoln$
    Terminal.Enabled=False
    Terminal.Status "Collecting forum user log ... Please wait"
    Comms.Send "ulog\r"
    WaitForPrompt "Prompt"
    CaptureRewind 7
    CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
    Capture CAPTURE_OFF
    Terminal.Enabled=True
    ' Add to import queue
    If QueueFile(Session.Service, filename, IM_DELETE) Then
        ReportSuccess id & " : User log collected from " & forum
    Else
        ReportSuccess id & " : User log for forum " & forum & " failed"
    End If
End Sub