【VB开源代码栏目提醒】:网学会员在VB开源代码频道为大家收集整理了“VB编写计算Access数据库密源代码 - 毕业设计“提供大家参考,希望对大家有所帮助!
VB 编写破解 Access 程序源代码1、 首先是窗体代码Option ExplicitPrivate Sub cmdOpenFile_Click Dim sFile As String Dim sPasswd As String Dim sVersion As String cmdOpenFile.Enabled False sFile INNER_GetFileNameTrue mdb .mdb.mdb MDB txtFileName.Text 请选择数据库文件 If LensFile 0 Then Shape1.Width 0 txtFileName sFile txtVersion txtPassword sPasswd INNER_GetAccessPwdsFile sVersion txtVersion sVersion txtPassword sPasswd End If cmdOpenFile.Enabled TrueEnd SubPrivate Sub Form_Load Shape1.Width 0End Sub2、接着是模块代码Option ExplicitConst USE_DAO 0If USE_DAO Then Public gDAO As DAO.DatabaseElse Public gADO As ADODB.ConnectionEnd IfPublic Function INNER_GetFileNameByVal fbOpen As Boolean _ Optional ByVal fsFilter As String _ Optional ByVal fsDefaultExt As String _ Optional ByVal fsDefFile As String _ Optional ByVal fsDialogTitle As String As String On Error GoTo ErrLabel Dim iReplace As Integer With frmMain.CommonDialog1 If fsFilter Then .Filter 所有文件 .. Else .Filter fsFilter End If .Flags cdlOFNHideReadOnly Or cdlOFNExplorer .CancelError True .DefaultExt fsDefaultExt If fsDialogTitle Then .DialogTitle fsDialogTitle If fsDefFile Then .FileName fsDefFile Do If fbOpen Then .ShowOpen Else .ShowSave End If If Len.FileName 0 Then Exit Function End If If Not fbOpen Then If LenDir.FileName 0 Then iReplace MsgBox代替存在的 .FileName 吗 vbYesNoCancel vbQuestion Else iReplace 0 End If If iReplace vbCancel Then Exit Function End If Else If Not LenDir.FileName 0 Then Exit Function End If Loop While iReplace vbNo If Not fbOpen Then If iReplace vbYes Then Kill .FileName End If End If INNER_GetFileName .FileName End WithErrLabel: Select Case Err.Number Case 75 MsgBox Err.Description 请重新选择文件路径 vbExclamation End SelectEnd FunctionPublic Function INNER_GetAccessPwdfsDBsee As String fsRetVer As String As String Dim sTemp As String Dim bytVer2 As Byte Dim bytDB_ID As Byte Dim byt2 As Byte Dim bytSecret19 As Byte Dim bytEncrept19 As Byte Dim l As Long Dim n As Long Dim lMax As Long Dim iFreeFile As Integer iFreeFile FreeFile Open fsDBsee For Binary As iFreeFile Get iFreeFile H9D bytVer If bytVer0 0 Then fsRetVer 3.51 Else fsRetVer ChrbytVer0 ChrbytVer1 ChrbytVer2 End If Get iFreeFile H15 bytDB_ID fsRetVer IIfbytDB_ID 0 Access97 Ver: Access200 Ver: fsRetVer If bytDB_ID 1 Then lMax 20 bytSecret0 H49 bytSecret1 HEC bytSecret2 H92 bytSecret3 H9C bytSecret4 H9 bytSecret5 H28 bytSecret6 HDC bytSecret7 H8A bytSecret8 H9B bytSecret9 H7B bytSecret10 H3A bytSecret11 HDF bytSecret12 HB8 bytSecret13 H13 bytSecret14 H0 bytSecret15 HB1 bytSecret16 HFB bytSecret17 H79 bytSecret18 H5D bytSecret19 H7CElseIf bytDB_ID 0 Then lMax 13 bytSecret0 H86 bytSecret1 HFB bytSecret2 HEC bytSecret3 H37 bytSecret4 H5D bytSecret5 H44 bytSecret6 H9C bytSecret7 HFA bytSecret8 HC6 bytSecret9 H5E bytSecret10 H28 bytSecret11 HE6 bytSecret12 H13Else Close iFreeFile MsgBox 你怎么打开我不知道的文件 vbQuestion GoTo ErrLabelEnd IfOn Error GoTo ErrLabelFor l 1 To lMax Get iFreeFile H43 l - 1 bytDB_ID 1 bytEncreptl - 1Next lClose iFreeFileFor n -1 To 255 sTemp DoEvents If n -1 Or bytDB_ID 0 Then frmMain.Shape1.Width frmMain.Label5.Width n 1 / 255 For l 1 To lMax n n bytDB_ID If l Mod 2 1 Then sTemp sTemp ChrbytEncreptl - 1 Xor bytSecretl - 1 Xor n Else sTemp sTemp ChrbytEncreptl - 1 Xor bytSecretl - 1 End If Next l sTemp ReplacesTemp Chr0 If bytDB_ID 0 Then GoTo Endlabel If sTemp Then If INNER_CanOpenDateBasefsDBsee sTemp Then Exit For Else sTemp End If End If Else If INNER_CanOpenDateBasefsDBsee sTemp Then MsgBox 根本就没有密码,何必劳我大架呢 vbQuestion Exit For End If End If Next nEndlabel: INNER_GetAccessPwd sTemp Exit FunctionErrLabel: INNER_GetAccessPwd Err.DescriptionEnd FunctionPublic Function INNER_CanOpenDateBasefsFilename As String fsPasswd As String AsBoolean On Error GoTo ErrLabel Dim sConn As String If USE_DAO Then Set gDAO DAO.OpenDatabasefsFilename False 0 pwd fsPasswd If Not gDAO Is Nothing Then INNER_CanOpenDateBase True Set gDAO Nothing End If Else Set gADO New ADODB.Connection sConn PROVIDERMicrosoft.Jet.OLEDB.4.0Data Source fsFilename _ Jet OLEDB:Database Password fsPasswd gADO.Open sConn If Not gADO Is Nothing Then INNER_CanOpenDateBase True Set gADO Nothing End If End IfErrLabel:End Function