news1.frm

读取新闻组(newsgroup)信息的程序

         Next
         Close #1
      End If
   Else
      StatusBar1.SimpleText = "Must Connect to News Server"
   End If
   
End Sub

Private Sub Command6_Click()
   Dim PlaceHolder As String
   If Dir$("server.lst") <> "" Then
      StatusBar1.SimpleText = "Getting list from file"
      Open "server.lst" For Input As #2
      List1.Clear
      Do Until EOF(2)
         Line Input #2, PlaceHolder
         List1.AddItem PlaceHolder
         Refresh
      Loop
      StatusBar1.SimpleText = "Finished getting list"
      Beep
   End If
   
End Sub

Private Sub Command7_Click()
   End
End Sub

Private Sub Form_Load()
   Command3.Enabled = False
   Command4.Enabled = False
   Command5.Enabled = False
   'Command6.Enabled = False
   Open "debug.lst" For Output As #3
   
   TotalTime = 0
   CommandString = "None"
   Timer1.Enabled = False
   HoldOverData = ""
   ConnectServer = False
   SSTab1.Tab = 0
   NewsServerName = GetSetting("Rnews", "Server Info", "Name")
End Sub
Private Sub List1_DblClick()
   Dim SendGroup As String
   If ConnectServer = True Then
      Debug.Print List1
      SSTab1.Tab = 1
      SendGroup = "GROUP " & List1 & Chr$(13) & Chr$(10)
      CommandString = "GROUP"
      Winsock1.SendData SendGroup
   Else
      StatusBar1.SimpleText = "Must Connect to News Server"
   End If

End Sub
Private Sub List2_Click()
   Dim holditem As String
   Dim articleNum As String
   Dim GetArticle As String
   holditem = List2
   ' Debug.Print holditem
   articleNum = Mid(holditem, 1, InStr(1, holditem, " "))
   GetArticle = "BODY " & articleNum & Chr$(13) & Chr$(10)
  CommandString = "BODY"
  Winsock1.SendData GetArticle
  
End Sub

Private Sub ServerName_Click()
   Form2.Show
End Sub


Private Sub SSTab1_Click(PreviousTab As Integer)

   Select Case SSTab1.Tab
      Case 0
         Command3.Visible = True
         Command4.Visible = True
         Command5.Visible = True
         Command6.Visible = True
      Case 1
         Command3.Visible = False
         Command4.Visible = False
         Command5.Visible = False
         Command6.Visible = False
      Case 2
         Command3.Visible = False
         Command4.Visible = False
         Command5.Visible = False
         Command6.Visible = False
   End Select

End Sub



Private Sub Timer1_Timer()
   If TotalTime = 3 Then
      ' Debug.Print "went past the time"
   End If
   TotalTime = TotalTime + 1
End Sub

Private Sub Winsock1_Close()
     StatusBar1.SimpleText = "Disconnected From " & NewsServerName
     ConnectServer = False

End Sub

Private Sub Winsock1_Connect()
   ConnectServer = True
   Command3.Enabled = True
   Command4.Enabled = True
   Command5.Enabled = True
   'Command6.Enabled = True
   StatusBar1.SimpleText = "Connected to " & NewsServerName
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   Dim recvData As String
   Dim wrap As String
   Dim crlf As Long
   Dim quitloop As Long
   Static PutList As String
   Dim CurrentPos As Long
   Dim HoldPos As Long
     
    wrap = Chr$(13) & Chr$(10)
    Winsock1.GetData recvData, vbString
'*****************************************************
'* Code to handle the List from server
'*****************************************************
'       Debug.Print recvData
       
    If CommandString = "LIST" Then
       'Debug.Print recvData & " ** "
       recvData = HoldOverData + recvData
       HoldOverData = ""
       bytesTotal = Len(recvData)
       crlf = 0
