Ağ Üzerinden Mesaj Göndermek

Bu örnek sayesinde ağ ortamında bilgisayarlar arası mail ve mesaj gönderilebilir. Aynı zamanda bir server programı da durumu ve olayları göstermektedir.

Option Explicit

Dim ID%

Private Function WSend(i%, Text$)
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
'Kullanilacak Port
Winsock(0).LocalPort = 10567
'Dinle
Winsock(0).Listen
End Sub

Private Sub Winsock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'Aktif Kullaniciyi tanimla
Dim i%
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

'Baglan
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)
'Aktif kullaniciyi tanimla
Dim i%
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

'Mesaj al
Dim Message$

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

'Mesaji paylastir
If Mid(Message, 1, 1) = 1 Then

Dim MFrom$, MTo$, MText$, ok%
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

'Kullanici belli degil
If ok = 0 Then
WSend Index, "Kullanici aktif degil"
SetList "3%" & MFrom & "$" & "Kullanici aktif degil"
End If
End If
End Sub

Function SetList(Message$)
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

Alıntıdır