主界面.frm

F:梦幻西游自动跑商开发

    Pckit As PointAPI
End Type
Private Type BussMan '商人的坐标
    胖子Maps As PointAPI
    瘦子Maps As PointAPI
    胖子Scrn As PointAPI
    瘦子Scrn As PointAPI
End Type
Private NeedBuyGood As Goods, WinPlace As WINDOWPLACEMENT, 当前Maps As String, PzSz(5) As BussMan, Now胖瘦 As String, Level As Long, YPstrs As String
Private 佛珠 As Goods, 纸扇 As Goods, 刀 As Goods, 帽子 As Goods, 酒 As Goods, 蜡烛 As Goods, 面粉 As Goods, 鹿茸 As Goods, 符 As Goods, 人参 As Goods, 铜油 As Goods, 铃铛 As Goods, 纸钱 As Goods, 项链 As Goods, 夜明珠 As Goods
Dim 商人YesNo As Boolean, Str1 As String, Str2 As String, LinShiP As PointAPI, Packet(20) As PointAPI, YinPiao As Long
Dim Cn As ADODB.Connection, Rs As ADODB.Recordset, Rcs As ADODB.Recordset, 登陆Point(5) As PointAPI, 帮派BaiHu(10) As PointAPI
Dim 进出帮派Point(10) As PointAPI, 进RBG1(12) As String, 进RBG2(12) As String, 进RBG3(12) As String, 出Point1(12) As PointAPI, 出Point2(12) As PointAPI, 出Point3(12) As PointAPI
Dim 出Screen1(12) As PointAPI, 出Screen2(12) As PointAPI, 出Screen3(12) As PointAPI
Private Sub MHXY_DLU() '梦幻西游登陆部分
Do Until SetForegroundWindow(FindWindow(vbNullString, Str1))
Loop
MoveToP 登陆Point(1), 5 '登陆Ponit(i) 是梦幻主界面的登陆坐标
    MouseLD
MoveToP 登陆Point(2), 5
Sleep 2000
MlD 2
MoveToP 登陆Point(3), 5
Sleep 2000
    MouseLD
    ZH_InPut
MoveToP 登陆Point(4), 5
Sleep 3000
MlD 2
End Sub

Private Sub ZH_InPut() '梦幻西游帐号输入部分，现在可以处理的特殊字符只有，“_!@#$%^&*()_+=”并且只支持小写字母。
KeyPress Lbl_Name.Caption
KeyPressEnter
KeyPress Lbl_Pswd.Caption
KeyPressEnter
End Sub

Private Sub Command1_Click() '登陆梦幻西游
If FindWindow(vbNullString, Str1) <> 0 Then
    SetForegroundWindow FindWindow(vbNullString, Str1)
    MHXY_DLU
