以temp.bin.db.cfg.dat结尾的都是什么类型的文件???
答案:1 悬赏:20 手机版
解决时间 2021-05-04 11:17
- 提问者网友:太高姿态
- 2021-05-03 19:00
以temp.bin.db.cfg.dat结尾的都是什么类型的文件???
最佳答案
- 五星知识达人网友:罪歌
- 2021-05-03 19:29
Option Explicit
Dim QQDir As String
Dim QQNumber As String
Sub Main()
On Error GoTo FinleNotFound
Dim QQPos As Long
QQDir = InputBox(" 请输入QQ安装的文件夹: ", "欢迎使用", "C: \Program Files\Tencent")
If QQDir = "" Then End
QQPos = SearchQQ(QQNumber)
If QQPos <> -1 Then
If MsgBox(" 要同时删除 " & QQNumber & "的聊天记录吗?", vbYesNo + vbInformation, "聊天记录") = vbYes Then DeleteChat QQNumber
DeleteQQ QQPos
Else
MsgBox " 没有找到 " & QQNumber & " 在本台计算机上的登陆信息 ", vbOKOnly + vbQuestion, " 找不到 "
End
FileNotFound:
If Err = "76" Then MsgBox "QQ的文件夹输入有误。", vbOKOnly + vbOKCancel, "有点问题": End
End If
Private Function SearchQQ(QQNum As String) As Long '用于实现QQ号的查找, 找到了返回它所在文件中的位置, 没有找到则返回 - 1
Dim QQLen As Integer, BeginPos As Long, SingleNum As String * 1, GetedNum As String
Open QQDir & "\dat\oicq2000.cfg" For Binary As #1 '打开oicq2000.cgf 文件
BeginPos = 13
While Not EOF(1)
Get #1, BeginPos, QQLen
If QQLen = Len(QQNumber) Then '判断QQ的位数是否相同
BeginPos = BeginPos + 4
For i = 1 To QQLen
Get #1, BeginPos, SingleNum
BeginPos = BeginPos + 1
If Mid(QQNumber, i, 1) <> SingleNum Then Exit For
Next
If i > Len(QQNumber) Then
SearchQQ = BeginPos - QQLen - 4 ' 没有找到则返回它所在文件中的位置
Close #1
Exit Function
Else
BeginPos = BeginPos + (QQLen - 1)
End If
Else
BeginPos = BeginPos + 4 + QQLen
End If
Wend
SearchQQ = -1
Close #1
End Function
Private Sub DeleteQQ(WritePos As Long) ' 删除QQ 记录
Dim Temp As Byte, QQLen As Integer, TotalNum As Byte, i As Long
Open QQDir & "\dat\oicp2000.cfg" For Binary As #2
Open QQDir & "\dat\oicp2000.cfg" For Binary As #3
Get #2, WritePos, QQLen
Get #2, 9, TotalNum
FileLong = LOF(2) - QQLen - 4
For i = 1 To WritePos - 1
Get #2, i, Temp
Put #3, i, Temp
Next
For i = WritePos To FileLong
Get #2, i + 4 + QQLen, Temp
Put #3, i, Temp
Next
Put #3
Dim QQDir As String
Dim QQNumber As String
Sub Main()
On Error GoTo FinleNotFound
Dim QQPos As Long
QQDir = InputBox(" 请输入QQ安装的文件夹: ", "欢迎使用", "C: \Program Files\Tencent")
If QQDir = "" Then End
QQPos = SearchQQ(QQNumber)
If QQPos <> -1 Then
If MsgBox(" 要同时删除 " & QQNumber & "的聊天记录吗?", vbYesNo + vbInformation, "聊天记录") = vbYes Then DeleteChat QQNumber
DeleteQQ QQPos
Else
MsgBox " 没有找到 " & QQNumber & " 在本台计算机上的登陆信息 ", vbOKOnly + vbQuestion, " 找不到 "
End
FileNotFound:
If Err = "76" Then MsgBox "QQ的文件夹输入有误。", vbOKOnly + vbOKCancel, "有点问题": End
End If
Private Function SearchQQ(QQNum As String) As Long '用于实现QQ号的查找, 找到了返回它所在文件中的位置, 没有找到则返回 - 1
Dim QQLen As Integer, BeginPos As Long, SingleNum As String * 1, GetedNum As String
Open QQDir & "\dat\oicq2000.cfg" For Binary As #1 '打开oicq2000.cgf 文件
BeginPos = 13
While Not EOF(1)
Get #1, BeginPos, QQLen
If QQLen = Len(QQNumber) Then '判断QQ的位数是否相同
BeginPos = BeginPos + 4
For i = 1 To QQLen
Get #1, BeginPos, SingleNum
BeginPos = BeginPos + 1
If Mid(QQNumber, i, 1) <> SingleNum Then Exit For
Next
If i > Len(QQNumber) Then
SearchQQ = BeginPos - QQLen - 4 ' 没有找到则返回它所在文件中的位置
Close #1
Exit Function
Else
BeginPos = BeginPos + (QQLen - 1)
End If
Else
BeginPos = BeginPos + 4 + QQLen
End If
Wend
SearchQQ = -1
Close #1
End Function
Private Sub DeleteQQ(WritePos As Long) ' 删除QQ 记录
Dim Temp As Byte, QQLen As Integer, TotalNum As Byte, i As Long
Open QQDir & "\dat\oicp2000.cfg" For Binary As #2
Open QQDir & "\dat\oicp2000.cfg" For Binary As #3
Get #2, WritePos, QQLen
Get #2, 9, TotalNum
FileLong = LOF(2) - QQLen - 4
For i = 1 To WritePos - 1
Get #2, i, Temp
Put #3, i, Temp
Next
For i = WritePos To FileLong
Get #2, i + 4 + QQLen, Temp
Put #3, i, Temp
Next
Put #3
我要举报
如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
推荐资讯