LEADERSOFT.ru Разработка на заказ программ и сайтов
Раздел обучения информационным технологиям
Разработка программ на Access
01. Данный пример показывает Вам техническое решение, которое может использоваться для бинарного редактирования файлов Access. Цель решения сравниванить по битно 2 файла: зашифрованный и нет. Таким образом, Вы сможете найти область изменения файла, где хранится ее пароль. Данное утверждение верно, только для некоторых версий Access.
Свойства продукта

 Microsoft Office: 2000,2002,2003,2007,2010  Архив с файлами: Перейти
 Операционная система: Windows XP,Vista  Применение: Базы данных Access
 Продажа: Купить  Файл исходника: ..\Access\03 Защита\la_protection1.mdb
 Язык интерфейса: Русский

   

Option Compare Database
Option Explicit

'***************************************************************
'Пример 1:   Удаление/установка пароля базы Данных /04.09.2000/
'***************************************************************

Dim pwdFree, pwdOne 'Массивы переменных, сохраняющих пароли

'==============================================================
'Название
'   Пример 1. Инициализация данных
Private Sub Form_Open(Cancel As Integer)
    'Нет пароля, пример шестнадцатиричной записи
    pwdFree = Array(&H86, &HFB, &HEC, &H37, &H5D, &H44, _
                    &H9C, &HFA, &HC6, &H5E, &H28, &HE6, &H13)
    'Пароль 1, пример десятичной записи
    pwdOne = Array(183, 251, 236, 55, 93, 68, _
                   156, 250, 198, 94, 40, 230, 19)
    
    'Значение файла в форме, назначаемое по умолчанию
    Me.myAccessFile.DefaultValue = "'" & funGetAppFolder & "\la_prot97.mdb" & "'"
    
    'Максимализировать приложение
    Application.DoCmd.RunCommand acCmdAppMaximize
End Sub


'==============================================================
'Название
'   Пример 1. Показать пароль
Private Sub butPassword_Click()
Dim As String
    MsgBox "Файл: " & Me.myAccessFile & Chr(13) & funReadHead(Me.myAccessFile), vbInformation, "Пароль файла"
End Sub


'==============================================================
'Название
'   Пример 1. Удалить пароль
Private Sub butDelPassword_Click()
    funSetPassword 0, "Пароль удален!"
End Sub


'==============================================================
'Название
'   Пример 1. Установить пароль
Private Sub butSetPassword_Click()
    funSetPassword 1, "Установлен пароль: 1"
End Sub


'==============================================================
'Название
'   Пример 1. Прочитать заголовок пароля
Private Function funReadHead(myFile As StringAs String
Dim As Integer, ID As Byte, pwd(12) As Byte
    On Error GoTo 999
    'Часть заголовка не защищенного файла
        ID = FreeFile 'Получить свободный идентификатор файла
        Open myFile For Binary As ID 'Открываем файл
        funReadHead = ""
        For i = 0 To 12
            Get #ID, 67 + i, pwd(i) 'Читаем пароль
            funReadHead = funReadHead & Format(pwd(i), "000") & ","
        Next i
        Close 'Закрываем открытые файлы
    Exit Function
999:
    MsgBox Err.Description
End Function


'==============================================================
'Название
'   Пример 1. Изменить пароль
Private Sub funSetPassword(myFlag As Integer, myMsg As String)
Dim As Integer, ID As Byte
    On Error GoTo 999
 
    If MsgBox("Изменить пароль файла ?", vbOKCancel + vbExclamation, "Изменение пароля") = vbOK Then
        ID = FreeFile 'Получить свободный идентификатор файла
        Open Me.myAccessFile For Binary As ID 'Открываем файл в двоичном виде
        For i = 0 To 12
            Select Case myFlag 'Выбираем режим установки
            Case 0: Put #ID, 67 + i, CByte(pwdFree(i)) 'Удаляем пароль
            Case 1: Put #ID, 67 + i, CByte(pwdOne(i))  'Записываем пароль 1
            End Select
        Next i
        Close 'Закрываем открытый файл
        MsgBox myMsg, vbInformation, "Изменение пароля" 'Сообщение
    End If
    
    Exit Sub
999:
    MsgBox Err.Description
End Sub


'==============================================================
'Название
'   Пример 1. проверить существование файла
Private Sub myAccessFile_AfterUpdate()
    If Dir(Me.myAccessFile) = "" Then
        MsgBox "Файл: " & Me.myAccessFile & " не существует!"
    End If
End Sub


'==============================================================
'Название
'   Пример 1. Открыть базу данных
Private Sub butView_Click()
      Application.FollowHyperlink Me.myAccessFile, , True
End Sub


'==============================================================
'Название
'   Пример 1. Прочитать папку (см. Лекции Access 2000)
Public Function funGetAppFolder() As String
Dim fs
    On Error GoTo 999  'Назначаем переход по ошибке
    Set fs = CreateObject("Scripting.FileSystemObject"'Создаем файловую систему
    funGetAppFolder = fs.GetFile(CurrentDb.Name).ParentFolder 'Находим папку
    Set fs = Nothing 'Уничтожаем переменную
    Exit Function 'Выходим из программы
999:
    MsgBox Err.Description 'Сообщаем об ошибке
    Err.Clear 'Очищаем поток от ошибок
End Function

Copyright © 2002-2015 ООО Лидер Эксэсс
Сайт работает под управлением: ASP.NET, Access