WINDOWS API
Từ A đến Z
(Kỳ 3)
API với Registry
Lược dịch và phát triển: Nguyễn Phương Thảo - 527 Điện Biên - TX. Yên BáiTrung tâm Dạy nghề và Phổ cập Tin học Miền núi ABC
I. Sơ lược về Registry
Registry là nơi lưu trữ tất cả các các loại cấu trúc dữ liệu. Cấu hình hệ thống Windows, cấu hình phần cứng máy tính, cấu hình thông tin về các chương trình ứng dụng dựa trên Win32, và các thiết lập người dùng khác đều được lưu trong Registry.
Ví dụ, bất cứ một phần cứng máy tính nào thay đổi đều làm chức năng Plug and Play (Cắm và chạy) khởi tạo ngay và làm thay đổi luôn cấu hình trong Registry.
Registry lưu trữ tất cả các thiết lập về cấu trúc bộ nhớ, phần cứng, thiết bị ngoại vi, và các thành phần liên quan đến mạng. Bạn sẽ tìm thấy ở đó nhiều hơn những thiết lập cần thiết trong các tệp khởi tạo ban đầu
Từ Win98 về sau, Windows có sử dụng Registry Checker để tự quét Registry, nếu không thấy gì, nó tự lưu backup một lần trong ngày, nếu tìm thấy lỗi sẽ sửa... có thể sửa bằng cách thay thế bản Registry đã backup gần nhất còn tốt. Registry Checker tối ưu hoá và nén file backup thành công mỗi lần khởi động máy. Nó còn làm một loạt các việc linh tinh như loại bỏ những khoảng trống không dùng trong Registry, tối ưu hoá...

