【市集助手】物品的网页市集信息保存与调用
首先声明，这只是外部软件，不涉及任何游戏数据，也不会影响到游戏平衡，只是方便玩家卖东西。
新赛季快要到了，我有一个烦恼，如果有几件词缀很复杂的装备一两天都没有卖出去，
那么再去网页市集搜索装备价格会很是麻烦，会浪费一两分钟分钟甚至几分钟的时间
于是我做了一个为了方便自己快速查询无法卖出去的物品价格的小程序
更新日志：
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
本帖最后由 絴祥啊啊啊 于 2021-8-25 13:29 编辑
浏览器不是有历史记录和收藏? GrayHole 发表于 2021-7-18 13:30
浏览器不是有历史记录和收藏?
浏览器的历史记录能显示装备名称？好几页的星团珠宝慢慢改名手动查找？你要是能做出一个专用浏览器出来，当我没说 絴祥啊啊啊 发表于 2021-7-18 13:39
浏览器的历史记录能显示装备名称？好几页的星团珠宝慢慢改名手动查找？你要是能做出一个专用浏览器出来， ...
我用的chrome这个插件
https://chrome.google.com/webstore/detail/tabs-outliner/eggkanocgddhmamlbiijnphhppkpkmkl?hl=zh-CN
可以保存标签 过滤器信息也全保存的 我是存起来 每天直接打开就行了
我还以为存收藏也是一样效果
{:3109:}
页:
[1]