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

Text File | 1999-10-06 | 18.3 KB | 491 lines

'T:HMILIB.EBS for CompuServe
' VA 4.52 release
' 20.11.97 SH - incorporated Taz' script split and reporting improvements

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
Declare Sub ReportSuccess(msg As String)
Declare Function FullErrorMessage() As String
Declare Sub LogResult(result As String)
Declare Sub RecordFileDownload(topic As String, fname As String)
Declare Function UniqueFileName$()
Declare Function FileUrl(fn As String) As String
Declare Function ParseSectionList(ByVal sect As String, ByVal validsects As Long, ByRef count As Integer) As Long
Declare Sub WriteLibraryMessage(forum As String, filedesc As FAPFILEDESCRIPTION, downloaded As String)
Declare Function SectionNumber(ByVal section As String)
Declare Sub NewSearchLibrary(id As String, forum As String, catalog As String, _
                  ssections As String, filename As String, uploadby As String, _
                  age As String, accesscount As String, keywords As String, _
                  title As String, description As String, full As String, _
                  replace As String)
Declare Function HMIGotoForum(ByVal forum As String) As Boolean
Declare Sub JoinForum(id As String, forum As String, handle As String, newmsgs As String)

Const BlockSize = 2048

Const IM_DELETE = 2048        ' Delete scratchpad file afterwards?
Const IM_MARKUNREAD = 131072

Public DownloadDir As String    'where downloads go
Public WhereAmI As String        'name of last forum/page etc
Public FAPconfig As FAPCONFIG
Public SectionLibIds(32) As Integer
Public szLibSection() As FAPSECTIONENTRY
Dim sectionvector As Long, filterVector As Long

Const ALL_HEADER_FIELDS% = &H1FF3
Const FAP_FDC_FILE_TYPE% = &H4
Const FAP_FDC_FILE_SIZE% = &H8
Const FAP_FDC_ABSTRACT% = &H100

Const FAP_SFH_FILENAME% = 0
Const FAP_SFH_USER_ID% = FAP_SFH_FILENAME + 1
Const FAP_SFH_KEYWORD% = FAP_SFH_USER_ID + 1
Const FAP_SFH_ACCESS_COUNT% = FAP_SFH_KEYWORD + 1
Const FAP_SFH_DATE_RANGE% = FAP_SFH_ACCESS_COUNT + 1
Const FAP_SFH_LAST_ACCESS_RANGE% = FAP_SFH_DATE_RANGE + 1
Const FAP_SFH_FILE_ABSTRACT% = FAP_SFH_LAST_ACCESS_RANGE + 1
Const FAP_SFH_FILE_BODY% = FAP_SFH_FILE_ABSTRACT + 1
Const FAP_SFH_MATCH_NON_PUBLIC_ONLY% = FAP_SFH_FILE_BODY + 1
Const FAP_SFH_SIZE_RANGE% = FAP_SFH_MATCH_NON_PUBLIC_ONLY + 1
Const FAP_SFH_TITLE% = FAP_SFH_SIZE_RANGE + 1

Const DAP_AL_VOLATILE = &H02
Const DAP_AP_SESSION_ONLY = &H01
Const DAP_AP_VOLATILE = &H02
Const DAP_AP_EX_HAVE_TITLE% = &H0100
Const DAP_AP_HAVE_HEADER% = &H04
Const DAP_AP_HAVE_TRAILER% = &H08
Const HMI_DATA_SIZE% = 1024
Const HMI_STATE_FIRST% = 0
Const HMI_STATE_NEXT% = HMI_STATE_FIRST + 1
Const FAP_USF_HIGH_MSG% = &H2
Const FAP_USF_NAME% = &H4
Const FAP_USR_JOIN% = &H1
Const FAP_USR_PERMANENT% = &H2
Const FAP_WAITING_MSGS% = &H1
Const FAP_NEW_BULLETINS% = &H2
Const FAP_CONFERENCE_IN_PROGRESS% = &H4
Const FAP_NOT_A_MEMBER% = &H8
Const FAP_IS_SYSOP% = &H10        ' user is SYSOP in this Forum
Const FAP_FREE_USER% = &H20
Const FAP_LOCKED_OUT% = &H40
Const FAP_TRANSACTION_BILLING% = &H80
Const FAP_ALLOW_MULTIPLE_SEARCH% = &H100
Const FAP_NISA_FORUM% = &H200

