API với Registry 3

'2.4 Chèn một MODULE CLASS bằng INSERT MODULE CLASS

'Module CCONVERTERTABLE - CLASS

'-------------------------------------------------------------

' Class Name: CConverterTable

' Mô tả: Lớp Class chứa tên và khoá reg bằng tay của đoạn text chuyển và lọc đồ hoạ.

'-------------------------------------------------------------

Option Explicit

Option Compare Text

' Hướng dẫn chứa trong converter/filter data

Private Type CNV_FLT_ELEMENT

strCnvName As String ' Tên của converter/filter

hOptKey As Long 'Lựa chọn reg key bằng tay

iNext As Integer ' chỉ số index của phần tử kế tiếp trong danh sách đã nối kết

End Type

' Kể từ VBA không có các pointers, bảng này để sử dụng một bảng về trường lớn để giả vờ một danh sách nối kết

'-----------

' Các hằng constants

'-----------

' Khởi tạo cỡ bảng

Private Const iINIT_TBL_SIZE = 10

' Cỡ bước nhảy (số gia tăng)

Private Const iINC_STEP = 5

'Giá trị trường.iNext của phần tử cuối cùng trong danh sách nối kết

Private Const iLAST_ELMNT = -1

'----------------------

' Những thành viên riêng

'----------------------

'Chính bảng đó

Private m_arrCnvTable() As CNV_FLT_ELEMENT

' Cỡ hiện tại của bảng

Private m_iCurrTblSize As Integer

' Số hiện tại của các chuyển đổi

Private m_iCurrNumCnv As Integer

' Chỉ số của phần chuyển đầu tiên trong dánh sách

Private m_iFirst As Integer

'------------------------------------------------

'--- Thêm vào phần thêm của chuyển đổi, đồng thời chuôi handle của nó ---

'--------- tới khoá Options key vào bảng ---------

'------------------------------------------------

Public Sub AddConverter(ByVal strCnvNameDummy As String, _

ByVal hOptKeyDummy As Long, _

ByVal bExportImportFlag As Boolean)

Dim i, j As Integer

Dim bExpImpOn As Boolean

Dim strTempOld As String

Dim strTempNew As String

Dim iPrev As Integer ' Phần tử có trước được so sánh với phần tử mới

Dim iFoll As Integer ' phần tử theo sau được so sánh với phần tử mới

Dim iCurr As Integer ' Phần tử hiện tại được thêm vào danh sách

Dim iCompRes As Integer ' Kết quả chuỗi string so sánh

bExpImpOn = False

' Định lại cỡ bảng nếu cần thiết

If m_iCurrNumCnv = m_iCurrTblSize Then

' Cỡ gia tăng

m_iCurrTblSize = m_iCurrTblSize + iINC_STEP

' Định lại cỡ

ReDim Preserve m_arrCnvTable(m_iCurrTblSize) As CNV_FLT_ELEMENT

End If

' True=Export, False=Import

' Kiểm tra trùng tên trong bảng có rồi

For i = 0 To m_iCurrNumCnv - 1

If m_arrCnvTable(i).strCnvName = strCnvNameDummy Then

bExpImpOn = True

Exit For

End If

Next

' Nếu có một tên trùng thì thêm hậu tố

If bExpImpOn = True Then

' Nối thêm hậu tố Export/Import tới tên chuyển

If bExportImportFlag = True Then ' currently called from Exports

' Phần cũ phải ở Imports

strTempOld = m_arrCnvTable(i).strCnvName & strREG_IMPORT

m_arrCnvTable(i).strCnvName = strTempOld

strTempNew = strCnvNameDummy & strREG_EXPORT

Else

' Phần cũ từ Exports thì đưa vào Import

strTempOld = m_arrCnvTable(i).strCnvName & strREG_EXPORT

m_arrCnvTable(i).strCnvName = strTempOld

strTempNew = strCnvNameDummy & strREG_IMPORT

