vb6怎麼做qq伺服器

① 如何使vb6.0開發區域網游戲能在QQ對戰平台里運行聯機

程序照樣做，但你在對戰平台的其它游戲中設置游戲程序為你的程序，然後試試看? 我沒試過。但這種對戰平台的模式應該是以它啟動游戲，然後強制虛擬接管游戲的所有網路操作，由自己和伺服器進行中轉，這樣就能將各處的人虛擬到同一區域網里了。

② 用VB6.0怎麼做qq登錄器

首先要知道QQ的伺服器IP，埠，以及登錄時的指令，沒有這些數據怎麼登錄呢？IP和埠可能好找，指令是不好找的，如果各個指令都能找到的話，QQ就要面臨被攻擊的危險了。。。。

③ VB怎樣用winsock控制項連接QQ伺服器

需要先了解QQ的網路協議
而且用winpcap最好，winsock差點
winpcap有個VB版的com控制項PacketX，不過我還沒研究好，你自己看看吧

④ VB製作QQ登錄窗口教程和代碼

1、在桌面上，滑鼠左鍵雙擊程序，打開VB編程軟體，在左邊工具欄上，單擊【Label】按鈕，在Form1窗口上繪制出兩標簽，用來寫文字的說明。

⑤ 用vb編寫QQ登陸！

在QQ登錄界面上輸入好帳號密碼並選中自動登錄，VB代碼：
Private Sub Command1_Click()
Shell "D:\Program Files\QQ2007\QQ.exe " 'QQ路徑
End Sub

⑥ VB6.0 如何實現「QQ在線狀態」

試試看API吧

http://wiki.opensns.qq.com/wiki/%E3%80%90QQ%E7%99%BB%E5%BD%95%E3%80%91%E7%BD%91%E7%AB%99%E6%8E%A5%E5%85%A5

http://wiki.opensns.qq.com/wiki/%E3%80%90QQ%E7%99%BB%E5%BD%95%E3%80%91API%E6%96%87%E6%A1%A3

⑦ 用vb做一個可以讀取qq昵稱的軟體 怎麼做

這個我認為難度比較大，其一：用戶的QQ用戶名和密碼等等信息都是存儲在QQ的伺服器中，你需要登錄到QQ伺服器的資料庫，這個可能性極小。其二：這個用戶名、密碼、昵稱等等是在登錄QQ時登錄界面調用QQ伺服器的資料庫，你可以在你的軟體調用QQ軟體，但是必須是QQ軟體才能登錄到QQ伺服器，這個難度不大，但還是不能達到你需要的效果；其三：當然你也可以使用第三方軟體，在後台將你的QQ密碼輸入，但是只要QQ登錄不成功，是不會顯示QQ伺服器的資料庫中的其他記錄的，因此基本沒有實現的可能。

⑧ 用vb怎麼做qq批量登陸器

添加一個工程，兩個bas(模塊)
在form1上添加四個text，（假如我要登錄兩個QQ，QQ：123456，密碼：123456789；QQ：456789，密碼：123456789）一個按鈕，把text1的text值改為：123456，把text2的text值改為：123456的密碼；把text3的text值改為：456789，把text4的text值改為：456789的密碼；在form1添加代碼：

Private Sub Command1_Click()
call loginnow(text1,text2) '要登錄更多的QQ請相應增加
call loginnow(text3,text4)
'......
End Sub
Private Sub Form_Load()
Command1.Caption = "Login"
Text2.PasswordChar = "*"
End Sub
private sub loginnow(byval QQ as string，byval pw as string)
Dim shell_s As String
Dim strQQpath As String
Dim i As String

getvalue strQQpath
shell_s = strQQpath & "QQ.exe" & " /START QQUIN:" & QQ & " PWDHASH:" & Str2QQPwdHash(pw) & " /STAT:41"
i = Shell(shell_s, vbHide)
end sub

在模塊1加入代碼：

Private m_lOnBits(30)
Private m_l2Power(30)
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Function Hex2Bin(HexStr1 As String)