Const FAP_MSS_ALL_MSGS% = 0
Const FAP_MSS_WAITING_MSGS% = FAP_MSS_ALL_MSGS + 1
Const FAP_MSS_SUBJECT_TEXT% = FAP_MSS_WAITING_MSGS + 1
Const FAP_MSS_ORIGINATOR_NAME% = FAP_MSS_SUBJECT_TEXT + 1
Const FAP_MSS_RECIPIENT_NAME% = FAP_MSS_ORIGINATOR_NAME + 1
Const FAP_MSS_MSGS_WITHOUT_REPLIES% = FAP_MSS_RECIPIENT_NAME + 1
Const FAP_MSS_HELD_MSGS% = FAP_MSS_MSGS_WITHOUT_REPLIES + 1
Const FAP_MSS_PRIVATE_MSGS% = FAP_MSS_HELD_MSGS + 1        ' to the user
Const FAP_MSS_MSGS_WITHOUT_SYSOP_REPLIES% = FAP_MSS_PRIVATE_MSGS + 1
Const FAP_MSS_MESSAGE_BODY% = FAP_MSS_MSGS_WITHOUT_SYSOP_REPLIES + 1
Const FAP_MSS_POSTING_DATE_RANGE% = FAP_MSS_MESSAGE_BODY + 1
Const FAP_MSS_EXPIRATION_DATE_RANGE% = FAP_MSS_POSTING_DATE_RANGE + 1
Const FAP_MSS_MESSAGES_HAS_BEEN_READ% = FAP_MSS_EXPIRATION_DATE_RANGE + 1

Const FAP_NO_MESSAGE_READ% = &H1
Const FAP_NO_MESSAGE_SEND% = &H2
Const FAP_NO_LIBRARY_READ% = &H4
Const FAP_NO_LIBRARY_SEND% = &H8
Const FAP_NO_CONFERENCE% = &H10
Const FAP_NO_PRIVATE_MSGS% = &H20
Const FAP_NO_MEMBERSHIP% = &H80
Const FAP_PRIVATE_FORUM% = &H100
Const FAP_RTC_CONFIG_SUPPORTED% = &H200
Const FAP_SEARCH_LIBRARY_ABSTRACTS% = &H400   ' Full text search of file abstrats allowed
Const FAP_SEARCH_LIBRARY_FILES% = &H800              ' Search text file contents
Const FAP_SEARCH_MESSAGE_BODIES% = &H1000     ' Searching message bodies allowed
Const FAP_LIBRARY_ONLY_FORUM% = &H2000

Const FAP_PRIVATE_MESSAGE% = &H1
Const FAP_EXTENDED_MESSAGE% = &H80

Const FAP_MC_THREAD_ID% = &H1000
Const FAP_MC_THREADS% = &H8000

Const FAP_MSR_PSEUDO_ROOTS% = &H80


