Peter Rachow de s basic code
Clever n Smart
Die 2. Funktion verbindet zu einen Newsserver und sendet eine Nachricht .
With these 2 functions you can send a message to any news server:
Needs Winsock-Control! Name: wskNMTP
In Public Domain by Peter Rachow 2003
Get more Code on http://www.peter-rachow.de
First call MakeMsg() the SendMsg()
Function MakeMsg$(strFrom, strMailAdr, strSubject$, strMsg$, strReference$)
Dim T1&, strS$, strS2$
Dim strDay$(7)
Dim strMon$(12)
Dim intLastAscii%
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"
strS = ""
strS = strS & "From: " & strFrom & " <" & strMailAdr & ">" & vbCrLf
strS = strS & "Newsgroups: " & frmMain.txtNG.Text & 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 & "Content-Type: text/plain; charset=iso-8859-1" & vbCrLf
strS = strS & "Content-Transfer-Encoding: 8bit" & vbCrLf & vbCrLf
intLastAscii = Len(strMsg)
For T1 = Len(strMsg) To 1 Step -1
If Asc(Mid$(strMsg, T1, 1)) >= 32 And Mid$(strMsg, T1, 1) <> "." Then
intLastAscii = T1
Exit For
End If
Next
strS = strS & Left$(strMsg, intLastAscii) & vbCrLf
MakeMsg = strS
End Function
Function SendMsg%(strFrom, strMailAdr, strSubject$, strMsg$, strReference$)
'Connect
Call SysMsg("Connecting to server: " & frmMain.txtServer)
intRxModeNMTP = RXM_CONNECT
frmMain.wskNMTP.RemotePort = 119
frmMain.wskNMTP.RemoteHost = frmMain.txtServer
frmMain.wskNMTP.Connect
Call SysMsg("OK.")
Do While intRxModeNMTP = RXM_CONNECT
DoEvents
Loop
frmMain.wskNMTP.SendData ("POST") & vbCrLf
intRxModeNMTP = RXM_POST
Do While intRxModeNMTP = RXM_POST
DoEvents
Loop
strMsg = MakeMsg(strFrom, strMailAdr, strSubject$, strMsg$, strReference$)
frmMain.wskNMTP.SendData strMsg & vbCrLf & "." & vbCrLf
intRxModeNMTP = RXM_POSTDONE
Do While intRxModeNMTP = RXM_POSTDONE
DoEvents
Loop
Call SysMsg("Disconnect...")
frmMain.wskNMTP.SendData "QUIT" & vbCrLf
intRxModeNMTP = RXM_QUIT
Do While intRxModeNMTP <> 0
DoEvents
Loop
SendMsg = 1
'Call Disconnect
End Function
Clever n Smart
news:ii4k7q$m6k$1...@speranza.aioe.org...
> Die erste Funktion erzeugt den String der kompletten Nachricht.
> Die 2. Funktion verbindet zu einen Newsserver und sendet eine Nachricht .
Anderes Beispiel von der Seite von Peter Rachow. Sende E-Mail an Empfänger
Sub SendMsg(strSenderName$, strSenderEMail$, strMailTo$, strMailSubject$,
strMsgTxt$, strSMTPServer$, strUser$, strPass$)
Dim strS$, intLSecs&
Dim T1%
frmMain.wsk1.Close
frmMain.cmdSend.Enabled = False
intRXMode1 = RXM_EMAILSEND
If strSMTPServer = "" Then
Call SysMsg("Kein gültiger Hostname: " & strSMTPServer)
Exit Sub
End If
If strSenderEMail = "" Then
Call SysMsg("Keine gültige Absenderadresse: " & strSenderEMail)
Exit Sub
End If
If strMailSubject = "" Then
Call SysMsg("Kein gültiger Betreff: " & strMailSubject)
Exit Sub
End If
Call SysMsg("Sende...")
strWinsock1 = "0"
frmMain.wsk1.RemotePort = 25
frmMain.wsk1.RemoteHost = strSMTPServer
frmMain.wsk1.Connect
intLSecs = intSecs
Do Until frmMain.wsk1.State = 7 '7=connected
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
'Authentifizierung am SMTP-Server
frmMain.wsk1.SendData "AUTH LOGIN" & vbCrLf
intLSecs = intSecs
Do Until Left$(strWinsock1, 3) = "334"
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
'USER
frmMain.wsk1.SendData CodeBase64(strUser) & vbCrLf
intLSecs = intSecs
Do Until Left$(strWinsock1, 3) = "334"
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
'PASS
frmMain.wsk1.SendData CodeBase64(strPass) & vbCrLf
intLSecs = intSecs
Do Until Left$(strWinsock1, 3) = "235"
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
strWinsock1 = "0"
frmMain.wsk1.SendData "MAIL FROM: <" & Trim(strSenderEMail) & ">" & vbCrLf
intLSecs = intSecs
Do Until Left$(strWinsock1, 3) = "250"
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
strWinsock1 = "0"
frmMain.wsk1.SendData "RCPT TO: <" & Trim(strMailTo) & ">" & vbCrLf
intLSecs = intSecs
Do Until Left$(strWinsock1, 3) = "250"
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
strWinsock1 = "0"
frmMain.wsk1.SendData "DATA" & vbCrLf
intLSecs = intSecs
Do Until Left$(strWinsock1, 3) = "354"
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
frmMain.wsk1.SendData "From: " & strSenderName & " <" & strSenderEMail &
">" & vbCrLf
frmMain.wsk1.SendData "Subject: " & strMailSubject & vbCrLf
'Nachrichtentext + evtl. Signatur
strS = vbCrLf & frmMain.txtMsg & vbCrLf
frmMain.wsk1.SendData strS & vbCrLf & "." & vbCrLf
intLSecs = intSecs
Do Until Left$(strWinsock1, 3) = "250"
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
strWinsock1 = ""
intRXMode1 = 0
frmMain.wsk1.SendData "QUIT" & vbCrLf
intRXMode1 = RXM_QUIT
intLSecs = intSecs
Do While intRXMode1 = RXM_QUIT
DoEvents
If intSecs - intLSecs > WSKTIMEOUT Then
Call AbortTransmission
Exit Sub
End If
Loop
intSentMails = intSentMails + 1
frmMain.lblSent = "Gesendet: " & Format(intSentMails)
frmMain.cmdSend.Enabled = True
frmMain.wsk1.Close
Call SysMsg("Versand beendet. Bye.")
End Sub
>
> With these 2 functions you can send a message to any news server:
>
> Needs Winsock-Control! Name: wskNMTP
>
> In Public Domain by Peter Rachow 2003
>
>
Clever n Smart
Peter Rachow @ http://www.peter-rachow.de
Function CodeBase64$(strInput$)
Dim T1%, T2%
Dim strIn$, strS$, strCh$, strOut$
Dim strLen%
strOut = ""
'strLen = Len(strInput) \ 6
strIn = strInput '& String((strLen + 1) * 6 - Len(strInput), "")
'String aus 0 und erzeugen
For T1 = 1 To Len(strIn)
strS = strS & MakeBitString(Asc(Mid$(strIn, T1, 1)))
Next
'String in 6er Gruppen zerlegen
For T1 = 1 To Len(strS) Step 6
Select Case MakeNumber(Mid$(strS, T1, 6))
Case 0 To 25: strCh = Chr(MakeNumber(Mid$(strS, T1, 6)) + 65)
Case 26 To 51: strCh = Chr(MakeNumber(Mid$(strS, T1, 6)) + 71)
Case 52 To 61: strCh = Chr(MakeNumber(Mid$(strS, T1, 6)) - 4)
Case 62: strCh = "+"
Case 63: strCh = "/"
Case Else: strCh = "?"
End Select
strOut = strOut & strCh
Next
strLen = Len(strOut) \ 4
strOut = strOut & String((strLen + 1) * 4 - Len(strOut), "=")
CodeBase64 = strOut
End Function
"Clever n Smart" <c...@nowhere.com> schrieb im Newsbeitrag
news:ii4kj5$nh7$1...@speranza.aioe.org...
Big Code
"Clever n Smart" <c...@nowhere.com> schrieb im Newsbeitrag
news:ii4mq6$f9$1...@speranza.aioe.org...
Big Code
bascom? How?
"Clever n Smart" <c...@nowhere.com> schrieb im Newsbeitrag
news:ii4k7q$m6k$1...@speranza.aioe.org...
> Die erste Funktion erzeugt den String der kompletten Nachricht.
> Die 2. Funktion verbindet zu einen Newsserver und sendet eine Nachricht .
>
> With these 2 functions you can send a message to any news server:
>
> Needs Winsock-Control! Name: wskNMTP
>
> In Public Domain by Peter Rachow 2003
>
> Get more Code on http://www.peter-rachow.de
/* Eine n-stellige Zahl direkt in das LCD schreiben */
/* Parameter: Startposition und Zeile; Zahl, */
/* darzustellende Ziffern, Position des Dezimalpunktes, (l)links- oder
(r)echtsbuendig */
int lcd_putnumber(int row, int col, int num, int digits, int dec, char
orientation)
{
char cl = col, minusflag = 0;
unsigned char cdigit[10] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, digitcnt = 0;
int t1, t2, n = num, r, x = 1;
if(num < 0)
{
minusflag = 1;
n *= -1;
}
/* Stellenzahl automatisch bestimmen */
if(digits == -1)
{
for(t1 = 1; t1 < 10 && (n / x); t1++)
x *= 10;
digits = t1 - 1;
}
if(!digits)
digits = 1;
for(t1 = digits - 1; t1 >= 0; t1--)
{
x = 1;
for(t2 = 0; t2 < t1; t2++)
x *= 10;
r = n / x;
cdigit[digitcnt++] = r + 48;
if(t1 == dec)
cdigit[digitcnt++] = 46;
n -= r * x;
}
digitcnt--;
t1 = 0;
/* Ausgabe */
switch(orientation)
{
case 'l':
cl = col;
if(minusflag)
{
lcd_putchar(row, cl++, '-');
digitcnt++;
}
while(cl <= col + digitcnt) /* Linksbuendig */
lcd_putchar(row, cl++, cdigit[t1++]);
break;
case 'r':
t1 = digitcnt; /* Rechtsbuendig */
for(cl = col; t1 >= 0; cl--)
lcd_putchar(row, cl, cdigit[t1--]);
if(minusflag)
lcd_putchar(row, --cl, '-');
}
if(dec == -1)
return digits;
else
return digits + 1;
}
/* Alle Daten des laufenden TG an die richtigen Stellen des LCD */
/* schreiben: Parameter: Tiefen in m, Zeit in sec. */
void lcd_printdiveinfo(int cdepth, int mdepth, int divetime)
{
lcd_putnumber(0, 0, cdepth, 3, 1, 'l');
lcd_putchar(0, 4, 'm');
lcd_putnumber(0, 6, mdepth, 3, 1, 'l');
lcd_putstring(0, 10, "m");
lcd_putnumber(0, 14, divetime, -1, -1, 'r'); /* Tauchzeit rechtsbuendig
1. Zeile */
lcd_putchar(0, 15, 39);
}
DeBasgal
DeBasgal
DeBasgal
Socks
"DeBasgal" <hel...@shit.com> schrieb im Newsbeitrag
news:iiaqau$rps$1...@speranza.aioe.org...
Helmut Meukel
news:ii6fv6$pu0$1...@speranza.aioe.org...
> Why u use $ instead of "string"?
>
Do you mean in the Dim statement above?
There are at least two possible answers:
1) habit. In older Basics there was no "As String", you had to add a $ instead.
Same with % (As Integer), & (As Long), !(As Single), # (As Double).
2) brevity. Compare those two:
Dim strIn$, strS$, strCh$, strOut$
Dim strIn As String, strS As String, strCh As String, strOut As String
Helmut.