如有你有帮助，请购买下载，谢谢！

VB编写破解Access程序源代码

1、 首先是窗体代码 Option Explicit

Private Sub cmdOpenFile_Click() Dim sFile As String Dim sPasswd As String Dim sVersion As String

cmdOpenFile.Enabled = False

sFile = INNER_GetFileName(True, \请选择数据库文件\

If Len(sFile) > 0 Then Shape1.Width = 0 txtFileName = sFile txtVersion = \ txtPassword = \

sPasswd = INNER_GetAccessPwd(sFile, sVersion) txtVersion = sVersion txtPassword = sPasswd End If

cmdOpenFile.Enabled = True End Sub

Private Sub Form_Load() Shape1.Width = 0 End Sub

2、接着是模块代码 Option Explicit

#Const USE_DAO = 0 #If USE_DAO Then

Public gDAO As DAO.Database #Else

Public gADO As ADODB.Connection #End If

Public Function INNER_GetFileName(ByVal 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 = \

.Filter = \所有文件 (*.*)|*.*\ Else

.Filter = fsFilter

1页

如有你有帮助，请购买下载，谢谢！

End If

.Flags = cdlOFNHideReadOnly Or cdlOFNExplorer .CancelError = True

.DefaultExt = fsDefaultExt

If fsDialogTitle <> \ If fsDefFile <> \ Do

If fbOpen Then .ShowOpen Else

.ShowSave End If

If Len(.FileName) = 0 Then Exit Function End If

If Not fbOpen Then

If Len(Dir(.FileName)) > 0 Then

iReplace = MsgBox(\代替存在的 \吗?\vbQuestion)

Else

iReplace = 0 End If

If iReplace = vbCancel Then Exit Function End If Else

If Not (Len(Dir(.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 With ErrLabel:

Select Case Err.Number Case 75

MsgBox Err.Description & \请重新选择文件路径!\ End Select End Function

Public Function INNER_GetAccessPwd(fsDBsee As String, fsRetVer As String) As String Dim sTemp As String

2页

如有你有帮助，请购买下载，谢谢！

Dim bytVer(2) As Byte Dim bytDB_ID As Byte Dim byt2 As Byte Dim bytSecret(19) As Byte Dim bytEncrept(19) 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 bytVer(0) = 0 Then fsRetVer = \ Else

fsRetVer = Chr(bytVer(0)) & Chr(bytVer(1)) & Chr(bytVer(2)) End If

Get #iFreeFile, &H15, bytDB_ID

fsRetVer = IIf(bytDB_ID = 0, \er:\ If bytDB_ID = 1 Then lMax = 20

bytSecret(0) = (&H49) bytSecret(1) = (&HEC) bytSecret(2) = (&H92) bytSecret(3) = (&H9C) bytSecret(4) = (&H9) bytSecret(5) = (&H28) bytSecret(6) = (&HDC) bytSecret(7) = (&H8A) bytSecret(8) = (&H9B) bytSecret(9) = (&H7B) bytSecret(10) = (&H3A) bytSecret(11) = (&HDF) bytSecret(12) = (&HB8) bytSecret(13) = (&H13) bytSecret(14) = (&H0) bytSecret(15) = (&HB1) bytSecret(16) = (&HFB) bytSecret(17) = (&H79) bytSecret(18) = (&H5D) bytSecret(19) = (&H7C) ElseIf bytDB_ID = 0 Then lMax = 13

bytSecret(0) = (&H86)

3页