'T:NewDownloadFile (subroutine) (CompuServe)
Sub NewDownloadFile(id As String, forum As String, filename As String, pubavail As Boolean)
    Dim section As Integer, sections As Long, ftype As Integer, i As Integer
    Dim catalog As Long, filesize As Long, l As Long
    Dim tforum As String, s As String, count As Long
    Dim b As Integer, fname As String, pterm(0 to 0) As FAPSEARCHTERM
    Dim fdesc() As FAPFILEDESCRIPTION, fterm(0 to 1) As FAPSEARCHTERM
    Dim URLForum as String

    tforum = forum
    If Not HMIGotoForum(tforum) Then
        LogResult "Unable to download file "+filename+" from "+forum
        Exit Sub
    End If

    ' Extract the section number
    section = Val(SectionNumber(forum))
    sections = 2 ^ section
    If (FAPconfig.svLibSections And sections) = 0 Then
        LogResult id + " : Failed : Unknown library section " & forum
        Exit Sub
    End If

    ' Scan library for the file
    On Error Goto NotFound_error
    If pubavail Then
        Terminal.Print "Downloading file " + filename + Basic.Eoln$

        pterm(0).cType = FAP_SFH_FILENAME
        pterm(0).lpPattern = filename
        FAPSearchFile fdesc(), HMI_STATE_FIRST%, 1, 1, sections, _
            FAP_FDC_FILE_TYPE% + FAP_FDC_FILE_SIZE%, pterm()
    Else
        Terminal.Print "Downloading unreleased file " + filename + Basic.Eoln$

        fterm(0).cType = FAP_SFH_FILENAME
        fterm(0).lpPattern = filename
        fterm(1).cType = FAP_SFH_MATCH_NON_PUBLIC_ONLY
        FAPSearchFile fdesc(), HMI_STATE_FIRST%, 1, 1, sections, _
            FAP_FDC_FILE_TYPE% + FAP_FDC_FILE_SIZE%, fterm()
    End If

    catalog = fdesc(0).dwCatalogNo
    filesize = fdesc(0).dwFileSize
    ftype = fdesc(0).nFileType

    If filesize = 0 Then
        Terminal.Print "File not found." + Basic.Eoln$
        LogResult "Unable to find "+filename+" in library "+forum
        Exit Sub
    End If

    On Error Goto DownloadFile_error
    Terminal.TransferStatus False, filename, 0, filesize

    ' Open file to write to
    If FileExists(DownloadDir+filename) Then
        count = FileLen(DownloadDir+filename) ' Resume file download
    Else
        count = 0
    End If
    Open DownloadDir+filename For Binary Access Write Shared As #1
    If count>0 Then
        Terminal.Print "Resuming file download at " & count & Basic.Eoln$
        Seek #1, count+1
    End If

    s = FAPReceiveFileOffset(HMI_STATE_FIRST%, catalog, ftype, 0, i, count+1)
    Do While s > ""
        Put #1, , s
        count = count + i
        Terminal.TransferStatus False, filename, count, filesize
        s = FAPReceiveFileOffset(HMI_STATE_NEXT%, catalog, ftype, 0, i, count+1)
    Loop
    If count < filesize Then
        Terminal.TransferStatus False, filename, count, count
        LogResult id & " : Possible incomplete download of "+filename+" from "+forum
        LogResult id & " : Reported size " & filesize & " actual size " & count
    End If
    Close #1
    Terminal.TransferStatus

    ' Write comment to catalog entry and import into messagebase
    tforum = ParseString(tforum, "/")+"/L"+LTrim(Str(section))
    RecordFileDownload tforum, LTrim$(Str$(catalog))
    If SectionLibIds(section) >= 0 Then
        tforum = tforum +"_" + szLibSection(SectionLibIds(section)).lpTitle
    Else
        tforum = tforum + "_Unknown"
    End If

    If pubavail Then
        URLForum = forum
        ReplaceAllInString URLforum, " ", "_"
        URLForum = "VA:" & Session.Service & ":" & URLForum & "#" & CStr(fdesc(0).dwCatalogNo)
        ReportSuccess id & " : Downloaded "+FileUrl(DownloadDir+filename)+" from " + URLForum
        NewSearchLibrary "", tforum, LTrim$(Str(catalog)), "", DownloadDir+filename, _
                         "", "", "", "", "", "", "y", "n"
    Else
        ReportSuccess id & " : Downloaded unreleased "+FileUrl(DownloadDir+filename)+" from " + forum
    End If
    Exit Sub

NotFound_error:
    LogResult "Unable to find "+filename+" in library "+forum
    Exit Sub

DownloadFile_error:
    Close #1
    Terminal.TransferStatus
    LogResult id & " : Failed to download "+filename+" from "+forum+" error : " + FullErrorMessage()
End Sub

'T:DownloadFile (subroutine) (CompuServe)
Sub DownloadFile(id As String, forum As String, filename As String)
    NewDownloadFile id, forum, filename, True
End Sub

'T:DownloadFileFinder (subroutine) (CompuServe)
Sub DownloadFileFinder(id As String, forum As String, filename As String, handle As String)
    Dim tforum As String

    tforum = forum
    If Not HMIGotoForum(forum) Then
        LogResult "Unable to download file "+filename+" from "+forum
        Exit Sub
    End If

    ' Check to see if we need to join the forum
    If ((FAPconfig.wAlerts And FAP_NOT_A_MEMBER%) <> 0) Then
        tforum = ParseString(tforum, "/")
        JoinForum "", tforum, handle, ""
    End If

    ' Download the file
    NewDownloadFile id, forum, filename, True
End Sub

Sub NextSearchTerm(ByRef searchterm() As FAPSEARCHTERM, ByRef i As Integer, sfh As Integer, pat As String)
    If pat="" Then Exit Sub
    ReDim Preserve searchterm(0 To i)
    searchterm(i).cType = sfh
    searchterm(i).lpPattern = pat
    i = i + 1
End Sub

