VB 5/6-Tipp 0328: Nachrichten im Netzwerk versenden
von Robert Albring
Beschreibung
Dieser Tipp gestattet es auf Basis des Winsock-Controls Mails und Nachrichten an andere Teilnehmer eines Netzwerks zu senden als auch zu empfangen. Als Basis dient ein Server-Programm welches den Verkehr regelt und die derzeitigen Aktionen anzeigt.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: keine | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektgruppe Gruppe1.vbg ------------- '---------- Anfang Projektdatei WinsockSender.vbp ---------- ' Die Komponente ' (MSWINSCK.OCX)' wird benötigt. '----- Anfang Formular "Form1" alias WinsockSender.frm ----- ' Steuerelement: Rahmensteuerelement "Frame1" ' Steuerelement: Schaltfläche "cmdConn" auf Frame1 ' Steuerelement: Schaltfläche "cmdDISC" auf Frame1 ' Steuerelement: Textfeld "IP" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label1" auf Frame1 ' Steuerelement: Textfeld "MTO" ' Steuerelement: Textfeld "MFROM" ' Steuerelement: Timersteuerelement "Timer1" ' Steuerelement: Windows Socket "Winsock1" ' Steuerelement: Textfeld "TXMESSAGE" ' Steuerelement: Schaltfläche "cmdSEND" ' Steuerelement: Beschriftungsfeld "Label3" ' Steuerelement: Beschriftungsfeld "lbl2" ' Steuerelement: Beschriftungsfeld "lbl1" ' Steuerelement: Beschriftungsfeld "RXMESSAGE" 'Autor: Robert Albring 'E-Mail: Robert.Albring@ReiseWelten.de Option Explicit Private Sub TXMESSAGE_Change() If MTO <> "" And TXMESSAGE <> "" Then cmdSEND.Enabled = True Else cmdSEND.Enabled = False End If End Sub Private Sub IP_Change() If MFROM <> "" And IP <> "" Then cmdConn.Enabled = True End If End Sub Private Sub MFROM_Change() If MFROM <> "" And IP <> "" Then cmdConn.Enabled = True End If End Sub Private Sub MTO_Change() If MTO <> "" And TXMESSAGE <> "" Then cmdSEND.Enabled = True Else cmdSEND.Enabled = False End If End Sub Private Sub Timer1_Timer() Timer1.Interval = 1000 Caption = "WinsockSender - Status = " & Winsock1.State End Sub Private Sub cmdConn_Click() cmdDISC.Enabled = True cmdConn.Enabled = False MFROM.Enabled = False IP.Enabled = False Call conn If MTO <> "" And TXMESSAGE <> "" Then cmdSEND.Enabled = True End If MTO.Enabled = True TXMESSAGE.Enabled = True MTO.SetFocus End Sub Private Sub cmdSEND_Click() If Winsock1.State <> 7 Then conn SEND "1" & MFROM & "%" & MTO & "$" & TXMESSAGE RXMESSAGE = "Nachricht versendet" End Sub Private Sub cmdDISC_Click() cmdDISC.Enabled = False cmdConn.Enabled = True MFROM.Enabled = True IP.Enabled = True SEND "4" & MFROM DoEvents Winsock1.Close cmdSEND.Enabled = False MTO.Enabled = False TXMESSAGE.Enabled = False End Sub Sub SEND(Text As String) If Winsock1.State = 7 Then Winsock1.SendData Text End Sub Function conn() If Winsock1.State <> 0 Then Winsock1.Close Winsock1.Connect IP, 10567 Do While Winsock1.State <> 7 DoEvents Loop SEND "2" & MFROM End Function Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim Message As String Winsock1.GetData Message RXMESSAGE = Message MsgBox Message End Sub '------ Ende Formular "Form1" alias WinsockSender.frm ------ '----------- Ende Projektdatei WinsockSender.vbp ----------- '-------------- Anfang Projektdatei MSERV.vbp -------------- ' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (mscomctl.ocx)' wird benötigt. ' Die Komponente ' (MSWINSCK.OCX)' wird benötigt. '---- Anfang Formular "MailServer" alias MAILSERVER.frm ---- ' Steuerelement: Windows Socket "Winsock" (Index von 0 bis 0) ' Steuerelement: Listenanzeigesteuerungselement "User" ' Steuerelement: Listenanzeigesteuerungselement "LMessage" 'Autor: Robert Albring 'E-Mail: Robert.Albring@ ReiseWelten.de Option Explicit Private ID As Integer Private Function WSend(i As Integer, Text As String) If Winsock(i).State = 7 Then Winsock(i).SendData Text Dim t As Long t = Timer Do While t + 0.5 > Timer DoEvents Loop End If End Function Private Sub Form_Load() If Winsock(0).State <> 0 Then Winsock(0).Close Winsock(0).LocalPort = 10567 Winsock(0).Listen End Sub Private Sub Winsock_ConnectionRequest(Index As Integer, _ ByVal requestID As Long) 'Aktive User Setzen Dim i As Integer START: For i = 1 To User.ListItems.Count User.ListItems.Item(i).SubItems(1) = _ Winsock(User.ListItems.Item(i)).State If User.ListItems.Item(i).SubItems(1) <> 7 Then Winsock(User.ListItems.Item(i)).Close Unload Winsock(User.ListItems.Item(i)) User.ListItems.Remove i Goto START End If Next i 'Verbinden If Index = 0 Then For i = 2 To User.ListItems.Count If User.ListItems(i) > User.ListItems(i - 1) + 1 Then Load Winsock(User.ListItems(i) - 1) Winsock(User.ListItems(i) - 1).LocalPort = 10567 Winsock(User.ListItems(i) - 1).Accept requestID Exit Sub End If Next i If User.ListItems.Count > 0 Then If User.ListItems(1) >= 2 Then Load Winsock(User.ListItems(1) - 1) Winsock(User.ListItems(1) - 1).LocalPort = 10567 Winsock(User.ListItems(1) - 1).Accept requestID Exit Sub End If Load Winsock(User.ListItems.Count + 1) Winsock(User.ListItems.Count + 1).LocalPort = 10567 Winsock(User.ListItems.Count + 1).Accept requestID Exit Sub End If Load Winsock(1) Winsock(1).LocalPort = 0 Winsock(1).Accept requestID End If End Sub Private Sub Winsock_DataArrival(Index As Integer, ByVal _ bytesTotal As Long) 'Aktive User Setzen Dim i As Integer START: For i = 1 To User.ListItems.Count User.ListItems.Item(i).SubItems(1) = _ Winsock(User.ListItems.Item(i)).State If User.ListItems.Item(i).SubItems(1) <> 7 Then Winsock(User.ListItems.Item(i)).Close Unload Winsock(User.ListItems.Item(i)) User.ListItems.Remove i Goto START End If Next i 'Nachricht Empfangen Dim Message As String Winsock(Index).GetData Message Call SetList(Mid(Message, 1, 1) & Index & Mid(Message, 2, _ Len(Message))) If Mid(Message, 1, 1) = 4 Then Exit Sub 'Nachricht Verteilen If Mid(Message, 1, 1) = 1 Then Dim MFrom As String, MTo As String, MText As String Dim ok As Integer MFrom = Mid(Message, 2, InStr(1, Message, "%") - 2) MTo = Mid(Message, InStr(1, Message, "%") + 1, _ InStr(1, Message, "$") - InStr(1, Message, _ "%") - 1) MText = Mid(Message, InStr(1, Message, "$") + 1, _ Len(Message)) ok = 0 For i = 1 To User.ListItems.Count If LCase(User.ListItems(i).SubItems(2)) = LCase(MTo) _ Or LCase(MTo) = "alle" Then If LCase(User.ListItems(i).SubItems(2)) <> _ LCase(MFrom) Then WSend User.ListItems.Item(i), MText SetList "3%" & User.ListItems(i).SubItems(2) _ & "$" & MText ok = 1 Exit Sub End If End If Next i 'User unbekannt If ok = 0 Then WSend Index, "User ist nicht aktiv" SetList "3%" & MFrom & "$" & "User ist nicht aktiv" End If End If End Sub Function SetList(Message As String) Dim litem As ListItem Select Case CInt(Mid(Message, 1, 1)) Case 1, 4 ID = ID + 1 If LMessage.ListItems.Count > 13 Then _ LMessage.ListItems.Remove 1 Set litem = LMessage.ListItems.Add(, , ID) litem.SubItems(1) = Mid(Message, 3, InStr(1, Message, "%") - 3) litem.SubItems(2) = Mid(Message, InStr(1, Message, "%") + 1, _ InStr(1, Message, "$") - InStr(1, Message, "%") - 1) litem.SubItems(3) = "<- " & Mid(Message, InStr(1, Message, "$") _ + 1, Len(Message)) Case 2 Set litem = User.ListItems.Add(, , Mid(Message, 2, 1)) litem.SubItems(1) = Winsock(CInt(Mid(Message, 2, 1))).State litem.SubItems(2) = Mid(Message, 3, Len(Message)) Case 3 If LMessage.ListItems.Count > 13 Then _ LMessage.ListItems.Remove 1 Set litem = LMessage.ListItems.Add(, , ID) litem.SubItems(1) = Mid(Message, 3, InStr(1, Message, "$") - 3) litem.SubItems(2) = "MailServer" litem.SubItems(3) = "<- " & Mid(Message, InStr(1, Message, "$") + _ 1, Len(Message)) End Select End Function '----- Ende Formular "MailServer" alias MAILSERVER.frm ----- '--------------- Ende Projektdatei MSERV.vbp --------------- '-------------- Ende Projektgruppe Gruppe1.vbg --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 31 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Robert Albring am 08.10.2006 um 13:11
Hallo zusammen,
ich kann die einwände am komplizierten Code verstehen, doch wer sowas schreibt, hat den Sinn nicht verstanden. Dieser Code soll ein Beispiel sein, wie mann mit eine Kommunikation zweier entfernter Programmteile macht. Des mit dem Senden von "Nachrichten" ist nur ein Beispiel. Man kann das alles auch Automatisieren und zwei Programmteile miteinander kommunizieren lassen. Dafür habe ich es geschrieben. Textnachrichten sind mit normalen Mitteln wirklich einfacher....
Kommentar von Sebastian am 13.01.2004 um 14:09
@vb-newbie
Das mit dem Verpackungsprogramm hat nicht hingehauen. Ich kann zwar das Projekt / Programm installieren, nuch es funktioniert nicht. Die allgemeine Meldung lautet: "Unable to create Socket", worauf ein Stapel-Fehler kommt und VB6 inklusive Rechner abstürtzt.
Hat einer ne Idee, was sonst noch helfen kann, das Programm unter Win95 zu laufen zu bringen?
Das Netzwerk zwichen diesem und einem Rchner mit Win98 funktioniert, eine Erweitering zu einem Rechner mit W2000P aber auch nicht.
Kommentar von Chari am 11.01.2004 um 17:25
Bei dem nicht einbinden können:
Bei mir sagt der beim Laden immer "Zugriff verweigert" und dann kann ich die Komponente auch nicht einbinden...
Kommentar von Chari am 11.01.2004 um 17:16
Also, ich kann die DLL irgendwie gar nicht einbinden... An Dominik Markowski: Das würde ich NIE benutzen. Der Empfänger braucht nur den NAchrichtendienst ausgeschaltet zu haben unjd schon kommt die Nachricht nicht an...
Kommentar von vb-newbie am 05.01.2004 um 20:50
@sebastian
Probier mal nen Setup Programm mit dem Verpackungs und Weitergabe Assistenten zu machen! Dann müsste es gehen.
@Stefan Buchner
Das funzt nicht so wie du gesagt hast mit UDP. Da muss noch mehr Code hin damit das funzt
@Dominic Markowski
Wie ist es mit dieser Methode möglich, das die Nachricht von einen VB Programm ausgewertet wird?? Ich finde es einfacher das über den Winsock zu machen...
Kommentar von Sebastian am 02.12.2003 um 15:15
Ich möchte das PRogramm auf einem Rechner mit Win95 nutzen. Was muss ich machen, damits zu laufen kommt?
Kommentar von Steve am 12.11.2003 um 15:38
Hatte den Lizenzfehler auch,obwohl ich die enterprise edition benutze.regsrv hat nix gebracht,aber habe auf der support seite von microsoft nen fix dafuer gefunden.
Bei mir hat er funktioniert.
schaut mal unter :
http://support.microsoft.com/default.aspx?scid=kb%3Bde%3BQ194751
Hoffe kann euch damit helfen.
Mfg Steve
Kommentar von TheFuture am 29.08.2003 um 19:07
Nen Bug beim Disconnect vom Mailserver, wenn Mailserver = selber Pc wie absender is, is drin...
Kommentar von LordFuture am 18.05.2003 um 11:00
Hi, kann mir jemand sagen warum ich folgende Fehlermeldung
Fehler beim Kompilieren:
Deklaration der Prozedur entspricht nicht der Beschreibung eines Ereignisses oder einer Prozedur mit demselben Namen:
Bei
Private Sub Winsock_ConnectionRequest(Index As Integer,ByVal requestID As _ Long)
erhalte?
(Details: http://foren.activevb.de/cgi-bin/foren/view.pl?id=&forum=4&msg=46421&root=46421&page=1)
Kommentar von Patric Joos am 14.05.2003 um 17:46
hallo!
Ich habe Visual Studio 6.0 Enterprise Edition und auch bei mir kommt der Lizenzierungsfehler... kann da nicht einer den Schlüssel bereitstellen?!?
Kommentar von Schiller am 07.04.2003 um 12:36
@sysopi
Das mit dem regsvr32 bringt nichts, damit wird die dll/ocx nur unter HKCR\CLSID\{xxxxx} REGISRIERT. Das bedeutet, das sie "mit dem System bekannt gemacht wird". Erst durch die LIZENSIERUNG, die unter HKCR\Licenses\ ist, wird sie nutzbar.
Kommentar von Dominic Markowski am 24.02.2003 um 10:28
Dieser Script ist viel zu Komplietiert...
Ich brauche nur 2 extfelder und ein Command Button, mein Sript ist in etwa so:
Private Command1_Click()
Open "C:\send.bat" for Output as #1
Print #1, "Net Send " & "txt1.text" & " " & txt2.text
close #1
Shell ("C:\send.bat")
End Sub
---------------------
Und somit benutzt man Microsofts vorprogrammierte Möglichkeit Nachrichten im netzwerk zu versenden.
---------------------
txt1.text = "Computername"
txt2.text = "Nachricht"
So ersparrt mann sich alle sorgen und so einen langen script!
Kommentar von FanatiX am 16.02.2003 um 20:06
geht noch einfacher unter win2k:
mit netsend [comp] [message] :o)
3 zeilen code gerademal ;)
Kommentar von sysopi am 15.01.2003 um 04:05
reg schluessel von ???.dll
versucht doch mal regsvr(32).exe ????.dll
damit wird die *.dll registiert.
Kommentar von Nycon am 05.01.2003 um 06:20
Mein Winsock 6.0 geht auch nicht, da erscheint dann das es nicht lizensiert ist.
@all kann mir einer sein Registrierschlüssel schicken ?
HKEY_CLASSES_ROOT\Licenses\
Kommentar von Schiller am 19.11.2002 um 14:39
Wer die Winsock-Lizenz braucht, muss nur von jemandem, der sie hat, den Registrierschlüssel HKEY_CLASSES_ROOT\Licenses\ expotieren und bei sich selbst wieder importieren. Bei mir hats jedenfalls funktioniert.
Kommentar von Fat-Sheep am 10.11.2002 um 16:19
Das problem kenne ich, hab aber noch keine lösung gefunden.
Kommentar von Goethe am 06.08.2002 um 09:40
Fehler in der V6 Enterprice Version bei Microsoft gibt es ein Update. Oder von mir!!
Kommentar von sourcefreak am 26.07.2002 um 01:46
ich hab das selbe problem wie mcdeath2000 bitte sagt mir wie ich die lizenz von winsck bekomme damit ich es in vb6 beutzen kann bittttttteeeee!
vielen dank im vorraus
Kommentar von Netzwerk-Loser am 12.07.2002 um 15:55
Was muss für diese Anwendung auf die Form und wie muss ich des nennen?
Kommentar von Kniffi am 26.03.2002 um 22:00
Hallo VB-Freunde, ich möchte ein SMS-Programm erstellen, habs auch schon, aber wie kann ich die nachrichten dann auch wirklich aufs handy übertragen lassen? bitte helft mir, ich verzweifle
Kommentar von Steffen Buchner am 26.03.2002 um 08:26
Das geht auch leichter, mit UDP
du baust ne winsock-control ein (name: winsock1), da stellt du bei protokoll von TCP auf UDP um. dann gibst du bei localport und remoteport 7000 (Beispiel) win. in die Sub form_load() schreibst du winsock1.remotehost="0.0.0.0":winsock1.senddata "" (Winsock auf Empfang) in winsock1_DataArrival(...) schreibst du winsock1.getdata brief,vbstring
in der variable brief ist dann der empfangene Brief drin. um was zu schicken, setzt du winsock1.remotehost="Empänger":ws.senddata "Hallo, wie gehts??"
Bei Empfäger kannst du die IP-Adresse oder den Netzwerk-Namen des Empfängers eingeben. Dieses Beispiel geht auch übers Internet. Allerdings ändert sich die internet-ip-adresse bei jeder einwahl.
Kommentar von Patrick am 11.02.2002 um 05:19
Wenn ihr Probleme habt, schaut mal unter: http://www.vbpro.de/tipps/tipp.asp?id=238
Kommentar von Ina am 23.08.2001 um 07:47
Irgendwas funktioniert nicht, wenn ich "disconnect" drücke.
litem.SubItems(1) = Mid(Message, 3, InStr(1, Message, "%")- 3)
gibt eine fehlermeldung "ungültiger funktionsaufruf" zurück. woran liegt das?
mfg Ina
Kommentar von activeX-Lover am 04.07.2001 um 20:43
Wenn ihr wollt schicke ich euch die Datei ich hab VB6 Professinol. Ihr müsst mir nur erklären wie!
Kommentar von Master Fusion am 05.05.2001 um 22:44
Das liegt daran, daß das Winsock Steuerlement man erst in der Enterprise oder Professional nutzen kann. Microsoft will Kohle für Features.
Kommentar von MrNokia am 08.04.2001 um 15:13
Bei mir ist auch das gleich wie bei McDeath2000 wer kann mir helfen??
Kommentar von McDeath2000 am 21.03.2001 um 21:59
Wenn ich in der Einsteiger Version von Vb 6 die winsock.dll laden will sagt mein rechner das ich nicht die lizenz habe es in der Entwurfsumgebung zu starten woran kann das Liegen BiTTE HELFT MIR
Kommentar von ALE am 10.02.2001 um 02:16
Ich habe das tool verstanden und neu geschrieben !!! Nur ein Problem hab ich !!! Wenn cih nicht online bin meldet Winsock einen Fehler. Obwohl mein Netzwerk richtig eingerichtet ist und läuft (TCP-IP). Wenn ich online bin. läuft alles LAN und WAN. selsam oder ?
Kommentar von D. Schüler am 03.02.2001 um 11:59
Ich versuche gerade auch ein Chat-Programm zu schreiben. Hier im Code wird nun das TCP-Protokoll Benutzt und eine explizite Verbindung mit einem Server hergestellt. Ich baue meinen Code auf dem UDP-Protokoll auf und benutze keinen Server, da ich alles auf den Port 65000 über den Netzwerk-Broadcast (IP z.B. 10.0.20.255) schicke. So bekommt jeder Rechner im Netzwerk diese Nachricht. Nur auf dem Rechner, auf dem mein Programm läuft, wird die Nachricht empfangen und angezeigt. Bei allen anderen wird diese ignoriert. Nachteil: Wenn im Netzwerk ein Server läuft, so protokolliert der jede Nachricht, die annkommt. So wird also auch unsere Nachricht auf dem Port 65000 Protokolliert und der Admin wird sich wundern wo die wohl herkommt.
Gruß
David
Kommentar von Christian am 05.01.2001 um 22:47
Leider verstehe ich nicht ganz den Quellcode und weiss auch nicht wie man Nachrichten sendet oder empfängt. Kann mir wer helfen?