[開源] 新楓之谷洋蔥（OpenSource MSOnion for NewBF）

作者： knowlet - 8月 16, 2013

楓之谷洋蔥是我目前堅持過最久的一個 Project，從我開始學習寫程式到現在...
現在來實現之前說過的開源吧～

裡面也沒有什麼特別的東西，不過是一段學習的歷程而已 =w=
半夜偷偷發，大大請無視，大牛請繞過，神馬請漂走...

版本演進：

從練習調用 AutoAsm 的數據執行工具（由於論壇資料遺失，已不可朔..）
後來把當時有的東西全部拼湊起來的版本（楓之谷洋蔥 2.1）
慢慢看得懂程式碼會用比較多元件整理後的版本（楓之谷洋蔥 v2.1.0.56）
在經過大大施捨的部分登入用程式碼之後終於學起來的版本（楓之谷洋蔥4.1.2）
過了半年全部重寫，正值樂逗改版的版本（NewMSOnion Alpha）
趨於穩定的版本，持續修正、更新，並加入自動更新器，目前的版本（新楓之谷洋蔥）

當然過程中大大小小也改了無數、發佈了無數的版本，只不過這幾個是我部落格有紀錄的版本而已...

其實當初在寫的時候就有想過哪一天一定會發出來，所以很多地方都有加註解，不過時間拖得久了，很多地方就亂了...

其實裡面模組很多都是開源的網路上找的到喔（笑

Form1.frm：主程式，帳密儲存、樂豆登入、遊戲啟動、遊戲登入、功能寫入、驅動調用、後台按鍵、指標讀取等等。

Option Explicit
Private Declare Function CEAutoAsm Lib "CEAutoAssembler.dll" (ByVal script As String, ByVal AllocID As Boolean, Alloc As Integer) As Boolean
Private Declare Function CEInitialize Lib "CEAutoAssembler.dll" (ByVal ngPassedPID As Long, ByVal Phandle As Long) As Integer
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Hp As Long, Mp As Long, Monster As Integer, RedPoint As Integer, Breath As Integer
Dim tBot1 As Integer, tBot2 As Integer, tBot3 As Integer, tBot4 As Integer, tBot5 As Integer, tBot6 As Integer, tAtkDown As Integer, tCh As Integer, TimeCheck As Single

Dim SystemBaseAdr As Long, MpAlarmBaseAdr As Long, MpAlarmOffest As Long, HpValueBaseAdr As Long, HpValueOffest As Long, ChrBaseAdr As Long, ChrBreathOffest As Long, RedBaseAdr As Long, MonBaseAdr As Long
Dim AutoLRICSEntry  As Long, AutoLRICSCallRet As Long, AutoLRJne As Long, GetFocus As Long, WPMAutoLR As Boolean, AutoLRICS As Long, AutoLRValue As Long
Dim IntersectRect As Long, FullMapICS As Long
Dim IsRectEmpty As Long, PhysicalGodICS As Long
Dim mCount As Date, mCountEnd As Date
Dim LoadScript As String
Dim MSBlack As Boolean, MultiON As Boolean, ReRun As Boolean
Dim HACK As New clsHack

'========== 遊戲連結 ==========
Private Sub AttachGame_Click()
    HACK.Pid = 0: HACK.Handle = 0: HACK.hWnd = 0: HACK.Inited = False
    If HACK.OpenProcessByWindow(vbNullString, "MapleStoryClass") Then
        Call AttachInitialize
        Call SetForegroundWindow(HACK.hWnd)
        Call SetWindowPos(HACK.hWnd, -2, 0, 5, 0, 0, &H1)
    ElseIf HACK.OpenProcessByWindow("MapleStory", "StartUpDlgClass") Then
        Call AttachInitialize
    Else
        Me.Caption = "楓之谷洋蔥"
        Call MsgBox("Game Not Found", vbCritical, "Faild")
    End If
End Sub
Private Sub AttachInitialize()
    Me.Caption = "MSOnion - " & HACK.Pid
    Call HACK.WritePointer(MpAlarmBaseAdr, MpAlarmOffest - 4, &H20): Call HACK.WritePointer(MpAlarmBaseAdr, MpAlarmOffest, &H20)
    Call ICSAdrInitialize
    Call ReAutoASM
    Call SetForegroundWindow(Me.hWnd)
    TmDCCheck.Enabled = CkDcCheck.value
    MSBlack = False: BlackMS.Caption = "脫機ON"
End Sub

Private Sub ICSAdrInitialize()
    
    IsRectEmpty = 0
    
    AutoLRICSEntry = "&H" & ReadData("AutoLR", "ICSEntry")
    AutoLRICSCallRet = "&H" & ReadData("AutoLR", "CallRet")
    AutoLRJne = "&H" & ReadData("AutoLR", "Jne")
    WPMAutoLR = False
    
    IntersectRect = 0
    
    If CkGod.value = 1 Then CkGod_Click
    If CkAutoLR.value = 1 Then CkAutoLR_Click
    If CkFullMap.value = 1 Then CkFullMap_Click
End Sub

Private Sub ReAutoASM()
    Dim i As Integer
    For i = 0 To lstScripts.ListCount - 1
        If lstScripts.Selected(i) = True Then Call lstScripts_ItemCheck(i)
    Next
End Sub

Private Sub CheckPic_Click()
    Call GetImage
End Sub

Private Sub CheckUpdate_Click()
On Error GoTo Er
    'Call Shell("rundll32.exe url.dll,FileProtocolHandler http://knowlet3389.blogspot.tw/p/msonion.html", vbHide)
    Dim http As Object, verCheck As String, Ver() As String
    Set http = CreateObject("MSXML2.ServerXMLHTTP")
    http.Open "GET", "http://knowlet3389.blogspot.tw/p/msonion.html", False
    http.setRequestHeader "Pragma", "no-cache"
    http.send
    verCheck = http.responseBody
    verCheck = StrConv(verCheck, vbUnicode)
    verCheck = Split(Mid(verCheck, InStr(34780, verCheck, "Latest Ver."), 20), "<")(0)
    Ver = Split(verCheck, ".")
    Set http = Nothing
    If Ver(1) > App.Major Or Ver(2) > App.Minor Or Ver(3) > App.Revision Then Call MsgBox("Your Ver." & App.Major & "." & App.Minor & "." & App.Revision & " is out of date. Please Update to the latest version!", vbInformation, verCheck) _
    : Call Shell("rundll32.exe url.dll,FileProtocolHandler http://knowlet3389.blogspot.tw/p/msonion.html", vbHide): End
    'MsgBox "檔案版本：" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & Ver, vbInformation, "目前版本"
    Exit Sub
Er:
    Call MsgBox("This Application can't be used anymore!", vbCritical, "Error"): End
End Sub

Private Sub CkAutoStart_Click()
    If CkAutoStart.value = 1 And lstBFAccount.ListIndex = -1 Then CkAutoStart.value = 0: Call MsgBox("No Account Chosen!", vbCritical, "Error")
End Sub

Private Sub CloseGame_Click()
    On Error Resume Next
    Call HACK.CloseGame
    HACK.Pid = 0: HACK.Handle = 0: HACK.hWnd = 0: HACK.Inited = False
End Sub

'========== 選單功能 ==========
Private Sub BlackMS_Click()
    If MSBlack = False Then
        Call ShowWindow(HACK.hWnd, 0)
        BlackMS.Caption = "脫機OFF"
        MSBlack = True
    Else
        Call ShowWindow(HACK.hWnd, 1)
        BlackMS.Caption = "脫機ON"
        MSBlack = False
    End If
End Sub