'T:NewSearchLibrary (subroutine) (CompuServe)
Sub NewSearchLibrary(id As String, forum As String, catalog As String, _
                  ssections As String, filename As String, uploadby As String, _
                  age As String, accesscount As String, keywords As String, _
                  title As String, description As String, full As String, _
                  replace As String)
    Dim fname As String, i As Integer, t As Long
    Dim section As Integer, tforum As String, count As Long
    Dim filedesc() As FAPFILEDESCRIPTION, tmpdesc As FAPFILEDESCRIPTION
    Dim searchterm() As FAPSEARCHTERM, errmsg As String
    Dim searchflags As Long, catno As Long, ok As Boolean

    tforum = forum
    catno = Val(catalog)
    If Not HMIGotoForum(tforum) Then
        LogResult "Unable to refresh library list from "+forum
        Exit Sub
    End If

    tforum = ParseString(tforum, "/")

    ' Set which bits of info we want
    searchflags = &H6FF
    If UCase(full)="Y" Then searchflags = searchflags + FAP_FDC_ABSTRACT%
    If UCase(replace)="Y" Then
        replace = "yes"
    Else
        replace = "no"
    End If
    ok = True

    ' Scan library for the files
    fname = UniqueFilename$()
    count = 0
    Capture CAPTURE_ON, fname
    CaptureText Basic.Eoln$+"#pragma ciscontrol=yes;markunread=yes;deleteexisting="+replace+Basic.Eoln$
    If catno > 0 Then
        Terminal.Print "Collecting library #" + LTrim$(Str(catno)) + Basic.Eoln$

        ' We know which catalog we want - get it
        On Error Goto EndOfLibrary_error
        i = FAPReadFileDescription(catno, searchflags, tmpdesc)
        If tmpdesc.lpFilename <> "" Then
            tmpdesc.dwCatalogNo = catno
            WriteLibraryMessage tforum, tmpdesc, filename
            count = 1
        End If
    Else
        Terminal.Print "Collecting libraries from sections " + LTrim$(ssections) + Basic.Eoln$

        If filename="" Then filename = "*.*"

        ' Set search terms
        i = 0
        NextSearchTerm searchterm(), i, FAP_SFH_FILENAME%, filename
        NextSearchTerm searchterm(), i, FAP_SFH_USER_ID%, uploadby
        NextSearchTerm searchterm(), i, FAP_SFH_TITLE%, title
        NextSearchTerm searchterm(), i, FAP_SFH_DATE_RANGE%, age
        NextSearchTerm searchterm(), i, FAP_SFH_ACCESS_COUNT%, accesscount
        NextSearchTerm searchterm(), i, FAP_SFH_KEYWORD%, keywords
        NextSearchTerm searchterm(), i, FAP_SFH_FILE_ABSTRACT%, description

        ' Select sections to search
        sectionvector = ParseSectionList(ssections, FAPconfig.svLibSections, i)
        t = 1
        For i = 0 to 24
            If sectionvector And t Then SetLastUpdated tforum & "/L" & i
            t = t + t
        Next

        Terminal.CaptureStatus CAPTURE_ON
        On Error Goto EndOfLibrary_error
        FAPSearchFile filedesc(), HMI_STATE_FIRST%, 1, 4, sectionvector, searchflags, searchterm()
        Do While filedesc(0).dwCatalogNo > 0
            For i = 0 To UBound(filedesc)
                If filedesc(i).dwCatalogNo > 0 Then
                    count = count + 1
                    Terminal.CaptureStatus count, "Receiving Library Message"
                    WriteLibraryMessage tforum, filedesc(i), ""
                End If
            Next

            FAPSearchFile filedesc(), HMI_STATE_NEXT%, 1, 4, sectionvector, searchflags, searchterm()
        Loop
        Terminal.Print "Collected "+LTrim$(Str(count))+" library entries" + Basic.Eoln$
    End If
EndOfLibrary_ok:
    On Error Goto 0
    Terminal.CaptureStatus CAPTURE_OFF
    Capture CAPTURE_OFF

    ' Add to import queue
    If count > 0 Then
        b = QueueFile(Session.Service, fname, IM_DELETE Or IM_MARKUNREAD)
    Else
        DeleteFile fname
    End If

    If ok And id<>"" Then ReportSuccess id & " : Downloaded library list(s) for " & forum & " " & LTrim$(ssections)
    Exit Sub
EndOfLibrary_error:
    If Err<>9 Then
        errmsg = FullErrorMessage()
        If InStr(errmsg, "No library sections specified in request")>0 Then
            LogResult "Error while downloading library from "+forum+" - no valid library section(s) selected"
        Else
            LogResult "Error while downloading library from "+forum+" error : " + errmsg
        End If
        ok = False
    End If
    Resume EndOfLibrary_ok
