It is currently Thu Aug 22, 2019 2:00 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 25 posts ]  Go to page 1, 2  Next
Author Message
 Post subject: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 12:51 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
Hi,

as promised in another thread, today i want to share my NNTP component. With this module, you can connect to a newsserver, download a list of newsgroups and headers, download and decode articles and all you need to handle messages with binary attachments.

Each command or constant in this library starts with Nntp or #Nntp. Private things have an underscore at the beginning and are not supposed to be called from externals. A command always returns #True on success or #False if it failed. The data returned by the news server is stored in a structure, which will also be handed over by argument.

Later i am going to make some examples how to communicate with a news server.

Update 7.9.2013: Minor Bug Fixes
Update 30.5.2013: Library now works with Unicode, Port added.
Update 22.2.2013: Adapted to PB 5.10, some bug fixes and new NntpPost() command.

Here is the source code:
Code:
;NNTP-Library, 7.9.2013, written by Uwe Keller

EnableExplicit

Enumeration ;attributes
  #NntpAttributeReceived
  #NntpAttributeSent
EndEnumeration
Enumeration ;multi part collector flags
  #NntpMultiPartByNumber = 1
  #NntpMultiPartRemoveYenc = 2
  #NntpMultiPartRemoveEmail = 4
  #NntpMultiPartKeepZeros = 8
EndEnumeration
Enumeration ;attachment encodings
  #NntpEncodingBase64
  #NntpEncodingUU
  #NntpEncodingYenc
EndEnumeration

Structure NntpReply
  Reply.s
EndStructure
Structure NntpListItem
  Newsgroup.s
  First.q
  Last.q
  Flag.s
EndStructure
Structure NntpListReply Extends NntpReply
  List Items.NntpListItem()
EndStructure
Structure NntpGroupReply Extends NntpReply
  Newsgroup.s
  First.q
  Last.q
  Count.q
EndStructure
Structure NntpXoverItem
  Number.q
  Subject.s
  Author.s
  Date.l
  Id.s
  References.s
  Bytes.l
  Xref.s
EndStructure
Structure NntpXoverReply Extends NntpReply
  List Items.NntpXoverItem()
EndStructure
Structure NntpXhdrItem
  Number.q
  Value.s
EndStructure
Structure NntpXhdrReply Extends NntpReply
  List Items.NntpXhdrItem()
EndStructure
Structure NntpArticleHeader
  Name.s
  Value.s
EndStructure
Structure NntpArticleAttachment
  Name.s
  List Data.a()
  Encoding.b
EndStructure
Structure NntpArticleReply Extends NntpReply
  List Headers.NntpArticleHeader()
  Text.s
  List Attachments.NntpArticleAttachment()
EndStructure
Structure NntpPostReply Extends NntpReply
  MessageId.s
EndStructure
Structure NntpMultiPart
  Subject.s
  Author.s
  Date.l
  Bytes.q
  Array Ids.s(0)
  Count.i ; number of retrieved parts
EndStructure
Structure NntpFileInfo
  Index.l
  Count.l
EndStructure
Structure NntpEncodeResult
  PartCount.i
  TotalBytes.q
  EncodedBytes.q
  CRC.l ;check-sum of whole file
EndStructure
Structure _Nntp
  Connection.i
  Host.s
  Received.q
  Sent.q
  *Buffer
  List Lines.s()
EndStructure

Global Dim _Nntps._Nntp(31)

CompilerIf #PB_Compiler_Unicode
  #CHARSIZE = 2
CompilerElse
  #CHARSIZE = 1
CompilerEndIf

Procedure.s DecodeHtml(Text.s)
  Protected xl, xr, encode.s, code.s, ascii
  ;decode HTML
  Repeat
    xl = FindString(Text, "&", xl + 1)
    If Not xl
      Break
    EndIf
    xr = FindString(Text, ";", xl)
    If Not xr
      Break
    EndIf
    encode = Mid(Text, xl + 1, xr - xl - 1)
    Restore HtmlCodes
    Repeat
      Read.s code
      If code = ""
        Break
      EndIf
      Read.a ascii
      If code = encode
        Text = ReplaceString(Text, "&" + code + ";", Chr(ascii))
        Break
      EndIf
    ForEver
    ;not found
    If code = "" And Left(encode, 1) = "#"
      ascii = Val(Mid(encode, 2))
      If ascii
        Text = ReplaceString(Text, "&" + encode + ";", Chr(ascii))
      EndIf
    EndIf
  ForEver
  ProcedureReturn Text
  DataSection
    HtmlCodes:
    Data.s "nbsp": Data.a 32
    Data.s "quot": Data.a 34
    Data.s "amp": Data.a 38
    Data.s "lt": Data.a 60
    Data.s "gt": Data.a 62
    Data.s "iexcl": Data.a 161
    Data.s "cent": Data.a 162
    Data.s "pound": Data.a 163
    Data.s "curren": Data.a 164
    Data.s "yen": Data.a 165
    Data.s "brvbar": Data.a 166
    Data.s "sect": Data.a 167
    Data.s "uml": Data.a 168
    Data.s "copy": Data.a 169
    Data.s "ordf": Data.a 170
    Data.s "laquo": Data.a 171
    Data.s "not": Data.a 172
    Data.s "shy": Data.a 173
    Data.s "reg": Data.a 174
    Data.s "macr": Data.a 175
    Data.s "deg": Data.a 176
    Data.s "plusmn": Data.a 177
    Data.s "sup2": Data.a 178
    Data.s "sup3": Data.a 179
    Data.s "acute": Data.a 180
    Data.s "micro": Data.a 181
    Data.s "para": Data.a 182
    Data.s "middot": Data.a 183
    Data.s "cedil": Data.a 184
    Data.s "sup1": Data.a 185
    Data.s "ordm": Data.a 186
    Data.s "raquo": Data.a 187
    Data.s "frac14": Data.a 188
    Data.s "frac12": Data.a 189
    Data.s "frac34": Data.a 190
    Data.s "iquest": Data.a 191
    Data.s "Agrave": Data.a 192
    Data.s "Aacute": Data.a 193
    Data.s "Acirc": Data.a 194
    Data.s "Atilde": Data.a 195
    Data.s "Auml": Data.a 196
    Data.s "Aring": Data.a 197
    Data.s "AElig": Data.a 198
    Data.s "Ccedil": Data.a 199
    Data.s "Egrave": Data.a 200
    Data.s "Eacute": Data.a 201
    Data.s "Ecirc": Data.a 202
    Data.s "Euml": Data.a 203
    Data.s "lgrave": Data.a 204
    Data.s "lacute": Data.a 205
    Data.s "lcirc": Data.a 206
    Data.s "luml": Data.a 207
    Data.s "ETH": Data.a 208
    Data.s "Ntilde": Data.a 209
    Data.s "Ograve": Data.a 210
    Data.s "Oacute": Data.a 211
    Data.s "Ocirc": Data.a 212
    Data.s "Otilde": Data.a 213
    Data.s "Ouml": Data.a 214
    Data.s "times": Data.a 215
    Data.s "Oslash": Data.a 216
    Data.s "Ugrave": Data.a 217
    Data.s "Uacute": Data.a 218
    Data.s "Ucirc": Data.a 219
    Data.s "Uuml": Data.a 220
    Data.s "Yacute": Data.a 221
    Data.s "THORN": Data.a 222
    Data.s "szlig": Data.a 223
    Data.s "agrave": Data.a 224
    Data.s "aacute": Data.a 225
    Data.s "acirc": Data.a 226
    Data.s "atilde": Data.a 227
    Data.s "auml": Data.a 228
    Data.s "aring": Data.a 229
    Data.s "aelig": Data.a 230
    Data.s "ccedil": Data.a 231
    Data.s "egrave": Data.a 232
    Data.s "eacute": Data.a 233
    Data.s "ecirc": Data.a 234
    Data.s "euml": Data.a 235
    Data.s "igrave": Data.a 236
    Data.s "iacute": Data.a 237
    Data.s "icirc": Data.a 238
    Data.s "iuml": Data.a 239
    Data.s "eth": Data.a 240
    Data.s "ntilde": Data.a 241
    Data.s "ograve": Data.a 242
    Data.s "oacute": Data.a 243
    Data.s "ocirc": Data.a 244
    Data.s "otilde": Data.a 245
    Data.s "ouml": Data.a 246
    Data.s "divide": Data.a 247
    Data.s "oslash": Data.a 248
    Data.s "ugrave": Data.a 249
    Data.s "uacute": Data.a 250
    Data.s "ucirc": Data.a 251
    Data.s "uuml": Data.a 252
    Data.s "yacute": Data.a 253
    Data.s "thorn": Data.a 254
    Data.s "yuml": Data.a 255
    Data.s ""
  EndDataSection