Private Sub DelScript_Click()
    On Error GoTo Er:
    If MsgBox("確認刪除" & lstScripts.List(lstScripts.ListIndex) & "？", 4 + 32, "確認") = vbYes Then
        Kill (App.Path & "\Scripts\" & lstScripts.List(lstScripts.ListIndex))
        lstScripts.RemoveItem (lstScripts.ListIndex)
    End If
    Exit Sub
Er:
    Call MsgBox(Err.Description, vbCritical, Err.Number)
End Sub

Private Sub GotoFolder_Click()
    Call Shell("rundll32.exe url.dll,FileProtocolHandler " & App.Path & "/Scripts", vbNormalFocus)
End Sub

Private Sub lstScripts_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo Err
    If Len(Trim(Data.Files(1))) Then
        Dim s
        For Each s In Data.Files
            Dim fileName As String
            fileName = Mid(s, InStrRev(s, "\") + 1)
            If LCase(Right(fileName, 3)) = "txt" Then
                FileCopy s, App.Path & "\Scripts\" & fileName
                lstScripts.AddItem (fileName)
            End If
        Next
    Else: Exit Sub: End If
Err:
End Sub

Private Sub WriteInPlay_Click()
    WriteInPlay.Checked = Not WriteInPlay.Checked
End Sub

Private Sub lstScripts_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button And vbRightButton Then PopupMenu Scripts
End Sub

Private Sub lxlX_Click()
    Frame5.Visible = False
End Sub

Private Sub CmdSaveScript_Click()
    If Len(txtSaveScript) = 0 Then Exit Sub
    Dim str() As String, fileName As String, i As Integer
    str = Split(txtSaveScript, Chr(13))
    
    fileName = InputBox("請輸入檔名", "Name", Replace(str(0), "/", vbNullString))
    If Len(fileName) = 0 Then Exit Sub
    
    If Not Right(fileName, 4) = ".txt" Then fileName = fileName & ".txt"
    Frame5.Visible = False
    For i = 0 To lstScripts.ListCount - 1
        If fileName = lstScripts.List(i) Then
            If OverWrite(App.Path & "\Scripts\" & fileName, txtSaveScript) = True Then Exit Sub
        End If
    Next
    If OverWrite(App.Path & "\Scripts\" & fileName, txtSaveScript) Then lstScripts.AddItem (fileName)
    Exit Sub
Er:     Call MsgBox(Err.Description, vbCritical, Err.Number)
End Sub

Private Function OverWrite(lpFileName As String, strS As String) As Boolean
    Dim FileNum As Integer
    OverWrite = False
    On Error GoTo OWError
    
    If Len(Dir(lpFileName, vbArchive Or vbHidden Or vbNormal Or vbReadOnly)) > 0 Then Kill lpFileName
    
    FileNum = FreeFile
    Open lpFileName For Binary As FileNum
    Put FileNum, , strS & vbCrLf
    Close FileNum
    OverWrite = True
    Exit Function
    
OWError:
    MsgBox "檔案操作失敗！" & vbCrLf & lpFileName, 16
End Function

Private Sub MultiMS_Click()
    Dim CMD As String
    If MultiON = False Then
        Call MsgBox("本多開只支援x86系統，且無繞過HS多開檢測！" & vbCrLf & "如置於中文路徑下將可能多開啟動失敗！", vbInformation, "提示")
'Call CHLoadDriver(App.Path & "\MultiDriver.dll")
        CMD = "cmd.exe /c sc create NtUserCallOneParam binpath= " + App.Path + "\MultiDriver.dll type= kernel start= auto && cmd.exe /c sc start  NtUserCallOneParam"
        Shell CMD, vbHide
        CMD = vbNullString
        MultiMS.Caption = "多開OFF"
        MultiON = True
    Else
'Call CHUnLoadDriver
        CMD = "cmd.exe /c sc stop NtUserCallOneParam && cmd.exe /c sc delete NtUserCallOneParam"
        Shell CMD, vbHide
        CMD = vbNullString
        MultiMS.Caption = "多開ON"
        MultiON = False
    End If
End Sub

Private Sub AddScript_Click()
    txtSaveScript = Chr(0)
    Frame5.Left = 0
    Frame5.Visible = True
    Frame5.ZOrder
End Sub

Private Sub ReadScript_Click()
    Call Shell("Notepad.exe " & App.Path & "\Scripts\" & lstScripts.List(lstScripts.ListIndex), vbNormalFocus)
End Sub

Private Sub Reload_Click()
    Call LoadScripts
End Sub

Private Sub SetCloseGame_Click()
    On Error GoTo Er:
    Dim Hr As Integer, Mn As Integer
    Hr = InputBox("請輸入小時數", "關閉遊戲設置", 0)
    Mn = InputBox("請輸入分鐘數", "關閉遊戲設置", 1)
    mCountEnd = Now
    mCount = SetCount(Hr, Mn, 0)
    TmCloseGame.Enabled = True
    MsgBox "將於" & Hr & "小時" & Mn & "分後關閉遊戲", vbInformation, "遊戲關閉設定完成"
Er:
End Sub

Private Sub SetClosGameA_Click()
    TmCloseGame.Enabled = False
    SetCloseGame.Caption = "定時關遊戲"
End Sub

Private Function SetCount(ByVal vHour As Long, ByVal vMinute As Long, vSecond As Long) As Date
    SetCount = mCountEnd + CDate(vHour & ":" & vMinute & ":" & vSecond)
End Function

Private Sub TmCloseGame_Timer()
    On Error GoTo Er:
    mCount = mCount - CDate("00:00:01")
    SetCloseGame.Caption = mCount
    If mCount < mCountEnd Then
        CkAutoStart.value = 0
        HACK.CloseGame
        TmCloseGame.Enabled = 0
        SetCloseGame.Caption = "定時關遊戲"
    End If
Er:
End Sub

Private Sub ShutdownPC_Click()
    Dim SD_Time As String
    SD_Time = InputBox("請輸入分鐘數" & vbCrLf & "*如果輸入錯誤可能導致立刻關機", "自動關機", 60)
    Call Shell("cmd /c shutdown -s -t " & Val(SD_Time) * 60, vbHide)
End Sub

Private Sub ShutodownA_Click()
    Call Shell("cmd /c shutdown -a", vbHide)
End Sub

'========== 功能鉤子 ==========
Private Sub CkAutoLR_Click()
    If WPMAutoLR = False Then
        GetFocus = HACK.ReadLong(AutoLRICSEntry)
        AutoLRICS = HACK.Alloc(128)
        AutoLRValue = HACK.Alloc(4)
        Call HACK.WriteAOBByString(AutoLRICS, "81 3C 24" & HACK.Address2Aob(AutoLRICSCallRet) & "00 75 07 C7 04 24" & HACK.Address2Aob((AutoLRICS + &H16)) & "68 34 3A BA 77 C3 50 FF 05" & HACK.Address2Aob(AutoLRValue) & "B8 0A 00 00 00 3B 05" & HACK.Address2Aob(AutoLRValue) & "7D 15 83 C0 0A 3B 05" & HACK.Address2Aob(AutoLRValue) & "7D 14 C7 05" & HACK.Address2Aob(AutoLRValue) & "01 00 00 00 C7 45 FC FF FF FF FF 58 EB 08 C7 45 FC 01 00 00 00 58 68" & HACK.Address2Aob(AutoLRJne) & "00 C3")
        WPMAutoLR = True
    End If
    If CkAutoLR.value = 1 Then Call HACK.WriteLong(AutoLRICSEntry, AutoLRICS) Else: Call HACK.WriteLong(AutoLRICSEntry, GetFocus)
End Sub

Private Sub CkFullMap_Click()
    IntersectRect = GetProcAddress(GetModuleHandleA("User32"), "IntersectRect")
    If IntersectRect = 0 Then Exit Sub
    FullMapICS = HACK.Alloc(64)
    Call HACK.WriteAOBByString(FullMapICS, "8B 04 24 81 38 85 C0 75 08 75 06 31 C0 40 C2 0C 00 55 8B EC")
    Call HACK.MakeJmp(FullMapICS + 20, IntersectRect + 5)
    If CkFullMap.value = 1 Then Call HACK.MakeJmp(IntersectRect, FullMapICS) Else: Call HACK.WriteAOBByString(IntersectRect, "8B FF 55 8B EC")
End Sub

Private Sub CkGod_Click()
    IsRectEmpty = GetProcAddress(GetModuleHandleA("User32"), "IsRectEmpty")
    If IsRectEmpty = 0 Then Exit Sub
    PhysicalGodICS = HACK.Alloc(64)
    Call HACK.WriteAOBByString(PhysicalGodICS, "8B 04 24 81 38 85 C0 74 11 75 06 31 C0 40 C2 04 00 55 8B EC")
    Call HACK.MakeJmp(PhysicalGodICS + 20, IsRectEmpty + 5)
    If CkGod.value = 1 Then Call HACK.MakeJmp(IsRectEmpty, PhysicalGodICS) Else: Call HACK.WriteAOBByString(IsRectEmpty, "8B FF 55 8B EC")
End Sub

Private Sub CkChrCut_Click()
    TmChrCut.Enabled = CkChrCut.value
    Call HACK.WritePointer(ChrBaseAdr, ChrBreathOffest - 8, 0)
End Sub

Private Sub CkDcCheck_Click()
'TmDCCheck.Enabled = CkDcCheck.value
End Sub

Private Sub CkLoli_Click()
    TmLoli.Enabled = CkLoli.value
    Call HACK.WritePointer(ChrBaseAdr, ChrBreathOffest - &H78, 0)
End Sub

Private Sub CkNoDelay_Click()
    TmNoDelay.Enabled = CkNoDelay.value
End Sub

'========== 按鍵鉤子 ==========
Private Sub CkAttackBot_Click()
    TmAttack.Enabled = CkAttackBot.value
    TmAttack.Interval = Val(txtAttackSet)
    txtAttackSet.Enabled = Not CBool(CkAttackBot.value)
End Sub

Private Sub CkPickBot_Click()
    TmPick.Enabled = CkPickBot.value
    TmPick.Interval = Val(txtPickSet)
    txtPickSet.Enabled = Not CBool(CkPickBot.value)
End Sub

Private Sub CkBot1_Click()
    tBot1 = Val(txtBotSet1)
    TmBot1.Enabled = CkBot1.value
    Call RingPst(HACK.hWnd, "Press", txtBot1)
End Sub

Private Sub CkBot2_Click()
    tBot2 = Val(txtBotSet2)
    TmBot2.Enabled = CkBot2.value
    Call RingPst(HACK.hWnd, "Press", txtBot2)
End Sub

Private Sub CkBot3_Click()
    tBot3 = Val(txtBotSet3)
    TmBot3.Enabled = CkBot3.value
    Call RingPst(HACK.hWnd, "Press", txtBot3)
End Sub

Private Sub CkBot4_Click()
    tBot4 = Val(txtBotSet4)
    TmBot4.Enabled = CkBot4.value
    Call RingPst(HACK.hWnd, "Press", txtBot4)
End Sub

Private Sub CkBot5_Click()
    tBot5 = Val(txtBotSet5)
    TmBot5.Enabled = CkBot5.value
    Call RingPst(HACK.hWnd, "Press", txtBot5)
End Sub

Private Sub CkBot6_Click()
    tBot6 = Val(txtBotSet6)
    TmBot6.Enabled = CkBot6.value
    Call RingPst(HACK.hWnd, "Press", txtBot6)
End Sub

Private Sub CkAtkDown_Click()
    tAtkDown = Val(txtAtkDownSet)
    TmAtkDown.Enabled = CkAtkDown.value
    Call RingPst(HACK.hWnd, "Up", txtAtkDown)
End Sub

Private Sub CkTalk_Click()
    TmTalk.Enabled = CkTalk.value
End Sub

'========== Frame切換 ==========
Private Sub CmdAutoBot_Click()
    Frame2.ZOrder
End Sub

Private Sub CmdBeanfun_Click()
    Frame3.ZOrder
End Sub

Private Sub CmdScripts_Click()
    Frame1.ZOrder
End Sub
'========== 自動換頻 ==========
Private Sub CmdCh_Click()
    TmLoli.Enabled = 1
    Do Until Breath = 0
        TmAttack.Enabled = 0: TmPick.Enabled = 0: TmAtkDown.Enabled = 0
        Sleep (300)
        DoEvents
    Loop
    
    Call RingPst(HACK.hWnd, "Press", "Esc"): Call RingPst(HACK.hWnd, "Press", "Enter"): Call RingPst(HACK.hWnd, "Press", "Left"): Call RingPst(HACK.hWnd, "Press", "Enter")
    CkLoli_Click
    TmAttack.Enabled = CkAttackBot.value: TmPick.Enabled = CkPickBot.value: tAtkDown = Val(txtAtkDownSet)
    
End Sub

Private Sub TmBreath_Timer()
    If CkChR.value = 1 And RedPoint > Val(txtChR) Then CmdCh_Click
    If CkChT.value = 1 Then
        tCh = tCh - 1
        If tCh <= 0 Then CmdCh_Click: tCh = Val(txtChT)
    Else
        tCh = Val(txtChT)
    End If
End Sub

'========== Form設定 ==========
Private Sub Form_Load()
    On Error Resume Next
    Call CheckUpdate_Click
    Me.Show
    Call SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, 3)
    With Me
        .Frame1.Left = 0
        .Frame2.Left = 0
        .Frame3.Left = 0
        .Frame1.ZOrder
    End With
    Call PointerInitialize
    Call ReadSetting_Click
    Call CheckFiles
    Call LoadScripts
    Call LoadAccountList
    Call HACK.ChangeImagePath
    MSBlack = False: MultiON = False: ReRun = False: WriteInPlay.Checked = False
    Call WebB.Navigate("http://tw.new.beanfun.com/game_zone/default.aspx"): WebB.Silent = 1: WebB.ZOrder
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    Me.Height = 7010
    Me.Width = 3225
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Cancel = True: Me.WindowState = 1
End Sub

Private Sub Form_Terminate()
    UnloadMe_Click
End Sub

Private Sub UnloadMe_Click()
    Call Shell("taskkill.exe /F /PID " & GetCurrentProcessId, vbHide)
End Sub
'========== 初始化 ==========
Private Sub CheckFiles()
    On Error GoTo hErr
    If Dir(App.Path & "\Account", vbDirectory) = "" Then Call MkDir(App.Path & "\Account")
    If Dir(App.Path & "\Scripts", vbDirectory) = "" Then Call MkDir(App.Path & "\Scripts")
    If Dir$(App.Path & "\CEAutoAssembler.dll") = "" Then Call MsgBox("CEAutoAssembler.dll Lost!", vbCritical, "Lost")
    Exit Sub
hErr:
    MsgBox Err.Number & Err.Description
End Sub
'========== 數據部分 ==========
Private Sub LoadScripts()
On Error GoTo Er:

    Dim strScriptsPath As String
    strScriptsPath = Dir(App.Path & "\Scripts\*.txt")
    
    lstScripts.Clear
    
    Do While Not Len(strScriptsPath) = 0
        lstScripts.AddItem (strScriptsPath)
        strScriptsPath = Dir()
    Loop: Exit Sub
Er:
    MsgBox Err.Number & Err.Description
End Sub

Private Sub LoadSelectedScript(strScriptFile As String)
    On Error GoTo Er
    Dim strScriptPath As String
    strScriptPath = App.Path & "\Scripts\" & strScriptFile
    
    Dim a() As Byte: ReDim a(FileLen(strScriptPath))
    Open strScriptPath For Binary As #1: Get #1, , a: Close #1
    LoadScript = StrConv(a, vbUnicode)
    
    Exit Sub
Er:
    MsgBox Err.Number & Err.Description
End Sub

Private Sub lstScripts_ItemCheck(Item As Integer)
    If CEInitialize(HACK.Pid, HACK.Handle) = 0 Then Exit Sub
    
    Dim AllocID As Integer
    If lstScripts.Selected(Item) = True Then
        Call LoadSelectedScript(lstScripts.List(Item))
        If Len(LoadScript) = 0 Then Exit Sub
        Call CEAutoAsm(LoadScript, True, AllocID)
    Else
        Call LoadSelectedScript(lstScripts.List(Item))
        If Len(LoadScript) = 0 Then Exit Sub
        Call CEAutoAsm(LoadScript, False, AllocID)
    End If
    LoadScript = vbNullString
End Sub

'========== Pointer初始化 ==========
Private Sub PointerInitialize()
    SystemBaseAdr = "&H" & ReadData("Pointer", "SystemBaseAdr")
    MpAlarmBaseAdr = "&H" & ReadData("Pointer", "MpAlarmBaseAdr")
    MpAlarmOffest = "&H" & ReadData("Pointer", "MpAlarmOffest")
    HpValueBaseAdr = "&H" & ReadData("Pointer", "HpValueBaseAdr")
    HpValueOffest = "&H" & ReadData("Pointer", "HpValueOffest")
    ChrBaseAdr = "&H" & ReadData("Pointer", "ChrBaseAdr")
    ChrBreathOffest = "&H" & ReadData("Pointer", "ChrBreathOffest")
    RedBaseAdr = MpAlarmBaseAdr + 4
    MonBaseAdr = MpAlarmBaseAdr + 8
End Sub

'========== 個人設定存取 ==========
Private Sub SaneSetting_Click()
    Call WriteIniString("HpMp", "HpSet", txtHpSet)
    Call WriteIniString("HpMp", "HpBot", txtHpBot)
    Call WriteIniString("HpMp", "MpSet", txtMpSet)
    Call WriteIniString("HpMp", "MpBot", txtMpBot)
    Call WriteIniString("Detect", "RedSet", txtRedSet)
    Call WriteIniString("Detect", "MonSet", txtMonSet)
    Call WriteIniString("BotSet", "AttackSet", txtAttackSet)
    Call WriteIniString("BotSet", "AttackBot", txtAttackBot)
    Call WriteIniString("BotSet", "PickSet", txtPickSet)
    Call WriteIniString("BotSet", "PickBot", txtPickBot)
    Call WriteIniString("BotSet", "BotSet1", txtBotSet1)
    Call WriteIniString("BotSet", "Bot1", txtBot1)
    Call WriteIniString("BotSet", "BotSet2", txtBotSet2)
    Call WriteIniString("BotSet", "Bot2", txtBot2)
    Call WriteIniString("BotSet", "BotSet3", txtBotSet3)
    Call WriteIniString("BotSet", "Bot3", txtBot3)
    Call WriteIniString("BotSet", "BotSet4", txtBotSet4)
    Call WriteIniString("BotSet", "Bot4", txtBot4)
    Call WriteIniString("BotSet", "BotSet5", txtBotSet5)
    Call WriteIniString("BotSet", "Bot5", txtBot5)
    Call WriteIniString("BotSet", "BotSet6", txtBotSet6)
    Call WriteIniString("BotSet", "Bot6", txtBot6)
    Call WriteIniString("BotSet", "AtkDownSet", txtAtkDownSet)
    Call WriteIniString("BotSet", "AtkDown", txtAtkDown)
    Call WriteIniString("Detect", "ChR", txtChR)
    Call WriteIniString("Detect", "ChT", txtChT)
    Call WriteIniString("Login", "Delay", txtDelay)
End Sub

Private Sub ReadSetting_Click()
    txtHpSet = ReadIniInt("HpMp", "HpSet")
    txtHpBot = ReadIniString("HpMp", "HpBot")
    txtMpSet = ReadIniInt("HpMp", "MpSet")
    txtMpBot = ReadIniString("HpMp", "MpBot")
    txtRedSet = ReadIniInt("Detect", "RedSet")
    txtMonSet = ReadIniInt("Detect", "MonSet")
    txtAttackSet = ReadIniInt("BotSet", "AttackSet")
    txtAttackBot = ReadIniString("BotSet", "AttackBot")
    txtPickSet = ReadIniInt("BotSet", "PickSet")
    txtPickBot = ReadIniString("BotSet", "PickBot")
    txtBotSet1 = ReadIniInt("BotSet", "BotSet1")
    txtBot1 = ReadIniString("BotSet", "Bot1")
    txtBotSet2 = ReadIniInt("BotSet", "BotSet2")
    txtBot2 = ReadIniString("BotSet", "Bot2")
    txtBotSet3 = ReadIniInt("BotSet", "BotSet3")
    txtBot3 = ReadIniString("BotSet", "Bot3")
    txtBotSet4 = ReadIniInt("BotSet", "BotSet4")
    txtBot4 = ReadIniString("BotSet", "Bot4")
    txtBotSet5 = ReadIniInt("BotSet", "BotSet5")
    txtBot5 = ReadIniString("BotSet", "Bot5")
    txtBotSet6 = ReadIniInt("BotSet", "BotSet6")
    txtBot6 = ReadIniString("BotSet", "Bot6")
    txtAtkDownSet = ReadIniInt("BotSet", "AtkDownSet")
    txtAtkDown = ReadIniString("BotSet", "AtkDown")
    txtChR = ReadIniInt("Detect", "ChR")
    txtChT = ReadIniInt("Detect", "ChT")
    txtDelay = ReadIniInt("Login", "Delay")
End Sub

'========== Label控制 ==========
Private Sub lblBreath_Change()
    lblBreath.Left = (Frame2.Width - lblBreath.Width) / 2
End Sub

Private Sub lblHpMp_Change()
    lblHpMp.Left = (Frame2.Width - lblHpMp.Width) / 2
End Sub

Private Sub lblRedMon_Change()
    lblRedMon.Left = (Frame2.Width - lblRedMon.Width) / 2
End Sub

'========== Pointer功能 ==========
Private Sub TmChrCut_Timer()
    Call HACK.WritePointer(ChrBaseAdr, ChrBreathOffest - 8, 1)
End Sub

Private Sub TmDCCheck_Timer()
    If HACK.ReadLong(ChrBaseAdr) = 0 Then Call RingPst(HACK.hWnd, "Press", "Enter")
End Sub

Private Sub TmLoli_Timer()
    Call HACK.WritePointer(ChrBaseAdr, ChrBreathOffest - &H78, 9)
End Sub

Private Sub TmNoDelay_Timer()
    Call HACK.WritePointer(ChrBaseAdr, ChrBreathOffest + 4, &HFFFFFFFF)
End Sub
'========== 遊戲檢查 ==========
Private Sub TmGameCheck_Timer()
    If Not HACK.ReadPointer(SystemBaseAdr, &H1C) = 0 Then
        TmHpMp.Enabled = 1: TmPointer.Enabled = 1: TmHotKey.Enabled = 1: TmBreath.Enabled = 1
        HACK.hWnd = HACK.ReadPointer(SystemBaseAdr, &H4)
        If CkDcCheck.value = 0 And HACK.ReadLong(ChrBaseAdr) = 0 Then Call RingPst(HACK.hWnd, "Press", "Enter")
    ElseIf FindWindow("#32770", "MapleStory") Then Call PostMessage(FindWindow("#32770", "MapleStory"), WM_CLOSE, 0, 0) ' HACK.CloseGame
    Else
        TmHpMp.Enabled = 0: TmPointer.Enabled = 0: TmHotKey.Enabled = 0: TmBreath.Enabled = 0
        HACK.Pid = 0: HACK.Handle = 0: HACK.Inited = False
        MSBlack = False: BlackMS.Caption = "脫機ON"
        If CkAutoStart.value = 1 Then Call lstBFAccount_DblClick
    End If
End Sub

'========== 按鍵Timer ==========
Private Sub TmAttack_Timer()
    If CkRed.value = 1 And Val(txtRedSet) < RedPoint Then Exit Sub
    If CkMon.value = 1 And Val(txtMonSet) > Monster Then Exit Sub
    Call RingPst(HACK.hWnd, "Press", txtAttackBot)
End Sub

Private Sub TmPick_Timer()
    Call RingPst(HACK.hWnd, "Press", txtPickBot)
End Sub

Private Sub TmBot1_Timer()
    tBot1 = tBot1 - 1
    If tBot1 <= 0 Then Delay (2): Call RingPst(HACK.hWnd, "Press", txtBot1): Sleep (300): Call RingPst(HACK.hWnd, "Press", txtBot1): tBot1 = Val(txtBotSet1)
End Sub

Private Sub TmBot2_Timer()
    tBot2 = tBot2 - 1
    If tBot2 <= 0 Then Delay (2): Call RingPst(HACK.hWnd, "Press", txtBot2): Sleep (300): Call RingPst(HACK.hWnd, "Press", txtBot2): tBot2 = Val(txtBotSet2)
End Sub

Private Sub TmBot3_Timer()
    tBot3 = tBot3 - 1
    If tBot3 <= 0 Then Delay (2): Call RingPst(HACK.hWnd, "Press", txtBot3): Sleep (300): Call RingPst(HACK.hWnd, "Press", txtBot3): tBot3 = Val(txtBotSet3)
End Sub

Private Sub TmBot4_Timer()
    tBot4 = tBot4 - 1
    If tBot4 <= 0 Then Delay (2): Call RingPst(HACK.hWnd, "Press", txtBot4): Sleep (300): Call RingPst(HACK.hWnd, "Press", txtBot4): tBot4 = Val(txtBotSet4)
End Sub

Private Sub TmBot5_Timer()
    tBot5 = tBot5 - 1
    If tBot5 <= 0 Then Delay (2): Call RingPst(HACK.hWnd, "Press", txtBot5): Sleep (300): Call RingPst(HACK.hWnd, "Press", txtBot5): tBot5 = Val(txtBotSet5)
End Sub

Private Sub TmBot6_Timer()
    tBot6 = tBot6 - 1
    If tBot6 <= 0 Then Delay (2): Call RingPst(HACK.hWnd, "Press", txtBot6): Sleep (300): Call RingPst(HACK.hWnd, "Press", txtBot6): tBot6 = Val(txtBotSet6)
End Sub

Private Sub TmAtkDown_Timer()
    If CkRed.value = 1 And Val(txtRedSet) < RedPoint Then Call RingPst(HACK.hWnd, "Up", txtAtkDown): Exit Sub
    If CkMon.value = 1 And Val(txtMonSet) > Monster Then Call RingPst(HACK.hWnd, "Up", txtAtkDown): Exit Sub
    Call RingPst(HACK.hWnd, "Down", txtAtkDown)
    tAtkDown = tAtkDown - 1
    If tAtkDown <= 0 Then Delay (3): Call RingPst(HACK.hWnd, "Press", txtAtkDown): tAtkDown = Val(txtAtkDownSet): Sleep (300)
End Sub
'========== Pointer讀取 ==========
Private Sub TmHpMp_Timer()
    Hp = HACK.ReadPointer(HpValueBaseAdr, HpValueOffest)
    Mp = HACK.ReadPointer(HpValueBaseAdr, HpValueOffest + 4)
    lblHpMp = "Hp:" & Hp & " Mp:" & Mp
    If CkHp = 1 And Hp < Val(txtHpSet) Then RingPst HACK.hWnd, "Press", txtHpBot
    If CkMp = 1 And Mp < Val(txtMpSet) Then RingPst HACK.hWnd, "Press", txtMpBot
End Sub

Private Sub TmPointer_Timer()
    RedPoint = HACK.ReadPointer(RedBaseAdr, &H2C)
    Monster = HACK.ReadPointer(MonBaseAdr, &H24)
    lblRedMon = "紅點:" & RedPoint & " 怪物:" & Monster
    
    Breath = HACK.ReadPointer(ChrBaseAdr, ChrBreathOffest - 4)
    lblBreath = "呼吸值:" & Breath
End Sub

Private Sub TmTalk_Timer()
    Call RingPst(HACK.hWnd, "Press", "Enter")
    Call RingPst(HACK.hWnd, "Press", "Down")
End Sub

'========== 設定鍵控制 ==========
Private Sub txtHpSet_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtMpSet_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtRedSet_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtMonSet_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtAttackSet_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
    If Val(txtAttackSet) > 10000 Then txtAttackSet = 100
End Sub
Private Sub txtPickSet_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
    If Val(txtPickSet) > 10000 Then txtPickSet = 100
End Sub
Private Sub txtBotSet1_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtBotSet2_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtBotSet3_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtBotSet4_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtBotSet5_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtBotSet6_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtAtkDownSet_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtChR_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtChT_KeyPress(KeyAscii As Integer)
    If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
End Sub
Private Sub txtHpBot_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtHpBot, KeyCode)
End Sub
Private Sub txtMpBot_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtMpBot, KeyCode)
End Sub
Private Sub txtAttackBot_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtAttackBot, KeyCode)
End Sub
Private Sub txtPickBot_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtPickBot, KeyCode)
End Sub
Private Sub txtBot1_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtBot1, KeyCode)
End Sub
Private Sub txtBot2_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtBot2, KeyCode)
End Sub
Private Sub txtBot3_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtBot3, KeyCode)
End Sub
Private Sub txtBot4_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtBot4, KeyCode)
End Sub
Private Sub txtBot5_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtBot5, KeyCode)
End Sub
Private Sub txtBot6_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtBot6, KeyCode)
End Sub
Private Sub txtAtkDown_KeyUp(KeyCode As Integer, Shift As Integer)
    Call SetKey(txtAtkDown, KeyCode)
