📄 frmgetpass.frm
字号:
VERSION 5.00
Begin VB.Form frmGetpass
Caption = "探测EXCEL97密码"
ClientHeight = 4290
ClientLeft = 4020
ClientTop = 3345
ClientWidth = 5385
Icon = "frmGetpass.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4290
ScaleWidth = 5385
Begin VB.PictureBox PIC1
Height = 2925
Left = 75
ScaleHeight = 2865
ScaleWidth = 3510
TabIndex = 7
Top = 810
Width = 3570
Begin VB.CheckBox chkNumber
Caption = "数字 ( 0 ~ 9)"
Height = 465
Left = 270
TabIndex = 14
Top = 450
Width = 2550
End
Begin VB.CheckBox chkLow
Caption = "小写英文字母 ( a ~ z)"
Height = 420
Left = 270
TabIndex = 13
Top = 900
Width = 2595
End
Begin VB.CheckBox chkUp
Caption = "大写英文字母 ( A ~ Z)"
Height = 495
Left = 270
TabIndex = 12
Top = 1320
Width = 2355
End
Begin VB.CheckBox chkOther
Caption = "其它可打印符号 ( @ ! % $ [ } 等)"
Height = 420
Left = 270
TabIndex = 11
Top = 1800
Width = 2940
End
Begin VB.CommandButton cmdYes
Caption = "确定"
Height = 345
Left = 2370
TabIndex = 10
Top = 2430
Width = 975
End
Begin VB.CheckBox chkDict
Caption = "首先探测密码字典 (DICT.DIC)"
Height = 390
Left = 255
TabIndex = 9
Top = 105
Value = 1 'Checked
Width = 2925
End
Begin VB.TextBox txtNum
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 420
TabIndex = 8
Text = "1"
Top = 2340
Width = 570
End
Begin VB.Label Label3
Caption = "从"
Height = 300
Left = 105
TabIndex = 16
Top = 2400
Width = 270
End
Begin VB.Label Label4
Caption = "位密码开始"
Height = 270
Left = 1050
TabIndex = 15
Top = 2385
Width = 1155
End
End
Begin VB.Timer Timer1
Left = 3375
Top = 105
End
Begin VB.CommandButton cmdClose
Caption = "关闭(&X)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 690
Left = 4035
TabIndex = 5
Top = 2055
Width = 1260
End
Begin VB.TextBox txtFileName
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 705
TabIndex = 3
Top = 150
Width = 2910
End
Begin VB.CommandButton cmdStop
Caption = "停止"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 690
Left = 4035
TabIndex = 1
Top = 1132
Width = 1260
End
Begin VB.CommandButton cmdOpen
Caption = "开始探测"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 690
Left = 4035
TabIndex = 0
Top = 180
Width = 1260
End
Begin VB.Image Image2
Height = 2385
Left = 495
Picture = "frmGetpass.frx":0442
Top = 915
Width = 3000
End
Begin VB.Label lblInfo
Height = 810
Left = 4020
TabIndex = 6
Top = 2910
Width = 1110
End
Begin VB.Image Image1
Height = 225
Left = 3720
Picture = "frmGetpass.frx":2668
Top = 3030
Width = 240
End
Begin VB.Label Label2
Caption = "文件名"
Height = 240
Left = 105
TabIndex = 4
Top = 240
Width = 615
End
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 60
TabIndex = 2
Top = 3855
Width = 5160
End
End
Attribute VB_Name = "frmGetpass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'EXCEL97密码探测器
'Program By: JYD Date:1999-01-01
'E-mail: jyd12@163.net
'WEB: http://vbvbok.yeah.net
'本程序只用于个人EXCEL密码遗忘时，试图探测密码；
'减少重复劳动，不可进行其它不当使用，否则后果由使用者自负；
'在文本框中输入EXCEL文档的全路径名称,例如： C:\doc\book1.xls；
'适用于WINDOWS95/98/NT系统 ，安装了EXCEL97 。
'此源码公开，欢迎感兴趣的网友优化提高。
'稍加修改即可用于探测ACCESS ,WORD 文档的密码。
'适当修改或增加密码字典:dict.DIC(纯文本)，可提高探测速度。
'可探测1~12位密码，可扩展为15位。
'可先以4位数字密码来测试本程序，然后再用其它组合。
'我发现网上也有类似程序，是共享程序。可能速度快一些.
Option Explicit
Dim vbExcel As Excel.Application
Private stopFlag As Boolean
Private StartNum As Integer
Private strChar(200)
Private strNumber(11) '数字
Private strCharUp(26) '大写英文字母
Private strCharLow(26) '小写英文字母
Private strCharOther(25) '其它符号
Private strCharMax As Integer
Private Max As Integer
Private DictFirst As Boolean
Private Num As Long
Private OK As Boolean
Private Filename As String
Private PassWord As String
Private Const OFS_MAXPATHNAME = 128
Private Type OFStruct
CBytes As Byte
FFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
SzPathName(OFS_MAXPATHNAME) As Byte
End Type
Private typOfStruct As OFStruct
Private Const OF_EXIST = &H4000
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFStruct, ByVal wStyle As Long) As Long
Private Function FileExist(ByVal sFilename As String) As Boolean
Dim typOfStruct As OFStruct
FileExist = False
On Error Resume Next
If Len(sFilename) > 0 Then
OpenFile sFilename, typOfStruct, OF_EXIST
FileExist = typOfStruct.nErrCode <> 2
End If
End Function
Private Function Dict() As Boolean
Dict = False
Dim DictFile As String
DictFile = App.Path
If Len(DictFile) > 3 Then DictFile = DictFile + "\"
DictFile = DictFile + "dict.dic"
On Error Resume Next
Open DictFile For Input As #1
If Err = 53 Then
MsgBox Str(Err) & " 没有找到密码字典文件 dict.dic !!"
Exit Function
End If
Dim prog As String
Do While Not EOF(1)
If stopFlag = True Then
Dict = False
Close #1
Exit Function
End If
Input #1, prog
Num = Num + 1
PassWord = prog
OK = OpenExcel(Filename, PassWord)
If OK = True Then
Close #1
Dict = True
Exit Function
End If
If prog <> UCase(prog) Then
Num = Num + 1
PassWord = UCase(prog)
OK = OpenExcel(Filename, PassWord)
If OK = True Then
Close #1
Dict = True
Exit Function
End If
End If
Loop
Close #1
End Function
Private Function E_1() As Boolean
E_1 = False
Dim i As Long
For i = 1 To Max
'===============
Num = Num + 1
If stopFlag = True Then
Set vbExcel = Nothing
MsgBox "用户中断!!"
Exit Function
End If
PassWord = strChar(i)
Label1.Caption = "探测次数:" & Str(Num) & " 密码:" & PassWord
DoEvents
OK = OpenExcel(Filename, PassWord)
If OK = True Then
E_1 = True
Exit Function
End If
'===============
Next i
End Function
Private Function E_2() As Boolean
E_2 = False
Dim i As Long
Dim j As Long
For i = 1 To Max
For j = 1 To Max
'===============
Num = Num + 1
If stopFlag = True Then
Set vbExcel = Nothing
MsgBox "用户中断!!"
Exit Function
End If
PassWord = strChar(i) + strChar(j)
Label1.Caption = "探测次数:" & Str(Num) & " 密码:" & PassWord
DoEvents
OK = OpenExcel(Filename, PassWord)
If OK = True Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -