107 lines
2.5 KiB
QBasic
107 lines
2.5 KiB
QBasic
|
Attribute VB_Name = "crypto"
|
||
|
|
'//+----------------------------------------------------------------------------
|
||
|
|
'//
|
||
|
|
'// File: crypto.bas
|
||
|
|
'//
|
||
|
|
'// Module: pbadmin.exe
|
||
|
|
'//
|
||
|
|
'// Synopsis: Functions to encrypt a database so as to hide passwords
|
||
|
|
'//
|
||
|
|
'// Copyright (c) 1997-1999 Microsoft Corporation
|
||
|
|
'//
|
||
|
|
'// Author: 11-Jul-2000 SumitC Created
|
||
|
|
'//
|
||
|
|
'//+----------------------------------------------------------------------------
|
||
|
|
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
'//+----------------------------------------------------------------------------
|
||
|
|
'//
|
||
|
|
'// Function: DBPassword, generates a password
|
||
|
|
'//
|
||
|
|
'//+----------------------------------------------------------------------------
|
||
|
|
Public Function DBPassword() As String
|
||
|
|
|
||
|
|
Dim pw As String
|
||
|
|
Dim i As Integer
|
||
|
|
|
||
|
|
On Error GoTo Err:
|
||
|
|
|
||
|
|
pw = "PhoneBookAdmin"
|
||
|
|
|
||
|
|
pw = Mid(pw, 1, 9) + Chr(Asc(Mid(pw, 10, 1)) + 2) + Mid(pw, 11)
|
||
|
|
pw = Mid(pw, 5) + Left(pw, 4)
|
||
|
|
For i = 4 To 12 Step 2
|
||
|
|
pw = Mid(pw, 1, i - 1) + Chr(Asc(Mid(pw, i, 1)) + 1) + Mid(pw, i + 1)
|
||
|
|
Next i
|
||
|
|
|
||
|
|
DBPassword = ";pwd=" + pw
|
||
|
|
|
||
|
|
Err:
|
||
|
|
' If Err <> 0 Then MsgBox "manip failed with " & Err.Description
|
||
|
|
|
||
|
|
End Function
|
||
|
|
|
||
|
|
|
||
|
|
'//+----------------------------------------------------------------------------
|
||
|
|
'//
|
||
|
|
'// Function: ConvertDatabaseIfNeeded, compacts/encrypts db if not already done
|
||
|
|
'//
|
||
|
|
'//+----------------------------------------------------------------------------
|
||
|
|
Public Sub ConvertDatabaseIfNeeded(Workspace As Object, szDBName As String, Options As Variant, fReadOnly As Variant)
|
||
|
|
|
||
|
|
Dim db As Database
|
||
|
|
|
||
|
|
On Error Resume Next
|
||
|
|
|
||
|
|
' first try to open the db without using a password
|
||
|
|
Set db = Workspace.OpenDatabase(szDBName, Options, fReadOnly)
|
||
|
|
|
||
|
|
If Err.Number = 0 Then
|
||
|
|
' db opened without a password. Needs to be converted
|
||
|
|
db.Close
|
||
|
|
On Error GoTo CompactErr
|
||
|
|
|
||
|
|
DBEngine.CompactDatabase szDBName, "TempConversionDatabase.mdb", dbLangGeneral, dbEncrypt, DBPassword
|
||
|
|
|
||
|
|
' rename the new db (play it safe, make sure the renames succeed first)
|
||
|
|
Name szDBName As "DeleteThis.mdb"
|
||
|
|
Name "TempConversionDatabase.mdb" As szDBName
|
||
|
|
Kill "DeleteThis.mdb"
|
||
|
|
End If
|
||
|
|
|
||
|
|
On Error GoTo CompactErr
|
||
|
|
' check that the db will open using the password
|
||
|
|
Set db = Workspace.OpenDatabase(szDBName, Options, fReadOnly, DBPassword)
|
||
|
|
db.Close
|
||
|
|
|
||
|
|
CompactErr:
|
||
|
|
|
||
|
|
'If Err <> 0 Then MsgBox "Failed to convert db with error: " & Err.Description
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
OpenErr:
|
||
|
|
|
||
|
|
'If Err <> 0 Then MsgBox "Failed to open db with error: " & Err.Description
|
||
|
|
Exit Sub
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|