End If

End If

' Thêm tên chuyển vào bảng

' bộ đếm số gia tăng

m_iCurrNumCnv = m_iCurrNumCnv + 1

' Vào tên chuyển đổi và khoá cán Options key handle

With m_arrCnvTable(m_iCurrNumCnv - 1)

If bExpImpOn = False Then

.strCnvName = strCnvNameDummy

.hOptKey = hOptKeyDummy

Else

.strCnvName = strTempNew

.hOptKey = hOptKeyDummy

End If

End With

' Xếp theo chỉ số

' danh sách rỗng?

If m_iCurrNumCnv = 1 Then

m_iFirst = 0

m_arrCnvTable(0).iNext = iLAST_ELMNT

Else

'Khởi tạo con trỏ pointers về chỉ số

iPrev = m_iFirst

iFoll = m_iFirst

iCurr = m_iCurrNumCnv - 1

' Liên kết nó với dấu vết

Do

' So sánh nếu mới hơn thì thêm phần tử vào sau

iCompRes = StrComp(m_arrCnvTable(iCurr).strCnvName, _

m_arrCnvTable(iFoll).strCnvName)

' Chèn vào đây

If iCompRes = -1 Then

m_arrCnvTable(iCurr).iNext = iFoll

If iFoll = m_iFirst Then

m_iFirst = iCurr

Else

m_arrCnvTable(iPrev).iNext = iCurr

End If

Exit Do

' Mang đi để tìm kiếm

Else

iPrev = iFoll

' Cải tiến nếu nó không phải phần tử cuối cùng.,

' Trường hợp khác loại bỏ nó, lặp tới cuối cùng bằng mọi cách

If Not (m_arrCnvTable(iFoll).iNext = iLAST_ELMNT) Then

iFoll = m_arrCnvTable(iFoll).iNext

End If

End If

Loop Until (m_arrCnvTable(iFoll).iNext = iLAST_ELMNT)

' Tải xuống từng bước với toàn bộ danh sách?

If m_arrCnvTable(iFoll).iNext = iLAST_ELMNT Then

' tạo một con trỏ theo sau ở cạnh nó.

m_arrCnvTable(iFoll).iNext = iCurr

'Tạo nó cuối cùng

m_arrCnvTable(iCurr).iNext = iLAST_ELMNT

End If

End If

Exit Sub

End Sub

Public Sub AddConverterNamesToCombo(ByRef cboCombo As Object)

Dim iIndex As Integer

iIndex = m_iFirst

While Not (iIndex = iLAST_ELMNT)

cboCombo.AddItem m_arrCnvTable(iIndex).strCnvName

iIndex = m_arrCnvTable(iIndex).iNext

Wend

End Sub

Public Property Get ConverterCount() As Integer

' trả về số trong danh sách chuyển đổi hay lọc

ConverterCount = m_iCurrNumCnv

End Property

'----------------------------------------

'--- Bỏ qua tên converter/filter, ---

'---- trả về Options key handle của nó -----

'----------------------------------------

Public Property Get OptionsHandle(ByVal strCnvNameDummy As String) As Long

Dim i As Integer

' Tìm thứ mà nó chuyển thành

For i = 0 To m_iCurrNumCnv - 1

If m_arrCnvTable(i).strCnvName = strCnvNameDummy Then

Exit For

End If

Next

'kiểm tra theo quy cách

If m_arrCnvTable(i).hOptKey = 0 Then

GoTo FatalError

End If

' Trả về Options handle của nó

OptionsHandle = m_arrCnvTable(i).hOptKey

Exit Property

FatalError:

DisplayErrorMsg strERR_UPDATE_OPTIONS

End Property

'----------------------------

'--- Khởi tạo bảng ---

'----------------------------

Private Sub Class_Initialize()

' Thiết lập cỡ bảng để khởi tạo

m_iCurrTblSize = iINIT_TBL_SIZE