Select Case UCase(HexStr1)
'16進制轉換二進制
Case "0"
q1 = "0000"
Case "1"
q1 = "0001"
Case "2"
q1 = "0010"
Case "3"
q1 = "0011"
Case "4"
q1 = "0100"
Case "5"
q1 = "0101"
Case "6"
q1 = "0110"
Case "7"
q1 = "0111"
Case "8"
q1 = "1000"
Case "9"
q1 = "1001"
Case "A"
q1 = "1010"
Case "B"
q1 = "1011"
Case "C"
q1 = "1100"
Case "D"
q1 = "1101"
Case "E"
q1 = "1110"
Case "F"
q1 = "1111"
End Select
Hex2Bin = q1
End Function
Function Hex2Bin1(HexStr2 As String)
'分斷
q1 = Hex2Bin(Mid(HexStr2, 1, 1))
q2 = Hex2Bin(Mid(HexStr2, 2, 1))
q3 = Hex2Bin(Mid(HexStr2, 3, 1))
q4 = Hex2Bin(Mid(HexStr2, 4, 1))
q5 = Hex2Bin(Mid(HexStr2, 5, 1))
q6 = Hex2Bin(Mid(HexStr2, 6, 1))
q7 = Hex2Bin(Mid(HexStr2, 7, 1))
q8 = Hex2Bin(Mid(HexStr2, 8, 1))
q9 = Hex2Bin(Mid(HexStr2, 9, 1))
q10 = Hex2Bin(Mid(HexStr2, 10, 1))
q11 = Hex2Bin(Mid(HexStr2, 11, 1))
q12 = Hex2Bin(Mid(HexStr2, 12, 1))
Hex2Bin1 = q1 & q2 & q3 & q4 & q5 & q6 & q7 & q8 & q9 & q10 & q11 & q12
End Function
Function Bin324(BinCode1 As String)
'填充
q1 = Mid(BinCode1, 1, 6)
q2 = Mid(BinCode1, 7, 6)
q3 = Mid(BinCode1, 13, 6)
q4 = Mid(BinCode1, 19, 6)
q5 = Mid(BinCode1, 25, 6)
q6 = Mid(BinCode1, 31, 6)
q7 = Mid(BinCode1, 37, 6)
q8 = Mid(BinCode1, 43, 6)

Bin324 = "00" & q1 & "00" & q2 & "00" & q3 & "00" & q4 & "00" & q5 & "00" & q6 & "00" & q7 & "00" & q8
End Function

Function Bin2Hex(BinCode2 As String)

'二進制轉換為16進制（BASE64一部分）
Select Case UCase(BinCode2)

Case "0000"
q1 = "0"
Case "0001"
q1 = "1"
Case "0010"
q1 = "2"
Case "0011"
q1 = "3"
Case "0100"
q1 = "4"
Case "0101"
q1 = "5"
Case "0110"
q1 = "6"
Case "0111"
q1 = "7"
Case "1000"
q1 = "8"
Case "1001"
q1 = "9"
Case "1010"
q1 = "A"
Case "1011"
q1 = "B"
Case "1100"
q1 = "C"
Case "1101"
q1 = "D"
Case "1110"
q1 = "E"
Case "1111"
q1 = "F"
End Select

Bin2Hex = q1

End Function

Function Bin2Hex2(BinCode As String)

q1 = Bin2Hex(Mid(BinCode, 1, 4))
q2 = Bin2Hex(Mid(BinCode, 5, 4))
q3 = Bin2Hex(Mid(BinCode, 9, 4))
q4 = Bin2Hex(Mid(BinCode, 13, 4))

Bin2Hex2 = q1 & q2 & q3 & q4
End Function

Function Bin2Hex3(BinCode3 As String)

q1 = Bin2Hex2(Mid(BinCode3, 1, 16))
q2 = Bin2Hex2(Mid(BinCode3, 17, 16))
q3 = Bin2Hex2(Mid(BinCode3, 33, 16))
q4 = Bin2Hex2(Mid(BinCode3, 49, 16))

