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

Text File | 1999-10-06 | 18.8 KB | 538 lines

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

Declare Function ParseString(args As String, delim As String) As String
Declare Function QueueFile(service As String, sfilename As String, queueflags As Long) As Boolean

Const IM_DELETE = 2048      ' Delete scratchpad file afterwards?

Public DownloadDir As String    'where downloads go
Public WorkingPath As String    'added to speed up Fetch stuff online
Public WhereAmI As String        'name of last forum/page etc
Public Sysop As Boolean            'are we a sysop?
Public InAscii As Boolean
Public LocalHMN As Boolean

Dim lastprompt As String    'Tracker name of the last prompt encountered
Dim lastmatch As String     'Tracker match text of the last prompt encountered
Dim MailSubject As String   'Subject for current mail message
Dim MailFilename As String  'Filename for current mail message
Dim Success As Boolean  'Whether command succeeded
Dim Failure As String       'Reason command failed (error message)
Dim sctrack As Tracker      'Success/Failure tracker
Dim BellSet As Boolean      'do we have ^G prompt set?
Dim nummessages As Integer
Dim LastDownMessages As String
Dim LastFailure As String   'last forum we failed going to
Dim binfname As String
Dim binfrom As String
Dim billingproblem As Boolean   'workaround CIS switching into 7bit mode
Dim SetHighMessage As Boolean

Declare Function UniqueFileName$
Declare Function MyDate$
Declare Sub SetHighMessageNumber

'T:Main - CIS (subroutine) (CompuServe) (CompuServe)
'Entry point. Does a complete blink
Sub Main
    On Error Goto Main_error
    If Instr(Command$, "debug") Then
        ViewportOpen
        Capture CAPTURE_ON
        Print "Current Directory = "; CurDir$
    End If

    Trackers.DefaultIgnoreCase = False
    Trackers.DefaultWildcard = False
    InAscii = False

    ' Default download dir
    DownloadDir = ReadIni$("Service "+Session.Service, "Download Directory", Session.IniFilename)
    AddBackSlash DownloadDir

    ' added this to use in RemoteSearch
    WorkingPath = ReadIni$("Service "+Session.Service, "Work Path", Session.IniFileName)
    AddBackSlash WorkingPath

    LocalHMN = StrComp(ReadIni$("Service "+Session.Service, "Local HMN", Session.IniFileName), "YES", 1)=0

    'Create the cis.rep file
    StartReportFile
    LogResult "CompuServe connection Started " + MyDate$ + " (" + _
        ReadIni$(Session.IniSection, "Description", Session.IniFileName)+ ")"
    Terminal.Log = True
    Terminal.Print "Started at " + MyDate$ + Basic.Eoln$

    LoadExtraLibraries
    LoadAddonLibraries
    SetUpStandardTrackers

    HMIMain

    LogResult "CompuServe connection Finished " + MyDate$
    Terminal.Print "Finished at " + MyDate$ + Basic.Eoln$
    'Close and queue the cis.rep file
    EndReportFile
    Exit Sub
Main_error:
    LogResult "Error:" + Str$(Err) + " in line " + Str$(Erl) + ":" + Error$
    LogResult "CompuServe connection Failed " + MyDate$
    'Close and queue the cis.rep file
    EndReportFile
End Sub

' Load the other libraries
Sub LoadExtraLibraries
    LoadScript "hmibase.ebs"
    LoadScript "hmimail.ebs"
    LoadScript "hmiforum.ebs"
    LoadScript "hmilib.ebs"
    LoadScript "hmisysop.ebs"
    LoadScript "basic.ebs"
    LoadScript "billing.ebs"
    LoadScript "ens.ebs"
    LoadScript "exec.ebs"
    LoadScript "online.ebs"
    LoadScript "sysop.ebs"
    LoadScript "sysop2.ebs"
    LoadScript "sysoplib.ebs"
    LoadScript "weather.ebs"
    LoadScript "ziff.ebs"
    LoadScript "obsolete.ebs"

    ' User created scripts should go into user.ebs
    LoadScript "user.ebs"
End Sub

'T:LookupForum (subroutine) (CompuServe)
Function LookupForum(forum As String) As String
    Dim newforum As String

    newforum = ReadIni$("Forum Lookup", forum, Session.ServicePath+"userlist.ini")
    If newforum="" Then
        newforum = ReadIni$("Forum Lookup", forum, Session.ServicePath+"list.ini")
    End If
    'LogResult "Forum Lookup: "+forum+" -> "+newforum
    If newforum="" Then
        LookupForum = forum
    Else
        LookupForum = newforum
    End If