' Khởi tạo bảng với nó

ReDim m_arrCnvTable(m_iCurrTblSize) As CNV_FLT_ELEMENT

' chưa thêm phần chọn

m_iCurrNumCnv = 0

' Hoặc không hiểu đối với phần tử đầu tiên

m_iFirst = -1

End Sub

'-----------------------------

'--- Dọn dẹp registry ---

'-----------------------------

Private Sub Class_Terminate()

Dim i As Integer

' Đóng tất cả khoá Option reg keys

For i = 0 To m_iCurrNumCnv - 1

Call RegCloseKey(m_arrCnvTable(i).hOptKey)

Next

End Sub

===========

'2.5 Chèn một Module bằng INSERT MODULE

'MODULE: EditOptCommon

'---------------------------------------

' Khai báo hằng dùng chung

'---------------------------------------

Option Explicit

' Phần bao trùm

' Hộp thoại và tiêu đề lời nhắc

Global Const strMSG_CAPTION = "Sửa soạn Converter và Filter Options"

' Nhãn lời nhắc khi có lỗi

Global Const strERR_LIST_CONVERTERS = "ListConverters"

' Lời nhắc về lỗi

Global Const strERR_NO_OPTIONS_FOUND = "Không có lựa chọn tìm thấy trong registry."

Global Const strERR_CANNOT_OPEN_REG = "Không thể mở được registry."

Global Const strERR_CANNOT_OPEN_REGKEY = "Không thể mở được khoá registry key."

Global Const strERR_CANNOT_ADD_NAME = "Không thể thêm tên vào danh sách chuyển đổi converter list."

Global Const strERR_INIT_MESSED_UP = "Khởi tạo quy trình ngắt và bỏ qua."

Global Const strERR_WRONG_STRING = "Chuỗi sai quy cách."

Global Const strERR_UPDATE_OPTIONS = "Lưạ chọn không thể cập nhật đúng đắn."

Global Const strERR_INIT_OPTIONSFORM = "Lỗi khởi tạo Edit Conversion Options form."

Global Const strERR_INTERNAL = "Macro không thể tiếp tục vì có một lỗi xảy ra."

Global Const strERR_PATH_TOO_LONG = "Đường dẫn thư mục quá dài."

' Lời nhắc lỗi Registry

Global Const strREG_ERR_CAPTION = "Registry hỏng."

Global Const strREG_ERR_BAD_DB = "Cơ sở dữ liêu sai."

Global Const strREG_ERR_BAD_KEY = "Sai khoá key."

Global Const strREG_ERR_CANT_OPEN = "Không thể mở registry."

Global Const strREG_ERR_CANT_READ = "Không đọc được registry."

Global Const strREG_ERR_CANT_WRITE = "Không viết vào được registry."

Global Const strREG_ERR_OUT_OF_MEMORY = "Bộ nhớ tràn."

Global Const strREG_ERR_INVALID_PARAMETER = "Sai tham số."

Global Const strREG_ERR_ACCESS_DENIED = "Reigstry bị từ chối truy xuất."

Global Const strREG_ERR_INVALID_PARAMETERS = "Sai các tham số."

Global Const strREG_ERR_NO_MORE_ITEMS = "Không thể nhiều khoản trong khoá key này."

Global Const strREG_ERR_BAD_ACCESS = "Truy nhập registry hỏng."

' Chuỗi trợ giúp Help

Global Const strHLP_DLG_CAPTION = "Edit Conversion Options Help"

Global Const strHLP_DLG_MSG1 = "Hộp lựa chọn Edit Converter and Filter"

Global Const strHLP_DLG_MSG2 = " cho phép bạn tự ý thiết lập duy nhất."

Global Const strHLP_DLG_MSG3 = " cho văn bản chuyển và lọc đồ hoạ."

' Nhãn các nút radio

Global Const strOPT_YES = "Yes"

Global Const strOPT_NO = "No"