Bin2Hex3 = q1 & q2 & q3 & q4
End Function
Function HexBase64(HexString As String)

HexBase64 = HexBase64_2(Bin2Hex3(Bin324(Hex2Bin1(HexString))))
End Function
Function HexBase64_1(HexString As String)

Select Case HexString

Case "00"
q1 = "A"
Case "01"
q1 = "B"
Case "02"
q1 = "C"
Case "03"
q1 = "D"
Case "04"
q1 = "E"
Case "05"
q1 = "F"
Case "06"
q1 = "G"
Case "07"
q1 = "H"
Case "08"
q1 = "I"
Case "09"
q1 = "J"
Case "0A"
q1 = "K"
Case "0B"
q1 = "L"
Case "0C"
q1 = "M"
Case "0D"
q1 = "N"
Case "0E"
q1 = "O"
Case "0F"
q1 = "P"
Case "10"
q1 = "Q"
Case "11"
q1 = "R"
Case "12"
q1 = "S"
Case "13"
q1 = "T"
Case "14"
q1 = "U"
Case "15"
q1 = "V"
Case "16"
q1 = "W"
Case "17"
q1 = "X"
Case "18"
q1 = "Y"
Case "19"
q1 = "Z"
Case "1A"
q1 = "a"
Case "1B"
q1 = "b"
Case "1C"
q1 = "c"
Case "1D"
q1 = "d"
Case "1E"
q1 = "e"
Case "1F"
q1 = "f"
Case "20"
q1 = "g"
Case "21"
q1 = "h"
Case "22"
q1 = "i"
Case "23"
q1 = "j"
Case "24"
q1 = "k"
Case "25"
q1 = "l"
Case "26"
q1 = "m"
Case "27"
q1 = "n"
Case "28"
q1 = "o"
Case "29"
q1 = "p"
Case "2A"
q1 = "q"
Case "2B"
q1 = "r"
Case "2C"
q1 = "s"
Case "2D"
q1 = "t"
Case "2E"
q1 = "u"
Case "2F"
q1 = "v"

Case "30"
q1 = "w"
Case "31"
q1 = "x"
Case "32"
q1 = "y"
Case "33"
q1 = "z"
Case "34"
q1 = "0"
Case "35"
q1 = "1"
Case "36"
q1 = "2"
Case "37"
q1 = "3"
Case "38"
q1 = "4"
Case "39"
q1 = "5"
Case "3A"
q1 = "6"
Case "3B"
q1 = "7"
Case "3C"
q1 = "8"
Case "3D"
q1 = "9"
Case "3E"
q1 = "+"
Case "3F"
q1 = "/"

End Select
HexBase64_1 = q1
End Function
Function HexBase64_2(HexString As String)
q1 = HexBase64_1(Mid(HexString, 1, 2))
q2 = HexBase64_1(Mid(HexString, 3, 2))
q3 = HexBase64_1(Mid(HexString, 5, 2))
q4 = HexBase64_1(Mid(HexString, 7, 2))
q5 = HexBase64_1(Mid(HexString, 9, 2))
q6 = HexBase64_1(Mid(HexString, 11, 2))
q7 = HexBase64_1(Mid(HexString, 13, 2))
q8 = HexBase64_1(Mid(HexString, 15, 2))
HexBase64_2 = q1 & q2 & q3 & q4 & q5 & q6 & q7 & q8
End Function

Function Hex2Base64(HexCode As String)

For i = 0 To Len(HexCode) Step 12
q1 = q1 & HexBase64(Mid(HexCode, i + 1, 12))

Next
Hex2Base64 = q1
End Function

Private Function md5_F(X, Y, z)
md5_F = (X And Y) Or ((Not X) And z)
End Function

Private Function md5_G(X, Y, z)
md5_G = (X And z) Or (Y And (Not z))
End Function