End Function

'T:ResetForum (subroutine) (CompuServe)
' Clears the current forum - so the next GoForum() does it
Sub ResetForum
    WhereAmI = ""
    Sysop = False
End Sub

'T:SectionNumber (function) (CompuServe)
'Returns section number as a string or "" if nothing there
Function SectionNumber(ByVal section As String)
    Dim i% As Integer
    Dim tsection As String

    SectionNumber = ""
    i% = InStr(section, "/S", 1)
    If i%=0 Then i% = InStr(section, "/L", 1)
    If i%<>0 Then
        tsection = Mid(section, i%+2)
        i% = InStr(tsection, "_")
        If i% = 0 Then i% = InStr(tsection, " ")
        If i%<>0 Then
            SectionNumber = Mid(tsection, 1, i%-1)
        Else
            SectionNumber = tsection
        End If
    End If
End Function

'T:ForumName (function) (CompuServe)
'Returns forum name part of forum/section or "" if nothing there
Function ForumName(ByVal forum As String) As String
    ForumName = ParseString(forum, "/")
End Function

'T:StartCapture (subroutine) (CompuServe)
' Opens capture file and sticks header it it
Function StartCapture(pseudo As String)
    Dim filename As String

    filename = UniqueFilename$()
    Capture CAPTURE_ON, filename
    CaptureText Basic.Eoln$+"!start "+pseudo+Basic.Eoln$
    StartCapture = filename
End Function

Sub ReplaceAllInString(txt As String, search As String, replace As String)
    Dim i As Integer, s As Integer, r As Integer

    s = Len(search)
    r = Len(replace)
    i = Instr(txt, search)
    While i > 0
        If s = r Then
            Mid$(txt, i, s) = replace
        Else
            txt = Left$(txt, i - 1) + replace + Mid$(txt, i + s)
        End If
        i = Instr(i + r, txt, search)
    Wend
End Sub

Sub ReplaceAnyInString(txt As String, search As String, replace As String)
    Dim i As Integer, s As Integer

    s = Len(txt)
    For i = 1 To s
        If Instr(search, Mid$(txt, i, 1)) Then
            Mid$(txt, i, 1) = replace
        End If
    Next
End Sub

'T:QueFetches (subroutine) (CompuServe)
'added this should make the Fetch process faster and neater
Sub QueFetches
   Dim c as Boolean, Fetchfilename As String

   Fetchfilename = WorkingPath + "mswfetch.tmp"

   If FileExists(Fetchfilename) Then
       If FileLen(Fetchfilename) > 0 Then
           c = QueueFile(Session.Service, Fetchfilename, IM_DELETE)
       Else
           DeleteFile Fetchfilename
       End If
   End If
End Sub

Function FullErrorMessage() As String
    FullErrorMessage = err & " in line " & erl & ":" & Error$
End Function

'T:Standard Trackers for CompuServe
'The standard CIS trackers
Sub SetUpStandardTrackers()
    Dim t As Tracker

    Set t = CreateTracker("PromptChoice1", "\nEnter choice!", "", True)
    Set t = CreateTracker("PromptChoice2", "\nEnter choice !", "", True)
    Set t = CreateTracker("PromptEnter", "\nPress <CR> !")
    Set t = CreateTracker("BadCommand", "\nI don't recognize that command.")
    Set t = CreateTracker("PromptNextOrChoice", "\nPress <CR> for next or type CHOICES !")
    Set t = CreateTracker("PromptMain", "\n!")
    Set t = CreateTracker("PromptForum", "\nForum !")
    Set t = CreateTracker("PromptMessages", "\nMessages !")
    Set t = CreateTracker("PromptAction", "\nRead action !")
    Set t = CreateTracker("PromptOK", "\nOK")
    Set t = CreateTracker("PromptPost", "\nPost action !")
    Set t = CreateTracker("PromptNumber1", "\nEnter choice number!")
    Set t = CreateTracker("PromptNumber2", "\nEnter choice number !")
    Set t = CreateTracker("PromptMail", "\nMail!")
    Set t = CreateTracker("PromptLibrary", "\nLIB ")
    Set t = CreateTracker("PromptAdditional", "\nDo you wish additional information (Y or N)!", "SendNo")
    Set t = CreateTracker("PromptMore", "\nMORE !", "SendCR")
    Set t = CreateTracker("PromptMore2", Chr$(19)+Chr$(13)+Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)+"PAGE", "SendCR")
    Set t = CreateTracker("PromptMore3", Chr$(13)+"PAGE", "SendCR")
    Set t = CreateTracker("PromptAdd", "ADDress or HELp")
    Set t = CreateTracker("PromptEmpty1", "\nThat page is empty !")
    Set t = CreateTracker("PromptEmpty2", "\nThat page is empty!")
    Set t = CreateTracker("PromptLast", "\nLast page, enter choice!")
    Set t = CreateTracker("PromptDelete", "Delete these messages\? (Y or N)!")
    Set t = CreateTracker("PromptSend1", "SEND!")
    Set t = CreateTracker("PromptSend2", "User ID):")
    Set t = CreateTracker("PromptLastPage1", "\nLast Page!", "", True)
    Set t = CreateTracker("PromptLastPage2", "\nLast Page !", "", True)
    Set t = CreateTracker("PromptSO1", "\nSO !", "", True)
    Set t = CreateTracker("PromptSO2", "\nMembership Maintenance !", "", True)
    Set t = CreateTracker("PromptSO3", "\nMaintenance !", "", True)