'*****************************************************
'Routine to parse the recvdata into list
'*****************************************************
       Do While crlf < bytesTotal
          HoldPos = InStr(1, recvData, wrap)
          If HoldPos = 0 Then
             HoldOverData = recvData
             Exit Do
          End If
          If HoldPos > bytesTotal Then
             Exit Do
          End If
          
          PutList = Mid(recvData, 1, HoldPos)
          crlf = HoldPos + crlf
          recvData = Mid(recvData, HoldPos + 2)
          
          List1.AddItem Mid(PutList, 1, InStr(1, PutList, " "))
          
          If (Mid((Right(recvData, 3)), 1, 1) = ".") And (Right(recvData, 1) = Chr$(10)) And _
              (Mid((Right(recvData, 4)), 1, 1) <> Chr$(34)) Then
             CommandString = "None"
             StatusBar1.SimpleText = "List Download"
             Beep
             Exit Do
          End If
       Loop
'*****************************************************
    End If
'*****************************************************
'* Group Code from server
'*****************************************************
   Dim SendStat As String
    If Mid(recvData, 1, 3) = "211" And CommandString = "GROUP" Then
       Text1.Text = recvData
       HoldPos = InStr(5, recvData, " ")
       AproxHeader = Mid(recvData, 5, HoldPos - 5)
       crlf = HoldPos
       HoldPos = InStr(HoldPos + 1, recvData, " ")
       StartMsg = Mid(recvData, crlf + 1, HoldPos - crlf)
       crlf = HoldPos
       HoldPos = InStr(HoldPos + 1, recvData, " ")
       StopMsg = Mid(recvData, crlf + 1, HoldPos - crlf)
       StatusBar1.SimpleText = "Downloading Header Number " & StartMsg & " to " & StopMsg
       SendStat = "STAT " & StartMsg & Chr$(13) & Chr$(10)
       Winsock1.SendData SendStat
       CommandString = "STAT"
       List2.Clear
    End If
'*****************************************************
'* STAT Code from server
'*****************************************************
    Dim SendHead As String
    If Mid(recvData, 1, 3) = "223" And CommandString = "STAT" Then
       Text1.Text = recvData
       CommandString = "HEAD"
       SendHead = "HEAD" & Chr$(13) & Chr$(10)
       Winsock1.SendData SendHead
    End If
'*****************************************************
'* Head Code from server
'*****************************************************
    If Mid(recvData, 1, 3) = "221" And CommandString = "HEAD" Then
       HoldPos = InStr(5, recvData, " ")
       SubjectLine = Mid(recvData, 5, HoldPos - 5)
       
       HoldPos = InStr(1, recvData, "Subject:")
       
       If HoldPos <> 0 Then     'Found Subject string
          recvData = Mid(recvData, HoldPos)
          
          ' Print #3, recvData
          HoldPos = InStr(1, recvData, wrap, vbBinaryCompare)
          SubjectLine = SubjectLine & " - " & Mid(recvData, 1, HoldPos - 1)
          List2.AddItem SubjectLine
          Refresh
          CommandString = "STAT"
          Winsock1.SendData "NEXT" & Chr$(13) & Chr$(10)
       Else
          CommandString = "GetRestofHeader"
          NextRec = recvData
       End If
    End If
    
    If CommandString = "GetRestofHeader" Then
       NextRec = NextRec + recvData
       HoldPos = InStr(1, NextRec, "Subject:")
       If HoldPos <> 0 Then
          crlf = InStr(HoldPos + 9, NextRec, "Date:")
          If crlf <> 0 Then
             For crlf = crlf To HoldPos Step -1
                If Mid(NextRec, crlf, 1) = " " Then
                   Exit For
                End If
             Next
             SubjectLine = SubjectLine & " - " & Mid(NextRec, HoldPos, crlf - HoldPos)
             List2.AddItem SubjectLine
             Refresh
             CommandString = "STAT"
             Winsock1.SendData "NEXT" & Chr$(13) & Chr$(10)
          Else
             CommandString = "GetRestofHeader"
          End If
       Else
          CommandString = "GetRestofHeader"
       End If
       
    End If
    If CommandString = "BODY" Then
      ' Debug.Print recvData
       Text2.Text = recvData
    End If
    Refresh
    
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
   StatusBar1.SimpleText = "Error " & Number & " " + Description
End Sub