Path: news.ccsf.jp!4bn.ne.jp!tomockey.ddo.jp!goblin2!goblin.stu.neva.ru!aioe.org!.POSTED!not-for-mail
From: "Program Files from the NET" <prgr@netprog.com>
Newsgroups: japan.comp.lang.visual-basic
Subject: Posting a message( was Re: Connecting a Newsserver)
Date: Wed, 18 Jan 2012 21:35:33 +0100
Organization: Aioe.org NNTP Server
Lines: 74
Message-ID: <jf7aej$av8$1@speranza.aioe.org>
References: <jeuufh$2ge$1@speranza.aioe.org> <jevddg$6sl$1@speranza.aioe.org>
NNTP-Posting-Host: LrFzPbL2uiVLem7QT/9rGA.user.speranza.aioe.org
X-Complaints-To: abuse@aioe.org
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.6157
X-RFC2646: Format=Flowed; Response
X-Antivirus-Status: Clean
X-Notice: Filtered by postfilter v. 0.8.2
X-Newsreader: Microsoft Outlook Express 6.00.2900.5931
X-Antivirus: avast! (VPS 120118-1, 18.01.2012), Outbound message
X-Priority: 3
X-MSMail-Priority: Normal
Xref: news.ccsf.jp japan.comp.lang.visual-basic:195

This function post a message on a newsserver

(C) Peter Rachow

Function SendMsg(strMyName As String, strMyMail As String, strNG As String, 
strSubject As String, strMsgText As String, strReference As String, 
strCancel As String)

    Dim strS As String

    Dim strDay$(7)
    Dim strMon$(12)

    strDay(1) = "Sun"
    strDay(2) = "Mon"
    strDay(3) = "Tue"
    strDay(4) = "Wed"
    strDay(5) = "Thu"
    strDay(6) = "Fri"
    strDay(7) = "Sat"

    strMon(1) = "Jan"
    strMon(2) = "Feb"
    strMon(3) = "Mar"
    strMon(4) = "Apr"
    strMon(5) = "May"
    strMon(6) = "Jun"
    strMon(7) = "Jul"
    strMon(8) = "Aug"
    strMon(9) = "Sep"
    strMon(10) = "Oct"
    strMon(11) = "Nov"
    strMon(12) = "Dec"

    frmMain.wskNMTP.SendData ("POST") & vbCrLf
    intRxModeNMTP = RXM_POST
    Do While intRxModeNMTP = RXM_POST
       DoEvents
    Loop

    strS = ""
    strS = strS & "From: " & strMyName & " <" & strMyMail & ">" & vbCrLf
    If strCancel <> "" Then
        strS = strS & "Control: cancel <" & strCancel & ">" & vbCrLf
    End If
    strS = strS & "Newsgroups: " & strNG & vbCrLf
    strS = strS & "Subject: " & strSubject & vbCrLf
    strS = strS & "Date: " & strDay(WeekDay(Date)) & ", "
    strS = strS & Left$(Date, 2) & " "
    strS = strS & strMon(Val(Mid$(Date, 4, 2))) & " "
    strS = strS & Right$(Format(Date, "dd-mm-yyyy"), 4) & " "
    strS = strS & Format(Time, "hh:mm:ss") & " +0100" & vbCrLf
    strS = strS & "Message-ID: <" & strRecMsgID & ">" & vbCrLf
    If strReference <> "" Then
        strS = strS & "References: <" & strReference & ">" & vbCrLf
    End If
    strS = strS & vbCrLf

    strS = strS & strMsgText

    frmMain.wskNMTP.SendData strS & vbCrLf & "." & vbCrLf

    intRxModeNMTP = RXM_POSTDONE
    Do While intRxModeNMTP = RXM_POSTDONE
       DoEvents
    Loop

    SendMsg = 1

End Function

(C) Peter Rachow