s.a arkadarşar VB ile sadece bir adet winsock kullanarak birden fazla bağlantıyı kabul ettirdim bir cok yerde yazı vardı fakat olmadı en sonunda kendi cabalarımla bunu becerdim lakin şimdi ufak bir sorunum var!!! server kurulduktan sonra gelen bağlantıları bilgisayar adına gore listeye alıyorum ve bağlanan kişileri goruyorum bu arada gelen bağlantı icin onay veriyorum ama şoyle bir sorunum var programa bir kişi bağlı ile karşılıklı yazışmada sorun yok ama 3. kişi bağlanınca sadece bir kişi ye msj gonderimi yapamadım yani diyelim ki 6 kullanıcı bağlı ama ben sadece birisine msj yollamak istiyorum yardım edecek ustalar varsa şimdiden teşekkur ederim programın tam kodunu vereceğim...
iyi calışmalar
FORM KODLARI
Dim i As Long
Dim Con As Long
Private Sub Command1_Click()
Winsock1(Con).SendData Text1.Text & ">>" & vbCrLf
Text1.Text = ""
End Sub
Private Sub Form_Load()
i = 0
Con = 0
Winsock1(0).LocalPort = "1453"
Winsock1(0).Listen
End Sub
Private Sub Command2_Click()
Winsock1(0).Close
End
End Sub
Private Sub Form_Unload(Cancel As Integer)
Winsock1(0).Close
End Sub
Private Sub Timer1_Timer()
Select Case Winsock1(0).State
Case 0
Label1.Caption = "Kapalı"
Case 1
Label1.Caption = "Acık"
Case 2
Label1.Caption = "Bağlantı bekleniyor"
Case 7
Label1.Caption = "Bağlı"
Case 9
Label1.Caption = "Hata!"
Case 8
Label1.Caption = "Bağlantı Kesildi"
Winsock1(0).Close
Winsock1(0).LocalPort = "1453"
End Select
End Sub
Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim cevap
ziyaretci = Winsock1(0).RemoteHostIP
DoEvents
cevap = MsgBox(Ipbul(ziyaretci) + " isimli bilgisayardan baglanma istegi geldi. Kabul ediyor musunuz?", vbYesNo + vbQuestion)
If cevap = vbYes Then
If Winsock1(0).State sckClosed Then Winsock1(0).Close
If Index = 0 Then
i = i + 1
Con = Con + 1
Load Winsock1(i)
Winsock1(i).LocalPort = 0
DoEvents
Winsock1(i).Accept requestID
DoEvents
Label1.Caption = Con
List1.AddItem Ipbul(Winsock1(0).RemoteHostIP)
Else
Winsock1(0).Close
Winsock1(0).LocalPort = "1453"
Winsock1(0).Listen
End If
End If
End Sub
Private Sub Winsock1_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Winsock1(Index).Close
DoEvents
Con = Con - 1
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim s As String
Winsock1(Index).GetData s
Text2.Text = Text2.Text & s & Chr(13) & Chr(10)
End Sub
================================================== =======================
Modul
Option Explicit
Private Const WSADescription_Len As Long = 256
Private Const WSASYS_Status_Len As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const IP_SUCCESS As Long = 0
Private Const SOCKET_ERROR As Long = -1
Private Const AF_INET As Long = 2
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Byte
szSystemStatus(0 To WSASYS_Status_Len) As Byte
imaxsockets As Integer
imaxudp As Integer
lpszvenderinfo As Long
End Type
Private Declare Function WSAStartup Lib "wsock32" _
(ByVal VersionReq As Long, _
WSADataReturn As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32" () As Long
Private Declare Function inet_addr Lib "wsock32" _
(ByVal s As String) As Long
Private Declare Function gethostbyaddr Lib "wsock32" _
(haddr As Long, _
ByVal hnlen As Long, _
ByVal addrtype As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenA" _
(lpString As Any) As Long
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Public Sub SocketsCleanup()
If WSACleanup() 0 Then
MsgBox Err.Number & Err.Description
End If
End Sub
Public Function Ipbul(ByVal sAddress As String) As String
Dim ptrHosent As Long
Dim hAddress As Long
Dim nbytes As Long
If SocketsInitialize() Then
hAddress = inet_addr(sAddress)
If hAddress SOCKET_ERROR Then
ptrHosent = gethostbyaddr(hAddress, 4, AF_INET)
If ptrHosent 0 Then
CopyMemory ptrHosent, ByVal ptrHosent, 4
nbytes = lstrlen(ByVal ptrHosent)
If nbytes > 0 Then
sAddress = Space$(nbytes)
CopyMemory ByVal sAddress, ByVal ptrHosent, nbytes
Ipbul = sAddress
End If
Else: MsgBox "Bulunamadı."
End If
SocketsCleanup
Else: MsgBox "IP adresini Doğru girmelisin."
End If
End If
End Function
__________________
winsock ile birden fazla bağlantı oke!!!! fakat bi sorun var!!!
Programlama0 Mesaj
●26 Görüntüleme
- ReadBull.net
- Programlama ve Yazılım
- Programlama
- winsock ile birden fazla bağlantı oke!!!! fakat bi sorun var!!!