End Sub

'T:SearchLibrary (subroutine) (CompuServe)
Sub SearchLibrary(id As String, forum As String, catalog As String, _
                  ssections As String, filename As String, uploadby As String, _
                  age As String, accesscount As String, keywords As String, _
                  title As String, description As String, full As String)
    NewSearchLibrary id, forum, catalog, ssections, filename, uploadby, _
                        age, accesscount, keywords, title, description, _
                        full, "n"
End Sub

Function CheckLibraryBeforePosting(id As String, topic As String, section As Integer) As Boolean
    Dim i As Integer

    If Not HMIGotoForum(topic) Then
        LogResult id + " : Failed : Unable to upload file."
        Exit Function
    End If

    If FAPconfig.wRestrictions And FAP_NO_LIBRARY_SEND Then
        LogResult id + " : Failed : Uploading not allowed in forum " & topic
        Exit Function
    End If

    section = Val(SectionNumber(topic))
    If (FAPconfig.svLibSections And (2 ^ section)) = 0 Then
        LogResult id + " : Failed : Unknown section " & topic
        Exit Function
    End If
    CheckLibraryBeforePosting = True
End Function

'T:UploadFile (subroutine) (CompuServe)
Sub UploadFile(id As String, forum As String, filename As String, _
               ftype As String, keywords As String, title As String, _
               msgfile As String)
    Dim path As String, sname As String, body As String, nState As Integer
    Dim section As Integer, SourceFileNum as Integer, SourceFileAt as Long
    Dim SourceFileLen as Long, TheData as String, BytesToRead as Long
    Dim i As Integer, iType As Integer

    If Not CheckLibraryBeforePosting(id, forum, section) Then
        Exit Sub
    End If

    Terminal.Print "Uploading file " + filename + Basic.Eoln$

    ' Does the file exist ?
    If Not FileExists(filename) Then
        LogResult "File doesn't exist"
        Exit Sub
    End If
    SourceFileLen = FileLen(filename)
    If SourceFileLen <= 0 Then
        LogResult "Can't upload file"
        Exit Sub
    End If
    SplitPath filename, path, sname
    iType = Val(ftype)

    ' Overwrite and reset file download counts
    If FAPSendFileInfo(section, SourceFileLen, iType, 3, sname, title, keywords)=0 Then
        LogResult "Failed sending file info"
        Exit Sub
    End If

    ' Send the abstract
    body = ReadMessageFile(msgfile, 2)
    If FAPSendFileAbstract(body, 3, "", Session.LoginName)=0 Then
        LogResult "Failed sending file abstract"
        Exit Sub
    End If

    ' Send the file
    On Error Goto UploadFile_error
    BytesToRead = SourceFileLen
    SourceFileNum = FreeFile()
    Open filename for Binary Access Read Shared as #SourceFileNum
    SourceFileAt = 1        'read point

    TheData = String$(BlockSize, " ")
    nState = 0

    ' Operate on blocks of BlockSize at a time
    Do While BytesToRead > BlockSize
        Terminal.TransferStatus True, filename, SourceFileAt-1, SourceFileLen
        Get #SourceFileNum, SourceFileAt, TheData
        i = FAPSendFileData(iType, TheData, nState)
        BytesToRead = BytesToRead - BlockSize
        SourceFileAt = SourceFileAt + BlockSize
        nState = 1
    Loop

    ' Now do the last block of less than BlockSize
    If BytesToRead > 0 then
        TheData = String$(BytesToRead, " ")
        Get #SourceFileNum, SourceFileAt, TheData
        i = FAPSendFileData(iType, TheData, nState)
    End If
    Terminal.TransferStatus True, filename, SourceFileLen, SourceFileLen
    i = FAPSendFileData(iType, "", nState)

    Close #SourceFileNum
    Terminal.TransferStatus
    ReportSuccess id & " : " & filename & " was uploaded to " & forum
    Exit Sub

UploadFile_error:
    Terminal.TransferStatus
    LogResult "Error in UploadFile : " + FullErrorMessage()
    Close #SourceFileNum
    Exit Sub
End Sub

Sub UpdateLibrary(id As String, forum As String, sect As String, sdate As String)
    SearchLibrary id, forum, "", sect, "", "", sdate, "", "", "", "", "y"
End Sub