End Sub

'T:SetStandardOptions (subroutine) (CompuServe)
Sub SetStandardOptions
    Comms.AutoDownload = PROT_QUICKB
    Comms.Send "set width 79\r"
    WaitForPrompt "Prompt"
End Sub

'T:SuccessMatched (subroutine) (CompuServe)
'Tracker procedure called if the success tracker is hit
Sub SuccessMatched(t As Tracker)
    Print "SuccessMatched :"; t.Name; "="; t.Match
    Success = True
    t.reset
End Sub

'T:FailureMatched (subroutine) (CompuServe)
'Tracker procedure called if the failure tracker is hit
'The match string is stored in the Failure variable for showing to the user
Sub FailureMatched(t As Tracker)
    Print "FailureMatched :"; t.Name; "="; t.Match
    Success = False
    Failure = Failure + t.Match
    t.reset
End Sub

'T:TrackSuccess (subroutine) (CompuServe)
'Set up a success tracker to match pattern s
'If the tracker isn't matched, we will report defaulterr
Sub TrackSuccess(s As String, defaulterr As String)
    If sctrack Is Not Nothing Then sctrack.delete
    Set sctrack = CreateTracker("sctrack", s, "SuccessMatched")
    Success = False
    Failure = defaulterr
End Sub

'T:TrackFailure (subroutine) (CompuServe)
'Set up a failure tracker to match pattern s
'If it is matched, the match string will be stored in the Failure variable
Sub TrackFailure(s As String)
    If sctrack Is Not Nothing Then sctrack.delete
    If s<>"" Then
        Set sctrack = CreateTracker("sctrack", s, "FailureMatched")
        Success = True
        Failure = ""
    End If
End Sub

'T:ReportSuccessFlag (subroutine) (CompuServe)
'At the end of the command, report whether it succeeded
'Assumes either TrackSuccess or TrackFailure has been called at start
Sub ReportSuccessFlag(id As String)
    If sctrack Is Not Nothing Then sctrack.delete
    If Success Then
        ReportSuccess id
    Else
        ReportFailure id, Failure
    End If
End Sub

'T:PromptMatches (function) (CompuServe) (CompuServe)
'Check if the last prompt tracker name matches prefix
Function PromptMatches(prefix As String)
    PromptMatches = (Left$(lastprompt, len(prefix)) = prefix)
End Function

'T:TimedWaitForPrompt(subroutine) (CompuServe)
'Timed wait for a prompt whose tracker name matches prefix
Sub TimedWaitForPrompt(prefix As String, timeout As Integer)
    Dim t As Tracker

    Print "WaitForPrompt "; prefix
    Trackers.Reset
    Do
        Set t = Wait(10 * timeout)
        lastprompt = t.Name
        lastmatch = t.Match
        t.reset
    Loop Until PromptMatches(prefix)
End Sub

'T:WaitForPrompt (subroutine) (CompuServe)
'Wait 4 mins for a prompt whose tracker name matches prefix
Sub WaitForPrompt(prefix As String)
    TimedWaitForPrompt prefix, 240
End Sub

'T:GoTop (subroutine) (CompuServe)
' Go to the top menu
Sub GoTop
    If SetHighMessage Then
        Comms.Send "high;l\r"
        WaitForPrompt "Prompt"
        SetHighMessage = False
    End If
    ResetForum
    Comms.Send "go cis:top\r"
    WaitForPrompt "Prompt"
End Sub