' Nhãn các nút lệnh comand

Global Const strCMD_OK = "OK"

Global Const strCMD_CANCEL = "Cancel"

Global Const strCMD_HELP = "Help"

Global Const strCMD_SET = "Set"

' Nhãn hộp label

Global Const strLBL_CONVERSION = "Conversion:"

Global Const strLBL_CNV_OPTION = "Conversion Option:"

Global Const strLBL_SETTING = "Setting:"

' Chọn nút thư mục text

Global Const strSEL_FLD_BUTTON_TEXT = "Select"

'---------------------------------------------------------------

'********** Đừng khoanh vùng CODE phía sau điểm này *********

'---------------------------------------------------------------

Global Const strEQUALS_SIGN = "="

' Hằng Registry và keys

Global Const REG_SZ As Long = 1

Global Const REG_DWORD As Long = 4

Global Const HKEY_CURRENT_USER = &H80000001

Global Const HKEY_LOCAL_MACHINE = &H80000002

Global Const ERROR_SUCCESS = 0&

Global Const ERROR_BAD_DB = 1&

Global Const ERROR_BAD_KEY = 2&

Global Const ERROR_CANT_OPEN = 3&

Global Const ERROR_CANT_READ = 4&

Global Const ERROR_CANT_WRITE = 5&

Global Const ERROR_OUT_OF_MEMORY = 6&

Global Const ERROR_INVALID_PARAMETER = 7&

Global Const ERROR_ACCESS_DENIED = 8&

Global Const ERROR_INVALID_PARAMETERS = 87&

Global Const ERROR_NO_MORE_ITEMS = 259&

Global Const SYNCHRONIZE = &H100000

Global Const STANDARD_RIGHTS_READ = &H20000

Global Const STANDARD_RIGHTS_WRITE = &H20000

Global Const STANDARD_RIGHTS_EXECUTE = &H20000

Global Const STANDARD_RIGHTS_REQUIRED = &HF0000

Global Const STANDARD_RIGHTS_ALL = &H1F0000

Global Const KEY_QUERY_VALUE = &H1

Global Const KEY_SET_VALUE = &H2

Global Const KEY_CREATE_SUB_KEY = &H4

Global Const KEY_ENUMERATE_SUB_KEYS = &H8

Global Const KEY_NOTIFY = &H10

Global Const KEY_CREATE_LINK = &H20

Global Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And Not (SYNCHRONIZE))

Global Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Global Const KEY_EXECUTE = (KEY_READ)

Global Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Global Const REG_OPTION_NON_VOLATILE = 0

' Đường dẫn registry paths tới text converters và graphics filters

Global Const strREG_TEXT_CNV_IMPORT = "SOFTWARE\Microsoft\Shared Tools\Text Converters\Import"

Global Const strREG_TEXT_CNV_EXPORT = "SOFTWARE\Microsoft\Shared Tools\Text Converters\Export"

Global Const strREG_GRAPH_FLT_IMPORT = "SOFTWARE\Microsoft\Shared Tools\Graphics Filters\Import"

Global Const strREG_GRAPH_FLT_EXPORT = "SOFTWARE\Microsoft\Shared Tools\Graphics Filters\Export"

' Đường dẫn registry tới User Shell Folders và thiết lập Conversion Wizard

Global Const strREG_PERFORM_BATCH = "Software\Microsoft\Office\9.0\Word\Wizards\Conversion Wizard"

Global Const strREG_USER_SHELL_FOLDERS = "Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders"

' Vài tên giá trị và dữ liệu

Global Const strREG_ALWAYS_BATCH = "AlwaysBatch"

Global Const strREG_YES = "Yes"

Global Const strREG_NO = "No"

Global Const strREG_PERSONAL = "Personal"

Global Const strC_DIR = "C:\"

Global Const strREG_CNV_NAME = "Name"

Global Const strREG_CNV_OPTIONS = "Options"

Global Const strREG_IMPORT = " (Import)"

