?? 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 = "數(shù)字 ( 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 = "關(guān)閉(&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系統(tǒng) ，安裝了EXCEL97 。
'此源碼公開，歡迎感興趣的網(wǎng)友優(yōu)化提高。
'稍加修改即可用于探測ACCESS ,WORD 文檔的密碼。
'適當修改或增加密碼字典:dict.DIC(純文本)，可提高探測速度。
'可探測1~12位密碼，可擴展為15位。
'可先以4位數(shù)字密碼來測試本程序，然后再用其它組合。
'我發(fā)現(xiàn)網(wǎng)上也有類似程序，是共享程序。可能速度快一些.
Option Explicit
Dim vbExcel As Excel.Application
Private stopFlag As Boolean
Private StartNum As Integer
Private strChar(200)
Private strNumber(11) '數(shù)字
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 = "探測次數(shù):" & 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 = "探測次數(shù):" & Str(Num) & " 密碼:" & PassWord
DoEvents
OK = OpenExcel(Filename, PassWord)
If OK = True Then
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -