APP REG NICK + SOURCE CODE

neh app buatan kang cobain
Ini cuma app sederhana buat reg nik mig33



neh wat yang pengen nyoba bikin app wat reg nick mig33.

PROFERTI:

-3 buah textbox (disini menggunakan xpcontrol) kasih nama dengan:

txtuname
txtnope
txtpass

-1 buah Richtextbox kasih nama dengan
Status

-3 buah command button (disini gw pake xpcontrol) kasih nama dengan:

xpbutton1

xpbutton2

xpbutton3 ( Visible = False )


REFERENCE

-Visual Basic For Applications
-Visual Basic runtime objects and procedures
-Visual Basic objects and Procedures
-OLE Automation
-Microsoft scripting Runtime

CODING

Form1

Code:

Dim DatIn As String
Dim DatOut As String
Dim coder As String
Dim Psize As String



Private Sub Form_Load()

End Sub

Private Sub Winsock1_Close()
Winsock1.Close
With status
.SelStart = Len(.Text)
.SelLength = Len(.Text)
.SelColor = &HFF&
.SelText = "***DISCONNECTED***" & vbCrLf
End With
XPButton3.Visible = False
XPButton1.Visible = True
End Sub

Private Sub Winsock1_Connect()
With status
.SelStart = Len(.Text)
.SelLength = Len(.Text)
.SelColor = &H8000&
.SelText = "***CONNECTED***" & vbCrLf
End With
XPButton3.Visible = True
XPButton1.Visible = False
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim a As String
Dim d As String
Dim e
Dim f As String

Winsock1.GetData DatIn, vbString
a = Left(DatIn, 4)
a = Asciitohex(a)

If a = "2 0 0 0" Then
    BadCode
End If

If a = "2 0 1 0" Then
    GoodCode
End If

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)
Winsock1.Close
With status
.SelStart = Len(.Text)
.SelLength = Len(.Text)
.SelColor = &HFF&
.SelText = "***SOCKET ERROR***" & vbCrLf
End With
XPButton3.Visible = False
XPButton1.Visible = True
End Sub

Private Sub XPButton1_Click() 'neh button wat konek
With status
.SelStart = Len(.Text)
.SelLength = Len(.Text)
.SelColor = &H0&
.SelText = "Connecting..." & vbCrLf
End With
With Winsock1
 .Close
 .RemoteHost = "gateway.mig33.com"
 .RemotePort = "9119"
 .Connect
 End With
End Sub

Private Sub XPButton2_Click() 'neh button wat Reg
If txtname.Text = "" Then
MsgBox "WOYY...!!! USERNAME NYA BELUM DIISI TUUUUHH!!!"
Else
If txtnope.Text = "" Then
MsgBox "WOYY...!!!  NO HP NYA BELUM DIISI TUUUUHH!!!"
Else
If txtpass.Text = "" Then
MsgBox "WOYY...!!! PASSWORD NYA BELUM DIISI TUUUUHH!!!"
Else
With status
.SelStart = Len(.Text)
.SelLength = Len(.Text)
.SelColor = &H0&
.SelText = "Please Wait..." & vbCrLf
End With
On Error GoTo t
Dim a
Dim B
Dim Pnope As String
Dim Ppass As String
Dim Pname As String
Dim Nope As String
Dim Pass As String
Dim Uname As String

Pnope = Len(txtnope.Text)
Ppass = Len(txtpass.Text)
Pname = Len(txtname.Text)
B = Pnope + 25
B = B + Ppass
B = B + Pname
Psize = Hex(B)
a = Len(Psize)
If a < 2 Then Psize = "0" & Psize
Pnope = Hex(Pnope)
a = Len(Pnope)
If a < 2 Then Pnope = "0" & Pnope
Ppass = Hex(Ppass)
a = Len(Ppass)
If a < 2 Then Ppass = "0" & Ppass
Pname = Hex(Pname)
a = Len(Pname)
If a < 2 Then Pname = "0" & Pname
Nope = Asciitohex(txtnope.Text)
Pass = Asciitohex(txtpass.Text)
Uname = Asciitohex(txtname.Text)
coder
= "02 00 64 00 04 00 00 00 " & Psize & " 00 04 00 00 00 " &
Pnope & " " & Nope & " 00 03 00 00 00 " & Ppass & "
" & Pass & " 00 02 00 00 00 " & Pname & " " & Uname
& " 00 01 00 00 00 01 01"
DatOut = HextoAscii(coder)
Winsock1.SendData DatOut

End If
End If
End If

Exit Sub
t:
Winsock1_Close
End Sub

Private Sub BadCode()
Dim a As String
Dim B
Dim BadOut As String
a = Mid(DatIn, 15, 1)
a = Asciitohex(a)
B = UnHex(a)

BadOut = Mid(DatIn, 16, B)
With status
.SelLength = Len(.Text)
.SelColor = &HFF&
.SelText = "***" & BadOut & "***" & vbCrLf
End With
End Sub

Private Sub GoodCode()
Dim a As String
Dim B
Dim GoodOut As String
a = Mid(DatIn, 15, 1)
a = Asciitohex(a)
B = UnHex(a)

GoodOut = Mid(DatIn, 16, B)
With status
.SelLength = Len(.Text)
.SelColor = &HFF0000
.SelText = "***" & GoodOut & "***" & vbCrLf
End With
End Sub

Private Sub XPButton3_Click() 'neh button wat Dc
Winsock1_Close
End Sub

neh coding wat module nya

Code:

Option Explicit
Public Function HextoAscii(inputstr As String) As String
Dim spilter As Variant, i As Integer, finnal As String
If InStr(1, inputstr, " ") <> 0 Then
spilter = Split(inputstr, " ")
For i = 0 To UBound(spilter)
finnal = finnal & Chr(Val("&H" & spilter(i)))
Next i
HextoAscii = finnal
ElseIf Len(inputstr) = 2 Then
finnal = Chr(Val("&H" & inputstr))
HextoAscii = finnal
End If
End Function

Public Function Asciitohex(inputstr As String) As String
On Error Resume Next
Dim spilter As Variant, i As Integer, finnal As String
For i = 1 To Len(inputstr)
finnal = finnal & Hex(Asc(Mid(inputstr, i, 1))) & " "
Next i
Asciitohex = Mid(finnal, 1, Len(finnal) - 1)
End Function

Public Function UnHex(sHex As String) As Long
    UnHex = Val("&H" & sHex)
End Function

itu kalo km pada mw bikin ndiri
kalo gak mw repot download aja yg dah jadi

Code:

http://www.4shared.com/file/77456618/fbcfe299/regNick.html

app ini butuh xpcontrol.ocx di sistem32 pc kamu
kalo lum punya download aja neh

Code:

ttp://www.4shared.com/file/66459238/fc4e33bb/XPControls.html?dirPwdVerified=752c9450

wew jangan-jangan u yang buat ya bro.. btw w sedot ahhhhhhhhh

nyobain ah....