Thursday, May 15, 2014

Throwback VB6: My old Chikka clone with source code

Alo! Nothing to post eh? Here's a throwback code... lels.

This was an old code wayback 2007??. I'm always facinated with networking how server and client communicate, the passing of data back and forth that kind of stuffs. I was learning winsock back then and
this was my first exercise. Nothing special here but if you're still into VB6 you might still get an idea about winsock.


Dim ServerData As String, ClientData As String, ServerInfo() As String, ServerIPandPort() As String, ParseCode As String, ParseCode1 As String

Dim newL As ListItem, UserInfo() As String
Dim FriendsInfo() As String, FriendsProfile() As String
Dim ProviderData() As String, Providers() As String
Dim KeepAlive1 As Long, KeepAlive2 As Long, KeepAliveHead As String
Dim CreditEnd1 As Long, CreditEnd2 As Long
Dim SendingState As Boolean, FriendsOK As Boolean

Private Sub cmbUsers_Click()
cmbNos.ListIndex = cmbUsers.ListIndex
End Sub

Private Sub cmdConnect_Click()
If cmdConnect.Caption = "Connect" Then
    cmdConnect.Caption = "Disconnect"
    sckServer.Close
    sckServer.Connect "209.10.203.102", 6301
    stbStatus.Panels(1).Text = "Disconnected"
    stbStatus.Panels(2).Text = "N/A"
    stbStatus.Panels(3).Text = "N/A"
    stbStatus.Panels(4).Text = "N/A"
    '209.10.201.101
Else
    If sckServer.State = sckConnected Then sckServer.SendData Chr$(&H2) & "02:007" & Chr$(&H9) & "3E" & Chr$(&H3)
    sckServer.Close
    cmdConnect.Caption = "Connect"
End If
End Sub

Private Sub cmdCredits_Click()
If sckServer.State = sckConnected Then sckServer.SendData Chr$(&H2) & "23:017" & Chr$(&H9) & "42" & Chr$(&H3)
'02 32 33 3a 30 30 39 09  34 33 03                .23:009. 43.
End Sub

Private Sub cmdSend_Click()
sckServer.SendData Chr$(&H2) & "14:007" & Chr$(&H9) & "001:" & cmbNos.Text & Chr$(&H9) & "030:0" & Chr$(&H9) & "032:" & txtMSG.Text & Chr$(&H2E) & Chr$(&H9) & "A1" & Chr$(&H3)
End Sub

Private Sub Form_Load()
SendingState = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
'sckServer.SendData Chr$(&H2) & "02:011" & Chr$(&H9) & "39" & Chr$(&H3)
End Sub

Private Sub sckServer_Close()
KeepAlive1 = &H4
KeepAlive2 = &H42
KeepAliveHead = "40:020"

CreditEnd1 = &H4
CreditEnd2 = &H4A
cmdConnect.Caption = "Connect"

stbStatus.Panels(1).Text = "Disconnected"
stbStatus.Panels(2).Text = "N/A"
stbStatus.Panels(3).Text = "N/A"
stbStatus.Panels(4).Text = "N/A"
End Sub

Private Sub sckServer_Connect()
stbStatus.Panels(1).Text = "Authenticating..."
End Sub

'CTPv1.2 Kamusta 86.97.62.109:1218 1213676783

Private Sub sckServer_DataArrival(ByVal bytesTotal As Long)

If SendingState Then
    MsgBox "Last query is still on-progress. Try again later."
    Exit Sub
End If

sckServer.GetData ServerData

ParseCode = Left$(ServerData, 7)
ParseCode = Mid(ParseCode, 2)
ParseCode1 = Left$(ServerData, 3)
ParseCode1 = Mid(ParseCode1, 2)

'Start
If Left$(ServerData, 3) = "CTP" Then
    ServerInfo() = Split(ServerData, " ")
    'ServerIPandPort() = Split(ServerInfo(2), ":")

    stbStatus.Panels(1).Text = "Connected (" & ServerInfo(0) & ")"
    stbStatus.Panels(4).Text = "Session ID: " & ServerInfo(3)
    
    sckServer.SendData Chr$(&H2) & "43" & Chr$(&H3A) & "001" & Chr$(&H9) & "001:9" & Chr$(&H9) & "003:v01" & Chr$(&H2E) & "01" & Chr$(&H2E) & "02" & Chr$(&H2E) & "000" & Chr$(&H9) & "002:v04" & Chr$(&H2E) & "03" & Chr$(&H2E) & "00" & Chr$(&H2E) & "000" & Chr$(&H9) & "60" & Chr$(&H3)

'02 34 33 3a 30 30 31 09  30 30 31 3a 39 09 30 30 .43:001. 001:9.00
'33 3a 76 30 31 2e 30 31  2e 30 32 2e 30 30 30 09 3:v01.01 .02.000.
'30 30 32 3a 76 30 34 2e  30 32 2e 30 30 2e 30 30 002:v04. 02.00.00
'31 09 36 30 03                                   1.60.

End If

Select Case ParseCode
'Login info
    Case "93:001"
    'Case "93"
        If Len(txtUsername.Text) < 12 Then
            sckServer.SendData Chr$(&H2) & "01:003" & Chr$(&H9) & "003:9" & Chr$(&H9) & "004:4" & Chr$(&H9) & "002:" & txtPassword.Text & Chr$(&H9) & "001:" & txtUsername.Text & Chr$(&H9) & "9B" & Chr$(&H3)
        Else
            sckServer.SendData Chr$(&H2) & "01:003" & Chr$(&H9) & "003:9" & Chr$(&H9) & "004:4" & Chr$(&H9) & "002:" & txtPassword.Text & Chr$(&H9) & "001:" & txtUsername.Text & Chr$(&H9) & "3A" & Chr$(&H3)
        End If