End Sub
'========== HotKey ==========
Private Sub TmHotKey_Timer()
    If Not GetForegroundWindow = HACK.hWnd Then Exit Sub
    If GetKeyState(&H12) < 0 And GetKeyState(&H58) < 0 Then Call CheckValue(CkAttackBot): Sleep (300) 'Alt+X
    If GetKeyState(&H12) < 0 And GetKeyState(&H5A) < 0 Then Call CheckValue(CkPickBot): Sleep (300) 'Alt+Z
End Sub
Private Sub CheckValue(CK As CheckBox)
    If CK.value = 0 Then CK.value = 1 Else: CK.value = 0
End Sub

'========== BeanFun ==========
Private Sub Cmd_Ok_Click()
    On Error GoTo Er
    If Len(txt_User.Text) = 0 Or Len(txt_Pass.Text) = 0 Or Len(txt_Check.Text) = 0 Then Exit Sub
    
    With WebB.Document.Frames.ifmForm1.Document
        .GetElementById("t_AccountID").value = txt_User.Text
        .GetElementById("t_Password").value = txt_Pass.Text
        .GetElementById("CodeTextBox").value = txt_Check.Text
        .GetElementById("btn_login").Click
    End With
    txt_Check.Text = vbNullString
    
    Do: DoEvents: Loop While WebB.Busy
    
    If InStr(WebB.Document.Frames.ifmForm1.Document.GetElementById("DivMsgBoxContainer").innertext, "錯誤") Then
        MsgBox "帳密或驗證碼錯誤", vbInformation, "ERROR"
        WebB.Document.Frames.ifmForm1.Document.GetElementById("MsgBoxOkBtn").Click
        Exit Sub
    End If
    
