17173有料社区

标题: 【市集助手】物品的网页市集信息保存与调用 [打印本页]

作者: 絴祥啊啊啊 时间: 2021-7-18 01:46
标题: 【市集助手】物品的网页市集信息保存与调用
本帖最后于 2021-8-25 13:29 编辑

首先声明，这只是外部软件，不涉及任何游戏数据，也不会影响到游戏平衡，只是方便玩家卖东西。

新赛季快要到了，我有一个烦恼，如果有几件词缀很复杂的装备一两天都没有卖出去，
那么再去网页市集搜索装备价格会很是麻烦，会浪费一两分钟分钟甚至几分钟的时间

于是我做了一个为了方便自己快速查询无法卖出去的物品价格的小程序

POE装备网页市集助手21.7.19.2.zip (206.46 KB, 下载次数: 520)

更新日志：
2021.7.19：现在不用选中地址栏，鼠标移过去按下快捷键会自动选中并回车，新增"参数设置.ini"配置文件，可以自定义字数上限、清空字数、保存间隔、窗体隐藏速度。

使用说明：
1.用管理员权限启动程序。

2.保存物品的网页市集地址：
鼠标移动到物品按下 Home 键, 然后打开网页市集，把要搜索的物品名称、词缀填好，点击搜索，
鼠标移动到网页地址栏，再次按下 Home 键会自动复制网页地址并保存到本地(下次就可以直接调用了)

3.调用物品的网页市集地址：
鼠标移动到物品位置按下 Home 键, 然后鼠标移动网页地址栏，
按下 Ins 键会粘贴对应物品的网页地址(前提是你之前搜索过，并且保存了)

4.快速按 4 次 Home 键关闭程序

注意：保存的信息超过 5 万字以后，会从最旧的信息里删除 1000 字，信息数据是每隔 5 秒保存到本地，现在这些可以到本地文件"参数设置.ini"里边更改
      所有服务器通用，只要是支持 Ctrl+C 复制物品信息的就能用，你要是没有 Home 键或 Ins 键，那就无缘了。

小程序是用 VB.NET 语言制作的，如无法运行，请自行百度安装 .NET Framework 4.6.1
如果报错什么的，可以评论或者私信，我一定解决！

Public Class Form1

Public 物品信息, 参数设置 As String

Public 隐藏窗体线程, 关闭窗体线程, 自动存储线程, 复制装备线程, 粘贴地址线程, 关闭提示线程 As System.Threading.Thread '定义一个新线程
Public Delegate Sub 要办的事(ByRef i As Int32)
Public 窗体透明度 = 1
Public lx As New LX.LX
Public dm As New Dm.dmsoft
Public 复制装备热键ID, 粘贴热键ID
Public 复制信息, 装备信息, 地址信息, 存储字数上限, 自动清空多少字, 自动存储间隔, 窗体隐藏速度
Public 复制次数 = 0
Public 装备地址 = "装备地址"
Public 按键次数 = 0
Public 文本 = ""
Public 线程锁 As Object = New Object  '制作一个锁头, 注意解锁以后其他线程才能进来执行！
Public 重复复制装备判断

Protected Overrides Sub WndProc(ByRef m As Message) '处理WINDOWS消息，触发事件
      If m.Msg = 786 Then
         If m.WParam.ToInt32 = 复制装备热键ID Then  '如果触发的按键ID是对的则会
            复制装备线程 = New System.Threading.Thread(AddressOf 复制装备)
            复制装备线程.Start()
         ElseIf m.WParam.ToInt32 = 粘贴热键ID Then
            粘贴地址线程 = New System.Threading.Thread(AddressOf 粘贴地址)
            粘贴地址线程.Start()
         End If
      End If
      MyBase.WndProc(m)  '这一句万万不能删！！
