Visual Basic Kod Bankası - Titreşimli Chat Programı

Titreşimli Chat Programı

Option Explicit

Dim received As String, received2 As String
Dim oldLeft As Integer, oldTop As Integer
Dim kiprama As Integer
Dim pPort As Integer

Private Sub Client1_Close()
Command2.Enabled = True
End Sub

Private Sub Client1_Connect()
Text1.Text = Text1.Text & "Karşı Tarafa Bağlanıldı. " & Now & vbCrLf
Command2.Enabled = False
End Sub

Private Sub Command1_Click()
Command1.Default = True
If Client1.State = sckConnected And Trim(Text2) <> "" Then
Client1.SendData "MSG" & Text4.Text & ">" & Text2.Text & vbCrLf
TxGelen.Text = TxGelen.Text & Text4.Text & ">" & Text2.Text & vbCrLf
Text2.Text = ""
End If
Text2.SetFocus
End Sub

Private Sub Command2_Click()
Client1.RemoteHost = Text3.Text
Client1.RemotePort = pPort
Client1.Connect
End Sub

Private Sub Command3_Click()
If Client1.State = sckConnected Then
Client1.SendData "CMD01" & vbCrLf
Text1.Text = Text1.Text & "Titreşim Gönderdiniz.." & Now & vbCrLf
End If
Text2.SetFocus
End Sub

Private Sub Form_Load()
Randomize Timer
pPort = 1498
Server1.LocalPort = pPort
Server1.Listen

Text1.Text = Server1.LocalPort & ". portta hazır.." & vbCrLf
End Sub

Private Sub Server1_Close()
Client1.Close
Server1.Close
Server1.Listen
End Sub

Private Sub Server1_Connect()
Text1.Text = Text1.Text & Server1.RemoteHost & " Bağlandı. " & Now & vbCrLf
End Sub
'Public frm1 As Form1
Private Sub Server1_ConnectionRequest(ByVal requestID As Long)
If Server1.State <> sckConnected Then
Server1.Close
Server1.Accept requestID
Command2.Enabled = False
Text1.Text = Text1.Text & requestID & " Id ile bağlantı alındı. " & Now & vbCrLf
' Dim frm1 As New Form1
' pPort = pPort + 1
' frm1.Show
If Client1.State = sckClosed Then
Client1.RemoteHost = Server1.RemoteHostIP
Client1.RemotePort = pPort
Client1.Connect
End If
End If
End Sub

Private Sub Server1_DataArrival(ByVal bytesTotal As Long)
Dim tmp_received As String

Server1.GetData tmp_received

received = received & tmp_received
tmp_received = ""

If InStr(received, vbCrLf) > 0 Then
tmp_received = Left(received, InStr(received, vbCrLf) - 1)
received = Mid(received, InStr(received, vbCrLf) + 2)
End If

' If tmp_received <> "" And Len(tmp_received) < 4 Then Server1.Close ' Protocol e uymadığın için bağlantıyı kestik..

If tmp_received <> "" Then
Select Case UCase(Left(tmp_received, 3))
Case "MSG": TxGelen.Text = TxGelen.Text & Mid(tmp_received, 4) & vbCrLf
Case "CMD": Call KomutIsle(Mid(tmp_received, 4))
Case Else: Server1.Close
End Select
End If
End Sub

Private Sub Text1_Change()
Text1.SelStart = Len(Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = 0 ' Değiştirilememesi için
End Sub

Private Sub Text4_LostFocus()
If Text4.Text = "" Then Text4.Text = "Guest" & Int(Rnd * 18000)
End Sub

Private Sub Timer1_Timer()
kiprama = kiprama + 1

Left = Left - Rnd * 100
Top = Top + Rnd * 177

Left = Left + Rnd * 100
Top = Top - Rnd * 177

If kiprama = 38 Then Timer1.Enabled = False: kiprama = 0: Form1.Left = oldLeft: Form1.Top = oldTop
End Sub

Private Function KomutIsle(cmd As String)
Select Case cmd
Case "01"
oldLeft = Left: oldTop = Top: Timer1.Enabled = True
Text1.Text = Text1.Text & "Bir Titreşim Aldınız.." & Now & vbCrLf
Case Else:
End Select
End Function

Private Sub TxGelen_Change()
TxGelen.SelStart = Len(TxGelen.Text)
End Sub

''''''''''''
' msg = mesaj
' cmd = komut
''''''''''''