Chinaunix首页 | 论坛 | 博客
  • 博客访问: 3726401
  • 博文数量: 356
  • 博客积分: 10458
  • 博客等级: 上将
  • 技术积分: 4734
  • 用 户 组: 普通用户
  • 注册时间: 2008-03-24 14:59
文章分类

全部博文(356)

文章存档

2020年(17)

2019年(9)

2018年(26)

2017年(5)

2016年(11)

2015年(20)

2014年(2)

2013年(17)

2012年(15)

2011年(4)

2010年(7)

2009年(14)

2008年(209)

分类: 系统运维

2008-04-06 16:19:51

m_Base64模块:

Option Explicit
'除以2的一次方是右移一位
'
乘以2的一次方是左移一位
'
(bytInText(i) And &HFC)  (2 ^ 2)
'
第一个字节的内容And运算0xFC(11111100)(取左边6位),再除以2的二次方(右移2位)
'
(bytInText(i) And &H3) * (2 ^ 4) Or (bytInText(i + 1) And &HF0)  (2 ^ 4)
'
第一个字节的内容And运算0x03(00000011)(取右边2位),再乘以2的四次方(左移4位)
'
第二个字节的内容And运算0xF0(11110000)(取左边4位),再除以2的四次方(右移4位)
'
两个结果再Or运算
'
(bytInText(i + 1) And &HF) * (2 ^ 2) + (bytInText(i + 2) And &HC0)  (2 ^ 6)
'
第二个字节的内容And运算0x0F(00001111)(取右边4位),再乘以2的二次方(左移2位)
'
第三个字节的内容And运算0xC0(11000000)(取左边2位),再除以2的六次方(右移6位)
'
两个结果再Or运算
'
bytInText(i + 2) And &H3F
'
第三个字节的内容And运算0x3F(00111111)(取右边6位)
        