EndProcedure
Procedure.s DecodeQuotedPrintable(Text.s)
  ;decodes a text encoded as quoted-printable.
  ;http://tools.ietf.org/html/rfc2045#section-6.7
  Protected x, v, h.s
  Repeat
    x = FindString(Text, "=", x + 1)
    If Not x
      Break
    EndIf
    ;cut out hex value
    h = Mid(text, x + 1, 2)
    ;get value
    If Len(h) = 2
      v = Val("$" + h)
      If v
        Text = Left(Text, x - 1) + Chr(v) + Mid(Text, x + 3)
      EndIf
    EndIf
  ForEver
  ProcedureReturn Text
EndProcedure
Procedure.s DecodeString(Text.s)
  ;decodes message headers of Non-ASCII text
  ;http://tools.ietf.org/html/rfc2047
  Protected xl, xr, left.s, right.s, center.s, a, b, encoding.s, encoded.s, decoded.s
  xl = FindString(Text, "=?")
  If xl
    For xr = Len(Text) - 1 To xl + 2 Step -1
      If Mid(Text, xr, 2) = "?="
        left = Mid(Text, 1, xl - 1)
        right = Mid(Text, xr + 2)
        xl + 2
        center = Mid(Text, xl, xr - xl)
        ;get encoding
        a = FindString(center, "?")
        If a
          b = FindString(center, "?", a + 1)
          If b
            encoding = Mid(center, a + 1, b - a - 1)
            encoded = Mid(center, b + 1)
            Select encoding
            Case "Q", "q" ;quoted-printable
              ProcedureReturn left + DecodeQuotedPrintable(encoded) + right
            Case "B", "b" ;base64
              decoded = Space(Len(encoded))
              Base64Decoder(@encoded, Len(encoded), @decoded, Len(decoded))
              ProcedureReturn left + decoded + right
            EndSelect
          EndIf
        EndIf
        Break
      EndIf
    Next
  EndIf
  ProcedureReturn Text
EndProcedure
Procedure DecodeUU(Text.s, List Out.a())
  ;decodes an UU encoded text
  ;http://en.wikipedia.org/wiki/Uuencoding
  Protected i, j, n, count, *a
  Static Dim c.a(3)
  *a = @Text
  ;first char contains number of bytes to be decoded
  count = (PeekA(*a) - 32) & %111111
  n = count
  For i = 2 To Len(Text) Step 4
    ;read 4 characters
    For j = 0 To 3
      *a + #CHARSIZE
      c(j) = (PeekA(*a) - 32) & %111111
    Next
    ;write bytes
    AddElement(Out())
    Out() = c(0) << 2 | c(1) >> 4
    n - 1
    IfDo(n = 0, Break)
    AddElement(Out())
    Out() = c(1) << 4 | c(2) >> 2
    n - 1
    IfDo(n = 0, Break)
    AddElement(Out())
    Out() = c(2) << 6 | c(3)
    n - 1
  Next
  ;return number of decoded bytes
  ProcedureReturn count
EndProcedure
Procedure DecodeBase64(Text.s, List Out.a())
  ;decode a Base64 encoded line
  Protected b64.a, chars.s, i, j, n, *a
  Static Dim c.a(3)
  ;setup Base64 array on very first call
  Static Dim b64(255)
  If Not b64('B')
    chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    For i = 1 To Len(chars)
      b64(Asc(Mid(chars, i, 1))) = i - 1
    Next
  EndIf
  ;decode line
  *a = @Text
  For i = 1 To Len(Text) Step 4
    ;get 4 bytes
    For j = 0 To 3
      c(j) = b64(PeekA(*a))
      *a + #CHARSIZE
    Next
    ;write bytes
    AddElement(Out())
    Out() = c(0) << 2 | c(1) >> 4
    n + 1
    If c(2) > 0
      AddElement(Out())
      Out() = c(1) << 4 | c(2) >> 2
      n + 1
      If c(3) > 0
        AddElement(Out())
        Out() = c(2) << 6 | c(3)
        n + 1
      EndIf
    EndIf
  Next
  ;return number of decoded bytes
  ProcedureReturn n
