贴吧又可以查IP了特来分享一下编程思路和部分算法

STiG · 发表于 2014-4-13 23:28:53

本帖最后由 STiG 于 2014-4-13 23:33 编辑

获取user_ip 这个很简单基本上都会吧
查一下ID所在帖子的网页源码就能找到一串数字
算法和之前的一样转换成16进制然后分4段转回10进制最后颠倒一下顺序就能得到IP地址了
但是这样挺费时费力的于是抽空用VB写了这个东西输入帖子地址和ID 就可以直接获取到IP

基本的东西很简单不用多说先用最简单的webbrowser控件载入帖子页面

然后遍历ID 这里要说一下度娘把ID里面的中文字全部转换成Unicode16进制编码显示了英文字母数字符号保持不变
为了将ID成功转换为度娘接受的模式我特别翻了一下Unicode编码表得知英文字母数字符号的编码是从32到126 所以条件这样写：

For i = 1 To Len(Text2.Text) 'ID逐字转换
  If AscW(Mid(Text2.Text, i, 1)) > 31 And AscW(Mid(Text2.Text, i, 1)) < 127 Then 'AscW将字符转换为Unicode10进制编码
j = j & Mid(Text2.Text, i, 1) '如果字符的编码是从32到126 那就不用转换直接读取到变量j里面
  Else
j = j & "\u" & LCase(Hex(AscW(Mid(Text2.Text, i, 1)))) '反之转换为Unicode16进制编码并小写再读取到变量j里面
  End If
Next '最终得出的j便是度娘可接受的模式了这样我们便可以用这个j来做遍历了

为什么要遍历ID 不直接遍历user_ip 然后再根据几楼来确定
那是因为user_ip不是在body里面一个ID只会有一个user_ip
如果一个帖子里面一个ID回复了两次或者两次以上那么就根本无法使用几楼来确定了

k = InStr(WebBrowser1.Document.documentelement.innerhtml, j) '首先查找ID起始于整个页面的第几个字符赋值给k
k = InStr(k - 33, WebBrowser1.Document.documentelement.innerhtml, "user_ip")
  ' 往前退33个字符（user_ip是在ID的前面这个33是我随便写的当时没去数要退多少个）然后找到"user_ip"起始位置
a = Val(Mid(WebBrowser1.Document.documentelement.innerhtml, k + 9, 10))
  ' 然后再往后进9个字符（user_ip":一共9个字符）用Mid获取10个字符（FFFFFFFF转换为10进制是4294967295 最多10个字符）
  ' 少一两个字符也不怕 Val可以强制转换为数字变量然后复制给a 这个a自然就是那个需要转换的IP地址了

这里开始才是算法的核心一开始我也以为很简单用Hex函数直接把10进制数转换为16进制不就行了后来发现没这么简单
问题在于Hex函数最多只能转换Long型整数 VB中Long型最大值才2147483647 远低于4294967295（早知道就不用VB写了坑爹）
于是我自己写了一个算法这里用到了10进制转2进制的思路先算末位

b = a / 16 'a就是刚刚的user_ip 除以16 这里VB自动识别成浮点型的除法明显不会再和Long型扯上什么关系了
c = InStr(b, ".") '如果不能被整除那么b自然就是一个小数于是找到小数点
e = a - Mid(b, 1, c - 1) * 16 '获取整数部分乘以16 然后用a去减就能得出余数了这个余数就是user_ip 16进制的末位
If e = 10 Then
  e = "A"
ElseIf e = 11 Then
  e = "B"
ElseIf e = 12 Then
  e = "C"
ElseIf e = 13 Then
  e = "D"
ElseIf e = 14 Then
  e = "E"
ElseIf e = 15 Then
  e = "F"
End If '这里按照16进制的表示法来然后这样：

d = Hex(Mid(b, 1, c - 1)) & e
'这里要注意的是就算最大4294967295 除以16也会远小于Long型的限制所以我们放心使用Hex函数吧
'获取前面的16进制位数然后加上最后一位

好了这个时候这个d就是user_ip 16进制的表现形式然后我们要分段颠倒一下顺序就能获取IP地址了这个我写在一个循环里面了

For i = Len(d) To 1 Step -2 '步频-2 每次减2 两位为一段倒序读取重新转换为10进制
  If i = 1 Then '有时候得出的d是7位那么明显就是ip的最后一位只用一个16进制数表示前面三段如果出现这种情况都会加一个0
Text3.Text = Text3.Text & CLng("&H" & Mid(d, i, 1))
  Else
Text3.Text = Text3.Text & CLng("&H" & Mid(d, i - 1, 2))
If i > 2 Then
   Text3.Text = Text3.Text & "." '别忘了IP地址里面的点
End If
  End If
Next

搞定各位可以按照我的思路去试试估计再过一段时间这个user_ip的BUG又得修复了到时候咱再想办法