Private Function md5_H(X, Y, z)
md5_H = (X Xor Y Xor z)
End Function

Private Function md5_I(X, Y, z)
md5_I = (Y Xor (X Or (Not z)))
End Function

Private Sub md5_FF(a, b, c, d, X, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), X), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Sub md5_GG(a, b, c, d, X, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), X), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Sub md5_HH(a, b, c, d, X, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), X), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Sub md5_II(a, b, c, d, X, s, ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), X), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub

Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount

Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448

lMessageLength = Len(sMessage)

lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)

lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop

lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)

ConvertToWordArray = lWordArray
End Function

Private Function WordToHex(lValue)
Dim lByte
Dim lCount

For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function

Public Function MD5(sMessage, stype)
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)

m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)

Dim X
Dim k
Dim AA
Dim BB
Dim CC
Dim DD
Dim a
Dim b
Dim c
Dim d

Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const S22 = 9
Const S23 = 14
Const S24 = 20
Const S31 = 4
Const S32 = 11
Const S33 = 16
Const S34 = 23
Const S41 = 6
Const S42 = 10
Const S43 = 15
Const S44 = 21

X = ConvertToWordArray(sMessage)

a = &H67452301
b = &HEFCDAB89
c = &H98BADCFE
d = &H10325476

For k = 0 To UBound(X) Step 16
AA = a
BB = b
CC = c
DD = d

md5_FF a, b, c, d, X(k + 0), S11, &HD76AA478
md5_FF d, a, b, c, X(k + 1), S12, &HE8C7B756
md5_FF c, d, a, b, X(k + 2), S13, &H242070DB
md5_FF b, c, d, a, X(k + 3), S14, &HC1BDCEEE
md5_FF a, b, c, d, X(k + 4), S11, &HF57C0FAF
md5_FF d, a, b, c, X(k + 5), S12, &H4787C62A
md5_FF c, d, a, b, X(k + 6), S13, &HA8304613
md5_FF b, c, d, a, X(k + 7), S14, &HFD469501
md5_FF a, b, c, d, X(k + 8), S11, &H698098D8
md5_FF d, a, b, c, X(k + 9), S12, &H8B44F7AF
md5_FF c, d, a, b, X(k + 10), S13, &HFFFF5BB1
md5_FF b, c, d, a, X(k + 11), S14, &H895CD7BE
md5_FF a, b, c, d, X(k + 12), S11, &H6B901122
md5_FF d, a, b, c, X(k + 13), S12, &HFD987193
md5_FF c, d, a, b, X(k + 14), S13, &HA679438E
md5_FF b, c, d, a, X(k + 15), S14, &H49B40821

md5_GG a, b, c, d, X(k + 1), S21, &HF61E2562
md5_GG d, a, b, c, X(k + 6), S22, &HC040B340
md5_GG c, d, a, b, X(k + 11), S23, &H265E5A51
md5_GG b, c, d, a, X(k + 0), S24, &HE9B6C7AA
md5_GG a, b, c, d, X(k + 5), S21, &HD62F105D
md5_GG d, a, b, c, X(k + 10), S22, &H2441453
md5_GG c, d, a, b, X(k + 15), S23, &HD8A1E681
md5_GG b, c, d, a, X(k + 4), S24, &HE7D3FBC8
md5_GG a, b, c, d, X(k + 9), S21, &H21E1CDE6
md5_GG d, a, b, c, X(k + 14), S22, &HC33707D6
md5_GG c, d, a, b, X(k + 3), S23, &HF4D50D87
md5_GG b, c, d, a, X(k + 8), S24, &H455A14ED
md5_GG a, b, c, d, X(k + 13), S21, &HA9E3E905
md5_GG d, a, b, c, X(k + 2), S22, &HFCEFA3F8
md5_GG c, d, a, b, X(k + 7), S23, &H676F02D9
md5_GG b, c, d, a, X(k + 12), S24, &H8D2A4C8A

