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