Er:
    WebB.Navigate "http://tw.new.beanfun.com/game_zone/default.aspx"
End Sub

Private Sub Cmd_ReGet_Click()
    On Error Resume Next
    'WebB.Navigate "http://tw.new.beanfun.com/game_zone/default.aspx"
    'Cmd_Ok.Enabled = False
    'Cmd_ReGet.Enabled = False
    WebB.Document.Frames.ifmForm1.Document.GetElementById("c_login_idpass_form_samplecaptcha_ReloadLink").Click
    Do: DoEvents: Loop Until WebB.ReadyState = READYSTATE_COMPLETE
    Delay (1)
    Call GetImage
End Sub

Private Sub txt_Check_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Cmd_Ok_Click
End Sub

Private Sub Update_Click()
On Error Resume Next
    If Shell("Data自動更新器") Then
        If MsgBox("使用 Data自動更新器 成功後請按下「是」來重新載入", vbYesNo, "更新中") = vbYes Then Call PointerInitialize Else: End
    Else
        MsgBox "自動更新器檔案遺失", vbCritical, "Miss"
    End If
End Sub

Private Sub WebB_DocumentComplete(ByVal pDisp As Object, URL As Variant)
On Error Resume Next
    If InStr(URL, "game_zone") Then
        'Call ClickBtn(WebB, "BF_anchorLoginBtn", "a")
        WebB.Document.GetElementById("BF_anchorLoginBtn").Click
        CheckPic.Cls
        Cmd_Ok.Enabled = 0: Cmd_ReGet.Enabled = 0: txt_Check.Enabled = 0
        WebB.ZOrder
        lblStatue.Caption = "狀態:歡迎使用"
    End If
    
    If InStr(URL, "loginform.aspx") Or InStr(URL, "id-pass_form.aspx") Then
        If ReRun = False Then ReRun = True
        Cmd_Ok.Enabled = 1: Cmd_ReGet.Enabled = 1: txt_Check.Enabled = 1
        Call GetImage
        Frame4.ZOrder
        lblStatue.Caption = "狀態:登入介面"
    End If
    
    If InStr(URL, "logout.aspx") Then
        WebB.ZOrder
        WebB.Navigate "http://tw.new.beanfun.com/game_zone/default.aspx"
    End If

End Sub

Private Sub GetImage()
    On Error GoTo Er
    Dim ctrlRange As Object
    Set ctrlRange = WebB.Document.Frames.ifmForm1.Document.body.createControlRange()
    ctrlRange.Add (WebB.Document.Frames.ifmForm1.Document.GetElementById("c_login_idpass_form_samplecaptcha_CaptchaImage"))
    'ctrlRange.Add (WebB.Document.Frames.ifmForm1.Document.images(1))
    ctrlRange.execCommand ("Copy")
    Delay (1)   '修正剪貼簿無法開啟問題
    CheckPic.Picture = Clipboard.GetData
    Clipboard.Clear
Er:
End Sub