'Base64编码函数
Public Function Base64_Encode(bytInText() As ByteAs Byte()
    
Dim Base64EncodeTable() As Byte
    
Dim lngInTextLen As Long, lngMod As Long, i As Long
    
Dim bytEncode() As Byte, lngEncodeLen As Long
    
    Base64_Encode 
= Chr(0)  '初始化函数返回值
    
    Base64EncodeTable() 
= "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=" '初始化Base64编码表
    Base64EncodeTable() = StrConv(Base64EncodeTable(), vbFromUnicode)  '转换为ANSI编码
    
    
If LBound(bytInText) <> 0 Then Exit Function  'bytInText数组下标不从零开始则出错返回
    
    lngInTextLen 
= UBound(bytInText) - LBound(bytInText) + 1  '计算bytInText数组长度
    
    lngMod 
= lngInTextLen Mod 3 '取模3后的余数(结果只有0、1、2三种情况)
    If lngMod = 0 Then
        lngEncodeLen 
= lngInTextLen / 3 * 4  '求编码后的长度
        lngInTextLen = lngInTextLen / 3 * 3  '取3的整数倍
    ElseIf lngMod = 1 Then
        lngEncodeLen 
= (lngInTextLen + 2/ 3 * 4  '求编码后的长度
        lngInTextLen = ((lngInTextLen + 2/ 3 - 1* 3 '取3的整数倍
    ElseIf lngMod = 2 Then
        lngEncodeLen 
= (lngInTextLen + 1/ 3 * 4  '求编码后的长度
        lngInTextLen = ((lngInTextLen + 1/ 3 - 1* 3 '取3的整数倍
    End If
    
    
'MsgBox "编码后的长度为" & lngEncodeLen & "字节!"
    'MsgBox "3的整数倍为" & lngInTextLen
    
    
ReDim bytEncode(0 To lngEncodeLen - 1'重新定义编码缓冲区
    lngEncodeLen = 0  '初始化编码长度计数
    
    
For i = 0 To lngInTextLen - 1 Step 3
        bytEncode(lngEncodeLen) 
= Base64EncodeTable((bytInText(i) And &HFC)  (2 ^ 2))
        bytEncode(lngEncodeLen 
+ 1= Base64EncodeTable((bytInText(i) And &H3) * (2 ^ 4Or (bytInText(i + 1And &HF0)  (2 ^ 4))
        bytEncode(lngEncodeLen 
+ 2= Base64EncodeTable((bytInText(i + 1And &HF) * (2 ^ 2Or (bytInText(i + 2And &HC0)  (2 ^ 6))
        bytEncode(lngEncodeLen 
+ 3= Base64EncodeTable(bytInText(i + 2And &H3F)
        lngEncodeLen 
= lngEncodeLen + 4
    
Next
    
    i 
= lngInTextLen - 1 + 1
    
If lngMod = 1 Then  '对剩余字节进行填充
        bytEncode(lngEncodeLen) = Base64EncodeTable((bytInText(i) And &HFC)  (2 ^ 2))
        bytEncode(lngEncodeLen 
+ 1= Base64EncodeTable((bytInText(i) And &H3) * (2 ^ 4))
        bytEncode(lngEncodeLen 
+ 2= Base64EncodeTable(64)  '填充=
        bytEncode(lngEncodeLen + 3= Base64EncodeTable(64)  '填充=
        lngEncodeLen = lngEncodeLen + 4
    
ElseIf lngMod = 2 Then
        bytEncode(lngEncodeLen) 
= Base64EncodeTable((bytInText(i) And &HFC)  (2 ^ 2))
        bytEncode(lngEncodeLen 
+ 1= Base64EncodeTable((bytInText(i) And &H3) * (2 ^ 4Or (bytInText(i + 1And &HF0)  (2 ^ 4))
        bytEncode(lngEncodeLen 
+ 2= Base64EncodeTable((bytInText(i + 1And &HF) * (2 ^ 2))
        bytEncode(lngEncodeLen 
+ 3= Base64EncodeTable(64)  '填充=
        lngEncodeLen = lngEncodeLen + 4
    
End If

    Base64_Encode 
= bytEncode()
End Function

'Base64解码函数
Public Function Base64_Decode(bytInText() As ByteAs Byte()
    
Dim Base64DecodeTable(1 To 122As Byte
    
Dim lngInTextLen As Long, i As Long
    
Dim bytDecode() As Byte, lngDecodeLen As Long
    
    Base64_Decode 
= Chr(0)  '初始化函数返回值
    
    
If LBound(bytInText) <> 0 Then Exit Function  'bytInText数组下标不从零开始则出错返回
    
    lngInTextLen 
= UBound(bytInText) - LBound(bytInText) + 1  '计算bytInText数组长度
    If lngInTextLen Mod 4 <> 0 Then Exit Function  '输入编码不是4的倍数则出错返回
    
    
For i = 1 To 122  '初始化Base64解码表
        Select Case i
        
Case 43  '+
            Base64DecodeTable(i) = 62
        
Case 47  '/
            Base64DecodeTable(i) = 63
        
Case 48 To 57  '0 - 9
            Base64DecodeTable(i) = 52 + (i - 48)
        
Case 65 To 90  'A - Z
            Base64DecodeTable(i) = 0 + (i - 65)
        
Case 97 To 122  'a - z
            Base64DecodeTable(i) = 26 + (i - 97)
        
Case Else
            Base64DecodeTable(i) 
= 255
        
End Select
    
Next
    lngDecodeLen 
= lngInTextLen / 4 * 3  '求解码后的最大长度
    ReDim bytDecode(0 To lngDecodeLen - 1)  '重新定义解码缓冲区
    'MsgBox "解码后的最大长度为:" & lngDecodeLen
    
    lngDecodeLen 
= 0  '初始化解码长度
    
    
For i = 0 To lngInTextLen - 1 Step 4
        bytDecode(lngDecodeLen) 
= (Base64DecodeTable(bytInText(i)) * (2 ^ 2)) Or ((Base64DecodeTable(bytInText(i + 1)) And &H30)  (2 ^ 4))
        bytDecode(lngDecodeLen 
+ 1= ((Base64DecodeTable(bytInText(i + 1)) And &HF) * (2 ^ 4)) Or ((Base64DecodeTable(bytInText(i + 2)) And &H3C)  (2 ^ 2))
        bytDecode(lngDecodeLen 
+ 2= ((Base64DecodeTable(bytInText(i + 2)) And &H3) * (2 ^ 6)) Or Base64DecodeTable(bytInText(i + 3))
        lngDecodeLen 
= lngDecodeLen + 3
    
Next
    
    
If bytInText(lngInTextLen - 1= &H3D Then  '判断最后两个字节的情况,求解码后的实际长度
        If bytInText(lngInTextLen - 2= &H3D Then
            lngDecodeLen 
= lngDecodeLen - 2  '最后两个字节为"="
        Else
            lngDecodeLen 
= lngDecodeLen - 1  '最后一个字节为"="
        End If
        bytDecode(lngDecodeLen) 
= 0  '在实际长度的后一个字节放个结束符
    End If
    
'MsgBox "解码后的实际长度为:" & lngDecodeLen
    
    Base64_Decode 
= bytDecode()
End Function

frmLogin.frm窗体

Option Explicit

Private Sub cmdAdd_Click()  '添加按钮
    frmSet.Show 1  '模态显示设置对话框
    Call QQ_DB_UpdataUserList(lvListView)
End Sub

Private Sub cmdDel_Click()  '删除按钮
    Dim i As Integer, blnSelect As Boolean
    
    
For i = 1 To lvListView.ListItems.Count
        
If lvListView.ListItems(i).Checked = True Then
            blnSelect 
= True
            
If MsgBox("你确定要删除QQ号码为:" & lvListView.ListItems(i).Text & "的记录吗?", vbInformation + vbOKCancel, "QQ自动登录器"= vbOK Then
                
Call QQ_DB_Del(lvListView.ListItems(i).Text)
            
End If
        
End If
    
Next
    
    
Call QQ_DB_UpdataUserList(lvListView)
    
If blnSelect = False Then
        
MsgBox "请先选择一个QQ号码!", vbInformation + vbOKOnly, "QQ自动登录器"
    
End If
End Sub

Private Sub cmdExit_Click()  '退出按钮
    End
End Sub

Private Sub cmdLogin_Click()  '登录按钮
    Dim i As Integer, strNum As String, intLoginMode As Integer, blnSelect As Boolean
    
    
If chkLoginMode.Value = 1 Then  '选中隐身登录复选框
        intLoginMode = 40
    
Else
        intLoginMode 
= 41
    
End If
    
    
For i = 1 To lvListView.ListItems.Count
        
If lvListView.ListItems(i).Checked = True Then
            blnSelect 
= True
            
            strNum 
= lvListView.ListItems(i).Text
            
Call QQ_AutoLogin(strNum, intLoginMode) '自动登录QQ
        End If
    
Next
    
    
If blnSelect = False Then
        
MsgBox "请先选择一个QQ号码!", vbInformation + vbOKOnly, "QQ自动登录器"
    
End If
End Sub

Private Sub cmdModify_Click()  '修改按钮
    Dim i As Integer, blnSelect As Boolean
    
    
For i = 1 To lvListView.ListItems.Count
        
If lvListView.ListItems(i).Checked = True Then
            blnSelect 
= True
            frmSet.g_strNum 
= lvListView.ListItems(i).Text
            frmSet.Show 
1
        
End If
    
Next
    
    
If blnSelect = False Then
        
MsgBox "请先选择一个QQ号码!", vbInformation + vbOKOnly, "QQ自动登录器"
    
End If
End Sub

Private Sub Form_Load()
    
If QQ_DB_Connect = False Then '连接数据库
        End
    
End If
    lvListView.SmallIcons 
= ilImageList
    
Call QQ_DB_UpdataUserList(lvListView)
End Sub

Private Sub lvListView_ItemClick(ByVal Item As MSComctlLib.ListItem)
    lvListView.SelectedItem.Checked 
= Not lvListView.SelectedItem.Checked
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
Call QQ_DB_Deconnetion  '断开与数据库的连接
End Sub

frmSet.frm窗体:

Option Explicit
Public g_strNum As String  '保存主窗口传递过来的QQ号码变量

Private Sub cmdCancel_Click()  '取消按钮
    Unload frmSet
End Sub

Private Sub cmdOK_Click()  '确定按钮
    Dim strNum As String, strPwd As String, lngRet As Long
    
    
If Trim(txtNumber.Text) = "" Or Trim(txtPassword.Text) = "" Or Trim(txtPassword2.Text) = "" Then
        
MsgBox "请输入完整的信息!", vbInformation Or vbOKOnly, "QQ自动登录器"
        txtNumber.SetFocus
        
Exit Sub
    
End If
    
    
If Trim(txtPassword.Text) <> Trim(txtPassword2.Text) Then
        
MsgBox "两次输入的密码不一致,请重新输入!", vbInformation Or vbOKOnly, "QQ自动登录器"
        txtPassword.Text 
= ""
        txtPassword2.Text 
= ""
        txtPassword.SetFocus
        
Exit Sub
    
End If
    
    strNum 
= Trim(txtNumber.Text)
    strPwd 
= Trim(txtPassword.Text)
    
    
If g_strNum <> "" Then  '修改密码信息
        Call QQ_DB_Edit(strNum, strPwd)
        
MsgBox "修改成功!", vbInformation Or vbOKOnly, "QQ自动登录器"
        Unload frmSet
    
Else '添加密码信息
        If QQ_DB_Find(strNum) Then
            
If MsgBox("您所输入的QQ号码信息已存在数据库中,是否改变密码信息?", vbInformation Or vbYesNo, "QQ自动登录器"= vbYes Then
                
Call QQ_DB_Edit(strNum, strPwd)
                
MsgBox "修改成功!", vbInformation Or vbOKOnly, "QQ自动登录器"
                Unload frmSet
            
Else
                
Exit Sub
            
End If
        
Else
            
Call QQ_DB_Add(strNum, strPwd)
            
MsgBox "记录成功!", vbInformation Or vbOKOnly, "QQ自动登录器"
            Unload frmSet
        
End If
    
End If
End Sub

Private Sub Form_Load()
    
If g_strNum <> "" Then
        txtNumber.Text 
= g_strNum
        txtNumber.Enabled 
= False
    
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    g_strNum 
= ""
End Sub

Private Sub txtNumber_KeyPress(KeyAscii As Integer)
    
If KeyAscii >= Asc(0And KeyAscii <= Asc(9Or KeyAscii = 8 Or KeyAscii = 13 Then
        
    
Else
        KeyAscii 
= 0
    
End If
End Sub
        该程序用ACCESS保存QQ的密码信息,可以实现批量登录。当你有多个QQ号码需要登录的时候就不用一个个去按QQ输密码了。程序还有一个需要改进的地方,就是保存密码的时候保存的是明文,虽然数据库加了密码,但现在ACCESS数据库好像不是很安全,网上经常看到有破解ACCESS数据库密码之类的文章。所以建议大家在保存密码的时候最好再加个自己的加密的方法。(直接保存密码的MD5也是不安全的喔,别人知道了MD5一样是可以登录你QQ的)
阅读(1732) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~