www.pudn.com > get_password.rar > frmmain.frm
VERSION 5.00
Object = "{FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.1#0"; "COMCT232.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmmain
BackColor = &H00C0E0FF&
Caption = "破解word&excel xp的密码的小工具"
ClientHeight = 7065
ClientLeft = 60
ClientTop = 450
ClientWidth = 3585
Icon = "frmmain.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7065
ScaleWidth = 3585
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame4
Caption = "密码区"
Height = 855
Left = -120
TabIndex = 21
Top = 4200
Width = 3855
Begin VB.TextBox Text1
Height = 375
Left = 1200
TabIndex = 23
Top = 360
Width = 2295
End
Begin VB.Label Label1
Caption = "破解进度"
Height = 375
Left = 240
TabIndex = 22
Top = 360
Width = 975
End
End
Begin MSComDlg.CommonDialog dialog
Left = 3240
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DialogTitle = "请选择加密的excel或word文档"
Filter = "excel(*.xls),word(*.doc)|*.xls;*.doc"
End
Begin VB.CommandButton cmdquit
Caption = "退出系统"
Height = 375
Left = 1800
TabIndex = 5
Top = 5040
Width = 1695
End
Begin VB.CommandButton cmdstartcrack
Caption = "开始破解"
Height = 375
Left = 0
TabIndex = 4
Top = 5040
Width = 1695
End
Begin VB.Frame Frame3
Caption = "选择密码长度"
Height = 855
Left = 0
TabIndex = 2
Top = 3360
Width = 3735
Begin ComCtl2.UpDown UpDown2
Height = 375
Left = 2760
TabIndex = 15
Top = 240
Width = 255
_ExtentX = 450
_ExtentY = 661
_Version = 327681
Value = 1
BuddyControl = "txtpasswordendlong"
BuddyDispid = 196613
OrigLeft = 2640
OrigTop = 720
OrigRight = 2895
OrigBottom = 1095
Max = 15
Min = 1
SyncBuddy = -1 'True
Wrap = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin ComCtl2.UpDown UpDown1
Height = 375
Left = 1200
TabIndex = 14
Top = 240
Width = 255
_ExtentX = 450
_ExtentY = 661
_Version = 327681
Value = 1
BuddyControl = "txtpasswordstartlong"
BuddyDispid = 196614
OrigLeft = 2640
OrigTop = 240
OrigRight = 2895
OrigBottom = 615
Max = 15
Min = 1
SyncBuddy = -1 'True
Wrap = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.TextBox txtpasswordendlong
Height = 375
Left = 2160
TabIndex = 13
Text = "2"
Top = 240
Width = 600
End
Begin VB.TextBox txtpasswordstartlong
Height = 390
Left = 600
TabIndex = 12
Text = "2"
Top = 240
Width = 585
End
Begin VB.Label Label4
Caption = "位"
Height = 255
Left = 3120
TabIndex = 20
Top = 360
Width = 255
End
Begin VB.Label Label2
Caption = "位"
Height = 375
Left = 1560
TabIndex = 19
Top = 360
Width = 255
End
Begin VB.Label Label5
Caption = "到"
Height = 255
Left = 1800
TabIndex = 17
Top = 360
Width = 255
End
Begin VB.Label Label3
Caption = "从第"
Height = 255
Left = 120
TabIndex = 16
Top = 360
Width = 375
End
End
Begin VB.Frame Frame2
Caption = "选择密码字符范围"
Height = 2055
Left = 0
TabIndex = 1
Top = 1320
Width = 3735
Begin VB.CheckBox chkothers
Caption = "其他OEM字符(26)"
Height = 375
Left = 1680
TabIndex = 11
Top = 1560
Width = 1935
End
Begin VB.CheckBox chkbracket
Caption = "括号(6)"
Height = 255
Left = 1680
TabIndex = 10
Top = 1080
Width = 975
End
Begin VB.CheckBox chkspace
Caption = "空格(1)"
Height = 255
Left = 1680
TabIndex = 9
Top = 480
Width = 1215
End
Begin VB.CheckBox chkuppercase
Caption = "大写字母(26)"
Height = 255
Left = 120
TabIndex = 8
Top = 1560
Width = 1575
End
Begin VB.CheckBox chklowercase
Caption = "小写字母(26)"
Height = 375
Left = 120
TabIndex = 7
Top = 960
Width = 1455
End
Begin VB.CheckBox chkdigital
Caption = "数字(10)"
Height = 255
Left = 120
TabIndex = 6
Top = 480
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "选择加密文件(*.xls、*.doc)"
Height = 1335
Left = 0
TabIndex = 0
Top = 0
Width = 3735
Begin VB.ComboBox Combo1
Height = 300
Left = 120
TabIndex = 18
Top = 360
Width = 3495
End
Begin VB.CommandButton cmdbrowse
Caption = "浏览"
Height = 375
Left = 1200
TabIndex = 3
Top = 840
Width = 1215
End
End
Begin VB.Label Label7
Caption = $"frmmain.frx":0E42
Height = 975
Left = 0
TabIndex = 25
Top = 6000
Width = 3615
End
Begin VB.Label Label6
Caption = "本破解软件的源代码取自互联网，此软件严禁用于非法活动，只可进行技术交流！"
Height = 495
Left = 0
TabIndex = 24
Top = 5520
UseMnemonic = 0 'False
Width = 3615
WordWrap = -1 'True
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdbrowse_Click()
dialog.ShowOpen
Combo1.Text = dialog.FileName
Combo1.Refresh
End Sub
Private Sub cmdquit_Click()
End
End Sub
Private Sub cmdstartcrack_Click()
Static blnprocessing As Boolean
Dim wd As New Word.Application, xls As New Excel.Application
Dim openreturn
Dim strpath, pass, strtemp, all_char(100) As String
Dim j, k, password_start_long, password_end_long, arraylen As Integer
Dim i, temp As Long
arraylen = 0 '数组初始化
If chkdigital.Value = 1 Then '字符校验开始
For j = arraylen To arraylen + 9
all_char(j) = Chr(Asc("0") + j - arraylen)
Next j
arraylen = arraylen + 10
End If
If chklowercase.Value = 1 Then '小写字符校验开始
For j = arraylen To arraylen + 25
all_char(j) = Chr(Asc("a") + j - arraylen)
Next j
arraylen = arraylen + 26
End If
If chkuppercase.Value = 1 Then '大写字符校验开始
For j = arraylen To arraylen + 25
all_char(j) = Chr(Asc("A") + j - arraylen)
Next j
arraylen = arraylen + 26
End If
If chkspace.Value = 1 Then '空格字符校验开始
all_char(arraylen) = ""
arraylen = arraylen + 1
End If
If chkbracket.Value = 1 Then '括号字符校验开始
all_char(arraylen) = "("
all_char(arraylen + 1) = ")"
all_char(arraylen + 2) = "{"
all_char(arraylen + 3) = "}"
all_char(arraylen + 4) = "["
all_char(arraylen + 5) = "]"
arraylen = arraylen + 6
End If
If chkothers.Value = 1 Then '括号字符校验开始
For j = arraylen To arraylen + 6 '33-39
all_char(j) = Chr(33 + j - arraylen)
Next j
arraylen = arraylen + 7
For j = arraylen To arraylen + 5 '42-47
all_char(j) = Chr(42 + j - arraylen)
Next j
arraylen = arraylen + 6
For j = arraylen To arraylen + 6 '58-64
all_char(j) = Chr(58 + j - arraylen)
Next j
arraylen = arraylen + 7
all_char(arraylen) = Chr(92)
arraylen = arraylen + 1
For j = arraylen To arraylen + 2 '94-96
all_char(j) = Chr(94 + j - arraylen)
Next j
arraylen = arraylen + 3
all_char(arraylen) = Chr(124)
all_char(arraylen) = Chr(126)
arraylen = arraylen + 2
End If
If arraylen = 0 Then
MsgBox "错误:'没有选择密码使用的字符'", , "请重新选择密码使用的字符范围..."
Exit Sub
End If
If blnprocessing Then
If MsgBox("真的要中断解密过程吗?", vbYesNo, "用户中断任务") = vbYes Then blnprocessing = False
Else
cmdstartcrack.Caption = "中断破解"
blnprocessing = True
strpath = Combo1.Text
If strpath = "" Then
MsgBox "错误:没有选择文件", , "请选择要解密的文件..."
Exit Sub
End If
strpath = Trim(strpath)
password_start_long = Val(txtpasswordstartlong.Text)
password_end_long = Val(txtpasswordendlong.Text)
If password_start_long > password_end_long Then
password_start_long = Val(txtpasswordendlong.Text)
password_end_long = Val(txtpasswordstartlong.Text)
End If
Label1.Caption = "破解进度:"
Label1.Refresh
On Error Resume Next
If UCase(Right(strpath, 3)) = "XLS" Then '破解excel开始
For k = password_start_long To password_end_long
For i = 0 To arraylen ^ k - 1
pass = ""
temp = i
For j = 1 To k - 1
temp = temp \ arraylen
pass = all_char(temp Mod arraylen) + pass
Next j
pass = pass + all_char(i Mod arraylen)
Set openreturn = xls.Workbooks.Open(FileName:=strpath, Password:=pass)
Text1.Text = pass
Text1.Refresh
If Err.Number <> 0 Then
Err.Clear
Else
Label1.Caption = "密码是:"
Text1.Text = pass
Me.Refresh
xls.Visible = True
cmdstartcrack.MousePointer = 0
cmdstartcrack.Caption = "开始破解"
blnprocessing = False
Set xls = Nothing
Exit Sub
End If
DoEvents
If Not blnprocessing Then Exit For
Next i
If Not blnprocessing Then Exit For
Next k
xls.Quit
Set xls = Nothing
Else
For k = password_start_long To password_end_long
For i = 0 To arraylen ^ k - 1
pass = ""
temp = i
For j = 1 To k - 1
temp = temp \ arraylen
pass = all_char(temp Mod arraylen) + pass
Next j
pass = pass + all_char(i Mod arraylen)
openreturn = wd.Documents.Open(FileName:=strpath, passworddocument:=pass)
Text1.Text = pass
Text1.Refresh
If Err.Number <> 0 Then
Err.Clear
Else
Label1.Caption = "密码是:"
Text1.Text = pass
Me.Refresh
wd.Visible = True
cmdstartcrack.MousePointer = 0
cmdstartcrack.Caption = "开始破解"
blnprocessing = False
Set wd = Nothing
Exit Sub
End If
DoEvents
If Not blnprocessing Then Exit For
Next i
If Not blnprocessing Then Exit For
Next k
wd.Quit
Set wd = Nothing
End If
cmdstartcrack.Caption = "开始破解"
If blnprocessing Then
MsgBox "没有找到密码,可能是位数不对!!..", , "提示信息..."
blnprocessing = False
End If
End If
End Sub
Private Sub Form_Load()
If App.PrevInstance Then
MsgBox "系统不允许程序运行多次，请关闭后再试。", vbInformation, "系统提示"
End If
End Sub