End Sub

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
      lx.启动()
      复制装备热键ID = lx.注册热键("Home", Handle, 1)
      粘贴热键ID = lx.注册热键("Ins", Handle, 1)
      dm.EnableKeypadMsg(0)
      物品信息 = "./物品信息.txt"
      参数设置 = "./参数设置.ini"
      'vb.net 判断物品信息是否存在，IF存在返回1，不存在返回0
      If System.IO.File.Exists(物品信息) Then
         '存在
      Else
         '创建TXT物品信息并写入数据，是覆盖全部内容！！
         IO.File.WriteAllText(物品信息, "")
      End If
      If System.IO.File.Exists(参数设置) Then
         '存在
      Else
         '创建TXT物品信息并写入数据，是覆盖全部内容！！
         IO.File.WriteAllText(参数设置, "")
      End If
      If dm.ReadIni("这里可以自定义一些参数", "存储字数上限", 参数设置) <> "" Then
         存储字数上限 = Val(dm.ReadIni("这里可以自定义一些参数", "存储字数上限", 参数设置))
      Else
         存储字数上限 = 50000
         dm.WriteIni("这里可以自定义一些参数", "存储字数上限", 存储字数上限, 参数设置)
      End If
      If dm.ReadIni("这里可以自定义一些参数", "自动清空多少字", 参数设置) <> "" Then
         自动清空多少字 = Val(dm.ReadIni("这里可以自定义一些参数", "自动清空多少字", 参数设置))
      Else
         自动清空多少字 = 1000
         dm.WriteIni("这里可以自定义一些参数", "自动清空多少字", 自动清空多少字, 参数设置)
      End If
      If dm.ReadIni("这里可以自定义一些参数", "自动存储间隔(毫秒)", 参数设置) <> "" Then
         自动存储间隔 = Val(dm.ReadIni("这里可以自定义一些参数", "自动存储间隔(毫秒)", 参数设置))
      Else
         自动存储间隔 = 5000
         dm.WriteIni("这里可以自定义一些参数", "自动存储间隔(毫秒)", 自动存储间隔, 参数设置)
      End If
      If dm.ReadIni("这里可以自定义一些参数", "窗体隐藏速度(越小越慢)", 参数设置) <> "" Then
         窗体隐藏速度 = Val(dm.ReadIni("这里可以自定义一些参数", "窗体隐藏速度(越小越慢)", 参数设置))
      Else
         窗体隐藏速度 = 1
         dm.WriteIni("这里可以自定义一些参数", "窗体隐藏速度(越小越慢)", 窗体隐藏速度, 参数设置)
      End If
      隐藏窗体线程 = New System.Threading.Thread(AddressOf 开头)
      隐藏窗体线程.Start() '线程开始，这只是一个线程，无法重复开始！

      文本 = My.Computer.FileSystem.ReadAllText(物品信息, System.Text.ASCIIEncoding.Default)  '读取物品信息内容
      自动存储线程 = New System.Threading.Thread(AddressOf 自动存储)
      自动存储线程.Start()
End Sub

Sub 开头()
      For i = 0 To 200 Step 1
         Threading.Thread.Sleep(50)
         Me.Invoke(New 要办的事(AddressOf 隐藏), 1)
      Next
End Sub

Sub 隐藏()
      窗体透明度 = 窗体透明度 - 窗体隐藏速度 / 100
      Me.Opacity = 窗体透明度
      If 窗体透明度 <= 0.4 Then
         Me.Hide()
         隐藏窗体线程.Abort()
      End If
End Sub

Sub 判断按键关闭程序()
      SyncLock 线程锁
         For i = 0 To 5 Step 1
            If 按键次数 >= 3 Then
                  关闭提示线程 = New System.Threading.Thread(AddressOf 关闭提示)
                  关闭提示线程.Start()
                  MsgBox("已关闭")
            End If
            Threading.Thread.Sleep(100)
            If i >= 5 Then
                  按键次数 = 0
                  Exit For
            End If
         Next
      End SyncLock
End Sub

Private Sub 网页市集助手_Click(sender As Object, e As EventArgs) Handles 网页市集助手.Click
      MsgBox("按下 Home 键复制装备信息, " + vbCrLf + "再次按下时复制网页地址, 或者按下Ins(全称Insert)粘贴对应装备的网页地址, " + vbCrLf + "快速按 4 次 Home 键关闭程序")
End Sub

Sub 关闭提示()
      Threading.Thread.Sleep(500)
      End
      Me.Close()
End Sub