Else
    ChDrive Mid(梦幻西游默认路径.Caption, 1, 1)
    ChDir Mid(梦幻西游默认路径.Caption, 1, InStrRev(梦幻西游默认路径.Caption, "\", Len(梦幻西游默认路径.Caption)))
    Shell 梦幻西游默认路径.Caption, vbNormalFocus
    ChDrive Mid(App.Path, 1, 1)
    MHXY_DLU
End If
End Sub

Private Sub Command2_Click()
If Text3.Text = "" Then
ZDPaoSHang 50000, "长安城"
Text3.Text = ""
Else
ZDPaoSHang 50000, Text3.Text
End If
Picture1_Click
End Sub

Function BeforeWindow() As String '获取前台窗口的文本
BeforeWindow = Space$(100)
GetWindowText GetForegroundWindow, BeforeWindow, 100
End Function

Private Sub Command3_Click()
Sleep 3000
MouseLD
End Sub

Private Sub Form_Load()
Dim i As Long
Set Cn = New ADODB.Connection
Set Rs = New ADODB.Recordset
Set Rcs = New ADODB.Recordset
Cn.ConnectionString = ADO.ConnectionString ' "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mydata.mdb;Persist Security Info=False"
Cn.Open
If InitializeWinIo = False Then '用InitializeWinIo函数加载驱动程序，如果成功会返回true，否则返回false
MsgBox "加载WinIo驱动失败"
Unload Me
Exit Sub
End If '****************以上是加载驱动**********************
LoadPixel "商品佛珠", 佛珠 '***************下面是配置商品的点像素颜色值**********
LoadPixel "商品纸扇", 纸扇
LoadPixel "商品武器", 刀
'-------------------------
LoadPixel "商品帽子", 帽子
LoadPixel "商品酒", 酒
LoadPixel "商品蜡烛", 蜡烛
'-------------------------
LoadPixel "商品面粉", 面粉
LoadPixel "商品鹿茸", 鹿茸
LoadPixel "商品符", 符
'-------------------------
LoadPixel "商品人参", 人参
LoadPixel "商品铜油", 铜油
LoadPixel "商品铃铛", 铃铛
'-------------------------
LoadPixel "商品项链", 项链
LoadPixel "商品纸钱", 纸钱
LoadPixel "商品夜明珠", 夜明珠
'-----------------------------
LoadPzSz
Str1 = "梦幻西游ONLINE"
    Rs.Open "select * from IDtable", Cn, adOpenStatic, adLockOptimistic
    Rs.MoveFirst
Str2 = Str1 & " - (" & Rs.Fields("Server").Value & " - " & Rs.Fields("Name").Value & "[" & Rs.Fields("ID").Value & "])"
        If Rs.Fields("username").Value <> "" Then Lbl_Name.Caption = Rs.Fields("username").Value
        If Rs.Fields("password").Value <> "" Then Lbl_Pswd.Caption = Rs.Fields("password").Value
        If Rs.Fields("Level").Value >= 60 Then
           If Rs.Fields("Level").Value >= 80 Then YinPiao = 42000 Else YinPiao = 50000
        Else
           YinPiao = 40000
        End If
        If YinPiao > 40000 Then Level = 150000 Else Level = 100000
     Rs.Close
Dim Xxx As String, a(20) As Long
Rs.Open "select * from 梦幻参数表", Cn, adOpenStatic, adLockOptimistic
Rs.MoveFirst
     Xxx = Rs.Fields("登陆坐标").Value '登陆坐标的加载
     For i = 1 To 8
        a(i) = Mid(Xxx, 1, InStr(1, Xxx, "|") - 1)
        Xxx = Mid(Xxx, InStr(1, Xxx, "|") + 1, Len(Xxx) - InStr(1, Xxx, "|"))
     If i Mod 2 = 1 Then
     登陆Point(i \ 2 + i Mod 2).X = a(i)
     Else
     登陆Point(i \ 2 + i Mod 2).Y = a(i)
     End If
     Next i
'-------------------------------------------------------------------------------------
     Xxx = Rs.Fields("帮派BaiHu").Value '帮派白虎堂的对话及领票的位置坐标设置
     For i = 1 To 10                     '第一个坐标是白虎堂总管的人物在画面的坐标
        a(i) = Mid(Xxx, 1, InStr(1, Xxx, "|") - 1) '第二个是给我些人物，也就是领票的位置
        Xxx = Mid(Xxx, InStr(1, Xxx, "|") + 1, Len(Xxx) - InStr(1, Xxx, "|")) '第三个是购买商品
     If i Mod 2 = 1 Then
     帮派BaiHu(i \ 2 + i Mod 2).X = a(i) '第四个是申请成为商人的位置
     Else
     帮派BaiHu(i \ 2 + i Mod 2).Y = a(i) '第五个是出金库的坐标位置
     End If
     Next i
'-------------------------------------------------------------------------------------
     Xxx = Rs.Fields("进出帮派坐标").Value '进出帮派的坐标设置
     For i = 1 To 20                     '第一个坐标是帮派总管在小地图的坐标，390，270
        a(i) = Mid(Xxx, 1, InStr(1, Xxx, "|") - 1) '第二个是帮派主管在屏幕的位置200，200
        Xxx = Mid(Xxx, InStr(1, Xxx, "|") + 1, Len(Xxx) - InStr(1, Xxx, "|")) '第三个是对话框 交谈 的坐标
     If i Mod 2 = 1 Then
     进出帮派Point(i \ 2 + i Mod 2).X = a(i) '第四个是对话框 我要回自己帮派 的坐标
     Else
     进出帮派Point(i \ 2 + i Mod 2).Y = a(i) '第五个是进 金库 的坐标
     End If
     Next i
'-------------------------------------------------------------------------------------
     梦幻西游默认路径.Caption = Rs.Fields("游戏路径").Value
     YPstrs = Rs.Fields("YPstra").Value
Rs.Close
商人YesNo = False
LoadCityRBG
For i = 1 To 20
    Packet(i).X = 227 + 51 * ((i - 1) Mod 5) '这个是买卖栏的格子，数量的坐标是X-30，Y-12
    Packet(i).Y = 114 + 51 * ((i - 1) \ 5) '包裹栏的X-165，Y+133，数量的坐标是再X-165-30，Y+133-14
Next i
GetWindowPlacement Me.hwnd, WinPlace
WinPlace.rcNormalPosition.Bottom = Screen.Height / 15 - 30
WinPlace.rcNormalPosition.ToP = Screen.Height / 15 - 426
WinPlace.rcNormalPosition.Right = Screen.Width / 15
WinPlace.rcNormalPosition.Left = Screen.Width / 15 - 545
SetWindowPlacement Me.hwnd, WinPlace
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.Picture = Image4.Picture
Picture1.Picture = Picture2.Picture
End Sub

Private Sub Form_Unload(Cancel As Integer)
ShutdownWinIo '程序结束时用ShutdownWinIo函数卸载驱动程
If Cn.State = 1 Then Cn.Close
End Sub
Private Sub LoadPixel(GoodName As String, Good As Goods) '从数据库读字符用，没有其他的用途暂时。
Rs.Open "select * from 临时商品价格表 where 商品名称=" & Chr(34) & GoodName & Chr(34), Cn, adOpenStatic, adLockOptimistic
Good.Pixels = Rs.Fields("像素字符").Value
Good.Name = GoodName
Rs.Close
End Sub

Private Sub MyMove(FromP As PointAPI, ToP As PointAPI, SleepTimes As Long)
Dim Stepx As Long, Stepy As Long, i As Long, j As Long, X As Long, Y As Long
X = ToP.X - (ToP.X - FromP.X) \ 13
Y = ToP.Y - (ToP.Y - FromP.Y) \ 13
If ToP.X - FromP.X < 0 Then Stepx = -1 Else Stepx = 1
If ToP.Y - FromP.Y < 0 Then Stepy = -1 Else Stepy = 1
For i = FromP.X To X Step Stepx
    SetCursorPos i, FromP.Y
    If i Mod 10 = 0 Then Sleep SleepTimes
Next i
For i = FromP.Y To Y Step Stepy
    SetCursorPos X, i
    If i Mod 10 = 0 Then Sleep SleepTimes
Next i
End Sub
Private Sub MoveToP(MubiaoP As PointAPI, SleepTime As Long)  '移动到指定的点，找到颜色是&H603818的点的坐标
Dim Pstart As PointAPI, Pend As PointAPI, SHDowP As PointAPI, h1 As Long, a As Long, b As Long, i As Long, j As Long
h1 = GetDC(0)
Do Until SHDowP.X = MubiaoP.X And SHDowP.Y = MubiaoP.Y
    GetCursorPos Pstart
If Pstart.X > 642 Or Pstart.Y > 508 Then
    MyMove Pstart, MubiaoP, SleepTime
Else
    a = Pstart.X - 99
    b = Pstart.Y - 99
For i = 1 To 200
    For j = 1 To 200
      If GetPixel(h1, a, b) = 6305816 Then Exit For '&H603818
      b = b + 1
    Next j
      If GetPixel(h1, a, b) = 6305816 Then Exit For
      a = a + 1
      b = b - 200
Next i
    SHDowP.X = a - 18
    SHDowP.Y = b - 20
    Pend.X = Pstart.X + MubiaoP.X - SHDowP.X
    Pend.Y = Pstart.Y + MubiaoP.Y - SHDowP.Y
    MyMove Pstart, Pend, SleepTime
End If
Loop
ReleaseDC 0, h1
End Sub

Function OCR(X As Integer, Y As Integer, Width As Integer, Height As Integer, RBG1 As Long, RBG2 As Long, RBG3 As Long) As Long
Dim Word临时 As String, h1 As Long, I1 As Long, I2 As Long, m As Long
ReDim 像素数组(Width, Height) As Boolean, 数字01(Width) As String, Jiage(Width + 1) As String
m = 1
    h1 = GetDC(0)
For I1 = 1 To Width
    For I2 = 1 To Height
像素数组(I1, I2) = (GetPixel(h1, X, Y) = RBG1 Or GetPixel(h1, X, Y) = RBG2 Or GetPixel(h1, X, Y) = RBG3)
    If 像素数组(I1, I2) Then 'True 表示 像素数组 和上面的三个颜色有一个相同
        数字01(I1) = 数字01(I1) & 1
    Else
        数字01(I1) = 数字01(I1) & 0
    End If
Y = Y + 1
    Next I2
Y = Y - 10
X = X + 1
    If CLng(数字01(I1)) = 0 Then
        m = m + 1
    Else
        Jiage(m) = Jiage(m) & 数字01(I1)
    End If
Next I1
    ReleaseDC 0, h1
For m = 1 To Width
  Select Case Jiage(m)
    Case "00100000010010000001011111111100000000010000000001"           '1
    Word临时 = Word临时 & 1
    Case "00110000110100000101010000100101000100010011100011"           '2
    Word临时 = Word临时 & 2
    Case "00110001100100000001010010000101001000010011011110"           '3
    Word临时 = Word临时 & 3
    Case "000000100000001101000001000100001000010111111111110000000101" '4
    Word临时 = Word临时 & 4
    Case "01111101100100100001010010000101001000010100011110"           '5
    Word临时 = Word临时 & 5
    Case "000111111000100100010100100001010010000101001000010110011110" '6
    Word临时 = Word临时 & 6
    Case "01110000000100000000010001111101011000000110000000"           '7
    Word临时 = Word临时 & 7
    Case "001100111001001100010100010001010001000101001100010011001110" '8
    Word临时 = Word临时 & 8
    Case "001111001101000010010100001001010000100101000100100011111100" '9
    Word临时 = Word临时 & 9
    Case "000111110000100000100100000001010000000100100000100001111100" '0
    Word临时 = Word临时 & 0
  End Select
Next m
    If Word临时 <> "" Then OCR = CLng(Word临时)
End Function

Function 四角Pixels() As String
Dim h1 As Long
h1 = GetDC(0)
四角Pixels = GetPixel(h1, 3, 29) & "[1]" & GetPixel(h1, 3, 508) & "[2]" & GetPixel(h1, 642, 29) & "[3]" & GetPixel(h1, 642, 508) & "[4]"
ReleaseDC 0, h1
End Function

Private Sub XingZou(XZtime As Long)  '取梦幻四个角点的颜色判断人物是否在行走，另外加一个时间参数，用于确定最大的循环时间
Dim S As String, i As Long, m As Long
Do Until S = 四角Pixels
If i > XZtime Then Exit Sub
S = 四角Pixels
    For m = 1 To 20
    Sleep 40
    DoEvents
    Next m
i = i + 1
Loop
End Sub

Private Sub ChiXiang() '吃香的部分
Dim P5 As PointAPI
P5.X = Packet(5).X - 165
P5.Y = Packet(5).Y + 133
KeyPressAlt "e"
MoveToP P5, 1  '道具栏第一行，第五列
MouseRD
KeyPressAlt "e"
End Sub

Private Sub ChuBP() '下面的都是关于走路的过程
MoveToP 帮派BaiHu(5), 1 '这个是出金库的坐标
MouseLD
Sleep 3000
Dim i As Long
For i = 6 To 10 '从6之后的 进出帮派Point 的坐标都是出帮派的坐标
    If 进出帮派Point(i).X <> 0 Then
    MoveToP 进出帮派Point(i), 1
    MouseLD
    XingZou 10
    End If
Next i
当前Maps = "长安城"
End Sub
Private Sub JinBP(NowMaps As String)
Dim i As Long
If NowMaps = "长安城" Then
Else
    KeyPressAlt "E"
    LinShiP.X = Packet(20).X - 165
    LinShiP.Y = Packet(20).Y + 133
    MoveToP LinShiP, 1
    MouseRD
    KeyPressAlt "E"
    LinShiP.X = Packet(20).X - 31
    LinShiP.Y = Packet(20).Y + 17
    MoveToP LinShiP, 1
    Sleep 500
    DoEvents
    Sleep 500
    MouseLD
    For i = 1 To 10
    Sleep 250
    DoEvents
    Next i
    NowMaps = "长安城"
End If
KeyPressTab
MoveToP 进出帮派Point(1), 1 '小地图上390,270的屏幕坐标
MouseLD
KeyPressTab
XingZou 240
MoveToP 进出帮派Point(2), 1 '帮派主管在屏幕的位置
MouseLD
MoveToP 进出帮派Point(3), 1 '帮派主管对话 交谈 屏幕的位置
MouseLD
MoveToP 进出帮派Point(4), 1 '帮派主管对话 我要回自己帮派 屏幕的位置
MouseLD
For i = 1 To 10
Sleep 200
DoEvents
Next i
MoveToP 进出帮派Point(5), 1 '帮派 进金库 屏幕的位置
MouseLD
XingZou 10
End Sub
Private Sub JiaoPiao()
JinBP 当前Maps
MoveToP 帮派BaiHu(1), 1 '1 是白虎堂总管在屏幕的坐标位置
KeyPressAlt "G"
KeyPressF9
MouseLD
Dim i As Long, j As Long, GK(20) As String, h1 As Long
h1 = GetDC(0)
For i = 1 To 20
    For j = 0 To 9