Global Const strREG_EXPORT = " (Export)"

' Cỡ lớn nhất của một text buffer

Global Const THREE_CHARS = 4

Global Const MAX_TEXT_BUFF = 255

Global Const ONE_K_BUFF = 1024

' Chọn thư mục trả về hằng số

Global Const lFILE_OPEN_SUCCESS = 0&

Global Const lFILE_OPEN_ERROR = 99&

' Các khoá chuyển và lọc registry keys

Global hCnvImpKeyHandle As Long

Global hCnvExpKeyHandle As Long

Global hFltImpKeyHandle As Long

Global hFltExpKeyHandle As Long

' FILETIME Type definition

Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

'---------------------------------

' Các hàm API với Registry

'---------------------------------

' Mở khoá RegOpenKeyEx

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _

(ByVal HKey As Long, ByVal lpSubKey As String, ByVal ulOPTIONS As _

Long, ByVal samDesired As Long, phkResult As Long) As Long

' Tạo khoá RegCreateKeyEx

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _

"RegCreateKeyExA" (ByVal HKey As Long, ByVal lpSubKey As String, _

ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _

As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _

As Long, phkResult As Long, lpdwDisposition As Long) As Long

' Đóng khoá RegCloseKey

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal HKey As Long) _

As Long

' Giá trị khoá RegEnumKeyEx

Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _

(ByVal HKey As Long, ByVal dwIndex As Long, ByVal lpname As String, _

lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _

lpcbClass As Long, lpftLasrWriteTime As FILETIME) As Long

' Giá trị lọc RegQueryValueEx

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _

"RegQueryValueExA" (ByVal HKey As Long, ByVal lpValueName As String, _

ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, _

lpcbData As Long) As Long

' Giá trị RegEnumValue

Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _

(ByVal HKey As Long, ByVal dwValueIndex As Long, ByVal lpValue As String, _

lpValueSize As Long, ByVal lpReserved As Long, lpTypeCode As Long, _

ByVal lpValueData As String, lpcbValueDataSize As Long) As Long

' Đặt chuỗi giá trị vào Registry

Declare Function RegSetValueExString Lib "advapi32.dll" Alias _

"RegSetValueExA" (ByVal HKey As Long, ByVal lpValueName As String, _

ByVal lReserved As Long, ByVal dwValueType As Long, ByVal lpData As String, _

ByVal lcbDataSize As Long) As Long

Public Sub ReportRegError(lErrNum As Long)

Dim strMsg As String

' Nó là cái nào?

Select Case lErrNum

Case ERROR_BAD_DB

strMsg = strREG_ERR_BAD_DB

Case ERROR_BAD_KEY

strMsg = strREG_ERR_BAD_KEY

Case ERROR_CANT_OPEN

strMsg = strREG_ERR_CANT_OPEN

Case ERROR_CANT_READ

strMsg = strREG_ERR_CANT_READ

Case ERROR_CANT_WRITE

strMsg = strREG_ERR_CANT_WRITE

Case ERROR_OUT_OF_MEMORY

strMsg = strREG_ERR_OUT_OF_MEMORY

Case ERROR_INVALID_PARAMETER

strMsg = strREG_ERR_INVALID_PARAMETER

Case ERROR_ACCESS_DENIED

strMsg = strREG_ERR_ACCESS_DENIED

Case ERROR_INVALID_PARAMETERS

strMsg = strREG_ERR_INVALID_PARAMETERS

Case ERROR_NO_MORE_ITEMS

strMsg = strREG_ERR_NO_MORE_ITEMS

Case Else

strMsg = strREG_ERR_BAD_ACCESS

End Select

' hiện nó

MsgBox strMsg, vbOKOnly, strREG_ERR_CAPTION

End Sub

===========

' 2.6 Chèn một Module INSERT MODULE

'Module RegOptions

Sub RegOptions()

RegOptionsForm.Show

End Sub

========