Các tệp Registry của Windows.
Registry hiện tại bao gồm 3 tệp chính:
1. Tệp USER.DAT
Dùng để lưu trữ những xác lập người sử dụng đối với các phần mềm.
2. Tệp SYSTEM.DAT
Dùng để lưu trữ những xác lập liên quan tới máy tính và phần cứng.
3. Tệp Policy.pol
System policies được thiết kế để chuẩn bị cho việc ghi đè bất cứ thiết lập đã được chứa trong 2 thành phần registry khác nhau.
System policies có thể chứa dữ liệu bổ sung đặc trưng tới mạng hay môi trường tổ hợp như đã được cài đặt bởi network administrator. Bản thân System policies cũng đã được chứa trong tệp Policy.pol. Không như SYSTEM.DAT và USER.DAT, Policy.pol không phải là thành phần bắt buộc của phần cài đặt Windows.
Lời khuyên của Microsoft về những công cụ xử lý registry
|
Phương pháp |
Thiết lập |
|
Control Panel |
Phần lớn thiết lập hệ thống SYSTEM. Ví dụ bạn sử dụng Display Properties để sửa các thành phần của mục appearance |
|
System Policy Editor |
Thiết lập người dùng, vài thiết lập hệ thống. |
|
Các chương trình tiện ích thứ 3 |
Thiết lập chi tiết ứng dụng |
Bạn có thể đã sử dụng Registry Editor để thay đổi Registry bằng tay. Tôi thường dùng Norton Registry Editor vì nó còn có thêm chức năng khác, ví dụ như tìm và thay thế đối với các thành phần của Registry.
Từ các phần mềm Registry Editor trên, ta nhận thấy registry được bố trí thành các nhánh lớn. Tại mỗi nhánh có các khoá SUBKEY. Tại các SUBKEY dữ liệu được lưu ở các dạng:
1. String (Dạng chuỗi)
2. Numeric (Dạng số)
3. Binary (Dạng nhị phân)
4. Expanded String (Dạng chuỗi mở rộng)
5. MultiString (Dạng chuỗi tổng hợp)
(Nếu bạn dùng Registry Editor - REGEDIT. EXE thì sẽ gọi tên khác là DWORD)
Ta hãy nghiên cứu sơ đồ mà Microsoft vẽ (Từ đĩa MSDN) về Registry:
Nhìn sơ đồ ta nhận thấy:
Nếu môi trường Windows là sân khấu thì Registry giống như một cuốn sổ tay của đạo diễn. Trong đó các thiết lập liên quan đến phần cứng thì hầu như không thay đổi (Nếu ta không thay phần cứng để phần đề tếch của Windows nhận ra). Nếu thay đổi phần cứng, phần đề tếch này sẽ bắt bạn phải đổi mã điều khiển đối với từng thiết bị.
Xin nói thêm phần này kỹ hơn một chút vì tôi nhận được rất nhiều thư hỏi của các bạn về những vấn đề liên quan đến phần cứng và DRIVER. Một số đông bạn chưa hiểu rõ cách thức làm việc của Windows nên ngay cả những lỗi rất đơn giản như màn hình chỉ có 16 màu (Không chọn được 256 màu hay cao hơn như High Color, True Color) cũng không biết cách giải quyết.
Khi máy tính của bạn có những thiết bị gì, hệ điều hành Windows khi cài đặt hoặc khi đề tếch thiết bị nó sẽ yêu cầu bạn phải đưa ra các tệp DRIVER của thiết bị đó. DRIVER là gì ư? Ồ! Nó chỉ là tệp mã điều khiển thiết bị. Giống như sơ đồ công tắc của thiết bị nào đó. Khi máy tính có công việc liên quan đến điều khiển thiết bị, hệ điều hành Windows sẽ tra trong Registry xem tệp mã nó là tệp nào. Tệp mã sẽ được nạp vào RAM một phần hay toàn bộ, ở một vị trí nào đó. Căn cứ vào lệnh đưa tới từ chương trình, Hệ điều hành sẽ đưa lệnh tới địa chỉ phần mã điều khiển này. Phần mã điều khiển sẽ chỉ tiếp cho con trỏ tới vị trí của lệnh cần thực hiện năm trong phần mã, tương ứng với mã lệnh đưa tới. Khi đó công việc được thực hiện chính xác vì phần mã đúng với thiết bị.
Nếu thiết bị một kiểu, mã DRIVER khác với kiểu được lắp vào máy, thì chẳng khác gì bạn đưa ra một sơ đồ máy khác với máy đang sử dụng. Khi đó sẽ có xung đột, trường hợp này Windows sẽ tự chuyển sang chức năng Đờ phôn ngầm định đối với các khoá, và như vậy bạn sẽ thấy Windows không thể hiện đúng với thực tế của mình. Bạn có thể vào Control Panel chọn mục System để kiểm tra, nếu thấy dấu ? cạnh tên mã thiết bị phần nào thì chọn Update để đổi mã.
Các khoá về mã phần cứng đều được lưu trong tệp SYSTEM.DAT. Do phần này ít thay đổi, vả lại chức năng Plug and Play của Windows quá siêu, nên ta sẽ tạm gác nghiên cứu đến phần này. Sau này tôi sẽ đề nghị một chương trình khoá thiết bị bằng phần mềm ở những chương sau.
Các khoá về phần mềm thường là lưu trữ các thiết lập Option... của từng phần mềm ứng dụng riêng. Ta có thể nhận ra, trước đây khi sử dụng Win 3.1 về trước, các thiết lập này được lưu trên đĩa bằng các tệp đuôi INI. Do Win32 khác xa về cấu trúc, nếu dùng các tệp INI sẽ tương đối bất tiện, ví dụ thực tế dung lượng bỏ phí trên đĩa cực lớn, nên Microsoft đã tích hợp vào các tệp Registry. Tuy nhiên, các tệp WIN.INI, SYSTEM.INI vẫn còn được sử dụng để có thể làm việc với các ứng dụng cũ.
Các khoá "mềm" có thể thay đổi thường xuyên khi ta sử dụng chức năng options để đặt lại. Ta nen lựa chọn tối ưu chứ đừng thí nghiệm vì sẽ có nhiều lỗi không đáng có. Bộ Norton Utilities có nhiều chức năng trong đó có Optimization Wizard (Tối ưu hoá) cũng sắp xếp và tổ chức lại Registry. WinDoctor và System Check thường kiểm tra sai sót hoặc thừa trong Registry để xử lý. Nếu bạn biết chút ít tiếng Anh, thì đó là công cụ thuận tiện đối với bạn.
2. Lập trình với Registry
Khi lập trình đối với Registry, bạn phải thực hiện hết sức thận trọng, sao lưu các tệp này thường xuyên để tránh lỗi đáng tiếc, phải mất công cài lại thì cũng rất mất thời gian.Sử dụng các hàm API đối với Registry cũng xin hết sức thận trọng. Tôi đưa ra một ví dụ để bạn có thể nghiên cứu rõ hơn. Đó là lập trình với Win API chính trong VBA. Ví dụ này sử dụng cách thiết đặt các tham số của WINWORD. Bạn có thể căn cứ vào đây để viết ra các ứng dụng khác tương tự. Phần này bạn chỉ việc copy phần lập trình để nghiên cứu và chạy thử.
2.1 Tạo Form
Để tạo Macro bạn hãy tạo Form tương tự như sau:
'Form thứ nhất
(Name)=EditCnvOptionsForm
Caption=Các lựa chọn sửa chữa Conversions
'Nhãn 1
(Name)=lblConversion
Caption= Conversion:
'Nhãn2
(Name)=lblCnvOption
Caption= Lựa chọn:
'Nhãn 3
(Name)=lblSetting
Caption= Thiết lập:
'Các hộp bỏ trống:
(Name)=cboConverters
(Name)=lstOptions
(Name)=txtSetting
(Name)=OptYes
(Name)=OptNo
'Các nút lệnh tuỳ ý Caption
(Name) =cmdSet
(Name) =cmdOK
(Name) =cmdHelp
'Viết lệnh cho Form thứ nhất:
'----------------------------------------------------
'--- Khởi tạo combo box với tên conveter ---
'----------------------------------------------------
Public Function ControlsInit() As Boolean
' Lấp đầy combo với đoạn text converters và graphics filters
ListConverters hCnvExpKeyHandle, HKEY_LOCAL_MACHINE, _
strREG_TEXT_CNV_EXPORT, strREG_CNV_NAME
ListConverters hCnvImpKeyHandle, HKEY_LOCAL_MACHINE, _
strREG_TEXT_CNV_IMPORT, strREG_CNV_NAME
ListConverters hFltExpKeyHandle, HKEY_LOCAL_MACHINE, _
strREG_GRAPH_FLT_EXPORT, strREG_CNV_NAME
ListConverters hFltImpKeyHandle, HKEY_LOCAL_MACHINE, _
strREG_GRAPH_FLT_IMPORT, strREG_CNV_NAME
' có bất cứ dữ liệu nào được đọc từ registry?
If clsCnvTable.ConverterCount = 0 Then
ControlsInit = False
Exit Function
End If
' lấp đầy combo box với tên converter names
clsCnvTable.AddConverterNamesToCombo cboConverters
' Chọn converter đầu tiên trên combo
cboConverters.ListIndex = 0
ControlsInit = True
End Function
Private Sub CommitChange(ByVal strNewString As String)
Dim strValue As String
Dim hHandleOptKey As Long
Dim res&
Dim strTemp As String
Dim i As Integer
' Nếu chọn phần trên list box khác
If ExtractOptionData(lstOptions.Value) <> strNewString Then
' triển khai chuỗi Value string
strValue = ExtractOptionValue(lstOptions.Value)
' Tìm khoá key handle của converter trên combo
hHandleOptKey = clsCnvTable.OptionsHandle(cboConverters.Value)
' Viết chuỗi dữ liệu mới Data string vào registry
res& = RegSetValueExString(hHandleOptKey, strValue, 0&, REG_SZ, _
strNewString, Len(strNewString))
If res& <> ERROR_SUCCESS Then
GoTo FatalError
End If
' Cập nhật lựa chọn vào list box
i = lstOptions.ListIndex
lstOptions.RemoveItem i
' bỏ cũlstOptions.AddItem strValue & strEQUALS_SIGN & strNewString, i '
Thêm mớilstOptions.ListIndex = i '
chiếu sáng trùngEnd If
Exit Sub
FatalError:
ReportRegError res&
End Sub
'-----------------------------------------
' Khai triển dữ liệu conversion option data
' Từ chuỗi định dạng "Option=Data"
'-----------------------------------------
Private Function ExtractOptionData(ByVal strDummy) As String
' Khai triển từng dòng sau khi bị biến thành 0
ExtractOptionData = Right$(strDummy, _
Len(strDummy) - InStr(strDummy, strEQUALS_SIGN))
End Function
'-----------------------------------------
' Khai triển giá trị lựa chọn conversion
' từ chuỗi định dạng "Option=Data"
'-----------------------------------------
Private Function ExtractOptionValue(ByVal strDummy As String) As String
' Khai triển từng dòng sau khi bằng 0
ExtractOptionValue = Left$(strDummy, InStr(strDummy, strEQUALS_SIGN) - 1)
End Function
'----------------------------------------------------------
' Liệt kê tất cả registered text converters và graphics filters
'----------------------------------------------------------
Private Sub ListConverters(keyHandleDummy As Long, _
ByVal lPredefRegKey As Long, _
ByVal strConverterDir As String, _
ByVal strWhatImLookingFor As String)
' Vị trí
Dim subKeyHandle&
Dim subSubKeyHandle&
Dim strKeyName$, strClassName$
Dim keyLen&, classLen&
Dim res&
Dim i%
' Nháp RegEnumKeyEx tempsDim subKey As String * MAX_TEXT_BUFF
' tên converterDim subSubKey As String * MAX_TEXT_BUFF '
options subkeyDim className As String * MAX_TEXT_BUFF
Dim keyLastWritten As FILETIME
' RegOpenKeyEx temps
Dim tempSubKey$
Dim tempAnotherSubKey$
' RegQueryValueEx temps
Dim strDataBuff As String * MAX_TEXT_BUFF
Dim strDataBuffSub As String
Dim lDataBuffSize As Long
' Cờ định hướng Export/Import
'
True=Export, False=ImportDim bExportImport As Boolean
Dim strTemp As String
' khởi tạo về vị trí
i% = 0
If ((strConverterDir = strREG_TEXT_CNV_IMPORT) Or _
(strConverterDir = strREG_GRAPH_FLT_IMPORT)) Then
bExportImport = False
Else
bExportImport = True
End If
' Mở đoạn Converters\Import key
res& = RegOpenKeyEx(lPredefRegKey, strConverterDir, _
0, KEY_ALL_ACCESS, keyHandleDummy)
If res& <> ERROR_SUCCESS Then
ReportRegError res&
Exit Sub
End If
' Đếm liệt kê tất cả converters và tốt nhất là mở các khoá keys
' cho mỗi converter subkeyDo While RegEnumKeyEx(keyHandleDummy, i%, subKey, MAX_TEXT_BUFF, 0, _
className, MAX_TEXT_BUFF, keyLastWritten) = ERROR_SUCCESS
' Mở nó
res& = RegOpenKeyEx(keyHandleDummy, subKey, 0&, KEY_ALL_ACCESS, _
subKeyHandle&)
' Nếu hỏng RegOpenKey thử lại 1 lần
If res& <> ERROR_SUCCESS Then
ReportRegError res&
Exit Do
Else
' Mở nội dung converter entries với khoá con Options subkey
res& = RegOpenKeyEx(subKeyHandle&, strREG_CNV_OPTIONS, 0&, _
KEY_ALL_ACCESS, subSubKeyHandle&)
lDataBuffSize = MAX_TEXT_BUFF
If res& = ERROR_SUCCESS Then
' thêm từng tên converter vào combo box
res& = RegQueryValueEx(subKeyHandle&, strWhatImLookingFor, _
0&, 0&, strDataBuff, lDataBuffSize)
If res& = ERROR_SUCCESS Then
' Ngắt trim và sửa cỡ của chuỗi string
strDataBuffSub = Left$(strDataBuff, lDataBuffSize - 1)
' và bảng table
clsCnvTable.AddConverter strDataBuffSub, subSubKeyHandle&, bExportImport
Else
'Thông báo lỗi ReportRegError res&
' converter kế tiếp với khoá Options keyGoTo ResumeDoLoop
End If
Else
GoTo ResumeDoLoop
End If
End If
ResumeDoLoop:
' make sure everything's neat and tidy
Call RegCloseKey(subKeyHandle&)
i% = i% + 1 ' i%++
Loop
' Rõ ràng và ngăn nắp
...Call RegCloseKey(keyHandleDummy)
Exit Sub
FatalError:
' Dọn dẹp xếp đặt
Set clsCnvTable = Nothing
DisplayErrorMsg strERR_INIT_MESSED_UP
End Sub
'------------------------------------------
' Thiết đặt radio buttons tuỳ theo
' thiết đặt trong list box
'------------------------------------------
Private Sub SetRadioButtons(ByVal strDummy As String)
' Các đối số có thể là "Yes" hoặc "No"
If strDummy = strOPT_YES Or strDummy = strOPT_NO Then
' Bật radio button bên phải lên
If strDummy = strOPT_YES Then
optYes.Value = True
optNo.Value = False
Else
optYes.Value = False
optNo.Value = True
End If
Else
DisplayErrorMsg strERR_WRONG_STRING
End If
End Sub
'-------------------------------------
'
Cập nhật nội dung trong list box'-------------------------------------
Private Sub UpdateOptions()
Dim i As Integer
Dim strListBoxEntry As String
' Các biến RegEnumValue
Dim hOptKey As Long
' Khoá Options reg keyDim strValue As String * MAX_TEXT_BUFF
Dim lValueSize As Long
Dim dwTypeCode As Long
Dim strValueData As String * MAX_TEXT_BUFF
Dim lValueDataSize As Long
' Đầu tiên nhận và bỏ nội dung tồn tại
' (Nếu có bất cứ thứ gì trong List box)
If lstOptions.ListCount <> 0 Then
lstOptions.Clear
End If
' nhận key handle từ bảng table
hOptKey = clsCnvTable.OptionsHandle(cboConverters.SelText)
If hOptKey = 0 Then
GoTo FatalError
End If
' bây giờ nhận thiết đặt
dwTypeCode = 0&
lValueSize = MAX_TEXT_BUFF
lValueDataSize = MAX_TEXT_BUFF
' Thiết đặt gì?
i = 0
Do While RegEnumValue(hOptKey, i, strValue, lValueSize, 0&, dwTypeCode, _
strValueData, lValueDataSize) <> ERROR_NO_MORE_ITEMS
' Bỏ qua tất cả không phải chuỗi (non-string) các cặp Value=Data
If dwTypeCode <> REG_SZ Then GoTo ResumeDoLoop
' Đầu tiên ngắt và sửa các cỡ chuỗi
strListBoxEntry = Left$(strValue, lValueSize) & strEQUALS_SIGN & _
Left$(strValueData, lValueDataSize)
' lần lượt thêm vào list box
lstOptions.AddItem strListBoxEntry
lValueSize = MAX_TEXT_BUFF
lValueDataSize = MAX_TEXT_BUFF
ResumeDoLoop:
i = i + 1
Loop
If lstOptions.ListCount > 0 Then
lstOptions.ListIndex = 0
Else
GoTo FatalError
End If
Exit Sub
FatalError:
DisplayErrorMsg strERR_UPDATE_OPTIONS
End Sub
'--------------------------------------
' Chỉ thay đổi nội dung list box nếu
' lựa chọn mới khác
'--------------------------------------
Private Sub cboConverters_Change()
UpdateOptions
End Sub
Private Sub cmdHelp_Click()
MsgBox strHLP_DLG_MSG1 & Chr(10) & Chr(13) & _
strHLP_DLG_MSG2 & Chr(10) & Chr(13) & _
strHLP_DLG_MSG3, _
vbOKOnly, strHLP_DLG_CAPTION
End Sub
Private Sub cmdOK_Click()
' Xoá bảng table
Set clsCnvTable = Nothing
Unload formEdOptions
Exit Sub
End Sub
Private Sub cmdSet_Click()
CommitChange txtSetting.Value
End Sub
'----------------------------------------------------
' Đưa ra radio buttons hoặc thiết lập edit box
'----------------------------------------------------
Private Sub lstOptions_Change()
Dim strTemp As String
If lstOptions.Value <> "" Then
' khai triển chuỗi thực tế của option
strTemp = ExtractOptionData(lstOptions.Value)
'Nó là "Yes" hay "No"?
If strTemp = strOPT_YES Or strTemp = strOPT_NO Then
' Cho hiện các radio buttons, ẩn edit box
'đặt vào nút phải right button
SetRadioButtons strTemp
' Nếu edit box được hiện?
If txtSetting.Visible Then
' ẩn nó
lblSetting.Visible = False
txtSetting.Visible = False
cmdSet.Visible = False
' Hiện các nút!
optYes.Visible = True
optNo.Visible = True
End If
' Nó chỉ là một chuỗi string!
Else
' Cho hiện edit box, ẩn các radio buttons
' cập nhật các chuỗi thiết đặt
txtSetting.Value = strTemp
' các nút hiện?
If optYes.Visible Then
'ẩn chúng
optYes.Visible = False
optNo.Visible = False
' hiện edit box
lblSetting.Visible = True
txtSetting.Visible = True
cmdSet.Visible = True
End If
End If
End If
End Sub
Private Sub optNo_Click()
CommitChange strOPT_NO
End Sub
Private Sub optYes_Click()
CommitChange strOPT_YES
End Sub
' Khởi tạo dialog và control captions
Private Sub UserForm_Initialize()
' dialog caption
Caption = strMSG_CAPTION
' command buttons
cmdOK.Caption = strCMD_OK
cmdHelp.Caption = strCMD_HELP
cmdSet.Caption = strCMD_SET
' radio buttons
optYes.Caption = strOPT_YES
optNo.Caption = strOPT_NO
' nhãn labels
lblConversion.Caption = strLBL_CONVERSION
lblCnvOption.Caption = strLBL_CNV_OPTION
lblSetting.Caption = strLBL_SETTING
' lấp đầy combo box
If ControlsInit = False Then
fEditInitSuccess = False
DisplayErrorMsg strERR_NO_OPTIONS_FOUND
Else
fEditInitSuccess = True
End If
End Sub
2.2 Form thứ 2 có 1 nút lệnh
(Name)=RegOptionsForm
Caption=Thiết lập lựa chọn trong Registry
'hay một tên khác tuỳ ý(Name)=cmdClose
'Chèn 2 Page là
(Name)=Page1
(Name)=Page2
'Trang 1 có các control, bạn căn cứ vào tiếp đầu ngữ của tên để xác định, tôi bỏ giải thích vì quá dài
(Name)=lblWordOption
(Name)=lstWordOpt
(Name)=lblWordSetting
(Name)=txtWordSet
(Name)=lblWordOptDesc
'Trang 2
(Name)=lblEqOption
(Name)=lstEqOpt
(Name)=lblEqSetting
(Name)=txtEqSet
(Name)=lblEqOptDesc
'Viết lệnh cho form thứ 2
'Các biến lấy giá trị ra từ đường dẫn đờ phôn ngầm định của Word 2000 được viết bởi Word không viết nội dung của chúng vào Registry
Dim iAutoSavePath, iDocPath, iPictPath, iProgPath, iStartPath, iToolsPath, iUserPath, iWkgrpPath As String
Dim item__$(), List__$(), list2__$(), Key$, errortext$, sSection()
Dim WItem__$(), EQItem__$(), EQlist__$(), WList__$(), Wkey$, EQKey$, help$, RegOptions$, notset$, errmsg1$, change, errchange$
Dim Space_$, sWordSet, sEqSet
Dim LangList__$(), Lang__$(), CurLang$, NumLanguages, sLangLbl, sDictLbl, sEngLbl, sCancelMessage, sCancelTitle, sRegWord, sRegOpts, sRegProof, sRegEqDir, sRegEqGen
'========================
' Sub để định vị
'========================
Private Sub Localize()
Dim HelpTitle$
errortext$ = "Một lỗi sảy ra khi viết vào CSDL registration. Có lẽ lý do của trường hợp này là ảnh hưởng của thuộc tính READ ONLY trong thư mục Windows, hoặc Windows đang chạy ở chế độ Safe mode. Khởi động lại Restart Windows trước khi chạy lại Macro này."
CurLang$ = "1033" ' sử dụng ngôn ngữ đầu tiên trong danh sách
Space_$ = " "
sCancelMessage = "Bạn đã chọn cancel. Tất cả các thay đổi sẽ bị mất. Bạn có muốn tiếp tục và không cất những thay đổi mà bạn thiết lập không? Chọn No để cất những thay đổi."
sCancelTitle = "Thôi không lựa chọn Registry Options"
sSection(0) = "Word 2000 Options"
sSection(1) = "Equation Editor Options"
'-------Nhận các đường dẫn nội bộ đờ phôn Built-in Default mà không viết vào Registry-----
iAutoSavePath = Application.Options.DefaultFilePath(wdAutoRecoverPath)
iPictPath = Application.Options.DefaultFilePath(wdPicturesPath)
iProgPath = Application.Options.DefaultFilePath(wdProgramPath)
iStartPath = Application.Options.DefaultFilePath(wdStartupPath)
iToolsPath = Application.Options.DefaultFilePath(wdToolsPath)
iUserPath = Application.Options.DefaultFilePath(wdUserTemplatesPath)
iWkgrpPath = Application.Options.DefaultFilePath(wdWorkgroupTemplatesPath)
iDocPath = System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Options", "doc-path")
If iDocPath = "" Then
iDocPath = System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders", "Personal")
End If
'------------Word 2000 Options --------
WItem__$(0, 2) = "Đặt thư mục nơi mà AutoRecovery nháp sẽ cất các tệp vào. Đờ phôn ngầm định sẽ là thư mục ..\<Windows>\Temp."
WItem__$(1, 2) = "Đặt đờ phôn đuôi để Word lưu backup. Thông thường đờ phôn sẽ là .WBK."
WItem__$(2, 2) = "Đặt cỡ lớn nhất của cache đồ hoạ Word bitmap(bằng KB). Nếu bạn sử dụng nhiều đồ hoạ trong văn bản mà lớn hơn bitmap cache có thể cải thiện tốc độ cuộn và vẽ lại. Khi đặt bằng 1 Word sẽ tự động điều chỉnh cỡ bitmap cache."
WItem__$(3, 2) = "Đặt cỡ của cache tệp Word file (bằng KB). Bạn có thể cải thiện tốc độ I/O (Vào ra) đối với tệp và các tác vụ khác trong Word bằng thay đổi cỡ cache. Nhỏ nhất và đờ phôn cỡ của cache là 64K."
WItem__$(4, 2) = "Thiết lập đờ phôn định dạng ngày tháng cho trường DATE. Chức năng này chỉ sử dụng cho mục đích tương thích những phần trước. Word 2000 thường sử dụng." & Chr(10) & Chr(10) & Space_$ & "Ví dụ: MMMM d, yyyy."
WItem__$(5, 2) = "Đờ phôn của tệp sử dụng văn bản Word. Đờ phôn là .DOC. Bạn phải khởi động lại Word thì phần thiết lập này mới có tác dụng."
WItem__$(6, 2) = "Đờ phôn thư mục chứa những văn bản Word." & Chr(10) & Chr(10) & Space_$ & "Đờ phôn là: " & iDocPath
WItem__$(7, 2) = "Đờ phôn tệp mẫu Word templates. Đờ phôn là .DOT. Bạn phải khởi động lại Word thì phần thiết lập này mới có tác dụng."
WItem__$(8, 2) = "Lựa chọn đường dẫn người dùng. Chức năng này chỉ sử dụng cho mục đích tương thích những phần trước. Nhớ rằng lựa chọn người dùng trong Word 2000 được cất ở Registry hay bên trong nó."
WItem__$(9, 2) = "Bật tắt Disables/Enables danh sách Font sử dụng gần nhất. Bạn phải khởi động lại Word thì phần thiết lập này mới có tác dụng. Vào số 0 hoặc1:" & Chr(10) & Chr(10) & Space_$ & "0 -Để có danh sách gần nhất Font." & Chr(10) & Space_$ & "1 - để không hiện danh sách này."
WItem__$(10, 2) = "Văn bản mẫu theo danh nghĩa template, được sử dụng khi tạo một đối tượng văn bản chứa Word hay ứng dụng OLE khác."
WItem__$(11, 2) = "Thiết lập đờ phôn đường dẫn khi sử dụng Insert Picture. Bạn phải khởi động lại Word thì phần thiết lập này mới có tác dụng. Bạn có thể cũng sử dụng Tools Options File Locations để thiết đặt."
WItem__$(12, 2) = "Theo lý thuyết nơi mà các tệp chương trình Word được lưu trữ." & Chr(10) & Chr(10) & Space_$ & "Đường dẫn đờ phôn: " & iProgPath
WItem__$(13, 2) = "Cho phép bạn tô bóng đồ hoạ bằng viết đè bằng một chức năng vẽ đặc biệt lên một vài máy in Hewlett-Packard. Sử dụng lựa chọn này khi in chậm. nếu máy in không hỗ trợ chức năng vẽ đặc biệt, thì khoá chuyển chẳng có tác dụng. Vào 0 cho No, 1 cho Yes."
WItem__$(14, 2) = "Thiết lập đường dẫn khởi động các tệp Word startup, như là templates và WLL's để tải khi khởi động Word." & Chr(10) & Chr(10) & Space_$ & "Đường dẫn đờ phôn ngầm định là: " & iStartPath
WItem__$(15, 2) = "Đặt đờ phôn định dạng thời gian cho trường TIME. Chức năng này chỉ sử dụng cho mục đích tương thích những phần trước. Word 2000 sử dụng định dạng." & Chr(10) & Chr(10) & Space_$ & "Ví dụ: h:mm:ss"
WItem__$(16, 2) = "Thiết lập nơi mà Word sẽ tìm kiếm ở công cụ proofing, lọc filters, chuyển đổi converters, và các cấu thành khác, trong trường hợp này chúng được đăng ký đúng đắn hoặc không tìm thấy trong các thư mục chuẩn."
WItem__$(17, 2) = "Theo lý thuyết từ điển người dùng cho kiểm tra chính tả số tương đương với thứ tự của từ điển người dùng trong danh sách Custom Dictionariestrong hộp thoại Options của tab Spelling."
WItem__$(18, 2) = "Đường dẫn cho tệp mẫu người dùng user templates. Nên nhớ rằng khi thiết lập thay đổi này cho Word, nó sẽ ảnh hưởng đến tất cả các ứng dụng Microsoft Office 2000 , ảnh hưởng tới Office Shortcut Bar." & Chr(10) & Chr(10) & Space_$ & "Ngầm định đờ phôn: " & iUserPath
WItem__$(19, 2) = "Đường dẫn cho nhóm mẫu workgroup templates. Bạn có thể chỉ rõ đường dẫn UNC path, ví dụ: " & Chr(10) & Chr(10) & Space_$ & "\\GROUP\USER\MYTMPLTS"
EQItem__$(0, 2) = "Thư mục chương trình Equation Editor. Equation Editor phải được cài đặt và chạy 1 lần cho chức năng này và thiết lập khác Equation Editor hiện."
EQItem__$(1, 2) = "Thiết lập Custom Zoom. Chức năng này chỉ có tác dụng khi Equation Editor được vào và tách rời ra 1 cửa sổ theo đường thiết lập ForceOpen."
EQItem__$(2, 2) = "Forces Equation Editor để mở khi nó tự tách rời thành 1 cửa sổ. Vào 0 hoặc 1:" & Chr(10) & Chr(10) & Space_$ & "0 - Mở trong cùng 1 nơi." & Chr(10) & Space_$ & "1 - Mở thành cửa sổ tách rời."
EQItem__$(3, 2) = "Hiện hoặc ẩn những ký tự không in được non-printing ."
EQItem__$(4, 2) = "Toolbar đã được đăng ký? 1 là yes, 0 là no."
EQItem__$(5, 2) = "Vị trí của toolbar nó được đăng ký:" & Chr(10) & Chr(10) & Space_$ & "1 - đỉnh của cửa sổ EQ Editor." & Chr(10) & Space_$ & "2 - đáy của cửa sổ EQ Editor."
EQItem__$(6, 2) = "Toolbar hiện? 1 là yes, 0 là no."
EQItem__$(7, 2) = "Vị trí của toolbar khi nó không đăng ký, Theo lý thuyết ở toạ độ X,Y với góc trái trên. Đơn vị là pixel."
EQItem__$(8, 2) = "Số của vơ sần Equation Editor."
EQItem__$(9, 2) = "Cỡ phòng chuẩn trên View menu."
help$ = "Để sửa chữa các thiết lập hệ thống liên quan đến Word được lưu trữ ở Windows Registry chọn một mục từ danh sách Section list, sau đó chọn Option. Thay đổi thiết lập trong hộp Setting đánh giá trị mới và chọn Change. Xin hãy cẩn thận."
RegOptions$ = "Microsoft Word Registry Options"
HelpTitle$ = "Microsoft Word RegOptions Help"
notset$ = "Sử dụng ngầm định"
errmsg1$ = "Thiết lập sai giá trị."
errchange$ = "Một vài thiết lập Word liên quan đến Registry, xin thoát và khởi động lại Word."
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub lstWordOpt_Change()
If Not IsNull(lstWordOpt.Value) Then
i = lstWordOpt.ListIndex
' ngăn chặn khoảng trắng trong textbox
If WItem__$(i, 3) = " " Then
txtWordSet.Text = ""
Else
txtWordSet.Text = WItem__$(i, 3)
End If
lblWordOptDesc = WItem__$(i, 2)
End If
End Sub
Private Sub lstEqOpt_Change()
If Not IsNull(lstEqOpt.Value) Then
i = lstEqOpt.ListIndex
txtEqSet.Text = EQItem__$(i, 3)
lblEqOptDesc = EQItem__$(i, 2)
End If
End Sub
Private Sub txtWordSet_Enter()
sWordSet = txtWordSet.Value
End Sub
Private Sub txtWordSet_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not sWordSet = txtWordSet.Value Then
i = lstWordOpt.ListIndex
WItem__$(i, 3) = txtWordSet.Text
If WItem__$(i, 3) = " " Then WItem__$(i, 3) = ""
System.PrivateProfileString("", WItem__$(i, 0), WItem__$(i, 1)) = WItem__$(i, 3)
End If
End Sub
Private Sub txtEqSet_Enter()
sEqSet = txtEqSet.Value
End Sub
Private Sub txtEqSet_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not sEqSet = txtEqSet.Value Then
i = lstEqOpt.ListIndex
EQItem__$(i, 3) = txtEqSet.Text
If EQItem__$(i, 3) = " " Then EQItem__$(i, 3) = ""
System.PrivateProfileString("", EQItem__$(i, 0), EQItem__$(i, 1)) = EQItem__$(i, 3)
End If
End Sub
Private Sub UserForm_Initialize()
ReDim item__$(0)
ReDim List__$(32)
ReDim sSection(6)
ReDim WItem__$(0)
ReDim EQItem__$(7)
ReDim EQlist__$(9)
ReDim WList__$(19)
Dim i
Dim x
Key$ = ""
errortext$ = ""
Wkey$ = ""
EQKey$ = ""
help$ = ""
RegOptions$ = ""
notset$ = ""
errmsg1$ = ""
change = 0
errchange$ = ""
Space_$ = ""
CurLang$ = ""
NumLanguages = 0
ReDim List__$(51), list2__$(51)
ReDim WItem__$(19, 3), EQItem__$(9, 3)
sRegWord = "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word"
sRegOpts = "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Options"
sRegEqDir = "HKEY_CURRENT_USER\Software\Microsoft\Equation Editor\3.0\Options\Directories"
sRegEqGen = "HKEY_CURRENT_USER\Software\Microsoft\Equation Editor\3.0\Options\General"
Localize
mulMainForm.Pages.Item(0).Caption = sSection(0)
mulMainForm.Pages.Item(1).Caption = sSection(1)
mulMainForm.Value = 0
'------------ Word 7.0 Options ---------
WItem__$(0, 0) = sRegOpts
WItem__$(0, 1) = "AutoSave-Path"
WItem__$(1, 0) = sRegOpts
WItem__$(1, 1) = "Bak-Extension"
WItem__$(2, 0) = sRegOpts
WItem__$(2, 1) = "BitMapMemory"
WItem__$(3, 0) = sRegOpts
WItem__$(3, 1) = "CacheSize"
WItem__$(4, 0) = sRegOpts
WItem__$(4, 1) = "DateFormat"
WItem__$(5, 0) = sRegOpts
WItem__$(5, 1) = "DOC-Extension"
WItem__$(6, 0) = sRegOpts
WItem__$(6, 1) = "DOC-Path"
WItem__$(7, 0) = sRegOpts
WItem__$(7, 1) = "DOT-Extension"
WItem__$(8, 0) = sRegOpts
WItem__$(8, 1) = "INI-Path"
WItem__$(9, 0) = sRegOpts
WItem__$(9, 1) = "NoFontMRUList"
WItem__$(10, 0) = sRegOpts
WItem__$(10, 1) = "OLEDOT"
WItem__$(11, 0) = sRegOpts
WItem__$(11, 1) = "Picture-Path"
WItem__$(12, 0) = sRegOpts
WItem__$(12, 1) = "ProgramDir"
WItem__$(13, 0) = sRegOpts
WItem__$(13, 1) = "SlowShading"
WItem__$(14, 0) = sRegOpts
WItem__$(14, 1) = "Startup-Path"
WItem__$(15, 0) = sRegOpts
WItem__$(15, 1) = "TimeFormat"
WItem__$(16, 0) = sRegOpts
WItem__$(16, 1) = "Tools-Path"
WItem__$(17, 0) = sRegOpts
WItem__$(17, 1) = "UpdateDictonaryNumber"
WItem__$(18, 0) = sRegOpts
WItem__$(18, 1) = "User-Dot-Path"
WItem__$(19, 0) = sRegOpts
WItem__$(19, 1) = "Workgroup-Dot-Path"
'-------------EQEdit
'--Các thư mục
EQItem__$(0, 0) = sRegEqDir
EQItem__$(0, 1) = "Appdir"
'--General
EQItem__$(1, 0) = sRegEqGen
EQItem__$(1, 1) = "CustomZoom"
EQItem__$(2, 0) = sRegEqGen
EQItem__$(2, 1) = "ForceOpen"
EQItem__$(3, 0) = sRegEqGen
EQItem__$(3, 1) = "ShowAll"
EQItem__$(4, 0) = sRegEqGen
EQItem__$(4, 1) = "ToolBarDocked"
EQItem__$(5, 0) = sRegEqGen
EQItem__$(5, 1) = "ToolBarDockPos"
EQItem__$(6, 0) = sRegEqGen
EQItem__$(6, 1) = "ToolBarShown"
EQItem__$(7, 0) = sRegEqGen
EQItem__$(7, 1) = "ToolBarWinPos"
EQItem__$(8, 0) = sRegEqGen
EQItem__$(8, 1) = "Version"
EQItem__$(9, 0) = sRegEqGen
EQItem__$(9, 1) = "Zoom"
'-------------------------
For i = 0 To 19
WItem__$(i, 3) = System.PrivateProfileString("", WItem__$(i, 0), WItem__$(i, 1))
If WItem__$(i, 3) = "" Then WItem__$(i, 3) = " "
WList__$(i) = WItem__$(i, 1)
Next
'--------------------
For i = 0 To 9
EQItem__$(i, 3) = System.PrivateProfileString("", EQItem__$(i, 0), EQItem__$(i, 1))
If EQItem__$(i, 3) = "" Then EQItem__$(i, 3) = " "
EQlist__$(i) = EQItem__$(i, 1)
Next
'-----------------------
lstWordOpt.List() = WItem__$
txtWordSet.Text = WItem__$(0, 3)
lblWordOptDesc.Caption = WItem__$(0, 2)
lstWordOpt.ColumnWidths = "0;-1"
lstEqOpt.List() = EQItem__$
txtEqSet.Text = EQItem__$(0, 3)
lblEqOptDesc.Caption = EQItem__$(0, 2)
lstEqOpt.ColumnWidths = "0;-1"
End Sub
=============
'2.3 Chèn một Module bằng INSERT MODULE
'Module COMMON
Option Explicit
' Khai báo biến
' Vị trí khoá Key Registry
Public strRegSettingsKey As String
' Cờ
Public fEditInitSuccess As Boolean
'true Khi hộp Edit Conv Options 'được khởi tạo' Forms
Public formEdOptions As EditCnvOptionsForm
'Options dialog' Khác
Public clsCnvTable As CConverterTable
' Đối tượng bảng converter/filterPublic Sub EditConversionOptions()
' Bảng converter/filter
Set clsCnvTable = New CConverterTable
If clsCnvTable Is Nothing Then
GoTo FatalError
End If
' Khởi tạo dialog box
Set formEdOptions = New EditCnvOptionsForm
If formEdOptions Is Nothing Then
' Xoá bảng
Set clsCnvTable = Nothing
GoTo FatalError
End If
If fEditInitSuccess = True Then
formEdOptions.Show
End If
Exit Sub
FatalError:
DisplayErrorMsg strERR_INIT_OPTIONSFORM
End Sub
' Trả về giá trị được lưu trong khoá registry key strId
Public Function StrFetchPref(strId As String) As String
On Error GoTo LReturnNull
StrFetchPref = System.PrivateProfileString("", strRegSettingsKey, strId)
Exit Function
LReturnNull:
StrFetchPref = ""
End Function
' Đưa ra strValue trong registry key strId
'Public Sub StorePref(strId As String, strValue As String)
Dim strTemp As String
' If string is empty, store "~" as placeholder
If (Len(strValue) = 0) Then
strTemp = "~"
Else
strTemp = strValue
End If
System.PrivateProfileString("", strRegSettingsKey, strId) = strTemp
End Sub
' Trả về chuỗi được lưu trong strId. Nếu rỗng, trả về strDefault
Public Function StrRestorePref(strId As String, strDefault As String) As String
Dim strTemp As String
strTemp = StrFetchPref(strId)
' Nếu chiều dài bằng 0 nó không có trong regsistry, Nên sử dụng giá trị đờ phôn
If Len(strTemp) = 0 Then
strTemp = strDefault
' "~" là chứng cứ để cho phép trả về chuỗi rỗng
ElseIf strTemp = "~" Then
strTemp = ""
End If
StrRestorePref = strTemp
End Function
' Đưa ra iVal trong registry key strId như một chuỗi string
Public Sub StoreValPref(strId As String, iVal As Integer)
StorePref strId, LTrim$(str$(iVal))
End Sub
' Trả về giá trị được lưu trong khoá key strId
' Nếu sai trả về iDefault.
Public Function FRestorePref(strId As String, fDefault As Boolean) As Boolean
Dim strVal As String
strVal = StrFetchPref(strId)
If Len(strVal) = 0 Then
FRestorePref = fDefault
Else
FRestorePref = Val(strVal)
End If
End Function
' Trả về giá trị được lưu trong khoá key strId
' Nếu sai trả về iDefault.
Public Function IRestorePref(strId As String, iDefault As Integer) As Integer
Dim strVal As String
strVal = StrFetchPref(strId)
If Len(strVal) = 0 Then
IRestorePref = iDefault
Else
IRestorePref = Val(strVal)
End If
End Function
' Hiện lời nhắc lỗi bằng một balloon nếu sử dụng tên thuyết minh Assistant
' hay hiện hộp thoại khi đang ở chế độ dùng dialog.
Public Sub DisplayErrorMsg(strErrMsg As String)
MsgBox strErrMsg, vbExclamation + vbOKOnly + vbApplicationModal
Err.Clear
End Sub
=================
'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/filterhOptKey As Long
'Lựa chọn reg key bằng tayiNext As Integer
' chỉ số index của phần tử kế tiếp trong danh sách đã nối kếtEnd 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ớiDim iFoll As Integer
' phần tử theo sau được so sánh với phần tử mớiDim iCurr As Integer
' Phần tử hiện tại được thêm vào danh sáchDim iCompRes As Integer
' Kết quả chuỗi string so sánhbExpImpOn = 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
========
Bạn thân mến!
Bạn có thể sẽ choáng ngợp vì phần ví dụ này rất dài. Trước đây tôi cũng như vậy. Nhưng tôi đã in ra và ngẫm nghĩ dần dần để hiểu nó một cách đúng mức và thấy nó chẳng có gì đáng ngại cả. Do INTERNET không thể cho phép viết quá dài nên khi đọc có gì bạn cần trao đổi xin mail tới:
Trung tâm Tin học ABC - 527 - Đường Điện Biên - TX. Yên BáiCác giáo viên sẽ giải đáp mọi thắc mắc của bạn.
PcLeHoan
1996 - 2002
Mirror :
http://www.pclehoan.com
Mirror :
http://www.lehoanpc.net
Mirror :
http://www.ktlehoan.com