Thursday, 4 September 2014

Membuat Chat Client Server dengan winsock vb6

Chat Clien Server



Pertama tambahkan dulu miscosoft winsock control 6.0 dengan cara CTRL + T atau project > component
berikut adalah sedikit contoh codingan chat client server dengan menggunakan winsock pada vb6

 FORM CLIENT NYA

Dim waktu As Integer
Dim sck As String




Private Sub cmdcekkoneksi_Click()

If Winsock1.State = sckConnected Then
MsgBox "konek"
Else
MsgBox "tidak konek"
Exit Sub
End If
End Sub

Private Sub cmdkoneksi_Click()
'jika server belom listening atau belom siap menerima koneksi
If sckListening = False Then
 Text2.Text = Text2.Text & "Gagal Terhubung" & vbCrLf
Exit Sub
'Else

End If
'state 7 berarti sudah terkoneksi dengan server
If Winsock1.State = 7 Then
   Exit Sub
    Winsock1.Close
    'state 9 error maka harus di tutup kembali
ElseIf Winsock1.State = 9 Then
   Winsock1.Close

End If
'state 8 berarti sudah terhubung tapi server terputus sehingga state mengambang
If Winsock1.State = 8 Then
    Winsock1.Close
    ElseIf Winsock1.State = 9 Then
   Winsock1.Close
 '  ElseIf Winsock1.State = 6 Then
  ' Winsock1.Close
End If

Winsock1.RemoteHost = "192.168.1.144"  'ip server
'Winsock1.RemoteHost = "192.168.43.202"
Winsock1.RemotePort = 1001
Winsock1.Connect

End Sub





Private Sub cmdsend_Click()

If Not Winsock1.State = 7 Then
Text2.Text = Text2.Text & "Tidak Terhubung Ke Server" & vbCrLf
Exit Sub
End If

Winsock1.SendData Me.Text1.Text
DoEvents
Text2.Text = Text2.Text & vbCrLf & "Client :" & Me.Text1.Text
Text1.Text = ""

End Sub


Private Sub Form_Load()
'main
'Label2.Caption = winsock1.LocalIP
Label2.Caption = "192.168.1.136"
'winsock1.RemoteHost = "192.168.1.144"

'status atau keadaan winsock
txtstate.Text = Winsock1.State

Timer1.Enabled = True


End Sub





Private Sub Timer1_Timer()
'If Winsock1.State = 8 Then
'Winsock1.Close
'End If

'If Not Winsock1.State = sckListening Then
      
 '       Else
' Text2.Text = Text2.Text & "Try to Connect" & vbCrLf
           
  'End If
sck = txtstate.Text
If sck <> Winsock1.State Then
  If Winsock1.State = 0 Then
        Text2.Text = Text2.Text & "Tidak Terhubung/Client Terputus" & vbCrLf
      '  Timer1.Enabled = False
    ElseIf Winsock1.State = 6 Then
    'Timer1.Enabled = False
        Text2.Text = Text2.Text & "Connecting" & vbCrLf
        'Timer1.Enabled = False
    ElseIf Winsock1.State = 7 Then
        Text2.Text = Text2.Text & "Terhubung" & vbCrLf
     '   Timer1.Enabled = False
    ElseIf Winsock1.State = 8 Then
        Text2.Text = Text2.Text & "Terputus Dari server" & vbCrLf
      '  Timer1.Enabled = False
    ElseIf Winsock1.State = 9 Then
        Text2.Text = Text2.Text & "Gagal Terhubung" & vbCrLf
       ' Timer1.Enabled = False
    End If
 End If

If Winsock1.State = 7 Then
Image1.Visible = False
Image2.Visible = True

Else
Image1.Visible = True
Image2.Visible = False
End If
txtstate.Text = Winsock1.State

End Sub



Private Sub winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String
Winsock1.GetData strdata

Text2.Text = Text2.Text & vbCrLf & "Server :" & strdata
Text2.SelStart = Len(Text2.Text)

End Sub

Private Sub winsock1_Error(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)
'MsgBox "Error : " & Description
'Winsock1.Close

End Sub





Private Sub winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String
Winsock1.GetData strdata

Text2.Text = Text2.Text & vbCrLf & "Server :" & strdata
Text2.SelStart = Len(Text2.Text)

End Sub

Private Sub winsock1_Error(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)
'MsgBox "Error : " & Description
'Winsock1.Close

End Sub

FORM SERVER NYA


Option Explicit

Private Sub cmdlisten_Click()
Timer1.Enabled = True
Winsock1.Close
 Winsock1.LocalPort = 1001
   Winsock1.Listen
'Winsock1.Connect

End Sub

Private Sub cmdsend_Click()
Winsock1.SendData Text1.Text
DoEvents

Text2.Text = Text2.Text & vbCrLf & "Server : " & Text1.Text
Text1.Text = ""

End Sub

Private Sub cmdstop_Click()
Timer1.Enabled = True
'Do Until Winsock1.State = 0
Winsock1.Close
'Loop
End Sub

Private Sub Form_Load()
main
Winsock1.LocalPort = 1001
Winsock1.Listen
Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()
'If Winsock1.State <> 7 Then
 ' Winsock1.Close
  'Winsock1.Listen
  'End If
  'Dim tempsck As String
'tempsck = txtstate.Text

'If tempsck <> Winsock1.State Then
'If Winsock1.State = 8 Then
 '   Winsock1.Close
  '  Text2.Text = Text2.Text & "Clien Terputus" & vbCrLf
   ' Winsock1.Listen
'   Text2.Text = Text2.Text & "Server Restart" & vbCrLf
'ElseIf Winsock1.State = 7 Then
 '   Text2.Text = Text2.Text & "Terhubung Dengan Klien" & vbCrLf
'Timer1.Enabled = False
'ElseIf Winsock1.State = 2 Then
 '   Text2.Text = Text2.Text & "Server Aktif" & vbCrLf
'Timer1.Enabled = False
'ElseIf Winsock1.State = 7 Then
 '   Text2.Text = Text2.Text & "Terhubung Dengan Klien" & vbCrLf
'Timer1.Enabled = False
'ElseIf Winsock1.State = 0 Then
 '   Text2.Text = Text2.Text & "Server Tidak Aktif" & vbCrLf
'Timer1.Enabled = False
'End If
'End If
If Winsock1.State = 0 Then
Image1.Visible = True
Image2.Visible = False
Else
Image1.Visible = False
Image2.Visible = True
End If


  txtstate.Text = Winsock1.State
 
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
 If Winsock1.State <> sckClosed Then
        Winsock1.Close
    End If
Winsock1.Accept requestID
 Text2.Text = Text2.Text & _
        "Accepted connection from: " & _
        Winsock1.RemoteHostIP & vbCrLf
End Sub

Private Sub winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strdata As String
Winsock1.GetData strdata

Text2.Text = Text2.Text & vbCrLf & "Client : " & strdata
Text2.SelStart = Len(Text2.Text)

End Sub



Jika masih belom jelas maka bisa download project nya di sini
http://www.4shared.com/rar/QYBuVN8Wce/chat_vb__1_.html
Perhatian: Yuk Baca Artikel bagus di Nurul Musthofa

Artikel Terkait

No comments:

Post a Comment

 

Network

Pesan

Semoga situs ini bermanfaat