peter-rachow.de : Send a messag to a newsserver (C) Peter Rachow

[VB-Stuff]

need a Winsock: wskNMTP

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"

'Connect
If ConnectServer(frmMain.cmbNMTPServer) = 0 Then
Exit Function
End If

Call SysMsg("Verbunden.")

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

Call SysMsg("Trenne...")

frmMain.wskNMTP.SendData "QUIT" & vbCrLf
intRxModeNMTP = RXM_QUIT
Do While intRxModeNMTP <> 0
DoEvents
Loop

frmMain.wskNMTP.Close

SendMsg = 1

End Function

(C) Peter Rachow