EndProcedure
Procedure DecodeYenc(Text.s, List Out.a())
  ;decode an yEnc encoded line
  ;http://www.yenc.org/yenc-draft.1.3.txt
  Protected i, n, a.a, special.b, *a
  *a = @Text
  For i = 1 To Len(Text)
    ;get byte
    a = PeekA(*a)
    *a + #CHARSIZE
    ;check special character
    If special
      special = #False
      ;subtract 64 modulo 256
      a - 64
    ElseIf a = 61
      special = #True
      ;this was the special so do not store into container
      Continue
    EndIf
    ;subtract 42 modulo 256
    a - 42
    ;append byte to data array
    AddElement(Out())
    Out() = a
    n + 1
  Next
  ;return number of decoded bytes
  ProcedureReturn n
EndProcedure
Procedure.l DecodeDate(Date.s)
  ;return a valid date of a string ([Weekday, ][0]1 Jan [20]03 00:00:00 [GMT|[+|-]0000) according RFC822 5.1
  Protected i, s.s, dd, mm, yy, hh, ii, ss, month.s, time.s
  ;get day but overread weekday
  i = 1
  Repeat
    s = StringField(Date, i, " ")
    dd = Val(s)
    i + 1
  Until i = 3 Or dd > 0
  ;init months
  Static NewMap months(), m
  If Not m
    For m = 1 To 12
      s = Mid("janfebmaraprmayjunjulaugsepoctnovdec", m * 3 - 2, 3)
      months(s) = m
    Next
  EndIf
  ;parse month
  month = LCase(StringField(Date, i, " "))
  mm = Months(month)
  i + 1
  ;year
  yy = Val(StringField(Date, i, " "))
  i + 1
  ;time
  time = StringField(Date, i, " ")
  hh = Val(StringField(time, 1, ":"))
  ii = Val(StringField(time, 2, ":"))
  ; seconds are optional
  ss = Val(StringField(time, 3, ":"))
  ;return real date
  ProcedureReturn Date(yy, mm, dd, hh, ii, ss)
EndProcedure

;public

Procedure.q NntpAttribute(Id, Attribute)
  ;returns an NNTP attribute value
  With _Nntps(Id)
    Select Attribute
    Case #NntpAttributeReceived
      ProcedureReturn \Received
    Case #NntpAttributeSent
      ProcedureReturn \Sent
    EndSelect
  EndWith
EndProcedure
Procedure.s NntpFindFilename(Subject.s)
  ;return the filename mentioned in the subject
  Protected xl, xm, xr, quotes.b, letters.a, digits.a, length
  ;get length of string
  length = Len(Subject)
  ;lookup extension dot
  For xm = length To 1 Step -1
    If Asc(Mid(Subject, xm, 1)) = '.'
      ;reset
      digits = 0
      quotes = #False
      letters = #False
      ;lookup extension
      For xr = xm + 1 To length
        Select Asc(Mid(Subject, xr, 1))
        Case '"'
          quotes = #True
          Break
        Case ' ', '/' ;space or invalid slash
          Break
        Case '0' To '9'
          digits + 1
        Default
          letters + 1
        EndSelect
      Next
      ;extension ok
      Select digits + letters
      Case 1 To 5
        ;lookup name
        For xl = xm - 1 To 1 Step -1
          Select Asc(Mid(Subject, xl, 1))
          Case ' '
            If Not quotes
              Break
            EndIf
          Case '"'
            If quotes
              Break
            EndIf
          Case '0' To '9', ',', '.'
            ;ok
          Default
            letters + 1
          EndSelect
        Next
        ;the full filename must at least have one letter
        If letters
          xl + 1
          If xl < xm
            ProcedureReturn Mid(Subject, xl, xr - xl)
            Break
          EndIf
        EndIf
      EndSelect
    EndIf
  Next
EndProcedure
Procedure NntpFindFileInfo(Subject.s, *Reply.NntpFileInfo)
  ;returns the file number and count
  Protected ci, x, xl, xr, idxlen, cntlen, center.s, a.a
  For ci = 1 To 3
    center.s = StringField("of|/|von", ci, "|")
    x = 0
    Repeat
      ;reset
      ClearStructure(*Reply, NntpFileInfo)
      ;lookup occurance
      x = FindString(Subject, center, x + 1, #PB_String_NoCase)
      ;limiter not found
      If Not x
        Break
      EndIf
      ;index
      idxlen = 0
      For xl = x - 1 To 1 Step -1
        a = Asc(Mid(Subject, xl, 1))
        If a >= '0' And a <= '9'
          *Reply\Index + (a - '0') * Pow(10, idxlen)
          idxlen + 1
        ElseIf idxlen > 0 Or a <> ' ' ;skip space between limiter and count
          Break
        EndIf
      Next
      ;count
      cntlen = 0
      For xr = x + Len(center) To Len(Subject)
        a = Asc(Mid(Subject, xr, 1))
        If a >= '0' And a <= '9'
          *Reply\Count * 10
          *Reply\Count + (a - '0')
          cntlen + 1
        ElseIf cntlen > 0 Or a <> ' ' ;skip space between limiter and count
          Break
        EndIf
      Next
      ;index and count found
      If idxlen > 0 And cntlen > 0
        ProcedureReturn #True
      EndIf
    ForEver
  Next
EndProcedure
Procedure.s NntpAuthorName(Author.s)
  ;return the name of an author
  Protected xl, xr
  xl = FindString(Author, "<")
  If xl > 0
    ;new format
    ProcedureReturn Trim(ReplaceString(Left(Author, xl - 1), Chr(34), " "))
  Else
    ;old format
    xl = FindString(Author, "(")
    If xl
      xl + 1
      xr = FindString(Author, ")", xl)
      If xr
        ProcedureReturn Mid(Author, xl, xr - xl)
      EndIf
    Else
      ;name missing, use first part of mail instead
      xl = FindString(Author, "@")
      If xl > 0
        ProcedureReturn Left(Author, xl - 1)
      EndIf
    EndIf
  EndIf
EndProcedure
Procedure NntpMultiPartAdd(List Items.NntpMultiPart(), *Xover.NntpXoverItem, Flags.b=0)
  ;add an Xover item to the collection
  Protected i, n, xl, xm, xr, index, count, reverse, found, subject.s
  ;lookup part index and count
  For i = Len(*Xover\Subject) To 1 Step -1
    Select Mid(*Xover\Subject, i, 1)
    Case ")"
      xr = i
    Case "/"
      xm = i
    Case "("
      xl = i
      Break
    EndSelect
  Next
  ;get index and count
  If xl > 0 And xm > xl And xr > xm
    index = Val(Mid(*Xover\Subject, xl + 1, xm - xl - 1))
    count = Val(Mid(*Xover\Subject, xm + 1, xr - xm - 1))
  EndIf
  ;is zero part (0/*)
  If index = 0 And count > 0
    If Flags & #NntpMultiPartKeepZeros ;convert to normal single part
      index = 1
      count = 1
    Else
      ProcedureReturn #False ;do not add
    EndIf
  EndIf
  ;validate index and count
  If index < 1 Or index > 9999
    index = 1
  EndIf
  If count < 1 Or count > 9999
    count = 1
  EndIf
  ;cut partinfo and trailing spaces from subject
  If xl = 0
    subject = *Xover\Subject
  Else
    Repeat
      xl - 1
    Until xl = 0 Or Mid(*Xover\Subject, xl, 1) <> " "
    subject = Left(*Xover\Subject, xl)
  EndIf
  ;remove yEnc
  If Flags & #NntpMultiPartRemoveYenc
    If LCase(Right(subject, 4)) = "yenc"
      subject = Left(subject, Len(subject) - 5)
    EndIf
  EndIf
  ;try to locate existing multi-part
  If count > 1 And LastElement(Items())
    reverse = 500 + count * 10 ;for larger files the entry must be searched in a larger range
    Repeat
      If Items()\Subject = subject
        found = #True
      EndIf
      n + 1
    Until found Or n > reverse Or Not PreviousElement(Items())
  EndIf
  ;create new multi-part
  If Not found
    LastElement(Items())
    AddElement(Items())
    Items()\Subject = subject
    If Flags & #NntpMultiPartRemoveEmail
      Items()\Author = NntpAuthorName(*Xover\Author)
    Else
      Items()\Author = *Xover\Author
    EndIf
    Items()\Date = *Xover\Date
    ReDim Items()\Ids(count - 1)
  EndIf
  ;store id/number and cumulate size
  index - 1
  If index <= ArraySize(Items()\Ids()) And Items()\Ids(index) = ""
    If Flags & #NntpMultiPartByNumber
      Items()\Ids(index) = Str(*Xover\Number)
    Else
      Items()\Ids(index) = *Xover\Id
    EndIf
    Items()\Bytes + *Xover\Bytes
    Items()\Count + 1
    ;return true if multi-part is complete
    If Items()\Count > ArraySize(Items()\Ids())
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure
Procedure.s NntpFindHeader(List Headers.NntpArticleHeader(), Name.s)
  ;returns a header by name
  ForEach Headers()
    If Headers()\Name = Name
      ProcedureReturn Headers()\Value
    EndIf
  Next
EndProcedure
Procedure NntpEncode(Filename.s, List Body.s(), Part, *Result.NntpEncodeResult)
  ;encodes a file into several parts using yenc
  Protected f, name.s, start.q, ende.q, pcrc.l, b.a
  #NntpPostPartSize = 500000
  With *Result
    \TotalBytes = FileSize(Filename)
    If \TotalBytes > 0
      start = (Part - 1) * #NntpPostPartSize
      If start <= \TotalBytes
        f = ReadFile(#PB_Any, Filename)
        If f
          ;number of parts
          \PartCount = 1 + (\TotalBytes - 1) / #NntpPostPartSize
          start = (Part - 1) * #NntpPostPartSize
          FileSeek(f, start)
          name.s = GetFilePart(Filename)
          ;header
          AddElement(Body())
          If \PartCount = 1 ;single-part
            Body() = "=ybegin line=128 size=" + Str(\TotalBytes) + " name=" + name
            ende = \TotalBytes - 1
          Else ;multi-part
            Body() = "=ybegin line=128 part=" + Str(part) + " total=" + Str(\PartCount) + " size=" + Str(Lof(f)) + " name=" + name
            ende = Loc(f) + #NntpPostPartSize - 1
            If ende > \TotalBytes - 1
              ende = \TotalBytes - 1
            EndIf
            AddElement(Body())
            Body() = "=ypart begin=" + Str(Loc(f) + 1) + " end=" + Str(ende + 1)
          EndIf
          ;write yEnc lines
          AddElement(Body())
          pcrc = 0
          While Loc(f) <= ende
            ;encode a byte
            b = ReadByte(f) + 42
            ;calculate CRC's
            \CRC = CRC32Fingerprint(@b, 1, \CRC)
            pcrc = CRC32Fingerprint(@b, 1, pcrc)
            ;encode byte
            Select b
            Case #NUL, #TAB, #LF, #CR, '=' ;is special
              Special:
              Body() + "=" + Chr(b + 64)
            Case ' ' ;space not allowed at the end of a line
              If Len(Body()) = 127
                Goto Special
              Else
                Goto Normal
              EndIf
            Case '.' ;dot not allowed on the very first column (valid for yEnc but invalid for NNTP)
              If Len(Body()) = 0
                Goto Special
              Else
                Goto Normal
              EndIf
            Default ;no special
              Normal:
              Body() + Chr(b)
            EndSelect
            ;make new line line
            If Len(Body()) >= 128
              AddElement(Body())
            EndIf
          Wend
          ;footer
          AddElement(Body())
          Body() = "=yend size=" + Str(Lof(f))
          ;attach part number and part CRC if multi-part
          If \PartCount > 1
            Body() + " part=" + Str(part) + " pcrc32=" + Hex(pcrc, #PB_Long)
          EndIf
          ;attach CRC of whole file to last part
          If Part = \PartCount
            Body() + " crc32=" + Hex(\CRC, #PB_Long)
          EndIf
          CloseFile(f)
          ;set number of encoded bytes
          \EncodedBytes = 1 + ende - start
          ;return #True on success
          ProcedureReturn #True
        EndIf
      EndIf
    EndIf
  EndWith
EndProcedure

;private

Procedure.s _NntpReceive(Id)
  ;receive response from newsserver
  With _Nntps(Id)
    Protected len, a, b, e, line.s, rest.s, first.s
    ;clear previous data
    ClearList(\Lines())
    ;receive all lines
    Repeat
      ;receive new data
      len = ReceiveNetworkData(\Connection, \Buffer, 1440)
      ;network error or no more data
      If len < 1
        Break
      EndIf
      ;count amount of received bytes
      \Received + len
      ;split received data by line ($CRLF#)
      a = \Buffer
      e = \Buffer + len - 1
      For b = a To e
        Select PeekA(b)
        Case #LF
          ;set line start behind LF (#CRLF$ was splitted caused by block data)
          a = b + 1
        Case #CR
          ;cut line
          line = PeekS(a, b - a, #PB_Ascii)
          ;check rest
          If rest
            line = rest + line
            rest = ""
          EndIf
          ;ready
          If line = "."
            Break 2
          EndIf
          ;remove the very first dot
          If Left(line, 1) = "."
            line = Mid(line, 2)
          EndIf
          ;keep first line as response
          If first = ""
            ;Debug "R: " + line
            first = line
            Select Left(line, 3)
            Case "215", "220", "221", "224"
              ;continue until "."
            Default
              ;reply is not a list so stop here
              Break 2
            EndSelect
          Else
            ;add line to collection
            AddElement(\Lines())
            \Lines() = line
          EndIf
          ;set new line start
          a = b + 1
        EndSelect
      Next
      ;keep the rest to stick it before next line (important: add rest to probably existing rest from previous batch)
      If b > a
        rest + PeekS(a, b - a, #PB_Ascii)
      EndIf
    ForEver
    ;return first line of response
    ProcedureReturn first
  EndWith
EndProcedure
Procedure _NntpSend(Id, Line.s)
  ;Debug "S: " + Line
  With _Nntps(Id)
    ;attach line feed
    Line + #CRLF$
    ;send command
    If SendNetworkString(\Connection, Line, #PB_Ascii)
      ;add sent bytes
      \Sent + Len(Line)
      ProcedureReturn #True
    EndIf
  EndWith
EndProcedure
Procedure.s _NntpHeaderSubValue(Value.s, Name.s)
  Protected i, x, subitem.s, subname.s, subvalue.s
  ;returns sub-values from header value by name
  For i = 1 To CountString(Value, ";")
    subitem = StringField(Value, 1 + i, ";")
    x = FindString(subitem, "=")
    If x > 0
      subname = LCase(Trim(Left(subitem, x - 1)))
      If subname = Name
        subvalue = Trim(Trim(Mid(subitem, x + 1)), Chr(34))
        ProcedureReturn subvalue
      EndIf
    EndIf
  Next
EndProcedure

;client

Procedure NntpConnect(Id, Host.s, Port, User.s, Pass.s, *Reply.NntpReply)
  ;open network connection and return connection id
  Protected i, reply.s
  ;clear previous result
  ClearStructure(*Reply, NntpReply)
  ;try multiple accounts if available
  With _Nntps(Id)
    ;init some data
    \Host = Host
    \Buffer = AllocateMemory(1440, #PB_Memory_NoClear)
    \Received = 0
    \Sent = 0
    ClearList(\Lines())
    ;network must be available
    If InitNetwork()
      ;init NNTP object data
      \Connection = OpenNetworkConnection(Host, Port)
      If \Connection
        ;read response
        *Reply\Reply = _NntpReceive(Id)
        ;check login result
        Select Left(*Reply\Reply, 3)
        Case "200", "201"
          ;authenticate if user/pass given
          If User = ""
            ProcedureReturn #True
          ElseIf _NntpSend(Id, "AUTHINFO USER " + User)
            reply = _NntpReceive(Id)
            If Left(reply, 3) <> "381"
              *Reply\Reply = reply
            ElseIf _NntpSend(Id, "AUTHINFO PASS " + Pass)
              reply = _NntpReceive(Id)
              If Left(reply, 3) <> "281"
                *Reply\Reply = reply
              Else
                ProcedureReturn #True
              EndIf
            EndIf
          EndIf
        EndSelect
      EndIf
    EndIf
  EndWith
EndProcedure
Procedure NntpDisconnect(Id)
  ;close connection and free up some resources
  With _Nntps(Id)
    If \Connection
      CloseNetworkConnection(\Connection)
      ClearList(\Lines())
      FreeMemory(\Buffer)
      \Connection = 0
      ;keep remain fields for further use (host, received, sent)
    EndIf
  EndWith
EndProcedure
Procedure NntpList(Id, Active.s, *Reply.NntpListReply)
  ;receive newsgroups list from news server
  ;http://tools.ietf.org/html/rfc977#section-3.6.1
  ;http://tools.ietf.org/html/rfc2980#section-2.1.2
  Protected *li.NntpListItem
  With _Nntps(Id)
    ;clear result
    ClearStructure(*Reply, NntpListReply)
    InitializeStructure(*Reply, NntpListReply)
    ;build command string
    Protected cmd.s
    If Active = ""
      cmd = "LIST"
    Else
      cmd = "LIST ACTIVE " + Active
    EndIf
    ;send request to news server
    If _NntpSend(Id, cmd)
      ;receive and store newsgroups
      *Reply\Reply = _NntpReceive(Id)
      If Left(*Reply\Reply, 3) = "215"
        ForEach \Lines()
          *li = AddElement(*Reply\Items())
          *li\Newsgroup = StringField(\Lines(), 1, " ")
          *li\Last = Val(StringField(\Lines(), 2, " "))
          *li\First = Val(StringField(\Lines(), 3, " "))
          *li\Flag = StringField(\Lines(), 4, " ")
        Next
        ;sort groups by name
        SortStructuredList(*Reply\Items(), #PB_Sort_Ascending, OffsetOf(NntpListItem\Newsgroup), #PB_String)
        ProcedureReturn #True
      EndIf
    EndIf
  EndWith
EndProcedure
Procedure NntpGroup(Id, Newsgroup.s, *Reply.NntpGroupReply)
  ;http://tools.ietf.org/html/rfc977#section-3.2.1
  ClearStructure(*Reply, NntpGroupReply)
  If _NntpSend(Id, "GROUP " + Newsgroup)
    With *Reply
      \Reply = _NntpReceive(Id)
      If Left(\Reply, 3) = "211"
        \Count = Val(StringField(\Reply, 2, " "))
        \First = Val(StringField(\Reply, 3, " "))
        \Last = Val(StringField(\Reply, 4, " "))
        \Newsgroup = StringField(\Reply, 5, " ")
        ProcedureReturn #True
      EndIf
    EndWith
  EndIf
EndProcedure
Procedure NntpArticle(Id, NumberOrId.s, *Reply.NntpArticleReply)
  ;http://tools.ietf.org/html/rfc977#section-3.1.1
  Protected state.b, *ah.NntpArticleHeader, *aa.NntpArticleAttachment, x
  Protected.s content_name, boundary, content_transfer_encoding
  ;local constants
  #_NntpStateHeader = 0
  #_NntpStateText = 1
  #_NntpStateBase64 = 2
  #_NntpStateUU = 3
  #_NntpStateYenc = 4
  ;short access
  With _Nntps(Id)
    If _NntpSend(Id, "ARTICLE " + NumberOrId)
      ;clear previous result
      ClearStructure(*Reply, NntpArticleReply)
      InitializeStructure(*Reply, NntpArticleReply)
      ;retrieve article
      *Reply\Reply = _NntpReceive(Id)
      If Left(*Reply\Reply, 3) = "220"
        ForEach \Lines()
          Select state
          Case #_NntpStateHeader
            ;decodes an article header
            Select Asc(Left(\Lines(), 1))
            Case 'A' To 'Z'
              ;add new header which must start with a letter
              x = FindString(\Lines(), ":")
              *ah = AddElement(*Reply\Headers())
              *ah\Name = Left(\Lines(), x - 1)
              *ah\Value = DecodeString(Mid(\Lines(), x + 2))
            Case #TAB, ' '
              ;append folded header to previous header (remove eventually tabs by spaces)
              *ah\Value + ReplaceString(DecodeString(\Lines()), #TAB$, " ")
            Case #NUL
              ;header/body split
              ;read thru all headers and get the latest value for Content-Type, content_name and Content-Transfer-Encoding
              ForEach *Reply\Headers()
               *ah = *Reply\Headers()
                Select LCase(*ah\Name)
                Case "content-type"
                  content_name = _NntpHeaderSubValue(*ah\Value, "name")
                  ;get boundary if multipart
                  If LCase(Left(*ah\Value, 10)) = "multipart/"
                    boundary = _NntpHeaderSubValue(*ah\Value, "boundary")
                  EndIf
                Case "content-disposition"
                  content_name = _NntpHeaderSubValue(*ah\Value, "filename")
                Case "content-transfer-encoding"
                  content_transfer_encoding = LCase(*ah\Value)
                EndSelect
              Next
              ;create new Base64 attachment
              If content_transfer_encoding = "base64"
                *aa = AddElement(*Reply\Attachments())
                *aa\Name = Trim(content_name)
                *aa\Encoding = #NntpEncodingYenc
                state = #_NntpStateBase64
              Else
                state = #_NntpStateText
              EndIf
            EndSelect
          Case #_NntpStateText
            ;decode as text but find binaries or mime parts
            ;new MIME part
            If Left(\Lines(), 2) = "--" And boundary And Mid(\Lines(), 3, Len(boundary)) = boundary
              ;return to headers will read additional multi-part headers
              state = #_NntpStateHeader
            ElseIf Left(\Lines(), 8) = "=ybegin "
              *aa = AddElement(*Reply\Attachments())
              *aa\Name = Trim(Mid(\Lines(), FindString(\Lines(), "name=", 1) + 5))
              *aa\Encoding = #NntpEncodingYenc
              state = #_NntpStateYenc
            ElseIf Left(\Lines(), 6) = "begin " And Val(Mid(\Lines(), 7, 3)) > 0
              *aa = AddElement(*Reply\Attachments())
              *aa\Name = Trim(Mid(\Lines(), 11))
              *aa\Encoding = #NntpEncodingUU
              state = #_NntpStateUU
            ElseIf \Lines() And (Asc(Left(\Lines(), 1)) - 32) / 3 = (Len(\Lines()) - 1) / 4
              *aa = AddElement(*Reply\Attachments())
              DecodeUU(\Lines(), *aa\Data())
              *aa\Encoding = #NntpEncodingUU
              state = #_NntpStateUU
            ElseIf \Lines() = "This is a multi-part message in MIME format."
              ;skip multi part message text
              ;add text (but do not start with empty lines)
            ElseIf *Reply\Text Or \Lines()
              ;quoted-printable
              If content_transfer_encoding = "quoted-printable"
                ;decode specials (=##)
                \Lines() = DecodeQuotedPrintable(\Lines())
                ;soft line-breaks with = at the end of the line
                If Right(\Lines(), 1) = "="
                  *Reply\Text + Left(\Lines(), Len(\Lines()) - 1)
                Else
                  *Reply\Text + \Lines() + #CRLF$
                EndIf
              Else
                ;normal text
                If *Reply\Text
                  *Reply\Text + #CRLF$
                EndIf
                *Reply\Text + \Lines()
              EndIf
            EndIf
          Case #_NntpStateBase64
            ;return to text state on empty line
            If \Lines() = ""
              state = #_NntpStateText
            ElseIf Left(\Lines(), 2) = "--" And Mid(\Lines(), 3, Len(boundary)) = boundary
              ;return to normal text end MIME part
              state = #_NntpStateText
            Else
              DecodeBase64(\Lines(), *aa\Data())
            EndIf
          Case #_NntpStateUU
            ;decode an UU encoded line
            If \Lines() = "" Or \Lines() = "end"
              ;return to text if UU data ended (normal or unexpected)
              state = #_NntpStateText
            Else
              DecodeUU(\Lines(), *aa\Data())
            EndIf
          Case #_NntpStateYenc
            ;decode an yEnc encoded line
            If Left(\Lines(), 6) = "=yend "
              ;return to text after Yenc has ended
              state = #_NntpStateText
              ;skip second yenc header line
            ElseIf Left(\Lines(), 7) <> "=ypart "
              DecodeYenc(\Lines(), *aa\Data())
            EndIf
          EndSelect
        Next
        ProcedureReturn #True
      EndIf
    EndIf
  EndWith
EndProcedure
Procedure NntpStat(Id, NumberOrId.s, *Reply.NntpReply)
  If _NntpSend(Id, "STAT " + NumberOrId)
    *Reply\Reply = _NntpReceive(Id)
    If Left(*Reply\Reply, 3) = "223"
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure
Procedure NntpXover(Id, First.q, Last.q, *Reply.NntpXoverReply)
  ;returns information from the overview database for a range of articles (see RFV 2980 para 2.8)
  Protected *xi.NntpXoverItem
  With _Nntps(Id)
    ;clear previous result
    ClearStructure(*Reply, NntpXoverReply)
    InitializeStructure(*Reply, NntpXoverReply)
    ;send XOVER command
    If _NntpSend(Id, "XOVER " + Str(First) + "-" + Str(Last))
      *Reply\Reply = _NntpReceive(Id)
      If Left(*Reply\Reply, 3) = "224"
        ForEach \Lines()
          *xi = AddElement(*Reply\Items())
          *xi\Number = Val(StringField(\Lines(), 1, #TAB$))
          *xi\Subject = DecodeString(StringField(\Lines(), 2, #TAB$))
          *xi\Author = DecodeString(StringField(\Lines(), 3, #TAB$))
          *xi\Date = DecodeDate(StringField(\Lines(), 4, #TAB$))
          *xi\Id = StringField(\Lines(), 5, #TAB$)
          *xi\References = StringField(\Lines(), 6, #TAB$)
          *xi\Bytes = Val(StringField(\Lines(), 7, #TAB$))
          *xi\XRef = StringField(\Lines(), 9, #TAB$)
        Next
        ProcedureReturn #True
      EndIf
    EndIf
  EndWith
EndProcedure
Procedure NntpXhdr(Id, Header.s, First.q, Last.q, MatchCode.s, *Reply.NntpXhdrReply)
  ;retrieve specific headers from a range of articles (see RFC 2980 para 2.6, 2.9 and 3.3)
  Protected *xi.NntpXhdrItem, cmd.s, x
  With _Nntps(Id)
    ;clear previous result
    ClearStructure(*Reply, NntpXhdrReply)
    InitializeStructure(*Reply, NntpXhdrReply)
    ;build command (use XHDR without or XPAT with matchcode)
    If MatchCode = ""
      cmd = "XHDR " + Header + " " + Str(First) + "-" + Str(Last)
    Else
      cmd = "XPAT " + Header + " " + Str(First) + "-" + Str(Last) + " " + MatchCode
    EndIf
    ;send command
    If _NntpSend(Id, cmd)
      *Reply\Reply = _NntpReceive(Id)
      If Left(*Reply\Reply, 3) = "221"
        ForEach \Lines()
          If Right(\Lines(), 6) <> "(none)"
            *xi = AddElement(*Reply\Items())
            x = FindString(\Lines(), " ")
            *xi\Number = Val(Left(\Lines(), x - 1))
            *xi\Value = DecodeString(Mid(\Lines(), x + 1))
          EndIf
        Next
        ProcedureReturn #True
      EndIf
    EndIf
  EndWith
EndProcedure
Procedure NntpDate(Id)
  ;returns the servers current date and time (see RFC 2980 para 3.2)
  Protected reply.s
  If _NntpSend(Id, "DATE")
    reply = _NntpReceive(Id)
    If Left(reply, 3) = "111"
      ProcedureReturn ParseDate("%yyyy%mm%dd%hh%ii%ss", Mid(reply, 5))
    EndIf
  EndIf
EndProcedure
Procedure NntpPost(Id, Newsgroup.s, From.s, Subject.s, List Body.s(), *Reply.NntpPostReply)
  ;http://tools.ietf.org/html/rfc977#section-3.10.1
  Protected xl, xr
  With *Reply
    ;invoke POST command
    _NntpSend(Id, "POST")
    \Reply = _NntpReceive(Id)
    If Left(\Reply, 3) = "340"
      ;catch message-id
      xl = FindString(\Reply, "<")
      xr = FindString(\Reply, ">", xl + 1)
      If xl > 0 And xr > xl
        ;take message-id from news server
        \MessageId = Mid(\Reply, xl, xr - xl + 1)
      Else
        ;make own message-id if not provided
        ;http://tools.ietf.org/html/rfc850#section-2.1.7
        \MessageId = "<" + FormatDate("%yyyy%mm%dd%hh%ii%ss", Date()) + Hex(Random(#MaxInt), #PB_Integer) + "@" + _Nntps(Id)\Host + ">"
        _NntpSend(Id, "Message-Id: " + \MessageId)
      EndIf
      ;send header
      ;http://tools.ietf.org/html/rfc850#section-2.1.5
      _NntpSend(Id, "Newsgroups: " + Newsgroup)
      ;http://tools.ietf.org/html/rfc850#section-2.1.3
      _NntpSend(Id, "From: " + From)
      ;http://tools.ietf.org/html/rfc850#section-2.1.6
      _NntpSend(Id, "Subject: " + Subject)
      _NntpSend(Id, "")
      ;send body
      ForEach Body()
        If Left(Body(), 1) = "."
          _NntpSend(Id, "." + Body())
        Else
          _NntpSend(Id, Body())
        EndIf
      Next
      ;finally send a dot on a line itself to finish post
      _NntpSend(Id, ".")
      ;check return code
      \Reply = _NntpReceive(Id)
      If Left(\Reply, 3) = "240"
        ProcedureReturn #True
      EndIf
    EndIf
  EndWith
EndProcedure

DisableExplicit

CompilerIf #PB_Compiler_IsMainFile
 
  #NntpHost = "" ;enter the host name of your news service provider here
  #NntpUser = "" ;enter your user name here
  #NntpPass = "" ;enter your password here
 
  If NntpConnect(0, #NntpHost, 119, #NntpUser, #NntpPass, cr.NntpReply)
    ;place your test code here
    NntpDisconnect(0)
  EndIf
CompilerEndIf

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Last edited by uwekel on Tue Jul 22, 2014 7:37 pm, edited 8 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 1:12 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
This sample show you how to connect to a news server. The first argument 0 identifies the NNTP object and must be in a range of 0 to 31. Because it is a public news server, username and password for authenticaton are missing or empty. If the connection is established, the reply from the newsserver is shown in the debug output. Afterwards the connection is closed. Please note that all information returned from the news server is stored in the NntpConnectResult-Structure.

Code:
;connect to your news server (this one below is a public news server)
If NntpConnect(0, "freenews.netfront.net", "", "", cr.NntpConnectResult)
  ;show login message
  Debug cr\Reply
  ;close the connection
  NntpDisconnect(0) 
EndIf

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 1:23 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
This sample shows how to download a list of newsgroups. If you leave the second argument of the NntpList command empty, you will receive a full list of all available newsgroups. The NntpListResult-Structure holds all data received from the news server. It includes a list of NntpListItem which holds the data for each newsgroup.

Code:
;connect to your news server (this one below is a public news server)
If NntpConnect(0, "freenews.netfront.net", "", "", cr.NntpConnectResult)
  ;retrieve a list of binary newsgroups
  If NntpList(0, "alt.binaries.*", lr.NntpListResult)
    ;show received newsgroups with numer of articles
    ForEach lr\Items()
      count.q = lr\Items()\Last - lr\Items()\First + 1
      Debug lr\Items()\Newsgroup + " (" + Str(count) + " articles)"
    Next
  EndIf
  ;close the connection
  NntpDisconnect(0)
EndIf

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 2:05 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
In this sample, we connect to the news server, select a known newsgroup by name and download the 100 most recent headers from that group. The NntpXoverResult returns a list of NntpXoverItems, which contain a lot of information about the articles like article number, subject, author, date, message-id, references and bytes.

Code:
;connect to your news server (this one below is a public news server)
If NntpConnect(0, "freenews.netfront.net", "", "", cr.NntpConnectResult)
  ;select a newsgroup to retrieve article headers from that group
  If NntpGroup(0, "alt.binaries.pictures.rail", gr.NntpGroupResult)
    ;download 100 most recent headers
    If NntpXover(0, gr\Last - 100, gr\Last, xr.NntpXoverResult)
      ;displays the subject line for all headers
      ForEach xr\Items()
        Debug xr\Items()\Subject
      Next
    EndIf
  EndIf
  ;close the connection
  NntpDisconnect(0)
EndIf

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 2:18 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
Now we are going to download the most recent article in a newsgroup. Binary attachments, if exists, will be decoded automatically. Supported encodings are Mime/Base64, UU and yEnc. Please note that the NNTP component has not a full MIME implementation. Instead it will only parse Base64 encodings within a MIME message. Attachment name and binary data are hold in the NntpArticleAttachment-Structure. In the sample below we request an article by article number, which requires an NntpGroup command first. If you request an article by message-id, the NntpGroup command can be omitted (on most servers).

Code:
;connect to your news server (this one below is a public news server)
If NntpConnect(0, "freenews.netfront.net", "", "", cr.NntpConnectResult)
  ;select a newsgroup to retrieve article headers from that group
  If NntpGroup(0, "alt.binaries.pictures.rail", gr.NntpGroupResult)
    ;download the most recent article
    If NntpArticle(0, Str(gr\Last), ar.NntpArticleResult)
      ;show message text
      Debug ar\Text
      ;show attachments (if any)
      ForEach ar\Attachments()
        Debug ar\Attachments()\Name
      Next
    EndIf
  EndIf
  ;close the connection
  NntpDisconnect(0)
EndIf

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 7:39 pm 
Offline
Addict
Addict

Joined: Sun Dec 12, 2010 12:36 am
Posts: 1617
Location: Somewhere in the midwest
That's pretty neat. Thanks for sharing this.
Do you plan to update/improve/maintain this toolset?

I have always been interested in making my own NewsReader client, although I only use UseNet on and off as funds for my account permit. But I am constantly in search of better newsreaders and not a single one has made me happy. They are either old and have outdated /outmoded GUI's, or the ones with newer GUI's lack the features of the older ones, or I can't find a feature I'd like at all.

I'd often thought about making a personal client for myself if I ever found the time / ambition.. But I would definitely need something like this to base it on. Something that will deal with all the connection protocols, encrypted connections, Binary encoding/decoding, etc.

_________________
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 7:58 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
Quote:
Do you plan to update/improve/maintain this toolset?

Yes, i use it for my own newsreader. I left the Windows world a while ago and now i am porting my sources from VB.Net to Purebasic. I have been programming newsreaders since 1998 and have already some experience in it. I think that the library already has a forge advanced status. My current PB project is in heavy work. If i or others detect a bug, of course i will update the file asap.

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 8:09 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Aug 31, 2005 11:09 pm
Posts: 3694
Location: Italy
Very interesting, thank you for sharing it.

Will you add support for SSL on 563 (default port I believe) ?

_________________
[ My little PureBasic review ]


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Tue Jul 03, 2012 8:19 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
luis wrote:
Will you add support for SSL on 563 (default port I believe) ?

It depends on the PB network commands and there is no SSL support. I have no idea how to implement it by my own. And yes, Port 563 is the default SSL port supported by all major news service providers.

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Wed Jul 04, 2012 7:09 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
Articles with large binary attachments are splitted into several single messages (this is due to server limitations). Multiparts are tagged with a (#/#) at the end of the subject line, where # is placeholder for a digit. The NNTP module provides an easy way to join these splits again. All articles belonging together will be collected in a list of NntpMultiPart-Structures. The tag in the subject line will then be removed.

This code section shows you how to use NntpMultiPart:

Code:
;create new list of multi-parts
NewList mps.NntpMultiPart()
;download some article headers per XOVER
If NntpXover(0, FirstArticleNumber, LastArticleNumber, xr.NntpXoverResult)
  ;put each xover-item to the multi-part collector
  ForEach xr\Items()
    If NntpMultiPartAdd(mps(), xr\Items())
      ;returns #True if it's a new multi-part or #False if the part has been added to an existing multi-part
    EndIf
  Next
EndIf

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Wed Jul 04, 2012 7:17 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
The NNTP component has 3 attributes which can be get or set by the NntpGetAttribute() or NntpSetAttribute() commands.

#NntpAttributeTimeout
Is the time with no data receival after a timeout occurs. The default value is 60 seconds. 0 means that no timeout occurs.

#NntpAttributeReceived
Returns the number of received bytes since connecting to the news server. You may also change this value (e.g reset).

#NntpAttributeSent
Returns the number of sent bytes since connecting to the news server. This value can be changed, too.

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Thu May 30, 2013 9:37 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Dec 03, 2011 5:54 pm
Posts: 736
Location: Oldenburg (Germany)
Since today the library works properly with Unicode :-)
I also added the port-number argument to the NntpConnect() procedure.

_________________
PB 5.70 LTS (x64) - Debian Testing, Gnome 3.30.2


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Sat Sep 07, 2013 6:56 pm 
Offline
User
User
User avatar

Joined: Thu Feb 26, 2004 5:42 pm
Posts: 87
Location: 28:58E 41:01N
What is ifDo(...,...) command ?
when I compile source, I have error for ifDo command.

_________________
PureBasic v5.22 LTS & Mac & Windows8


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Sat Sep 07, 2013 8:55 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Feb 17, 2010 12:00 am
Posts: 1324
Location: (Embarrassed to say country)
total stab in the dark, just based on reading the code, no actually execution of any kind; I'd say it's a macro:


Code:
macro ifdo( boolean, command )
if boolean
  command
endif
endmacro


Top
 Profile  
Reply with quote  
 Post subject: Re: NNTP component for newsserver communication
PostPosted: Sat Sep 07, 2013 9:43 pm 
Offline
User
User
User avatar

Joined: Thu Feb 26, 2004 5:42 pm
Posts: 87
Location: 28:58E 41:01N
Thanks jassing :D


do you know section / endsection . I searhed forum but not found.

_________________
PureBasic v5.22 LTS & Mac & Windows8


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 25 posts ]  Go to page 1, 2  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 4 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye