2. Pilih Stadard EXE
3. Buat sebuah Form Server seperti pada gambar si bawah ini, dan beri nama untuk setiap komponennya:
Dan berikut sintaxnya:
Project1 - Form1 (code) :
Dim jml_koneksi As Integer
Dim zz As Integer
Private Sub Command1_Click()
str_sql = "SELECT * FROM admin WHERE user = '" & Text1.Text & "'"
Set rs = New ADODB.Recordset
rs.Open str_sql, koneksi, adOpenDynamic, adLockOptimistic
If rs.EOF = False Then
If rs!pass = Text2.Text Then
t_isi_pesan.Text = t_isi_pesan.Text & "Connect to: " & Winsock1(jml_koneksi).RemoteHostIP & vbCrLf
zz = 2
Else
MsgBox "Maaf Password salah", vbExclamation, Pesan
Winsock1(jml_koneksi).Close
End If
Else
MsgBox "Maaf Username Salah", vbExclamation, Pesan
Winsock1(jml_koneksi).Close
End If
End Sub
Private Sub Form_Load()
buka_koneksi
jml_koneksi = 0
zz = 0
End Sub
Private Sub listen_Click()
On Error GoTo Err
Winsock1(0).Close
Winsock1(0).LocalPort = t_port.Text
Winsock1(0).listen
Exit Sub
Err:
MsgBox "Error : " & Err.Description, vbCritical
End Sub
Private Sub siarkan_Click()
Winsock1(jml_koneksi).SendData Winsock1(jml_koneksi).LocalHostName & ":" & t_pesan.Text
t_isi_pesan.Text = t_isi_pesan.Text & "Server :" & t_pesan.Text & vbCrLf
End Sub
Private Sub Winsock1_Close(Index As Integer)
Winsock1(jml_koneksi).Close
t_isi_pesan = t_isi_pesan & "-Disconnect-" & vbCrLf
End Sub
Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
jml_koneksi = jml_koneksi + 1
Load Winsock1(jml_koneksi)
Winsock1(jml_koneksi).Accept requestID
zz = 1
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim strdata As String
Dim intcnt As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
If zz = 1 Then
Winsock1(Index).GetData strdata
a = InStr(1, strdata, " ")
user = Left(strdata, a - 1)
Text1.Text = user
b = Len(strdata)
c = b - a
pass = Right(strdata, c)
Text2.Text = pass
zz = 2
End If
If zz = 2 Then
Winsock1(Index).GetData strdata
t_isi_pesan.Text = t_isi_pesan.Text & Winsock1(jml_koneksi).LocalHostName & ":" & strdata & vbCrLf
End If
For intcnt = 1 To jml_koneksi
If Winsock1(intcnt).State = sckConnected Then
Winsock1(intcnt).SendData strdata
DoEvents
End If
Next intcnt
End Sub
Project1 - Module1 (code):
Public koneksi As New ADODB.Connection
Public rs As New ADODB.Recordset
Public str_koneksi As String
Public str_sql As String
Public Sub buka_koneksi()
str_koneksi = "Driver=MySQL ODBC 5.1 Driver;SERVER=localhost;UID=root;DATABASE=user_chating;PORT=3306"
If koneksi.State = 1 Then
koneksi.Close
End If
'Membuka koneksi connection
koneksi.Open str_koneksi
End Sub
4. Buatlah sebuah Form Client seperti pada gambar si bawah ini, dan beri nama untuk setiap komponennya:
Dan berikut sintaxnya:
Dim z As Integer
Private Sub c_dis_Click()
Winsock2.Close
t_pesan.Enabled = 0
t_isi_pesan.Enabled = 0
c_kirim.Enabled = 0
connect.Enabled = 1
status.Caption = "Gagal Menghubungi Server"
End Sub
Private Sub c_kirim_Click()
Winsock2.SendData t_pesan.Text
t_isi_pesan.Text = t_isi_pesan.Text & vbCrLf & t_pesan.Text
End Sub
Private Sub connect_Click()
Winsock2.connect t_ip.Text, t_port.Text
End Sub
Private Sub Form_Load()
status.Caption = "Gagal Menghubungi Server"
t_pesan.Enabled = 0
t_isi_pesan.Enabled = 0
c_kirim.Enabled = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Winsock2.Close
End Sub
Private Sub status_Change()
If status.Caption = "Gagal Menghubungi Server" Then
Winsock2.Close
t_pesan.Enabled = 0
t_isi_pesan.Enabled = 0
c_kirim.Enabled = 0
connect.Enabled = 1
End If
End Sub
Private Sub t_pass_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Winsock2.connect t_ip.Text, t_port.Text
End If
End Sub
Private Sub t_pesan_Click()
t_pesan.Text = ""
End Sub
Private Sub t_pesan_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Winsock2.SendData t_pesan.Text
t_isi_pesan.Text = t_isi_pesan.Text & vbCrLf & t_pesan.Text
End If
End Sub
Private Sub Winsock2_Close()
status.Caption = "Gagal Menghubungi Server"
t_pesan.Enabled = 0
t_isi_pesan.Enabled = 0
c_kirim.Enabled = 0
End Sub
Private Sub Winsock2_Connect()
Winsock2.SendData t_user.Text
Winsock2.SendData " "
Winsock2.SendData t_pass.Text
status.Caption = "Terhubung Ke Server"
t_pesan.Enabled = 1
t_isi_pesan.Enabled = 1
c_kirim.Enabled = 1
connect.Enabled = 0
End Sub
Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
Dim pesan As String
Winsock2.GetData pesan
t_isi_pesan.Text = t_isi_pesan.Text & vbCrLf & pesan
End Sub
5. Jalankan Form Server, ketik port yang ingin kita buka, misalnya 2068, lalu klik "Dengarkan".
6. Jalankan Form Client, Isi IP Server, Port, Username, dan Password:
7. Lalu pada Form Server, Klik "Cek Database", jika username dan password terdapat pada database (MySql), maka client sudah siap utuk melakukan Chating, yang tidak terdapat dalam database maka, akan muncul pesan,"Username/Password Salah".
8. Selamat Mencoba......
