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

Text File | 1999-10-06 | 5.3 KB | 180 lines

'T:NEWSNET.EBS for CIX
' VA 4.52 release

'Add file to import queue
Declare Function AddToDoList16 Pascal Lib "addons.dll" Alias "AddToDoList" (ByVal szService As String, ByVal szFileName As String, ByVal szMailname As String, ByVal iFlags As Long) As Integer
Declare Function AddToDoList32 Pascal Lib "addons32.dll" Alias "AddToDoList" (ByVal szService As String, ByVal szFileName As String, ByVal szMailname As String, ByVal iFlags As Long) As Long

'T:iFlags for CIX (constant)
Global Const IM_DELETE = 2048        ' Delete scratchpad file afterwards?

Declare Function GotoAreaOk(id As String, serv As String)
Declare Function UniqueFileName$
Declare Function QueueFile(service As String, sfilename As String, _
                           queueflags As Long) As Boolean
Declare Sub ReportSuccess(id As String)
Declare Sub ReportFailure(id As String, reason As String)

'T:NewsCont (subroutine) (CIX)
Sub NewsCont(t As Tracker)
    Comms.Send "n\r"
    WaitForPrompt "Prompt"
    Comms.Send "end\r"
    WaitForPrompt "Prompt"
    t.reset
End Sub

'T:DownNewsnet (subroutine) (CIX)
Sub DownNewsnet(id As String)
    Dim t As Tracker
    Dim ResOK As Tracker
    Dim ResErr As Tracker

    Terminal.Status "Going into Usenet"
    If Not GotoAreaOk(id, "Newsnet") Then
        Exit Sub
    End If
    Terminal.Status ""

    Comms.Send "echo Newsnet scratchpad\r"
    WaitForPrompt "Prompt"
    Set t = CreateTracker("NewsContinue", "Continue\? (Y/N)", "NewsCont")
    Comms.Send "batch all endbatch\r"
    Terminal.Status "Collecting messages from usenet"
    TimedWaitForPrompt "Prompt", 180 ' 3 minutes
    t.delete
    Terminal.Status ""
    Comms.Send "download messages\r"

    Set ResErr = CreateTracker("Result200", "Result 200:")
    Set ResOk = CreateTracker("ResultOK", "\*\*")
    WaitFor "\*\*"
    DeleteFile "cixnews.msg"
    FileDownload PROT_ZMODEM, "cixnews.msg"
    WaitFor "Newsnet:"
    ResErr.delete
    ResOK.delete
    If QueueFile(Session.Service, "cixnews.msg", IM_DELETE)=True Then
            ReportSuccess id & " : Collected Newsnet messages"
            SetLastUpdated "Read messages from Newsgroups"
    Else
            ReportFailure id, "Empty newsnet scratchpad or download failure"
    End If
End Sub

'T:CopyUsenetMessageToFile (subroutine) (CIX)
'Copy a message file to the CIXNEWS script
'Terminate with a line containing just "."
Sub CopyUsenetMessageToFile(filename As String)
    Dim inpline As String

    On Error Goto CopyMessageToFile_error
    Open filename For Input Access Read Shared As #1
    While Not Eof(1)
        Line Input #1, inpline
        If inpline <> "." Then
            Print #6, inpline
        End If
    Wend
CopyMessageToFile_nofile:
    On Error Goto 0
    Close #1
    Exit Sub
CopyMessageToFile_error:
    Resume CopyMessageToFile_nofile
End Sub

'T:PostNewsnet (subroutine) (CIX)
' Post message to newsnet - can be either a say/comment
Sub PostNewsnet(id As String, newsgroup As String, subject As String, filename As String)
    Dim messagescript As String
    Dim messagetmp As String

    Terminal.Status "Going into Usenet"
    If Not GotoAreaOk(id, "Newsnet") Then
        Exit Sub
    End If
    Terminal.Status ""

    messagetmp = Session.ServicePath + "cixnews.tmp"
    DeleteFile messagetmp
    Open messagetmp For Output Access Write Shared As #6

    Print #6, "Newsgroups: " + newsgroup
    If subject<>"" Then
        Print #6, "Subject: " + subject
    End If
    Print #6, "X-Newsreader: Virtual Access"
    If subject="" Then
        Print #6, "Subject: ";
    Else
        Print #6,
    End If
    CopyUsenetMessageToFile filename
    Close #6

    'Find out length of msg and do the #! Rnews line
    messagescript = Session.ServicePath + "cixnews.upl"
    DeleteFile messagescript
    Open messagescript For Output Access Write Shared As #6
    Print #6, "#! rnews " & (FileLen(messagetmp)-1)
    CopyUsenetMessageToFile messagetmp
    Print #6, "."
    Close #6

    Comms.Send "upload messages\r"
    WaitFor "\*\*"
    FileUpload PROT_ZMODEM, messagescript
    WaitFor ":"

    ReportSuccess id & " : Posted Newsnet message to " & newsgroup
End Sub

'T:JoinNewsgroup (subroutine) (CIX)
Sub JoinNewsgroup(id As String, newsgroup As String, limit As String)
    Terminal.Status "Going into Usenet"
    If Not GotoAreaOk(id, "Newsnet") Then
        Exit Sub
    End If
    Terminal.Status "Joining " & newsgroup & " newsgroup"
    Comms.Send "join " + newsgroup + " " + limit + "\r"
    WaitForPrompt "Prompt"
    ReportSuccess id & " : Subscribed to newsgroup " & newsgroup
    Terminal.Status ""
End Sub

'T:ResignNewsgroup (subroutine) (CIX)
Sub ResignNewsgroup(id As String, newsgroup As String)
    Terminal.Status "Going into Usenet"
    If Not GotoAreaOk(id, "Newsnet") Then
        Exit Sub
    End If
    Terminal.Status "Resigning from " & newsgroup & " newsgroup"
    Comms.Send "resign " + newsgroup + "\r"
    WaitForPrompt "Prompt"
    ReportSuccess id & " : Resigned from newsgroup " & newsgroup
    Terminal.Status ""
End Sub

'T:RefreshNewsgroups (subroutine) (CIX)
Sub RefreshNewsgroups(id As String)
    Terminal.Status "Going into Usenet"
    If Not GotoAreaOk(id, "Newsnet") Then
        Exit Sub
    End If
    Terminal.Status "Collecting Newsgroup List"
    Comms.Send "file newsgrouplist\r"
    WaitForPrompt "Prompt"
    Comms.Send "download newsgrouplist\r"
    WaitFor "\*\*"
    DeleteFile Session.ServicePath+"news.lis"
    FileDownload PROT_ZMODEM, Session.ServicePath+"news.lis"
    WaitFor "Newsnet:"
    Comms.Send "killscratch\r"
    WaitForPrompt "Prompt"
    ReportSuccess id & " : Collected new newsgroup list"
    Terminal.Status ""
End Sub