'T:SetSysop (subroutine) (global)
Sub SetSysop(t As Tracker)
    Print "Matched:"; t.name
    t.reset
    Sysop = True
End Sub

'T:GoForum (function) (CompuServe)
' Intelligently GO forum/page etc
Function GoForum(ByVal forum As String) As Boolean
    Dim go1 As Tracker, go2 As Tracker, go3 As Tracker, go4 As Tracker
    Dim go5 As Tracker, go6 As Tracker, go7 As Tracker, go8 As Tracker
    Dim go9 As Tracker, go10 As Tracker, go11 As Tracker, go12 As Tracker
    Dim go13 As Tracker, go14 As Tracker, go15 As Tracker, go16 As Tracker
    Dim go17 As Tracker, go18 As Tracker, go19 As Tracker, go20 As Tracker
    Dim go21 As Tracker, go22 As Tracker, go23 As Tracker, go24 As Tracker
    Dim go25 As Tracker, go26 As Tracker, go27 As Tracker, go28 As Tracker
    Dim go29 As Tracker, go30 As Tracker, go31 As Tracker, t As Tracker
    Dim sysop1 As Tracker, sysop2 As Tracker, sysop3 As Tracker
    Dim filename As String, b As Boolean

    ' Mangle the forum name a bit
    forum = ParseString(forum, "/")
    If Instr(forum, ":")=0 Then
        forum = "cis:"+forum
    End If

    ' Use the lookup table to auto-convert menus to forums.
    ' eg. 'PCPLUS' -> 'PCPFORUM'
    forum = LookupForum(forum)

    ' Sort out any switch between ascii/hmi
    If InAscii=False Then
        SetHighMessageNumber
        ResetForum
        InAscii = True
    End If

    ' If we're already here then do nothing
    If WhereAmI <> forum Then
        GoForum = False

        ' If we failed last time then we're just gonna fail again
        If LastFailure=forum Then
            Exit Function
        End If
        BellSet = False
        On Error Goto GoForum_error
        If SetHighMessage Then
            Comms.Send "high;l\r"
            WaitForPrompt "Prompt"
            SetHighMessage = False
        End If
        Trackers.Delete 'disable all trackers
        ResetForum

        Set go1 = CreateTracker("GoPromptForum1", "\nForum !", "")
        Set go3 = CreateTracker("GoMore1", "\nMORE !", "SendCR")
        Set go4 = CreateTracker("GoPromptMenu", "\n!", "")
        Set go5 = CreateTracker("GoUnavailable1", "\n? Service is temporarily unavailable", "")
        Set go6 = CreateTracker("GoUnavailable2", "\n% ENS is temporarily unavailable due to hardware problems.", "")
        Set go7 = CreateTracker("GoUnavailable3", "\n?*is temporarily unavailable", "", False, True)
        Set go8 = CreateTracker("GoUnavailable4", "Capacity limit exceeded, please try later", "")
        Set go9 = CreateTracker("GoUnavailable5", "INSTOF Tempcore OPEN failure", "")
        Set go10= CreateTracker("GoUnavailable6", "This Forum is temporarily\nclosed for maintenance.", "")
        Set go11= CreateTracker("GoUnavailable7", "\n% Forum is at maximum capacity", "")
        Set go12= CreateTracker("GoUnavailable8", "\n?? LOGTWO - Cannot take more than 2 minutes to Log-in", "")
        Set go13= CreateTracker("GoUnavailableHMI1", "\nYour communications software is not able to access this product", "")
        Set go14= CreateTracker("GoUnavailableHMI2", "\nRequested page is empty. Key T for top!", "")
        Set go15= CreateTracker("GoUnavailableHMI3", "\nCIM Only Product   GGG-292", "")
        Set go16= CreateTracker("GoPressCR1", "\nPress <CR> !", "SendCR")
        Set go17= CreateTracker("GoPressCR2", "\nPress <CR> to continue :", "SendCR")
        Set go18= CreateTracker("GoUnknown1", "\n* is unrecognized!", "", False, True)
        Set go19= CreateTracker("GoUnknown2", "\nUnknown service error!", "")
        Set go20= CreateTracker("GoPromptIssue1", "\n\rIssue:")
        Set go21= CreateTracker("GoPromptIssue2", "\nIssue:")
        Set go22= CreateTracker("GoPromptCommodity1", "\n\rCommodity:")
        Set go23= CreateTracker("GoPromptCommodity2", "\nCommodity:")
        Set go24= CreateTracker("GoPromptCompany1", "\n\rCompany:")
        Set go25= CreateTracker("GoPromptCompany2", "\nCompany:")
        Set go26= CreateTracker("GoEmpty", "\nThat page is empty!")
        Set go27= CreateTracker("GoNewsflash", "\nNews Flash:")
        Set go28= CreateTracker("GoEnterChoice1", "\nEnter choice!")
        Set go29= CreateTracker("GoEnterChoice2", "\nEnter choice !")
        Set go30= CreateTracker("GoMore2", Chr$(19)+Chr$(13)+Chr$(0)+Chr$(0)+Chr$(0)+Chr$(0)+"PAGE", "SendCR")
        Set go31= CreateTracker("GoMore3", Chr$(13)+"PAGE", "SendCR")
        Set sysop1 = CreateTracker("GoLibNeeded", "\nThe following Libraries need attention:")
        Set sysop2 = CreateTracker("GoLibNoBlocks", "\nThe Forum Libraries have No Blocks")
        Set sysop3 = CreateTracker("GoSysop", "\nGreetings, SYSOP!", "SetSysop")

        ' Try to go
        WhereAmI = ""
        Comms.Send "go " + forum + "\r"
        WaitForPrompt "Go"

        ' Capture the newsflash
        If PromptMatches("GoNewsflash") Then
            filename = StartCapture(forum+"/Newsflash CompuServe")
            CaptureText "News Flash"+Basic.Eoln$
            WaitForPrompt "Go"
            CaptureRewind 7
            CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
            Capture CAPTURE_OFF
            b = QueueFile(Session.Service, filename, IM_DELETE)
        End If

        ' Capture the library attention messages
        If PromptMatches("GoLib") Then
            sysop1.Active = False
            sysop2.Active = False
            filename = StartCapture(forum+"/Sysop_Logs Library_Attention")
            CaptureText lastmatch
            WaitForPrompt "Go"
            CaptureRewind 7
            CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
            Capture CAPTURE_OFF
            b = QueueFile(Session.Service, filename, IM_DELETE)
        End If

        ' Check for a ^G prompt
        If PromptMatches("GoPromptForum1") Then
            On Error Resume Next
            Set t = Wait(2)
        End If

        Terminal.Status "GoForum: "+forum
        On Error Goto 0
        Trackers.delete
        SetupStandardTrackers

        ' Handle the prompt
        If PromptMatches("GoUnavailable") Then
            LastFailure = forum
            SetHighMessage = False
            If PromptMatches("GoUnavailable1") Then
                WaitFor "continue:"
                GoTop
            Else
                If PromptMatches("GoUnavailableHMI") Then
                    ' Oops!  A HMI forum
                    filename = StartCapture(forum+"/Newsflash CompuServe")
                    CaptureText "New Forum Information"+Basic.Eoln$
                    CaptureText "Virtual Access is currently not able to access this forum. Ashmount"+Basic.Eoln$
                    CaptureText "Research is currently working to rapidly bring this service back to you."+Basic.Eoln$+Basic.Eoln$

                    CaptureText "In the mean time you can use the CompuServe Information Manager"+Basic.Eoln$
                    CaptureText "available in GO CIMSOFT forum."+Basic.Eoln$+Basic.Eoln$

                    CaptureText "More details about this new forum product is available in GO NEWFORUM."+Basic.Eoln$
                    CaptureText "If you have any questions, GO FEEDBACK or send mail to CompuServe"+Basic.Eoln$
                    CaptureText "Customer Service at 70006,101."+Basic.Eoln$
                    CaptureText "!end"+Basic.Eoln$
                    Capture CAPTURE_OFF
                    b = QueueFile(Session.Service, filename, IM_DELETE)
                    If PromptMatches("GoUnavailableHMI1") Then Comms.Send Chr$(3)+"T\r"
                    If PromptMatches("GoUnavailableHMI2") Then Comms.Send "GO TOP\r"
                End If
                WaitFor "\n!"
            End If
            LogResult "GoForum:"+forum+":Failed - unavailable."
            Exit Function
        End If
        If PromptMatches("GoUnknown") Or PromptMatches("GoEmpty") Then
            LastFailure = forum
            SetHighMessage = False
            GoTop
            LogResult "GoForum:"+forum+":Failed - unknown."
            Exit Function
        End If

        ' It all worked
        WhereAmI = forum
    End If

    LastFailure = ""
    GoForum = True
    Exit Function

GoForum_error:
    On Error Goto 0
    LogResult "GoForum:"+forum+":Failed error: "+Error$+" ("+LTrim(Str$(Err))+")"
    Trackers.delete
    SetupStandardTrackers
End Function