'02 30 31 3a 30 30 33 09  30 30 33 3a 39 09 30 30 .01:003. 003:9.00
'34 3a 34 09 30 30 32 3a  62 6f 73 73 74 77 65 65 4:4.002: aaaaaaaa
'64 09 30 30 31 3a 30 30  39 31 38 36 33 32 34 34 a.001:00 91863244
'30 39 09 33 41 03                                09.3A.
'Retreive User info
    Case "41:000"
    'Case "41"
            UserInfo() = Split(ServerData, ":")
        
            stbStatus.Panels(2).Text = Mid(UserInfo(2), 1, Len(UserInfo(2)) - 4) & " " & Mid(UserInfo(3), 1, Len(UserInfo(3)) - 4)
            stbStatus.Panels(3).Text = Mid(UserInfo(4), 1, Len(UserInfo(4)) - 4)
        
            sckServer.SendData Chr$(&H2) & "91:000" & Chr$(&H9) & "3F" & Chr$(&H3)

'02 39 31 3a 30 30 30 09  33 46 03                .91:000. 3F.
'Parse friends
    Case "31:004"
    'Case "31"
            lstFriends.ListItems.Clear
            cmbUsers.Clear
            
            FriendsInfo() = Split(ServerData, "010:")
            
            For x = 1 To UBound(FriendsInfo)
                FriendsProfile() = Split(FriendsInfo(x), ":")
                cmbUsers.AddItem Mid(FriendsProfile(2), 1, Len(FriendsProfile(2)) - 4)
                cmbNos.AddItem "0" & Right(Mid(FriendsProfile(0), 1, Len(FriendsProfile(0)) - 4), 10)
                
                Set newL = lstFriends.ListItems.Add
                
                newL.Text = Mid(FriendsProfile(2), 1, Len(FriendsProfile(2)) - 4)
                newL.SubItems(1) = Mid(FriendsProfile(0), 1, Len(FriendsProfile(0)) - 4)
                newL.SubItems(2) = Mid(FriendsProfile(20), 1, Len(FriendsProfile(20)) - 4)
            Next
            
        sckServer.SendData Chr$(&H2) & "89:002" & Chr$(&H9) & "48" & Chr$(&H3) & Chr$(&H2) & "24:005" & Chr$(&H9) & "40" & Chr$(&H3)
'02 38 39 3a 30 30 32 09  34 38 03                .89:002. 48.
'02 32 34 3a 30 30 35 09  34 30 03                .24:005. 40.
        pausefor 2
        
        cmdCredits_Click
    'Case "30:028"
    Case Else
End Select

'Credits
    If Left$(ParseCode, 2) = "30" Then
        lstCredits.ListItems.Clear
        cmbProvider.Clear
            
        ProviderData() = Split(ServerData, "040:")
            
        For x = 1 To UBound(ProviderData)
            Providers() = Split(ProviderData(x), ":")
                
            Set newL = lstCredits.ListItems.Add
                
            newL.Text = Mid(Providers(0), 1, Len(Providers(0)) - 4)
            newL.SubItems(1) = Mid(Providers(1), 1, Len(Providers(1)) - 4)
            newL.SubItems(2) = Mid(Providers(2), 1, Len(Providers(2)) - 7)
            newL.SubItems(3) = Int(newL.SubItems(1)) - Int(newL.SubItems(2))
                
            cmbProvider.AddItem newL.Text
        Next
            
        'sckServer.SendData Chr$(&H2) & "89:" & Right("000" & Hex(CreditEnd1), 3) & Chr$(&H9) & Right("00" & Hex(CreditEnd2), 2) & Chr$(&H3)
        CreditEnd1 = CreditEnd1 + 2
        CreditEnd2 = CreditEnd2 + 2
            
        If cmbProvider.ListCount > 0 Then cmbProvider.ListIndex = 0
    End If
    
'Misc
    Select Case ParseCode1
    Case "40"
        sckServer.SendData Chr$(&H2) & "90:" & Right("000" & Hex(KeepAlive1), 3) & Chr$(&H9) & Right("00" & Hex(KeepAlive2), 2) & Chr$(&H3)
        KeepAlive1 = KeepAlive1 + 2
        KeepAlive2 = KeepAlive2 + 2
'02 39 30 3a 30 30 34 09  34 32 03                .90:004. 42.
    Case Else
    End Select

End Sub

Private Sub sckServer_SendComplete()
SendingState = False
End Sub

'Send Message
'02 31 34 3a 30 30 37 09  30 30 31 3a 30 39 31 38 .14:007. 001:0918
'36 33 32 34 34 30 39 09  30 33 30 3a 30 09 30 33 6324409. 030:0.03
'32 3a 75 77 6f 20 73 77  69 74 2e 09 41 31 03    2:uwo sw it..A1.
Private Sub sckServer_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
SendingState = True
End Sub

NOTE: This was made specifically for old Chikka version and will not work with the current version. Chikka is based on Jabber if you're interested making your own clone out of the latest version you might want to check Jabber.NET.

 

Copyright 2017 Code Monkey