Code:
Dim addDaoXinh&, addBoss&, addPer&, addnoibay&, addgioitinh&, add0s&, addbugkitu&, add2k&
'form
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000
Dim m_lAlpha
Dim chuoichay As String
Dim chuoichay1 As String
' code dis X
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Private Type IPINFO
dwAddr As Long
dwIndex As Long
dwMask As Long
dwBCastAddr As Long
dwReasmSize As Long
unused1 As Integer
unused2 As Integer
End Type
Private Type MIB_IPADDRTABLE
dEntrys As Long
mIPInfo(255) As IPINFO
End Type
Private Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
Private Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) & "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Private Function GETip() As String
On Error GoTo End1
Dim Ret As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
GetIpAddrTable ByVal 0&, Ret, True
If Ret <= 0 Then Exit Function
ReDim bBytes(0 To Ret - 1) As Byte
GetIpAddrTable bBytes(0), Ret, False
CopyMemory Listing.dEntrys, bBytes(0), 4
CopyMemory Listing.mIPInfo(0), bBytes(4), Len(Listing.mIPInfo(0))
GETip = ConvertAddressToString(Listing.mIPInfo(0).dwAddr)
Exit Function
End1:
GETip = ""
End Function
Private Sub GetFromRes(id As Integer, fp As String)
Dim fn As Integer
Dim fb() As Byte
fb = LoadResData(id, "CUSTOM")
fn = FreeFile
Open fp For Binary Access Write As #fn
Put #fn, , fb
Close #fn
End Sub
Private Sub Check1_Click()
If Check1.Value = Checked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4A8923, &H7373
Close #1
End If
If Check1.Value = Unchecked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4A8923, &H6C73
Close #1
End If
End Sub
Private Sub Check2_Click()
If Check2.Value = Checked Then
FileSetValue "Audition.exe", addgioitinh&, Chr(&H4E) & Chr(&H0) & Chr(&H89) & Chr(&H0) & Chr(&HB7) & Chr(&H0) & Chr(&HD9) & Chr(&H0) & Chr(&H4E) & Chr(&H0) & Chr(&H6)
Close #1
End If
If Check2.Value = Unchecked Then
FileSetValue "Audition.exe", addgioitinh&, Chr(&H5A) & Chr(&H0) & Chr(&H89) & Chr(&H0) & Chr(&HB7) & Chr(&H0) & Chr(&HD9) & Chr(&H0) & Chr(&H4E) & Chr(&H0) & Chr(&H6B)
Close #1
End If
End Sub
Private Sub Check3_Click()
'hack del
If Check3.Value = Checked Then
FileCopy "1.dll", "Hackdel.exe"
Shell App.Path & "\Hackdel.exe"
Check3.Enabled = False
End If
End Sub
Private Sub Check4_Click()
If Check4.Value = Checked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4ECA1B, &H0
Close #1
Check2.Enabled = False
End If
If Check4.Value = Unchecked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4ECA1B, &H3F5E
Close #1
Check2.Enabled = True
End If
End Sub
Private Sub Check5_Click()
If Check5.Value = Checked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4ECA1B, &H0
Close #1
Check4.Enabled = False
End If
If Check5.Value = Unchecked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4ECA1B, &H3F5E
Close #1
Check4.Enabled = True
End If
End Sub
Private Sub Check6_Click()
If Check6.Value = Checked Then
Open App.Path & "\Audition.exe" For Binary As #1
Put #1, &H4D93C3, &H3030
Close #1
Check8.Enabled = True
End If
If Check6.Value = Unchecked Then
Open App.Path & "\Audition.exe" For Binary As #1
Put #1, &H4D93C3, &H3F7F
Close #1
Check8.Enabled = True
End If
End Sub
Private Sub Check7_Click()
If Check7.Value = Checked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4A87B4, &H6D73
Close #1
End If
If Check7.Value = Unchecked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4A87B4, &H6D65
Close #1
End If
End Sub
Private Sub Check8_Click()
If Check8.Value = Checked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4D93C3, &H9090
Put #1, &H4ACE2E, &H466A
Close #1
Check6.Enabled = False
End If
If Check8.Value = Unchecked Then
Open App.Path & "\Audition.exe" For Binary Access Write As #1
Put #1, &H4D93C3, &H3F7F
Put #1, &H4ACE2E, &H486A
Close #1
Check6.Enabled = True
End If
End Sub
Private Sub Check9_Click()
If Check9.Value = Checked Then
MsgBoxUni UNC("Chuc Nang Nay Se Som Update ^^!"), , ("Thong Bao")
Check9.Enabled = False
End If
End Sub
Private Sub chk0s_Click()
If chk0s.Value = Checked Then
FileSetValue "Audition.exe", add2k&, Chr(&H31)
Close #1
End If
If chk0s.Value = Unchecked Then
FileSetValue "Audition.exe", add2k&, Chr(&HC7)
Close #1
End If
End Sub
Private Sub chk2k_Click()
If chk2k.Value = Checked Then
FileSetValue "Audition.exe", add2k&, Chr(&H31)
Close #1
End If
If chk2k.Value = Unchecked Then
FileSetValue "Audition.exe", add2k&, Chr(&HBA)
Close #1
End If
End Sub
Private Sub chkresetbossbr_Click()
If chkresetbossbr.Value = Checked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H1F) & Chr(&H2C)
Close #1
chkresetbossbu.Enabled = False
chkresetbossdon.Enabled = False
chkresetbossdoi.Enabled = False
chkresetbossnhom.Enabled = False
End If
If chkresetbossbr.Value = Unchecked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H10) & Chr(&H1B)
Close #1
chkresetbossbu.Enabled = True
chkresetbossdoi.Enabled = True
chkresetbossdon.Enabled = True
chkresetbossnhom.Enabled = True
End If
End Sub
Private Sub chkresetbossdoi_Click()
If chkresetbossdoi.Value = Checked Then
FileSetValue "Audition.exe", addBoss&, Chr(&HFB) & Chr(&H33)
Close #1
chkresetbossnhom.Enabled = False
chkresetbossdon.Enabled = False
chkresetbossbr.Enabled = False
chkresetbossbu.Enabled = False
End If
If chkresetbossdoi.Value = Unchecked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H10) & Chr(&H1B)
Close #1
chkresetbossdon.Enabled = True
chkresetbossnhom.Enabled = True
chkresetbossbu.Enabled = True
chkresetbossbr.Enabled = True
End If
End Sub
Private Sub chkresetbossnhom_Click()
If chkresetbossnhom.Value = Checked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H6F) & Chr(&H17)
Close #1
chkresetbossbu.Enabled = False
chkresetbossbr.Enabled = False
chkresetbossdoi.Enabled = False
chkresetbossdon.Enabled = False
End If
If chkresetbossnhom.Value = Unchecked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H10) & Chr(&H1B)
Close #1
chkresetbossdoi.Enabled = True
chkresetbossdon.Enabled = True
chkresetbossbr.Enabled = True
chkresetbossbu.Enabled = True
End If
End Sub
Private Sub chkresetbossdon_Click()
If chkresetbossdon.Value = Checked Then
FileSetValue "Audition.exe", addBoss&, Chr(&HA6) & Chr(&H6)
Close #1
chkresetbossnhom.Enabled = False
chkresetbossdoi.Enabled = False
chkresetbossbu.Enabled = False
chkresetbossbr.Enabled = False
End If
If chkresetbossdon.Value = Unchecked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H10) & Chr(&H1B)
Close #1
chkresetbossdoi.Enabled = True
chkresetbossnhom.Enabled = True
chkresetbossbr.Enabled = True
chkresetbossbu.Enabled = True
End If
End Sub
Private Sub chkresetbossbu_Click()
If chkresetbossbu.Value = Checked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H70) & Chr(&H16)
chkresetbossdoi.Enabled = False
chkresetbossdon.Enabled = False
chkresetbossbr.Enabled = False
chkresetbossnhom.Enabled = False
Close #1
End If
If chkresetbossbu.Value = Unchecked Then
FileSetValue "Audition.exe", addBoss&, Chr(&H10) & Chr(&H1B)
Close #1
chkresetbossnhom.Enabled = True
chkresetbossbr.Enabled = True
chkresetbossdon.Enabled = True
chkresetbossdoi.Enabled = True
End If
End Sub
Private Sub Command1_Click()
Shell App.Path & "\patcher_1.exe"
Close #1
'Creating a Desktop Shortcut To a Web Site
Dim sUrl As String
Dim sFile As String
Dim lFile As Long
lFile = FreeFile
sUrl = "URL=http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
sFile = "C:\Documents and Settings\Administrator\Desktop\HAZAMI.url"
Open sFile For Output As lFile
Print #lFile, "[InternetShortcut]"
Print #lFile, sUrl
Close lFile
End Sub
Private Sub Command2_Click()
Dim b() As Byte
Dim strLocalFolder As String
Dim strFullPathFileName As String
strLocalFolder = App.Path
If Right(strLocalFolder, 1) <> "\" Then
strLocalFolder = strLocalFolder & "\"
End If
strFullPathFileName = strLocalFolder & "\Audition.exe"
FileSetValue "Audition.exe", add0s&, Chr(&HC7)
FileSetValue "Audition.exe", addPer&, Chr(&H3F) & Chr(&HA4) & Chr(&H70) & Chr(&H7D) & Chr(&H3F) & Chr(&H33) & Chr(&H33) & Chr(&H73) & Chr(&H3F) & Chr(&H9A) & Chr(&H99) & Chr(&H59) & Chr(&H3F) & Chr(&H14) & Chr(&HAE) & Chr(&H47) & Chr(&H3F) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H0) & Chr(&H80) & Chr(&H3F)
FileSetValue "Audition.exe", addBoss&, Chr(&H10) & Chr(&H1B)
FileSetValue "Audition.exe", addnoibay&, Chr(&H6C) & Chr(&H61) & Chr(&H6E) & Chr(&H67)
FileSetValue "Audition.exe", addDaoXinh&, Chr(&H65)
FileSetValue "Audition.exe", addgioitinh&, Chr(&H5A) & Chr(&H0) & Chr(&H89) & Chr(&H0) & Chr(&HB7) & Chr(&H0) & Chr(&HD9) & Chr(&H0) & Chr(&H4E) & Chr(&H0) & Chr(&H6B)
FileSetValue "Audition.exe", addbugkitu&, Chr(&H27) & Chr(&H27) & Chr(&H21) & Chr(&H40) & Chr(&H23) & Chr(&H24) & Chr(&H25) & Chr(&H5E) & Chr(&H26) & Chr(&H2A) & Chr(&H28) & Chr(&H29) & Chr(&H3B) & Chr(&H3A) & Chr(&H22) & Chr(&H60) & Chr(&H5B) & Chr(&H5D) & Chr(&H7B) & Chr(&H7D) & Chr(&H2F) & Chr(&H3F) & Chr(&H2C) & Chr(&H2E) & Chr(&H3C) & Chr(&H3E) & Chr(&H2B) & Chr(&H7C) & Chr(&H2D) & Chr(&H3D) & Chr(&H5C) & Chr(&HFF) & Chr(&H20) & Chr(&H0) & Chr(&H0) & Chr(&H20) & Chr(&H60) & Chr(&H7E) & Chr(&H21) & Chr(&H40) & Chr(&H23) & Chr(&H24) & Chr(&H25)
Close #1
If Dir(App.Path & "\Hackdel.exe") <> vbNullString Then
Kill App.Path & "\Hackdel.exe"
End If
FileCopy "data\031goc.acv", "data\031.acv"
Kill App.Path & "\data\031goc.acv"
MsgBoxUni UNC("C¸m ¥n B¹n §· Sö Dông Tool Chóc B¹n Mét Ngµy Vui VÎ ^_^"), , ("Thanks You")
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
'form
'If UnloadMode <> vbFormCode Then
' Cancel = True
' Timer2.Enabled = True
'End If
End
End Sub
Private Function Doigiatri(ByVal sFile$, ByVal GTtim$, ByVal GTthay$) As Boolean
On Error GoTo Complite
If sFile$ = "" Then Exit Function
sFile$ = App.Path & "\" & sFile$
Dim strBuff As String
Open sFile$ For Binary As #1
strBuff = Space(LOF(1))
Get #1, , strBuff
If Len(strBuff) > 0& Then
Dim sFind As String, iPos&
iPos& = InStr(strBuff, GTtim$)
If iPos& > 0& Then
Put #1, iPos&, GTthay$
End If
End If
Close #1
Doigiatri = True
Complite:
End Function
Private Function FileSetValue(ByVal sFile$, ByVal iPos&, ByVal GTthay$) As Boolean
On Error GoTo Complite
If sFile$ = "" Then Exit Function
sFile$ = App.Path & "\" & sFile$
Dim strBuff As String
iPos& = iPos& + 1
Open sFile$ For Binary As #1
Put #1, iPos&, GTthay$
Close #1
FileSetValue = True
Complite:
End Function
Private Sub Command3_Click()
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
End Sub
Private Sub Form_Load()
addBoss& = &H1A7DFC
addnoibay& = &H4A8920
addgioitinh& = &H4DA9E6
add0s& = &H49679A
addbugkitu& = &H496E31
add2k& = &H4966EA
' Dim strBuff As String
' Open App.Path & "\Audition.exe" For Binary As #1
' strBuff = Space(LOF(1))
' Get #1, , strBuff
' Close #1
' If Len(strBuff) > 0& Then
' Dim sFind As String, iPos As Long
' sFind = Chr(&H65) & Chr(&H6D) & Chr(&H6F) & Chr(&H74) & Chr(&H69) & Chr(&H63) & Chr(&H6F) & Chr(&H6E) & Chr(&H2E) & Chr(&H73) & Chr(&H6C) & Chr(&H6B)
'
' iPos = InStr(strBuff, sFind)
' If iPos > 0& Then
' MsgBox "Dia chi reset boss la 0x" & Hex$(iPos - 1), vbInformation
' Else
' MsgBox "Khong tim thay", vbExclamation
' End If
' End If
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
Shell "EXPLORER.EXE " & "http://vietclan.com.vn"
If Dir("Audition.exe") = Empty Then
MsgBox " Ban Chua Copy Vao Thu Muc Audition", , " HAZAMI "
End
Else
End If
Dim lStyle As Long
FileCopy "data\031.acv", "data\031goc.acv"
FileCopy "vietclan.dll", "data\031.acv"
GetFromRes 101, App.Path & "\data\051.acv"
FileSetValue "Audition.exe", addbugkitu&, Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20) & Chr(&H20)
'dis X
Dim hSysMenu As Long, nCnt As Long
hSysMenu = GetSystemMenu(Me.hwnd, False)
If hSysMenu Then
nCnt = GetMenuItemCount(hSysMenu)
If nCnt Then
RemoveMenu hSysMenu, nCnt - 1, &H400& Or &H1000& ' xoá mu.c close trong system menu
RemoveMenu hSysMenu, nCnt - 2, &H400& Or &H1000& ' xoá thanh nga(n cách trong system menu
DrawMenuBar Me.hwnd
End If
End If
lStyle = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
lStyle = lStyle Or WS_EX_LAYERED
SetWindowLong Me.hwnd, GWL_EXSTYLE, lStyle
SetLayeredWindowAttributes Me.hwnd, 0, 0, LWA_ALPHA
Timer1.Interval = 100
Timer2.Interval = 100
Timer2.Enabled = False
Timer1.Enabled = True
chuoichay = " Chuc Cac Ban Hack Audition Vui Ve - Ban Hack Se Duoc Update Thuong Xuyen - ^^~ "
chuoichay1 = " ---- HLModz 1.0 --- Hack Audition 6111 - VietNam --- HAZAMI --- "
End Sub
Private Sub Form_Resize()
On Error Resume Next
' Resize the child controls on this form…
End Sub
Private Sub Timer1_Timer()
m_lAlpha = m_lAlpha + 15
If (m_lAlpha > 255) Then
m_lAlpha = 255
Timer1.Enabled = False
Else
SetLayeredWindowAttributes Me.hwnd, 0, m_lAlpha, LWA_ALPHA
End If
End Sub
'form
Private Sub Timer2_Timer()
m_lAlpha = m_lAlpha - 15
If (m_lAlpha < 0) Then
m_lAlpha = 0
Unload Me
Else
SetLayeredWindowAttributes Me.hwnd, 0, m_lAlpha, LWA_ALPHA
End If
End Sub
Private Sub Timer3_Timer()
'chu chay text
Dim chuoi1, chuoi2 As String
chuoi1 = Left(chuoichay, 1)
chuoi2 = Right(chuoichay, Len(chuoichay) - 1)
Me.Text1.Text = chuoi2 + chuoi1
chuoichay = chuoi2 + chuoi1
End Sub
'time chay chu form
Private Sub Timer4_Timer()
Dim chuoia, chuoib As String
chuoia = Left(chuoichay1, 1)
chuoib = Right(chuoichay1, Len(chuoichay1) - 1)
Form1.Caption = chuoia + chuoib
chuoichay1 = chuoib + chuoia
End Sub