md5_HH a, b, c, d, X(k + 5), S31, &HFFFA3942
md5_HH d, a, b, c, X(k + 8), S32, &H8771F681
md5_HH c, d, a, b, X(k + 11), S33, &H6D9D6122
md5_HH b, c, d, a, X(k + 14), S34, &HFDE5380C
md5_HH a, b, c, d, X(k + 1), S31, &HA4BEEA44
md5_HH d, a, b, c, X(k + 4), S32, &H4BDECFA9
md5_HH c, d, a, b, X(k + 7), S33, &HF6BB4B60
md5_HH b, c, d, a, X(k + 10), S34, &HBEBFBC70
md5_HH a, b, c, d, X(k + 13), S31, &H289B7EC6
md5_HH d, a, b, c, X(k + 0), S32, &HEAA127FA
md5_HH c, d, a, b, X(k + 3), S33, &HD4EF3085
md5_HH b, c, d, a, X(k + 6), S34, &H4881D05
md5_HH a, b, c, d, X(k + 9), S31, &HD9D4D039
md5_HH d, a, b, c, X(k + 12), S32, &HE6DB99E5
md5_HH c, d, a, b, X(k + 15), S33, &H1FA27CF8
md5_HH b, c, d, a, X(k + 2), S34, &HC4AC5665

md5_II a, b, c, d, X(k + 0), S41, &HF4292244
md5_II d, a, b, c, X(k + 7), S42, &H432AFF97
md5_II c, d, a, b, X(k + 14), S43, &HAB9423A7
md5_II b, c, d, a, X(k + 5), S44, &HFC93A039
md5_II a, b, c, d, X(k + 12), S41, &H655B59C3
md5_II d, a, b, c, X(k + 3), S42, &H8F0CCC92
md5_II c, d, a, b, X(k + 10), S43, &HFFEFF47D
md5_II b, c, d, a, X(k + 1), S44, &H85845DD1
md5_II a, b, c, d, X(k + 8), S41, &H6FA87E4F
md5_II d, a, b, c, X(k + 15), S42, &HFE2CE6E0
md5_II c, d, a, b, X(k + 6), S43, &HA3014314
md5_II b, c, d, a, X(k + 13), S44, &H4E0811A1
md5_II a, b, c, d, X(k + 4), S41, &HF7537E82
md5_II d, a, b, c, X(k + 11), S42, &HBD3AF235
md5_II c, d, a, b, X(k + 2), S43, &H2AD7D2BB
md5_II b, c, d, a, X(k + 9), S44, &HEB86D391

a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next

If stype = 32 Then
MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
Else
MD5 = LCase(WordToHex(b) & WordToHex(c))
End If

End Function

Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult

lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000

lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If

AddUnsigned = lResult
End Function

Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If

If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function

Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If

RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function

Private Function RotateLeft(lValue, iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Public Function Str2QQPwdHash(Str1 As String)

Str2QQPwdHash = Hex2Base64(MD5(Str1, 32)) & "=="

End Function

在模塊2加入代碼：

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Dim lbuffer As Long, sbuffer As String, hkey As Long, ltype As Long

Public Function getvalue(svalue) As Long
rtn = RegOpenKeyEx(&H80000002, "Software\TENCENT\QQ", 0, &H20000 Or &H1& Or &H8& Or &H10&, hkey)
If rtn <> 0& Then
getvalue = rtn
Exit Function
End If

getvalue = RegQueryValueEx(hkey, "Install", 0, ltype, ByVal 0, lbuffer)
lbuffer = 255
sbuffer = Space(lbuffer)
getvalue = RegQueryValueEx(hkey, "Install", 0, ltype, ByVal sbuffer, lbuffer)
svalue = Left(sbuffer, InStr(sbuffer, Chr(0)) - 1)
RegCloseKey hkey
End Function

⑨ 怎麼用vb6.0 做一個QQ登陸器

先要抓包，記錄QQ登錄時向伺服器發送的信息
然後用VB做個程序，先打開，QQ，然後向伺服器發送抓包抓出來的那些信息即可！