Ağ üzerinde mesajlaşmak için

AÐ ÜZERİNDEN MESAJ GÖNDERMEK
Bu örnek sayesinde ag ortaminda bilgisayarlar arasi mail ve mesaj gönderilebilir. Ayni zamanda bir server programi da durumu ve olaylari göstermekedir.

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

güzel ama benim kinden degil

arkadaşım sen baya iyisin basicte banada örnek program gönderebilir misin ama biraz daha kolay olsun yeni başladım basice ilgilenirsen çok sevinirim