Private Sub LoadAccountList()
    On Error GoTo Er:
    lstAccount.Clear
    
    Dim File As String
    File = Dir(App.Path & "\Account\" & "*.ini")
    
    While Len(File)
        lstAccount.AddItem File
        File = Dir()
    Wend
    
    Exit Sub
Er:
    MsgBox "帳戶讀取錯誤", , "Fail"
End Sub

Private Sub Home_Click()
    WebB.ZOrder
    Call WebB.Navigate("http://tw.new.beanfun.com/game_zone/default.aspx")
    CmdBeanfun_Click
End Sub

Private Sub Login_Click()
    On Error Resume Next
    WebB.ZOrder
    WebB.Navigate "https://tw.newlogin.beanfun.com/logout.aspx?service=999999_T0"
End Sub

Private Sub forcelogun_Click()
    WebB.Stop
    If InStr(WebB.LocationURL, "loginform.aspx") Then
        Call GetImage
        If ReRun = False Then ReRun = True
        Cmd_Ok.Enabled = 1: Cmd_ReGet.Enabled = 1: txt_Check.Enabled = 1
        Frame4.ZOrder
        lblStatue.Caption = "狀態:登入介面"
    ElseIf MsgBox("頁面錯誤！是否強制顯示登入介面？", vbYesNo + vbCritical, "確認") = vbYes Then Frame4.ZOrder
        
    End If
End Sub

Private Sub AddAccount_Click()
    CmdBeanfun_Click
    If Len(txt_User) = 0 Or Len(txt_Pass) = 0 Then Exit Sub
    Dim fileName As String
    fileName = InputBox("請輸入儲存的檔名：" & vbCrLf & "提示：請避免使用帳號作為檔名，儲存後檔案將會加密，不使用帳號為檔名可降低被猜中帳密的機率。", "請輸入檔名", txt_User.Text)
    Call SaveAccount(txt_User, txt_Pass, fileName)
    Call LoadAccountList
End Sub
Private Sub lstAccount_Click()
    txt_User = ReadUserName(lstAccount.List(lstAccount.ListIndex))
    txt_Pass = ReadPassword(lstAccount.List(lstAccount.ListIndex))
End Sub
Private Sub DelAccount_Click()
    CmdBeanfun_Click
    On Error Resume Next
    If MsgBox("是否刪除" & lstAccount.List(lstAccount.ListIndex), vbYesNo, "確認") = vbYes Then
        Kill (Replace(App.Path & "\" & lstAccount.List(lstAccount.ListIndex), "\\", "\"))
        Call LoadAccountList
    End If
End Sub

Private Sub ReAccount_Click()
    Call LoadAccountList
    CmdBeanfun_Click
End Sub

Private Sub ReLoadBeanfun_Click()
    Call Shell("taskkill.exe /im BFWidgetKernel.exe /f", vbHide)
    WebB.Navigate "http://tw.new.beanfun.com/game_zone/default.aspx"
End Sub

Private Sub GotoBeanfun_Click()
    Call Shell("rundll32.exe url.dll,FileProtocolHandler http://tw.new.beanfun.com/game_zone/default.aspx", vbHide)
End Sub
'========== 取得快速列表 ==========
Private Sub CmdGetAccount_Click()
    On Error Resume Next
    
    WebB.Navigate "javascript:BeanFunBlock.WebTrendCounter('DCSext.bf_GameZone','610074T9_StartGame');BeanFunBlock.StartGameByService('610074', 'T9');"
    Do: DoEvents: Loop While WebB.Busy
    Delay (1)
    
    lblStatue.Caption = "狀態:取得帳號列表"
    
    Dim strAccountData As String
    'WebB.Document.GetElementById("BF_btnQuickStart").Click
   ' Delay (1)
    
    'strAccountData = WebB.Document.GetElementById("BF_divPopWindow").Document.GetElementById("BF_BaseList").OuterHtml
    strAccountData = WebB.Document.Frames.fbContent.Document.GetElementById("ulServiceAccountList").innerhtml

    'WebB.Document.GetElementById("BF_btnQuickStart").Click
    
    Dim strAccount() As String
    'strAccount() = Split(strAccountData, "LI onclick=""")
    strAccount() = Split(strAccountData, "LI onclick=""GameAccount.StartGame(")

    lbAccount.Clear
    lstBFAccount.Clear
    
    Dim i As Integer
    For i = 1 To UBound(strAccount)
        'lbAccount.AddItem (Split(strAccount(i), """>")(0))
        'lstBFAccount.AddItem (Split(Split(strAccount(i), "")(1), "
")(0))
        lbAccount.AddItem ("BeanFunBlock.StartGameWithAccountData('610074','T9'," & Split(Split(strAccount(i), "GameAccount"">")(0), ";")(0))
        lstBFAccount.AddItem (Split(Split(strAccount(i), ">")(2), "<")(0))
    Next
    
    If lstBFAccount.ListCount = 0 Then GoTo Er
        lblStatue.Caption = "狀態:列表取得成功"
        WebB.Document.GetElementById("fbClose").Click
    Exit Sub
    
Er:
    MsgBox "網頁正在載入或帳號未登入" & vbCrLf & "P.s 如還是無法解決請至BF首頁查詢", vbInformation, "請稍後在試!"
    WebB.ZOrder
End Sub

Private Sub lstBFAccount_DblClick()
    Call WebB.Navigate("javascript:" & lbAccount.List(lstBFAccount.ListIndex))
'Do: DoEvents: Loop Until WebB.ReadyState = READYSTATE_COMPLETE
    Dim GetCaption As Boolean
    TimeCheck = 10: TmTimeCheck.Enabled = 1
    Do Until GetCaption
        On Error Resume Next
        GetCaption = Len(WebB.Document.GetElementById("fbCaption"))
        lblStatue.Caption = "檢查起始狀態:" & TimeCheck
        If TimeCheck <= 0 Then GoTo Er
        Sleep (300)
        DoEvents
    Loop
    If WebB.Document.Frames.fbContent.Document.GetElementById("lblFriendlyReminder").innertext = "友善提醒" Then
        lblStatue.Caption = "狀態:友情提醒處理中..."
        Delay (7)
        WebB.Document.Frames.fbContent.Document.GetElementById("cbxRemoveServiceFriendlyReminder").Click
        WebB.Document.Frames.fbContent.Document.GetElementById("btnFriendlyReminderOK").Click
    End If
Er:
    TmTimeCheck.Enabled = 0
    If CkAutoStart.value = 1 Then Call StartGame
End Sub
'========== 遊戲啟動 ==========
Private Sub StartGame()
    On Error Resume Next
    TmDCCheck.Enabled = False: HACK.CloseGame
    Delay (1)
    
    TimeCheck = 59: TmTimeCheck.Enabled = 1
    Do Until HACK.Inited
        If TimeCheck <= 0 Then GoTo Er
        lblStatue.Caption = "等待遊戲啟動視窗:" & TimeCheck
        Call HACK.OpenProcessByWindow("MapleStory", "StartUpDlgClass")
        DoEvents
    Loop
    TmTimeCheck.Enabled = 0
    
    If CkPlay.value = 0 Then Call PostMessage(HACK.hWnd, WM_CLOSE, 0, 0)
    
    If WriteInPlay.Checked Then ReAutoASM
    
    TimeCheck = 23: TmTimeCheck.Enabled = 1
    Do While HACK.ReadPointer(SystemBaseAdr, &H4) = 0
        If TimeCheck <= 0 Then GoTo Er
        lblStatue.Caption = "等待視窗初始:" & TimeCheck
        Sleep (900)
        DoEvents
    Loop
    TmTimeCheck.Enabled = 0
    
    TimeCheck = 150: TmTimeCheck.Enabled = 1
    Do While HACK.ReadPointer(SystemBaseAdr, &H1C) = 0
        If TimeCheck <= 0 Or HACK.ReadPointer(SystemBaseAdr, &H4) = 0 Then GoTo Er
        lblStatue.Caption = "等待登入畫面:" & TimeCheck
        Sleep (900)
        DoEvents
    Loop
    TmTimeCheck.Enabled = 0
    
    'Call RingPst(HACK.hWnd, "Press", "Enter") '跳過開場動畫
    lblStatue.Caption = "狀態:啟動完成"
    Delay Val(txtDelay)
    lblStatue.Caption = "狀態:完成延遲"
    Delay (13)
    
    Call CmdLoginMe_Click
    Exit Sub
    
Er:
    lblStatue.Caption = "狀態:啟動失敗"
    Call HACK.CloseGame
    HACK.Pid = 0: HACK.Handle = 0: HACK.hWnd = 0: HACK.Inited = False
End Sub
'========== 角色登入 ==========
Private Sub CmdLoginMe_Click()
    On Error Resume Next
    HACK.hWnd = HACK.ReadPointer(SystemBaseAdr, &H4)
    If HACK.Inited = False Then GoTo Er
    lblStatue.Caption = "狀態:正在登入伺服器"
    Dim i As Integer
    For i = 0 To (21 - lstServer.ListIndex) '登入伺服器
        Call RingPst(HACK.hWnd, "Press", "Tab")
    Next
    Delay (1)
    Call RingPst(HACK.hWnd, "Press", "Enter")
    
    If HACK.ReadPointer(SystemBaseAdr, &H4) = 0 Then GoTo Er
    Delay (1)
    lblStatue.Caption = "狀態:正在登入頻道"
    For i = 1 To lstChannel.ListIndex '登入頻道
        Call RingPst(HACK.hWnd, "Press", "Tab")
    Next
    RingPst HACK.hWnd, "Press", "Enter"
    lblStatue.Caption = "狀態:正在登入延遲"
    Delay Val(txtDelay)
    
    If HACK.ReadPointer(SystemBaseAdr, &H4) = 0 Then GoTo Er
    lblStatue.Caption = "狀態:正在選擇角色"
    For i = 1 To 15 '至最左邊
        Call RingPst(HACK.hWnd, "Press", "Left")
    Next
    For i = 1 To lstChrNum.ListIndex '選擇角色
        Call RingPst(HACK.hWnd, "Press", "Right")
    Next
    Delay (1)
    Call RingPst(HACK.hWnd, "Press", "Enter")
    Call RingPst(HACK.hWnd, "Press", "Enter")
    Call SetWindowPos(HACK.hWnd, -2, 0, 5, 0, 0, &H1)
    Call RingPst(HACK.hWnd, "Press", "Enter")
    
    TimeCheck = 23: TmTimeCheck.Enabled = 1
    Do While HACK.ReadPointer(ChrBaseAdr, ChrBreathOffest + 4) = 0
        If TimeCheck <= 0 Or HACK.ReadPointer(SystemBaseAdr, &H4) = 0 Then GoTo Er
        lblStatue.Caption = "正在檢查登入狀態:" & TimeCheck
        Sleep (900)
        DoEvents
    Loop
    TmTimeCheck.Enabled = 0
    
    lblStatue.Caption = "登入成功，歡迎使用！"
    Call AttachInitialize
    Call SetForegroundWindow(HACK.hWnd)
    Exit Sub
    
Er:
    lblStatue.Caption = "狀態:登入失敗"
    Call HACK.CloseGame
    HACK.Pid = 0: HACK.Handle = 0: HACK.hWnd = 0: HACK.Inited = False
End Sub
'========== 資訊儲存 ==========
Private Sub lstServer_Click()
    Call WriteIniString("Account", "Server", lstServer.ListIndex)
End Sub

Private Sub lstChannel_Click()
    Call WriteIniString("Account", "Channel", lstChannel.ListIndex)
End Sub

Private Sub lstChrNum_Click()
    Call WriteIniString("Account", "ChrNum", lstChrNum.ListIndex)
End Sub

Private Sub CmdReadSet_Click()
    lstServer.ListIndex = ReadIniInt("Account", "Server")
    lstChannel.ListIndex = ReadIniInt("Account", "Channel")
    lstChrNum.ListIndex = ReadIniInt("Account", "ChrNum")
End Sub

Private Sub TmTimeCheck_Timer()
    TimeCheck = TimeCheck - 1 '倒數
End Sub

還有模組...

clsHack.cls：原創作者 Inndy，此為修改版，加入 Je、Jne 函數，刪除 DLLInject 函數（當初是為了改善誤判）

'======================================================================================
'=本Class由秋楓落葉 (Inndy) 撰寫，請隨意使用但勿移除本註解
'================================================================================
'===這裡面有什麼？===============================================================
'================================================================================
'=====OpenProcess部分，統一用Process_All_Access開啟
'=======OpenProcessByWindow                   (FindWindow取得PID並開啟進程)
'=======OpenProcessByProcessName              (例舉進程，根據進程名稱取得PID並開啟)
'=======OpenProcess                           (只需填入PID)
'================================================================================
'=====寫入部分
'=======WriteMemory                           (幾乎等於WriteProcessMemory這條API)
'=======WriteByte、WriteLong、WriteString、WriteCurrency...等寫入函數
'=======WriteAOBByString                      (字串AOB寫入)
'=======WriteMultiPointerByString             (寫入多重指標)
'================================================================================
'=====讀取部份
'=======ReadMemory                            (幾乎等於ReadProcessMemory這條API)
'=======ReadByte、ReadLong、ReadString、ReadCurrency...等讀取函數
'=======ReadMultiPointerByString              (讀取多重指標)
'================================================================================
'====多重Pointer表示式：5A3B08=>460:A8:C
'======================================================================================
Option Explicit
'=====================================SETTING=====================================
Private Const PreAllocSize As Long = &H10000 * 8
'=======================================API=======================================
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcessAPI Lib "kernel32" Alias "OpenProcess" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemoryAPI Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
'Private Declare Function ReadProcessMemoryAPI Lib "kernel32" Alias "ReadProcessMemory" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ZwReadVirtualMemory Lib "ntdll" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function CloseHandleAPI Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
'=====================================Consts======================================
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const MEM_COMMIT = &H1000
Private Const PAGE_READWRITE = &H4
'==================================VarsForClass===================================
Private PreAllocAddress As Long
Private AllocedSize As Long
'======================================Vars=======================================
Public Inited As Boolean
Public hWnd, Handle, Pid As Long

Public Function OpenProcess(Optional ByVal lpPID As Long = -1) As Long
    If lpPID = 0 And Pid = 0 Then Exit Function
    'If lpPID > 0 And Pid = 0 Then Pid = lpPID
    If lpPID > 0 Then Pid = lpPID
    Handle = OpenProcessAPI(PROCESS_ALL_ACCESS, False, Pid)
    OpenProcess = Handle
    If Handle > 0 Then Inited = True
End Function

Public Function OpenProcessByWindow(ByVal lpWindowName As String, Optional ByVal lpClassName As String = vbNullString) As Long
    hWnd = FindWindow(lpClassName, lpWindowName)
    GetWindowThreadProcessId hWnd, Pid
    OpenProcessByWindow = OpenProcess
End Function

Public Function CloseHandle() As Long
    If Not Inited Then Exit Function
    CloseHandle = CloseHandleAPI(Handle)
    Handle = 0
    hWnd = 0
    Pid = 0
    Inited = False
End Function

Public Function CloseGame() As Long
    If Not Inited Then Exit Function
    CloseGame = TerminateProcess(Handle, 0&)
    CloseHandle
    Handle = 0
    Pid = 0
    hWnd = 0
End Function

Public Function ChangeImagePath(Optional ByVal lpImagePath As String = "C:\WINDOWS\system32\taskmgr.exe") As Long
    Static BeUsed As Boolean
    If BeUsed = False Then
        Dim hProcess As Long
        hProcess = OpenProcessAPI(PROCESS_ALL_ACCESS, 0, GetCurrentProcessId)
        If hProcess = 0 Then Exit Function
        Dim sLenth As Long
        Dim BaseAddress As Long
        sLenth = LenB(lpImagePath) + 1 + 26
        BaseAddress = VirtualAllocEx(hProcess, ByVal 0&, ByVal sLenth, MEM_COMMIT, PAGE_READWRITE)
        If BaseAddress = 0 Then Exit Function
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 0, ByVal VarPtr(&H30058B64), 4, False
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 4, ByVal VarPtr(&H8B000000), 4, False
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 8, ByVal VarPtr(&HC0831040), 4, False
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 12, ByVal VarPtr(&H245C8B3C), 4, False
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 16, ByVal VarPtr(&H89188904), 4, False
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 20, ByVal VarPtr(&HC2042444), 4, False
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 24, ByVal VarPtr(&H10), 2, False
        WriteProcessMemoryAPI hProcess, ByVal BaseAddress + 26, ByVal StrPtr(lpImagePath), sLenth, False
        CloseHandleAPI hProcess
        CallWindowProc BaseAddress, BaseAddress + 26, 0, 0, 0
        BeUsed = True
        ChangeImagePath = BaseAddress
    End If
End Function

Public Function WriteMemory(ByVal lpAddress As Long, ByVal lpBuffer As Long, ByVal lpSize As Long) As Long
WriteMemory = WriteProcessMemoryAPI(Handle, ByVal lpAddress, ByVal lpBuffer, ByVal lpSize, False)
End Function

Public Function WriteByte(ByVal lpAddress As Long, ByVal lpValue As Byte) As Long
    WriteByte = WriteProcessMemoryAPI(Handle, ByVal lpAddress, ByVal VarPtr(lpValue), ByVal LenB(lpValue), False)
End Function

Public Function WriteLong(ByVal lpAddress As Long, ByVal lpValue As Long) As Long
    WriteLong = WriteProcessMemoryAPI(Handle, ByVal lpAddress, ByVal VarPtr(lpValue), ByVal LenB(lpValue), False)
End Function

Public Function WriteString(ByVal lpAddress As Long, ByVal lpValue As String) As Long
    WriteString = WriteProcessMemoryAPI(Handle, ByVal lpAddress, ByVal VarPtr(lpValue), ByVal LenB(lpValue), False)
End Function

Public Function WriteAOBByString(ByVal lpAddress As Long, ByVal lpAobString As String) As Long
    Dim WriteI As Integer
    Dim WriteStr() As String
    Dim WriteBuff() As Byte
    lpAobString = Trim(lpAobString)
    WriteStr() = Split(lpAobString, " ")
    ReDim WriteBuff(UBound(WriteStr))
    For WriteI = 0 To UBound(WriteStr)
        WriteBuff(WriteI) = (Val("&H" + WriteStr(WriteI)))
    Next WriteI
    WriteAOBByString = WriteProcessMemoryAPI(Handle, ByVal lpAddress, ByVal VarPtr(WriteBuff(0)), UBound(WriteBuff) + 1, 0&)
End Function

Public Function WritePointer(ByVal lpAddress As Long, ByVal lpOffset As Long, ByVal lpValue As Long) As Long
    WritePointer = WriteLong(ReadLong(lpAddress) + lpOffset, lpValue)
End Function

Public Function WriteMultiPointerByString(ByVal lpPointerList As String, ByVal lpBuffer As Long, ByVal lpSize As Long) As Long
'HACK.WriteMultiPointerByString "5A3B08=>460:A8:0", VarPtr(Gold), 4
    Dim PointerList() As String
    Dim tmp1, tmp2, i As Long
    tmp1 = Val("&H" & Split(lpPointerList, "=>")(0))
    PointerList = Split(Split(lpPointerList, "=>")(1), ":")
    For i = 0 To UBound(PointerList)
        tmp2 = ReadLong(tmp1) + Val("&H" & PointerList(i))
        tmp1 = tmp2
    Next
    tmp2 = WriteMemory(tmp1, lpBuffer, lpSize)
    WriteMultiPointerByString = tmp2
End Function

Public Function ReadMemory(ByVal lpAddress As Long, ByVal lpBuffer As Long, ByVal lpSize As Long) As Long
ReadMemory = ZwReadVirtualMemory(Handle, ByVal lpAddress, ByVal lpBuffer, ByVal lpSize, False)
End Function

Public Function ReadLong(ByVal lpAddress As Long) As Long
    Dim value As Long
    ZwReadVirtualMemory Handle, ByVal lpAddress, ByVal VarPtr(value), ByVal 4, False
    ReadLong = value
End Function

Public Function ReadDouble(ByVal lpAddress As Long) As Double
    Dim value As Double
    ZwReadVirtualMemory Handle, ByVal lpAddress, ByVal VarPtr(value), ByVal 8, False
    ReadDouble = value
End Function

Public Function ReadString(ByVal lpAddress As Long, ByVal lpSize As Long) As String
    Dim value As String
    value = Space(lpSize)
    ZwReadVirtualMemory Handle, ByVal lpAddress, ByVal StrPtr(value), ByVal lpSize, False
    ReadString = value
    value = ""
End Function

Public Function ReadPointer(ByVal lpAddress As Long, ByVal lpOffset As Long) As Long
    ReadPointer = ReadLong(ReadLong(lpAddress) + lpOffset)
End Function

Public Function ReadMultiPointerByString(ByVal lpPointerList As String, ByVal lpBuffer As Long, ByVal lpSize As Long) As Long
'HACK.ReadMultiPointerByString "5A3B08=>460:A8:C", VarPtr(Gold), 4
    Dim PointerList() As String
    Dim tmp1, tmp2, i As Long
    tmp1 = Val("&H" & Split(lpPointerList, "=>")(0))
    PointerList = Split(Split(lpPointerList, "=>")(1), ":")
    For i = 0 To UBound(PointerList)
        tmp2 = ReadLong(tmp1) + Val("&H" & PointerList(i))
        tmp1 = tmp2
    Next
    tmp2 = ReadMemory(tmp1, lpBuffer, lpSize)
    ReadMultiPointerByString = tmp2
End Function

Public Function Alloc(ByVal lpSize As Long, Optional ByVal lpAddress As Long = 0) As Long
    If Not Inited Then Exit Function
    If PreAllocAddress = 0 Then
        PreAllocAddress = VirtualAllocEx(Handle, ByVal lpAddress, ByVal PreAllocSize, MEM_COMMIT, PAGE_READWRITE)
    End If
    If lpSize > (PreAllocSize / 4) Then '大於1/4的預先申請空間，就另外申請
        Alloc = VirtualAllocEx(Handle, ByVal lpAddress, ByVal lpSize, MEM_COMMIT, PAGE_READWRITE)
        Exit Function
    End If
    If lpSize + AllocedSize > PreAllocSize Then '申請空間會超出預先申請空間時，多申請一些空間
        PreAllocAddress = VirtualAllocEx(Handle, ByVal lpAddress, ByVal PreAllocSize, MEM_COMMIT, PAGE_READWRITE)
        AllocedSize = 0
    End If
    Alloc = PreAllocAddress + AllocedSize
    AllocedSize = AllocedSize + lpSize
End Function

Public Function MakeJmp(ByVal lpAddress As Long, ByVal lpJmpAddress As Long, Optional ByVal lpNops As Long = 0) As Long
    MakeJmp = CBool(WriteByte(lpAddress, &HE9)) And CBool(WriteLong(lpAddress + 1, lpJmpAddress - lpAddress - 5))
    If lpNops = 0 Then Exit Function
    MakeJmp = MakeJmp And CBool(MakeNops(lpAddress + 5, lpNops))
End Function

Public Function MakeCall(ByVal lpAddress As Long, ByVal lpCallAddress As Long, Optional ByVal lpNops As Long = 0) As Long
    MakeCall = CBool(WriteByte(lpAddress, &HE8)) And CBool(WriteLong(lpAddress + 1, lpCallAddress - lpAddress - 5))
    If lpNops = 0 Then Exit Function
    MakeCall = MakeCall And CBool(MakeNops(lpAddress + 5, lpNops))
End Function

Public Function MakeNops(ByVal lpAddress As Long, ByVal lpSize As Long) As Long
    If lpSize = 0 Then
        MakeNops = True
        Exit Function
    End If
    Dim NOP() As Byte
    ReDim NOP(lpSize)
    Dim i As Long
    For i = 0 To lpSize - 1
        NOP(i) = &H90
    Next
    MakeNops = WriteMemory(lpAddress, VarPtr(NOP(0)), lpSize)
End Function

Public Function Address2Aob(ByVal Address As Long) As String
    Dim tmpAOB As String, reAOB As String, i As Integer
    tmpAOB = Hex(Address)
    For i = 1 To 7
        If (i Mod 2) = 1 Then reAOB = Mid(tmpAOB, i, 2) & " " & reAOB
    Next
    Address2Aob = Chr(32) & Trim(reAOB) & Chr(32)
End Function

Public Function asm_Je(ByVal FromAdd As Long, ByVal TargetAdd As Long) As String
    Dim jneAdd As String, reAOB As String, i As Integer
    jneAdd = Hex(TargetAdd - (FromAdd + 6))
    For i = 1 To 7
        If (i Mod 2) = 1 Then reAOB = Mid(jneAdd, i, 2) & " " & reAOB
    Next
    asm_Je = Chr(32) & Trim(reAOB) & Chr(32)
End Function

Public Function asm_Jne(ByVal FromAdd As Long, ByVal TargetAdd As Long) As String
    Dim jneAdd As String, reAOB As String, i As Integer
    jneAdd = Hex(TargetAdd - (FromAdd + 6))
    For i = 1 To 7
        If (i Mod 2) = 1 Then reAOB = Mid(jneAdd, i, 2) & " " & reAOB
    Next
    asm_Jne = Chr(32) & Trim(reAOB) & Chr(32)
End Function

modPst.bas：我也不大清楚這是誰源創的，已經流傳很久的後台腳本... 有加入一些 KeyCode...

Public opIndex As Long
Public OpCode() As Byte
Dim hModuleNoFree As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpDllName As String) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpDest As Any, ByVal lpSource As Any, ByVal cBytes As Long)
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Integer

Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Public Const WM_CLOSE = &H10

Public Function RingPst(Handle As Long, KeyType As String, KeyCode As String)
Dim KeyValue As Long
KeyValue = 0 '
'判斷按鍵並轉換成code
If KeyCode = "`" Then KeyValue = &HE5
If KeyCode = "Esc" Then KeyValue = &H1B
If KeyCode = "Left" Then KeyValue = &H25
If KeyCode = "Up" Then KeyValue = &H26
If KeyCode = "Right" Then KeyValue = &H27
If KeyCode = "Down" Then KeyValue = &H28
If KeyCode = "Enter" Then KeyValue = &HD
If KeyCode = "Tab" Then KeyValue = &H9
If KeyCode = "Shift" Then KeyValue = &H10
If KeyCode = "Ctrl" Then KeyValue = &H11
If KeyCode = "Alt" Then KeyValue = &H12
If KeyCode = "Space" Then KeyValue = &H20
If KeyCode = "PageUp" Then KeyValue = &H21
If KeyCode = "PageDown" Then KeyValue = &H22
If KeyCode = "End" Then KeyValue = &H23
If KeyCode = "Home" Then KeyValue = &H24
If KeyCode = "Insert" Then KeyValue = &H2D
If KeyCode = "Delete" Then KeyValue = &H2E
If KeyCode = "0" Then KeyValue = &H30
If KeyCode = "1" Then KeyValue = &H31
If KeyCode = "2" Then KeyValue = &H32
If KeyCode = "3" Then KeyValue = &H33
If KeyCode = "4" Then KeyValue = &H34
If KeyCode = "5" Then KeyValue = &H35
If KeyCode = "6" Then KeyValue = &H36
If KeyCode = "7" Then KeyValue = &H37
If KeyCode = "8" Then KeyValue = &H38
If KeyCode = "9" Then KeyValue = &H39
If KeyCode = "A" Then KeyValue = &H41
If KeyCode = "B" Then KeyValue = &H42
If KeyCode = "C" Then KeyValue = &H43
If KeyCode = "D" Then KeyValue = &H44
If KeyCode = "E" Then KeyValue = &H45
If KeyCode = "F" Then KeyValue = &H46
If KeyCode = "G" Then KeyValue = &H47
If KeyCode = "H" Then KeyValue = &H48
If KeyCode = "I" Then KeyValue = &H49
If KeyCode = "J" Then KeyValue = &H4A
If KeyCode = "K" Then KeyValue = &H4B
If KeyCode = "L" Then KeyValue = &H4C
If KeyCode = "M" Then KeyValue = &H4D
If KeyCode = "N" Then KeyValue = &H4E
If KeyCode = "O" Then KeyValue = &H4F
If KeyCode = "P" Then KeyValue = &H50
If KeyCode = "Q" Then KeyValue = &H51
If KeyCode = "R" Then KeyValue = &H52
If KeyCode = "S" Then KeyValue = &H53
If KeyCode = "T" Then KeyValue = &H54
If KeyCode = "U" Then KeyValue = &H55
If KeyCode = "V" Then KeyValue = &H56
If KeyCode = "W" Then KeyValue = &H57
If KeyCode = "X" Then KeyValue = &H58
If KeyCode = "Y" Then KeyValue = &H59
If KeyCode = "Z" Then KeyValue = &H5A
If KeyCode = "F1" Then KeyValue = &H70
If KeyCode = "F2" Then KeyValue = &H71
If KeyCode = "F3" Then KeyValue = &H72
If KeyCode = "F4" Then KeyValue = &H73
If KeyCode = "F5" Then KeyValue = &H74
If KeyCode = "F6" Then KeyValue = &H75
If KeyCode = "F7" Then KeyValue = &H76
If KeyCode = "F8" Then KeyValue = &H77
If KeyCode = "F9" Then KeyValue = &H78
If KeyCode = "F10" Then KeyValue = &H79
If KeyCode = "F11" Then KeyValue = &H7A
If KeyCode = "F12" Then KeyValue = &H7B
If KeyCode = "None" Then Exit Function

'判斷按件格式
Select Case KeyType
    Case "Press" '按下彈起
        rundll32 "user32", "PostMessageA", Handle, &H100, KeyValue, MakeKeyLparam(KeyValue, &H100)
        rundll32 "user32", "PostMessageA", Handle, &H101, KeyValue, MakeKeyLparam(KeyValue, &H101)
    Case "Down" '按下
        rundll32 "user32", "PostMessageA", Handle, &H100, KeyValue, MakeKeyLparam(KeyValue, &H100)
    Case "Up" '彈起
        rundll32 "user32", "PostMessageA", Handle, &H101, KeyValue, MakeKeyLparam(KeyValue, &H101)
End Select

End Function

Function MakeKeyLparam(ByVal VirtualKey As Long, ByVal flag As Long) As Long
'參數VirtualKey表示按鍵虛擬碼,flag表示是按下鍵還是釋放鍵，用WM_KEYDOWN和WM_KEYUP這兩個常數表示
Dim s As String
Dim Firstbyte As String 'lparam參數的24-31位
If flag = WM_KEYDOWN Then '如果是按下鍵
Firstbyte = "00"
Else
Firstbyte = "C0" '如果是釋放鍵
End If
Dim Scancode As Long
'獲得鍵的掃描碼
Scancode = MapVirtualKey(VirtualKey, 0)
Dim Secondbyte As String 'lparam參數的16-23位元，即虛擬鍵掃描碼
Secondbyte = Right("00" & Hex(Scancode), 2)
s = Firstbyte & Secondbyte & "0001" '0001為lparam參數的0-15位，即發送次數和其他擴展資訊
MakeKeyLparam = Val("&H" & s)
End Function

Public Sub AddByteToCode(bData As Byte)
    OpCode(opIndex) = bData
    opIndex = opIndex + 1
End Sub
Public Sub AddLongToCode(lData As Long)
    CopyMemory VarPtr(OpCode(opIndex)), VarPtr(lData), 4
    opIndex = opIndex + 4
End Sub

'將Integer型態的變數寫到OpCode種
Public Sub AddIntToCode(iData As Byte)
    CopyMemory VarPtr(OpCode(opIndex)), VarPtr(iData), 2
    opIndex = opIndex + 2
End Sub
Public Function RunDll32NoFree(LibFileName As String, ProcName As String, ParamArray Params()) As Long
Dim hProc As Long
Dim hModule As Long

Dim i As Long, CodeStar As Long
ReDim OpCode(400 + 6 * UBound(Params)) '保留用來寫OPCODE
'讀取模組
If hModuleNoFree <> 0 Then
    hModule = hModuleNoFree
Else
    hModule = LoadLibrary(ByVal LibFileName)
    If hModule = 0 Then
        MsgBox "Library讀取失敗"
        Exit Function
    End If
    hModuleNoFree = hModule
End If

'取得函數位址
hProc = GetProcAddress(hModule, ByVal ProcName)
If hProc = 0 Then
   MsgBox "函數讀取失敗", vbCritical
   FreeLibrary hModule
   Exit Function
End If

'---以下為Assembly--

'程式起始位址必須是16的倍數
CodeStar = (VarPtr(OpCode(0)) Or &HF) + 1

opIndex = CodeStar - VarPtr(OpCode(0)) '程式開始的元素位置

'前端部份以中斷點填滿
For i = 0 To opIndex - 1
    OpCode(i) = &HCC 'int 3
Next

'--------以下開始放入所需的程式----------

'將參數push到堆疊
'由於是STDCall CALL 參數由最後一個開始放到堆疊
For i = UBound(Params) To 0 Step -1
   AddByteToCode &H68 'push
   AddLongToCode CLng(Params(i))  '參數位址
Next i

'call hProc
AddByteToCode &HE8 'call
AddLongToCode hProc - VarPtr(OpCode(opIndex)) - 4 '函數位址 用call的定址

'-----------結束所需的程式--------------

'返回呼叫函數
AddByteToCode &HC2 'ret 10h
AddByteToCode &H10
AddByteToCode &H0

'執行剛剛寫完的Assembly Code
RunDll32NoFree = CallWindowProc(CodeStar, 0, 1, 2, 3)

'FreeLibrary hModule '釋放模組
End Function

Public Function rundll32(LibFileName As String, ProcName As String, ParamArray Params()) As Long
Dim hProc As Long
Dim hModule As Long

Dim i As Long, CodeStar As Long
ReDim OpCode(400 + 6 * UBound(Params)) '保留用來寫OPCODE
'讀取模組
hModule = LoadLibrary(ByVal LibFileName)
If hModule = 0 Then
    MsgBox "Library讀取失敗"
    Exit Function
End If

'取得函數位址
hProc = GetProcAddress(hModule, ByVal ProcName)
If hProc = 0 Then
   MsgBox "函數讀取失敗", vbCritical
   FreeLibrary hModule
   Exit Function
End If

'---以下為Assembly--

'程式起始位址必須是16的倍數
CodeStar = (VarPtr(OpCode(0)) Or &HF) + 1

opIndex = CodeStar - VarPtr(OpCode(0)) '程式開始的元素位置

'前端部份以中斷點填滿
For i = 0 To opIndex - 1
    OpCode(i) = &HCC 'int 3
Next

'--------以下開始放入所需的程式----------

'將參數push到堆疊
'由於是STDCall CALL 參數由最後一個開始放到堆疊
For i = UBound(Params) To 0 Step -1
   AddByteToCode &H68 'push
   AddLongToCode CLng(Params(i))  '參數位址
Next i

'call hProc
AddByteToCode &H68  '// push
AddLongToCode VarPtr(OpCode(opIndex)) + 5 + 4 + 5

'// add 5 bytes
AddByteToCode &H8B
AddByteToCode &HFF  '// mov edi,edi
AddByteToCode &H55  '// push ebp
AddByteToCode &H8B
AddByteToCode &HEC  '// mov ebp,esp

AddByteToCode &HE9
AddLongToCode hProc - VarPtr(OpCode(opIndex)) + 1 '函數位址 用call的定址

'AddByteToCode &HE8 'call
'AddLongToCode hProc - VarPtr(OpCode(opIndex)) - 4 '函數位址 用call的定址

'-----------結束所需的程式--------------

'返回呼叫函數
AddByteToCode &HC2 'ret 10h
AddByteToCode &H10
AddByteToCode &H0

'執行剛剛寫完的Assembly Code
rundll32 = CallWindowProc(CodeStar, 0, 1, 2, 3)

FreeLibrary hModule '釋放模組
End Function

Public Function RunDll32Add5(LibFileName As String, ProcName As String, ParamArray Params()) As Long
Dim hProc As Long
Dim hModule As Long

Dim i As Long, CodeStar As Long
ReDim OpCode(400 + 6 * UBound(Params)) '保留用來寫OPCODE
'讀取模組
hModule = LoadLibrary(ByVal LibFileName)
If hModule = 0 Then
    MsgBox "Library讀取失敗"
    Exit Function
End If

'取得函數位址
hProc = GetProcAddress(hModule, ByVal ProcName)
If hProc = 0 Then
   MsgBox "函數讀取失敗", vbCritical
   FreeLibrary hModule
   Exit Function
End If

'---以下為Assembly--

'程式起始位址必須是16的倍數
CodeStar = (VarPtr(OpCode(0)) Or &HF) + 1

opIndex = CodeStar - VarPtr(OpCode(0)) '程式開始的元素位置

'前端部份以中斷點填滿
For i = 0 To opIndex - 1
    OpCode(i) = &HCC 'int 3
Next

'--------以下開始放入所需的程式----------

'將參數push到堆疊
'由於是STDCall CALL 參數由最後一個開始放到堆疊
For i = UBound(Params) To 0 Step -1
   AddByteToCode &H68 'push
   AddLongToCode CLng(Params(i))  '參數位址
Next i

'call hProc
AddByteToCode &H68  '// push
AddLongToCode VarPtr(OpCode(opIndex)) + 5 + 4 + 5

'// add 5 bytes
AddByteToCode &H8B
AddByteToCode &HFF  '// mov edi,edi
AddByteToCode &H55  '// push ebp
AddByteToCode &H8B
AddByteToCode &HEC  '// mov ebp,esp

AddByteToCode &HE9
AddLongToCode hProc - VarPtr(OpCode(opIndex)) + 1 '函數位址 用call的定址

'AddByteToCode &HE8 'call
'AddLongToCode hProc - VarPtr(OpCode(opIndex)) - 4 '函數位址 用call的定址

'-----------結束所需的程式--------------

'返回呼叫函數
AddByteToCode &HC2 'ret 10h
AddByteToCode &H10
AddByteToCode &H0

'執行剛剛寫完的Assembly Code
RunDll32Add5 = CallWindowProc(CodeStar, 0, 1, 2, 3)

FreeLibrary hModule '釋放模組
End Function

Module1.bas：一些雜亂的副程式、函數：加密法、按鍵判斷、Ini 設定檔讀寫...

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long

Public Sub SetKey(Text As TextBox, KeyCode As Integer)
Select Case KeyCode
Case 16
Text = "Shift"
Case 17
Text = "Ctrl"
Case 18
Text = "Alt"
Case 33
Text = "PageUp"
Case 34
Text = "PageDown"
Case 35
Text = "End"
Case 36
Text = "Home"
Case 38
Text = "Up"
Case 40
Text = "Down"
Case 45
Text = "Insert"
Case 46
Text = "Delete"
Case 48 To 57
Text = Chr(KeyCode)
Case 65 To 90
Text = Chr(KeyCode)
Case Else
Text = "None"
End Select
End Sub
Public Sub Delay(ByVal Sec As Single)
Dim sgnThisTime As Single, sgnCount As Single
sgnThisTime = Timer
Do While sgnCount < Sec
 sgnCount = Timer - sgnThisTime
 DoEvents
Loop
End Sub
Public Sub WriteIniString(ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String)
Call WritePrivateProfileString(lpApplicationName, lpKeyName, lpString, App.Path & "\Setting.ini")
End Sub

Public Function ReadIniString(ByVal lpApplicationName, ByVal lpKeyName As String) As String
Dim Out As String * 50
GetPrivateProfileString lpApplicationName, lpKeyName, "按鍵設定", Out, 50, App.Path & "\Setting.ini"
ReadIniString = Out
End Function

Public Function ReadIniInt(ByVal lpApplicationName, ByVal lpKeyName As String) As Integer
ReadIniInt = GetPrivateProfileInt(lpApplicationName, lpKeyName, 100, App.Path & "\Setting.ini")
End Function

Public Function ReadData(ByVal lpApplicationName, ByVal lpKeyName As String) As String
Dim Out As String * 50
GetPrivateProfileString lpApplicationName, lpKeyName, 0, Out, 50, App.Path & "\Data.ini"
ReadData = Out
End Function

Public Sub SaveAccount(ByVal lpUserName As String, ByVal lpPassword As String, ByVal lpFileName As String)
Call WritePrivateProfileString("Account", "User", Encryption(lpUserName), App.Path & "\Account\" & lpFileName & ".ini")
Call WritePrivateProfileString("Account", "Pass", Encryption(lpPassword), App.Path & "\Account\" & lpFileName & ".ini")
End Sub

Public Function ReadUserName(ByVal lpFileName As String) As String
Dim UserName As String * 50
GetPrivateProfileString "Account", "User", Chr(0), UserName, 50, App.Path & "\Account\" & lpFileName
ReadUserName = Decryption(UserName)
End Function

Public Function ReadPassword(ByVal lpFileName As String) As String
Dim UserName As String * 50
GetPrivateProfileString "Account", "Pass", Chr(0), UserName, 50, App.Path & "\Account\" & lpFileName
ReadPassword = Decryption(UserName)
End Function

'加密函數
Public Function Encryption(str As String, Optional ByVal pwd As String = "KNowlet3389") As String
Dim cipher_text As String
Const MIN_ASC = 32  '
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1

Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer

    offset = NumericPassword(pwd)
    Rnd -1
    Randomize offset

    str_len = Len(str)
    For i = 1 To str_len
        ch = Asc(Mid$(str, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch + offset) Mod NUM_ASC)
            ch = ch + MIN_ASC
            cipher_text = cipher_text & Chr$(ch)
        End If
    Next i
    
    Encryption = cipher_text
End Function


'解密函數
Public Function Decryption(str As String, Optional ByVal pwd As String = "KNowlet3389") As String
    Dim plain_text As String
    Const MIN_ASC = 32  ' Space.
    Const MAX_ASC = 126 ' ~.
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1
    
    Dim offset As Long
    Dim str_len As Integer
    Dim i As Integer
    Dim ch As Integer
        offset = NumericPassword(pwd)
        Rnd -1
        Randomize offset
        str_len = Len(str)
        For i = 1 To str_len
            ch = Asc(Mid$(str, i, 1))
            If ch >= MIN_ASC And ch <= MAX_ASC Then
                ch = ch - MIN_ASC
                offset = Int((NUM_ASC + 1) * Rnd)
                ch = ((ch - offset) Mod NUM_ASC)
                If ch < 0 Then ch = ch + NUM_ASC
                ch = ch + MIN_ASC
                plain_text = plain_text & Chr$(ch)
            End If
        Next i
        Decryption = plain_text
End Function


Private Function NumericPassword(ByVal Password As String) As Long
Dim value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer

    str_len = Len(Password)
    For i = 1 To str_len

        ch = Asc(Mid$(Password, i, 1))
        value = value Xor (ch * 2 ^ shift1)
        value = value Xor (ch * 2 ^ shift2)

        shift1 = (shift1 + 7) Mod 19
        shift2 = (shift2 + 13) Mod 23
    Next i
    NumericPassword = value
End Function

不知道有沒有漏貼什麼，總之專案點此下載：Google
歡迎有需要者拿去參考，可是不要名字改一改拿去賣之類的喔 XD

留言

米米粒2013年8月17日上午11:13
學程式設計這條路是非常艱辛...
本人我也僅是個業餘...
看蔥大一路下來的過程...
真的感到佩服^_^
回覆刪除
回覆
BobyHD2013年8月19日凌晨1:18
大大您的樂豆搜尋帳號列表搜尋不到喔 <(_ _)>
回覆刪除
回覆
米米粒2013年8月19日晚上10:16
站長~

請問你的code這段是如何用的@@

我怎都用不出來....
回覆刪除
回覆
ewfwe2013年8月20日下午2:25
對我這這些不會地來說已經是很厲害了
感謝大大的分享
回覆刪除
回覆
Unknown2014年6月27日晚上8:31
站長您好
我目前正學習Java和C# java已經考到了 SE 得證照了所以這兩個物件導向都還算蠻熟了還在專研中
現在想說難得學了這些當年覺得高攀不起的外掛這些希望能嘗試看看
但現在苦於不知該從何處開始下手
我對外掛的了解大概只知道他是改封包數據這些
可以詳細一點說明一下外掛的原理嗎
讓我可以有個頭開始努力
回覆刪除
回覆
Unknown2014年8月21日下午4:12
可以貼Vb.net的原碼嗎?
回覆刪除
回覆
UM2015年1月26日凌晨1:25
恩想請教蔥大一個問題@@
因為有很長一段時間沒碰MS了
發現有DLL注入然後才把GUI顯示出來
跟普通寫成EXE開啟直接鎖定會有差嗎?@@?
回覆刪除
回覆

新增留言

搜尋此網誌

KNowlet 技術の休閒

[開源] 新楓之谷洋蔥（OpenSource MSOnion for NewBF）

留言

張貼留言

本月最夯

[低調] SauceNAO 以圖搜圖輕鬆找出原繪師（Pixiv Only）

偷用電腦，怎知？事件檢視器全記錄！（開機時間、啟動項時間...）

[Chrome] 不用任何擴充功能，Chrome 內建開發者工具讓您輕鬆下載任何影片！