''' <summary>
''' 写入信息(内容, 0是装备1是地址)
''' </summary>
''' <param name="a"></param>
''' <param name="b"></param>
Sub 写入信息(a, b)
      If b = 0 Then
         装备信息 = a
         If InStr(1, 文本, a) = 0 Then
            文本 = 文本 + vbCrLf + a + "="
         Else
            '有装备信息,什么都不做
         End If
      ElseIf b = 1 Then
         If InStr(1, 文本, 装备信息) = 0 Then
            MsgBox("装备信息不存在")
            Exit Sub
         Else
            文本 = Replace(文本, 装备信息 + "=", 装备信息 + "=" + 地址信息 + vbCrLf + vbCrLf)
         End If
      End If
End Sub
''' <summary>
''' 读取地址(装备信息)
''' </summary>
''' <param name="a"></param>
Sub 读取地址(a)
      If InStr(1, 文本, a) = 0 Then
         MsgBox("装备不存在")
      Else
         Try
            '正常执行的语句....
            Dim 装备前位置 = InStr(1, 文本, a)
            Dim 等号位置 = InStr(装备前位置, 文本, "=")
            Dim 回车位置 = InStr(等号位置, 文本, vbCrLf)
            Dim 地址长度 = 回车位置 - 等号位置 - 1
            If 地址长度 <= 3 Then
                  MsgBox("装备地址信息不存在")
                  复制次数 = 0
                  粘贴地址线程.Abort()
                  Exit Sub
            End If
            地址信息 = Mid(文本, 等号位置 + 1, 地址长度)
         Catch
            '如果上面出现错误，这里立即执行。
            MsgBox("装备地址信息不存在")
            复制次数 = 0
            粘贴地址线程.Abort()
            Exit Sub
         End Try
      End If
End Sub

Sub 自动存储()
      For i = 0 To 1 Step 0
         Threading.Thread.Sleep(自动存储间隔)
         If Len(文本) >= 存储字数上限 Then
            Dim 要清空的 = Mid(文本, 0, 自动清空多少字)
            文本 = Replace(文本, 要清空的, "")
         End If
         My.Computer.FileSystem.WriteAllText(物品信息, 文本, False, System.Text.Encoding.Default) 'true为追加 flase 为覆盖
      Next
End Sub

Sub 复制装备()
      按键次数 += 1
      关闭窗体线程 = New System.Threading.Thread(AddressOf 判断按键关闭程序)
      关闭窗体线程.Start()

      复制次数 += 1
      If 复制次数 = 1 Then
         dm.KeyDownChar("ctrl")
         dm.KeyDownChar("c")
         Threading.Thread.Sleep(20)
         dm.KeyUpChar("ctrl")
         dm.KeyUpChar("c")

         Me.Invoke(New 要办的事(AddressOf 复制), 1)
         Threading.Thread.Sleep(50)
         重复复制装备判断 = 装备信息
         If Len(装备信息) <= 70 Then
            复制次数 = 0
            MsgBox("请先复制物品信息")
            Exit Sub
         End If
         Call 写入信息(装备信息, 0)
      ElseIf 复制次数 = 2 Then
         dm.LeftClick()
         dm.KeyDownChar("ctrl")
         dm.KeyDownChar("a")
         Threading.Thread.Sleep(20)
         dm.KeyUpChar("ctrl")
         dm.KeyUpChar("a")
         Threading.Thread.Sleep(50)
         dm.KeyDownChar("ctrl")
         dm.KeyDownChar("c")
         Threading.Thread.Sleep(20)
         dm.KeyUpChar("ctrl")
         dm.KeyUpChar("c")
         Threading.Thread.Sleep(50)
         dm.KeyPressChar("esc")

         Me.Invoke(New 要办的事(AddressOf 复制), 1)
         Threading.Thread.Sleep(50)
         If 地址信息 = 重复复制装备判断 Then
            'MsgBox(装备信息)
            复制次数 = 1
            Exit Sub
         End If
         Call 写入信息(地址信息, 1)
         复制次数 = 0
      End If
End Sub
Sub 粘贴地址()
      Call 读取地址(装备信息)
      Me.Invoke(New 要办的事(AddressOf 粘贴), 1)
      Threading.Thread.Sleep(50)

      dm.LeftClick()
      dm.KeyDownChar("ctrl")
      dm.KeyDownChar("a")
      Threading.Thread.Sleep(20)
      dm.KeyUpChar("ctrl")
      dm.KeyUpChar("a")
      Threading.Thread.Sleep(50)
      dm.KeyDownChar("ctrl")
      dm.KeyDownChar("v")
      Threading.Thread.Sleep(20)
      dm.KeyUpChar("ctrl")
      dm.KeyUpChar("v")
      Threading.Thread.Sleep(50)
      dm.KeyPressChar("enter")

      复制次数 = 0
End Sub

Sub 复制()
      If 复制次数 = 1 Then
         装备信息 = Clipboard.GetText()
      ElseIf 复制次数 = 2 Then
         地址信息 = Clipboard.GetText()
      End If
End Sub
Sub 粘贴()
      Clipboard.SetText(地址信息) ' 拷贝数据到粘贴板
End Sub

End Class

作者: GrayHole 时间: 2021-7-18 13:30
浏览器不是有历史记录和收藏?

作者: 絴祥啊啊啊 时间: 2021-7-18 13:39

发表于 2021-7-18 13:30
浏览器不是有历史记录和收藏?

浏览器的历史记录能显示装备名称？好几页的星团珠宝慢慢改名手动查找？你要是能做出一个专用浏览器出来，当我没说

作者: GrayHole 时间: 2021-7-18 13:52

发表于 2021-7-18 13:39
浏览器的历史记录能显示装备名称？好几页的星团珠宝慢慢改名手动查找？你要是能做出一个专用浏览器出来， ...

我用的chrome这个插件
https://chrome.google.com/websto ... hhppkpkmkl?hl=zh-CN
可以保存标签过滤器信息也全保存的我是存起来每天直接打开就行了
我还以为存收藏也是一样效果

作者: Dionysus1618 时间: 2021-8-11 09:41

欢迎光临 17173有料社区 (//bbs.17173.com/)