Connecting a Newsserver

[Program Files from the NET]

Found a cool Function to connect to e NMTP-Server (C) Peter Rachow from
germany

Function ConnectServer(strServer As String) '(C) 2009 Peter Rachow

Dim lngSecsOld As Long

Call SysMsg("Connecting: " & strServer)
If frmMain.wskNMTP.State = sckClosed Then
frmMain.wskNMTP.RemotePort = 119
frmMain.wskNMTP.RemoteHost = strServer
frmMain.wskNMTP.Connect
intRxModeNMTP = RXM_CONNECT
lngSecsOld = lngSecs

Do While intRxModeNMTP = RXM_CONNECT
DoEvents
If lngSecs > lngSecsOld + TIMEOUTSECS Then
frmMain.wskNMTP.Close
Call SysMsg("Time out.")
ConnectServer = 0
Exit Function
End If
Loop
Else
Call SysMsg("Connection alredy exists.")
ConnectServer = 0
Exit Function
End If

ConnectServer = 1

End Function

You need a Winsock-Control wskNMTP and a function to Show SysMsgs (can
either be a MsgBox or e listbox or sth).

Have fun!

[Program Files from the NET]

General declarations:

(C) Peter Rachow
Option Explicit

Global Const APPNAME = "Newsmodule"
Global lngSecs As Long

Global intRxModeNMTP As Integer
Global strRecMsgID As String
Global lngLastArticleInGroup As Long
Global strWinsockNMTP As String

'Const for Winsock
Global Const RXM_CONNECT = 1
Global Const RXM_GROUPINFO = 2
Global Const RXM_GETSTAT = 3
Global Const RXM_GETHEADER = 4
Global Const RXM_GETBODY = 5
Global Const RXM_POST = 10
Global Const RXM_POSTDONE = 11
Global Const RXM_GETGROUPLIST = 12
Global Const RXM_CANCEL = 99
Global Const RXM_QUIT = 100

Global Const TIMEOUTSECS = 30

'Const for Grouplist
Global intGroupListMode As Long
Global Const GRPLISTLONG = 1
Global Const GRPLISTSHORT = 0

Use this code in a seperate module!


"Program Files from the NET" <pr...@netprog.com> schrieb im Newsbeitrag
news:jeuufh$2ge$1...@speranza.aioe.org...

[Program Files from the NET]

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