Điều khiển trong Registry bằng code ? (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Miền Cát Trắng

Thành viên hoạt động
Tham gia
18/5/13
Bài viết
171
Được thích
37
Xin chào các bạn.
Tôi đang muốn thực hiện công việc đó là điều khiển sự thay đổi trong registry bằng code.
Cụ thể là làm sao để tôi có thể thêm hoặc xoá 1 file có tên là Test với dạng DWORD vào trong thư mục sau HKEY_CURRENT_USER\Control Panel

Xin hỏi các bạn vấn đề nêu trên của tôi có thể thực hiện được không, nếu có rất mong nhận được sự giúp đỡ.
Xin cảm ơn.
 
Xin chào các bạn.
Tôi đang muốn thực hiện công việc đó là điều khiển sự thay đổi trong registry bằng code.
Cụ thể là làm sao để tôi có thể thêm hoặc xoá 1 file có tên là Test với dạng DWORD vào trong thư mục sau HKEY_CURRENT_USER\Control Panel

Xin hỏi các bạn vấn đề nêu trên của tôi có thể thực hiện được không, nếu có rất mong nhận được sự giúp đỡ.
Xin cảm ơn.
Chắc là được vì mình thấy nhiều rồi.
 
Upvote 0
Xin chào các bạn.
Tôi đang muốn thực hiện công việc đó là điều khiển sự thay đổi trong registry bằng code.
Cụ thể là làm sao để tôi có thể thêm hoặc xoá 1 file có tên là Test với dạng DWORD vào trong thư mục sau HKEY_CURRENT_USER\Control Panel

Xin hỏi các bạn vấn đề nêu trên của tôi có thể thực hiện được không, nếu có rất mong nhận được sự giúp đỡ.
Xin cảm ơn.

Cụ thể là bạn muốn xóa cái gì? Xóa 1 file là xóa cái gì?
Trong registry chỉ có cái vụ XÓA KEY hoặc VALUE thôi
Lấy ví dụ: Xóa Key tên là "Test" nằm trong "HKEY_CURRENT_USER\Software\Microsoft\Office" ta làm như sau:
Mã:
Function DelRegkey(ByVal sKey As String)
  CreateObject("WScript.Shell").Run "cmd /c reg delete """ & sKey & """ /f", 0, True
End Function
Mã:
Sub Main()
  Dim sKey As String
  sKey = "[COLOR=#0000cd]HKEY_CURRENT_USER\Software\Microsoft\Office\[/COLOR][COLOR=#ff0000]Test[/COLOR]"
  DelRegkey sKey
End Sub
 
Upvote 0
Anh Hải có thể cho em xin đoạn code về vấn đề mà em đã nêu trên được không ạ?
Cảm ơn Anh đã thông tin ạ.

Đây là đoạn code có liên quan đến HKEY CURRENT USER. Bạn tham khảo rồi chế biến nha
PHP:
Private Sub DeleteVBOM()
  Dim regKey As String
  regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\AccessVBOM"
  CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD"
  CreateObject("WScript.Shell").RegDelete regKey
End Sub
 
Upvote 0
Cụ thể là bạn muốn xóa cái gì? Xóa 1 file là xóa cái gì?
Trong registry chỉ có cái vụ XÓA KEY hoặc VALUE thôi
Lấy ví dụ: Xóa Key tên là "Test" nằm trong "HKEY_CURRENT_USER\Software\Microsoft\Office" ta làm như sau:
Mã:
Function DelRegkey(ByVal sKey As String)
  CreateObject("WScript.Shell").Run "cmd /c reg delete """ & sKey & """ /f", 0, True
End Function
Mã:
Sub Main()
  Dim sKey As String
  sKey = "[COLOR=#0000cd]HKEY_CURRENT_USER\Software\Microsoft\Office\[/COLOR][COLOR=#ff0000]Test[/COLOR]"
  DelRegkey sKey
End Sub

Em chào Thầy!
Đây không phải là cái em cần xoá, Thầy xem ảnh minh hoạ ạ, cái em muốn xoá là ở trong khung màu đỏ ạ.
Nhưng mà code này của Thầy cũng là một món đồ nghề hay đó,hihi. Nó xoá toàn bộ thư mục Test.
Thầy viết cho em xin thêm code tạo thư mục test với ạ.


Test.jpg

-----------------------
Đây là đoạn code có liên quan đến HKEY CURRENT USER. Bạn tham khảo rồi chế biến nha
PHP:
Private Sub DeleteVBOM()
  Dim regKey As String
  regKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & "\Excel\Security\AccessVBOM"
  CreateObject("WScript.Shell").RegWrite regKey, 1, "REG_DWORD"
  CreateObject("WScript.Shell").RegDelete regKey
End Sub

Cảm ơn Anh Hải, đúng là code này đây!
========================
Phiền Thầy và Anh cho em xin thêm code tạo file test và thư mục (key) test nữa ạ.Code trên mới chỉ là xoá thôi ạ.
Em xin cảm ơn!
 
Lần chỉnh sửa cuối:
Upvote 0
Em chào Thầy!
Đây không phải là cái em cần xoá, Thầy xem ảnh minh hoạ ạ, cái em muốn xoá là ở trong khung màu đỏ ạ.
Nhưng mà code này của Thầy cũng là một món đồ nghề hay đó,hihi. Nó xoá toàn bộ thư mục Test.
Thầy viết cho em xin thêm code tạo thư mục test với ạ.

Cảm ơn Anh Hải, đúng là code này đây!
========================
Phiền Thầy và Anh cho em xin thêm code tạo file test và thư mục (key) test nữa ạ.Code trên mới chỉ là xoá thôi ạ.
Em xin cảm ơn!

File Test là thế nào?

Bạn có 1 key (thư mục trong Registry) đã tồn tại, ở đây là "HKEY_CURRENT_USER\Control Panel", và bạn muốn thêm vào key đó 1 giá trị có Name (tên của giá trị) = Test và Value (giá trị của cái ông Test kia) = xyz. Nhìn hình thì tôi thấy xyz = 0. Nhưng bạn có nhu cầu thiết lập bao nhiêu là chuyện của bạn.
Tóm lại bạn có 3 cột với tiêu đề: "Name", "Type" và "Value" hoặc Data (tôi không rõ trong Windows tiếng Anh gọi là gì)

Làm gì có "file Test"?
------------

Mã:
Sub ThemGiaTriVaoKey[B][COLOR=#ff0000]DaCo[/COLOR][/B](ByVal KeyExists As String, ByVal Name As String, Value, ByVal type_ As String)
    CreateObject("WScript.Shell").RegWrite KeyExists & "\" & Name, Value, type_
End Sub

Sub ThemSubKeyVaoKey[B][COLOR=#ff0000]DaCo[/COLOR][/B](ByVal KeyExists As String, Byval SubKey As String)
    CreateObject("WScript.Shell").RegWrite KeyExists, SubKey
End Sub

Sub bla()
'    them subkey "hichic" vao key da co la "HKEY_CURRENT_USER\Control Panel"
    ThemSubKeyVaoKey[B][COLOR=#ff0000]DaCo[/COLOR][/B] "HKEY_CURRENT_USER\Control Panel", "hichic"
'    them gia tri co ten la "he he" va gia tri la 0 kieu DWORD vao key "HKEY_CURRENT_USER\Control Panel\hichic" vua duoc tao
    ThemGiaTriVaoKeyDaCo "HKEY_CURRENT_USER\Control Panel\hichic", "he he", 0, "REG_DWORD"
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cháu cảm ơn Chú Siwtom rất nhiều ạ.
Có thêm bài viết của Chú cùng với bài của Thầy NDU và Anh Quang Hải thì với cháu như vậy là đã thấy rất thỏa mãn trong chủ đề này rồi ạ.

Tuy nhiên có một vài trường hợp khác như hình ảnh bên dưới:
hichic.jpg
Làm sao để phân biệt được riêng cái 32 bit hoặc 64 bít ạ?
Hix GPE cảm giác sao giờ chậm quá vào mãi không được.
 
Upvote 0
À đúng rồi gửi hình ảnh mới thấy DWORD là 32-bit còn QWRD là 64-bit ...+-+-+-+
 
Upvote 0
Em chào Thầy!
Đây không phải là cái em cần xoá, Thầy xem ảnh minh hoạ ạ, cái em muốn xoá là ở trong khung màu đỏ ạ.
Nhưng mà code này của Thầy cũng là một món đồ nghề hay đó,hihi. Nó xoá toàn bộ thư mục Test.

Thế thì kiểu khác rồi:
Mã:
Function DelRegValue(ByVal sKey As String, ByVal ValName As String)
  CreateObject("WScript.Shell").Run "cmd /c reg delete """ & sKey & """ /v """ & ValName & """ /f", 0, True
End Function
Mã:
Sub Main()
  Dim sKey As String, ValName As String
  sKey = "[COLOR=#0000cd]HKEY_CURRENT_USER\Control Panel[/COLOR]"
  ValName = "[COLOR=#ff0000]test[/COLOR]"
  DelRegValue sKey, ValName
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Thầy viết cho em xin thêm code tạo thư mục test với ạ.

Quên mất bạn hỏi câu này:
Mã:
Function AddRegkey(ByVal sKey As String)
  CreateObject("WScript.Shell").Run "cmd /c reg Add """ & sKey & """", 0, True
End Function
Mã:
Sub Main()
  Dim sKey As String
  sKey = "[COLOR=#ff0000]HKEY_CURRENT_USER\Control Panel\Test[/COLOR]"
  AddRegkey sKey
End Sub
 
Upvote 0
DWORD là DOUBLE WORD. Trong Windows thì WORD là 2 BYTE, tức DWORD = 4 byte = 4*8 bit = 32 bit

QWORD = QUADRUPLE WORD = 4 WORD = 8 BYTE = 64 bit

@Chú Siwtom,Thầy Ndu,Anh Quang Hải!
Tất cả các code trong bài này không sử dụng được trong win8 (cụ thể đã test trên win8-64bit).
Rất mong nhận được thêm sự hỗ trợ của GPE ạ !
 
Upvote 0
@Chú Siwtom,Thầy Ndu,Anh Quang Hải!
Tất cả các code trong bài này không sử dụng được trong win8 (cụ thể đã test trên win8-64bit).
Rất mong nhận được thêm sự hỗ trợ của GPE ạ !

Thật ra thì trên GPE cũng ít người xài Win8-64. Và trong số nhũng người đang xài thì có bao nhiêu phần trăm biết về VBA?
Riêng tôi vẫn đang xài Win7-32 nên cũng chẳng biết phải test bằng cách nào (đợi khi đổi máy tính mới có lẽ sẽ nghiên cứu?)
Tóm lại: Tôi bó tay với vụ 64 rồi. Bạn có thể search google để tham khảo thử
 
Upvote 0
Miền Cát Trắng chắc đang làm gì liên quan tới bản quyền gì đây nè!! Mình không có sử dụng win 8, lúc trước mình có dùng như đã bỏ mình nghĩ nó có thể liên quan tới AUC không? Bạn truy cập với quyền admin?
 
Upvote 0
Tóm lại: Tôi bó tay với vụ 64 rồi. Bạn có thể search google để tham khảo thử
Ôi, Các Thầy ở đây mà bó tay hết thì google chắc cũng hết cửa thôi ạ!
Hixx... không lẽ cứ mỗi lần nâng cấp phiên bản mới là lại rất mệt vì sự không tương thích sao?
---------------------
Miền Cát Trắng chắc đang làm gì liên quan tới bản quyền gì đây nè!! Mình không có sử dụng win 8, lúc trước mình có dùng như đã bỏ mình nghĩ nó có thể liên quan tới AUC không? Bạn truy cập với quyền admin?
Dạ em cũng đã sử dụng bằng quyên admin rồi ạ. Nhưng em nghĩ vấn đề này không ảnh hưởng gì cả vì em đã test qua trên winxp bằng quyền Limited code vẫn hoạt động bình thường...
 
Upvote 0
Ôi, Các Thầy ở đây mà bó tay hết thì google chắc cũng hết cửa thôi ạ!


Cũng không phải là bó tay, vì thật ra bây giờ muốn cái gì cũng có thể hỏi bác Google, bác sẽ trả lời tất
Vấn đề là: Cho dù tôi có search được một code nào đó hoặc phương pháp nào đó thì tôi phải test đi test lại nhiều lần mới tin chắc rằng nó dùng được (tôi chưa bao giờ chỉ nhìn code mà chắc ăn nó ngon lành)
Riêng bạn, đang dùng 64 bit thì có cơ hội để test code mà, tội gì không thử
 
Upvote 0
Tất cả các code trong bài này không sử dụng được trong win8 (cụ thể đã test trên win8-64bit).
Rất mong nhận được thêm sự hỗ trợ của GPE ạ !

Ôi, Các Thầy ở đây mà bó tay hết thì google chắc cũng hết cửa thôi ạ!
Hixx... không lẽ cứ mỗi lần nâng cấp phiên bản mới là lại rất mệt vì sự không tương thích sao?


Tôi không có Windows 8 cũng chả có Windows nào 64 bit.
Tôi không biết lỗi tại đâu. Tôi không biết có thể giúp được bạn không. Nhưng tôi rất dị ứng với những kiểu cung cấp thông tin như thế.

"không sử dụng được" đối với tôi nó không là thông tin gì cụ thể. Code chạy thì có thông báo lỗi? Thì máy treo? Thì không có thông báo lỗi gì cả nhưng Registry không thay đổi? Nếu có lỗi thì bao giờ cũng có thông báo lỗi, ngoại trừ máy treo khi có lỗi nặng. Vậy tại sao lại cung cấp thông tin "không sử dụng được", chả nói lên cái gì cả.

Cụ thể là bạn làm gì? Bạn thêm thư mục con vào thư mục nào đó trong Registry? Hay bạn thêm một giá trị nào đó? Bạn nói là bạn đã thử trên XP vậy nếu là thêm giá trị thì là thêm DWORD? Và trên Windows 8 64 bit cũng là thêm DWORD hay thêm QWORD?

Không có chút code nào để xem bạn làm gì, không có miêu tả thao tác, miêu tả cái gọi là "không sử dụng được" thì bạn nghĩ người khác giúp bạn thế nào? Nếu không có Windows 8 64 bit để test thì ít ra cũng phải có chút thông tin nào đó, có chỗ để bấu víu, có cơ sở để mà đoán mò.

Còn cái kiểu ... Tôi rất dị ứng với kiểu đó.
 
Upvote 0
Cảm ơn Chú Switom,Cháu cảm ơn Chú rất nhiều!
Không ngờ ngoài những vấn đề kiến thức tin học ra Chú còn dạy cho một bài học thật cần thiết và rất quí báu như vậy. Cháu sẽ mãi ghi nhớ bài học này để hi vọng nó sẽ giúp cháu rút ra nhiều kinh nghiệm trong cuộc sống sau này.Cho cháu được cảm ơn chú thêm một lần nữa ạ... cháu cảm ơn Chú đã nhắc cháu ạ!hì
Cháu cũng không nghĩ ra là mình sẽ phải nêu cụ thể những vấn đề phát sinh đó.

Về các trường hợp lỗi của các code trong bài thì hiện tại ở công ty cháu có máy mới nhập lên cài phiên bản win 8-64bit Office2013 (cháu cũng chưa bao giờ được sửa dụng hệ điều hành và phiên bản office này) Trên hệ điều hành này các code liên quan đến registry không thể hoạt động, đó là lỗi bôi màu vàng tại code không khác gì một code bình thường bị lỗi.
Cụ thể cháu cũng không nhớ rõ từng code bị lỗi ra sao nữa. Nhưng khi nào đến công ty cháu sẽ test lại rồi thông tin lại lên GPE để Chú và Thầy NDU cùng các chuyên gia xem xét ạ.
 
Upvote 0
Tôi không có Windows 8 cũng chả có Windows nào 64 bit.
Tôi không biết lỗi tại đâu. Tôi không biết có thể giúp được bạn không. Nhưng tôi rất dị ứng với những kiểu cung cấp thông tin như thế.

"không sử dụng được" đối với tôi nó không là thông tin gì cụ thể. Code chạy thì có thông báo lỗi? Thì máy treo? Thì không có thông báo lỗi gì cả nhưng Registry không thay đổi? Nếu có lỗi thì bao giờ cũng có thông báo lỗi, ngoại trừ máy treo khi có lỗi nặng. Vậy tại sao lại cung cấp thông tin "không sử dụng được", chả nói lên cái gì cả.

Cụ thể là bạn làm gì? Bạn thêm thư mục con vào thư mục nào đó trong Registry? Hay bạn thêm một giá trị nào đó? Bạn nói là bạn đã thử trên XP vậy nếu là thêm giá trị thì là thêm DWORD? Và trên Windows 8 64 bit cũng là thêm DWORD hay thêm QWORD?

Không có chút code nào để xem bạn làm gì, không có miêu tả thao tác, miêu tả cái gọi là "không sử dụng được" thì bạn nghĩ người khác giúp bạn thế nào? Nếu không có Windows 8 64 bit để test thì ít ra cũng phải có chút thông tin nào đó, có chỗ để bấu víu, có cơ sở để mà đoán mò.

Còn cái kiểu ... Tôi rất dị ứng với kiểu đó.

@Chú Siwtom cùng Thầy Ndu!
Cháu xin up lên những hình ảnh 1 báo lỗi khi chụp được. Chú cùng Thầy Ndu xem nếu cần thêm thông tin gì thì cháu sẽ cung cấp thêm sau ạ.

Cấu hình:
5.jpg
Đoạn code liên quan đến vấn đề tắt mở usb:
1.jpg

2.jpg

3.jpg

4.jpg
 
Upvote 0
Hình ảnh up lên web có vẻ hơi mờ!
Cháu xin up lại ảnh vào file nén, Chú và Thầy xem ạ!
 

File đính kèm

Upvote 0
Hình ảnh up lên web có vẻ hơi mờ!
Cháu xin up lại ảnh vào file nén, Chú và Thầy xem ạ!

1. Khi có lỗi thì có thông báo lỗi. Thông báo lỗi của bạn đâu?
2. Hiện bạn thao tác trong nhánh HKEY_LOCAL_MACHINE. Bạn thử thao tác trong nhánh HKEY_CURRENT_USER xem sao.
 
Upvote 0
1. Khi có lỗi thì có thông báo lỗi. Thông báo lỗi của bạn đâu?
2. Hiện bạn thao tác trong nhánh HKEY_LOCAL_MACHINE. Bạn thử thao tác trong nhánh HKEY_CURRENT_USER xem sao.
@Chú siwtom!
Cháu đã kiểm lại như Chú hướng dẫn ạ.

Với hệ điều hành win 8.1 64bit thì
1.Với nhánh HKEY_CURRENT_USER:

Đúng là các code của Chú và anh QuangHai đều có thể chạy bình thường(cho kết quả theo ý muốn).

Còn code của Thầy NDU thì không hoạt động được trong nhánh này (chạy không có thông báo lỗi nhưng cũng không thấy có hiện tượng kết quả sau khi chạy xong).

2.Với nhánh HKEY_LOCAL_MACHINE:
Cháu xin gửi lại Chú những thông bào lỗi và hình ảnh chụp được ạ!Ảnh up lên web không được rõ,Chú xem file đính kèm nhé.

Nếu cần cung cấp thêm thông tin gì Chú thông tin cho cháu biêt nhé!
Cháu cảm ơn Chú đã quan tâm và giúp đỡ!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
@Chú siwtom!
Cháu đã kiểm lại như Chú hướng dẫn ạ.

Với hệ điều hành win 8.1 64bit thì
1.Với nhánh HKEY_CURRENT_USER:

Đúng là các code của Chú và anh QuangHai đều có thể chạy bình thường(cho kết quả theo ý muốn).

Còn code của Thầy NDU thì không hoạt động được trong nhánh này (chạy không có thông báo lỗi nhưng cũng không thấy có hiện tượng kết quả sau khi chạy xong).

2.Với nhánh HKEY_LOCAL_MACHINE:
Cháu xin gửi lại Chú những thông bào lỗi và hình ảnh chụp được ạ!Ảnh up lên web không được rõ,Chú xem file đính kèm nhé.

Nếu cần cung cấp thêm thông tin gì Chú thông tin cho cháu biêt nhé!
Cháu cảm ơn Chú đã quan tâm và giúp đỡ!

Thôi thế này hẵng. Trước hết ta thử như sau. Bạn hãy tắt UAC rồi chạy code. Hoặc mở Excel as administrator --> mở tập tin có code --> chạy code.
Ta xem kết quả ra sao. Mà hiện thời bạn thử cho REG_DWORD thôi.
 
Upvote 0
Thôi thế này hẵng. Trước hết ta thử như sau. Bạn hãy tắt UAC rồi chạy code. Hoặc mở Excel as administrator --> mở tập tin có code --> chạy code.
Ta xem kết quả ra sao. Mà hiện thời bạn thử cho REG_DWORD thôi.

@Chú Siwtom!
Cháu cảm ơn Chú đã tìm cách giúơ cháu.Cháu đã làm theo cách này"Bạn hãy tắt UAC rồi chạy code:
Để tắt UAC cháu thực hiện như sau:
Disable UAC trên Windows 8:
Bước 1: Mở Control Panel >> Small Icon >> User Accounts.
Bước 2: Click vào Change User account control settings.
Bước 3: Để tắt UAC,kéo thanh trượt Never notify position và sau đó click Ok.

Không biết cháu thực hiện đã theo ý của Chú chưa,nhưng code chạy vẫn bị lỗi như ảnh đính kèm Chú ạ:
1.jpg
2.jpg


Còn cách này mở Excel as administrator cháu chưa test được vì chưa biết cách.Cháu cũng đã có tìm trên mạng:

C:\Program Files\Microsoft Office\Office14\excel.exe
or
C:\Program Files(86)\Microsoft Office\Office14\excel.exe
Right click on it> properties> compatibility> uncheck all >
Then click on change settings for al users> uncheck all > ok >ok
then check if you can open files normally.

nhưng cháu cũng không thấy cái file excel.exe nào để làm theo nữa.
6.jpg

Rất mong được Chú chỉ bảo thêm ạ.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
@Chú Siwtom!
Cháu cảm ơn Chú đã tìm cách giúơ cháu.Cháu đã làm theo cách này"Bạn hãy tắt UAC rồi chạy code:
Để tắt UAC cháu thực hiện như sau:


Không biết cháu thực hiện đã theo ý của Chú chưa,nhưng code chạy vẫn bị lỗi như ảnh đính kèm Chú ạ:
View attachment 120204
View attachment 120205


Còn cách này mở Excel as administrator cháu chưa test được vì chưa biết cách.Cháu cũng đã có tìm trên mạng:



nhưng cháu cũng không thấy cái file excel.exe nào để làm theo nữa.
View attachment 120206

Rất mong được Chú chỉ bảo thêm ạ.

Tôi cũng không biết nghĩ thế nào nữa.
Trước đó tôi nói thử thao tác trên HKEY_CURRENT_USER vì thường là mỗi user có thể thay đổi trong khóa này. Còn trong HKEY_LOCAL_MACHINE thì chỉ có administrator có quyền.
Nhìn "permission denied" thì rõ ràng là không có quyền rồi. Còn thay đổi như thế nào thì tôi cũng chưa có ý tưởng.

À, khi bạn đã tắt UAC thì trước khi chạy code bạn có khởi động lại Windows không?

Nếu có thời gian tôi sẽ thử viết code dùng hàm API xem sao.
Thực tình là tôi chưa bao giờ có Vista, Windows 7, 8 nên cũng không tìm hiểu.
 
Upvote 0
Tôi cũng không biết nghĩ thế nào nữa.
Trước đó tôi nói thử thao tác trên HKEY_CURRENT_USER vì thường là mỗi user có thể thay đổi trong khóa này. Còn trong HKEY_LOCAL_MACHINE thì chỉ có administrator có quyền.
Nhìn "permission denied" thì rõ ràng là không có quyền rồi. Còn thay đổi như thế nào thì tôi cũng chưa có ý tưởng.

À, khi bạn đã tắt UAC thì trước khi chạy code bạn có khởi động lại Windows không?

Nếu có thời gian tôi sẽ thử viết code dùng hàm API xem sao.
Thực tình là tôi chưa bao giờ có Vista, Windows 7, 8 nên cũng không tìm hiểu.

Dạ có Chú ạ! Khi kéo về mức thấp nhất cháu thử không được nên nghĩ rằng có thể cần khởi động lại win...và cũng không được.
Vâng,khi nào tiện Chú giúp cháu nhé!
Cảm ơn Chú ạ!
 
Upvote 0
File Test là thế nào?

Bạn có 1 key (thư mục trong Registry) đã tồn tại, ở đây là "HKEY_CURRENT_USER\Control Panel", và bạn muốn thêm vào key đó 1 giá trị có Name (tên của giá trị) = Test và Value (giá trị của cái ông Test kia) = xyz. Nhìn hình thì tôi thấy xyz = 0. Nhưng bạn có nhu cầu thiết lập bao nhiêu là chuyện của bạn.
Tóm lại bạn có 3 cột với tiêu đề: "Name", "Type" và "Value" hoặc Data (tôi không rõ trong Windows tiếng Anh gọi là gì)

Làm gì có "file Test"?
------------

Mã:
Sub ThemGiaTriVaoKey[B][COLOR=#ff0000]DaCo[/COLOR][/B](ByVal KeyExists As String, ByVal Name As String, Value, ByVal type_ As String)
    CreateObject("WScript.Shell").RegWrite KeyExists & "\" & Name, Value, type_
End Sub

Sub ThemSubKeyVaoKey[B][COLOR=#ff0000]DaCo[/COLOR][/B](ByVal KeyExists As String, Byval SubKey As String)
    CreateObject("WScript.Shell").RegWrite KeyExists, SubKey
End Sub

Sub bla()
'    them subkey "hichic" vao key da co la "HKEY_CURRENT_USER\Control Panel"
    ThemSubKeyVaoKey[B][COLOR=#ff0000]DaCo[/COLOR][/B] "HKEY_CURRENT_USER\Control Panel", "hichic"
'    them gia tri co ten la "he he" va gia tri la 0 kieu DWORD vao key "HKEY_CURRENT_USER\Control Panel\hichic" vua duoc tao
    ThemGiaTriVaoKeyDaCo "HKEY_CURRENT_USER\Control Panel\hichic", "he he", 0, "REG_DWORD"
End Sub

Trong bài này Chú đã viết cho cháu hàm thêm key và giá trị.
Chú viết thêm giúp cháu hàm xóa key và xóa giá trị với ạ.
Vì hàm này vẫn có thể chạy trên nhánh HKEY_CURRENT_USER win 8.1 64 được Chú ạ.
 
Upvote 0
Trong bài này Chú đã viết cho cháu hàm thêm key và giá trị.
Chú viết thêm giúp cháu hàm xóa key và xóa giá trị với ạ.
Vì hàm này vẫn có thể chạy trên nhánh HKEY_CURRENT_USER win 8.1 64 được Chú ạ.

Mã:
Sub AddValueToKeyExist(ByVal KeyExists As String, ByVal Name As String, Value, ByVal type_ As String)
    CreateObject("WScript.Shell").RegWrite KeyExists & "\" & Name, Value, type_
End Sub

Sub AddSubkeyToKeyExist(ByVal KeyExists As String, ByVal subkey As String)
    CreateObject("WScript.Shell").RegWrite KeyExists, subkey
End Sub

Sub DeleteSubkeyOrValue(ByVal subkey As String, Optional ByVal ValueName As String = vbNullString)
'    ValueName = vbNullString: xoa subkey
'    ValueName <> vbNullString: xoa gia tri ValueName trong subkey
    CreateObject("WScript.Shell").RegDelete subkey & "\" & ValueName
End Sub

Sub bla()
'    them subkey "hichic" vao key da co la "HKEY_CURRENT_USER\Control Panel"
    AddSubkeyToKeyExist "HKEY_CURRENT_USER\Control Panel", "hichic"
'    them gia tri co ten la "he he" va gia tri la 0 kieu DWORD vao key "HKEY_CURRENT_USER\Control Panel\hichic" vua duoc tao
    AddValueToKeyExist "HKEY_CURRENT_USER\Control Panel\hichic", "he he", 0, "REG_DWORD"
End Sub

Sub hichic()
'    xoa gia tri he he
'    DeleteSubkeyOrValue "HKEY_CURRENT_USER\Control Panel\hichic", "he he"
'    xoa key hichic
    DeleteSubkeyOrValue "HKEY_CURRENT_USER\Control Panel\hichic"
End Sub
------------------
Bạn thử chạy sub WriteValue xem thông báo thế nào

module1
Mã:
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_ALL_ACCESS = &H3F
Private Const KEY_WOW64_64KEY = &H100
Private Const ERROR_SUCCESS = 0
Private Const REG_DWORD = 4

#If VBA7 And Win64 Then
    Private Type SECURITY_ATTRIBUTES
            nLength As Long
            lpSecurityDescriptor As LongPtr
            bInheritHandle As Long
    End Type
    
    Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
        (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, _
        ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
    Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
        (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal Reserved As Long, _
        ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
        lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As LongPtr, lpdwDisposition As Long) As Long
    Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As LongPtr) As Long
#Else
    Private Type SECURITY_ATTRIBUTES
      nLength As Long
      lpSecurityDescriptor As Long
      bInheritHandle As Boolean
    End Type
    
    Private Declare Function RegCreateKeyEx Lib "advapi32" 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, _
       lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
       lpdwDisposition As Long) As Long
    Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
      (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
       ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
    Private Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long
#End If

Public Sub WriteValue()
Dim hkey As LongPtr, value_ As Long, lCreate As Long, tSA As SECURITY_ATTRIBUTES
    If RegCreateKeyEx(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\USBSTOR", 0, "", _
            0, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, tSA, hkey, lCreate) = ERROR_SUCCESS Then
        value_ = 3
        RegSetValueEx hkey, "Start", 0, REG_DWORD, value_, LenB(value_)
        RegCloseKey hkey
    End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn thử chạy sub WriteValue xem thông báo thế nào

Hix,Cháu rất cảm ơn Chú siwtom đã nhiệt tình cố gắng tìm cách giúp đỡ.

Cháu đã test thử tất cả các code trong bài trên hệ điều hành win7 32bit:
Tất cẩ đều đã chạy thành công.
Riêng sub WriteValue thì phải tắt UAC sau đó khởi động lại win thì mới chạy OK.

Còn với hệ điều hành Win8.1 64 bit lúc nào có kết quả test cháu sẽ thông tin lại để Chú cùng mọi người biết kết quả ạ.
Hi vọng là sẽ được!Cháu cảm ơn Chú nhiều.


@Chú thanhlanh!
Cháu cảm ơn Chú đã tham gia giúp đỡ và góp ý.Nhưng thật sự cháu không hiểu bài đó vận dụng như thế nào để mà test cả,,,Hix
Nếu tiện mong Chú chỉ bảo thêm ạ.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
@Chú thanhlanh!
Cháu cảm ơn Chú đã tham gia giúp đỡ và góp ý.Nhưng thật sự cháu không hiểu bài đó vận dụng như thế nào để mà test cả,,,Hix
Nếu tiện mong Chú chỉ bảo thêm ạ.

' Khai báo và các hàm:

Mã:
Option Explicit
Private Const MyHKEY =[COLOR=#ff0000] [B]&H80000001[/B][/COLOR]   ' HKEY_CURRENT_USER
Private Const MyKey_Name =[COLOR=#ff0000] "[B]Control Panel\GPE[/B]"[/COLOR]
Private Const MyData_Type = [COLOR=#ff0000]4[/COLOR]   '"[B]REG_DWORD[/B]" - Kieu so 32 bit
'Private Const MyData_Type = [COLOR=#ff0000]1[/COLOR]   '[B]"REG_SZ[/B]" - Kieu chuoi Unicode
Private Const MyData_Name =[COLOR=#ff0000] "[B]Mien cat trang[/B]"[/COLOR]


Private Const KEY_ALL_ACCESS = &H2003F
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _
                                      ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
                                      ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _
                                      ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
                                       ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
                                       ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" ( _
                                        ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" ( _
                                      ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
                                         ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                                         ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
                                      
Public Function GetKeyDataValue(RegKeyRoot As Long, RegKeyName As String, KeyDateType As Long, KeyValueName As String)


    Dim OpenKey As Long, hKey As Long, strTempVal As String, KeyValSize As Long, lngI As Long


    OpenKey = RegOpenKeyEx(RegKeyRoot, RegKeyName, 0, KEY_ALL_ACCESS, hKey)


    strTempVal = String$(1024, 0)
    KeyValSize = 1024


    OpenKey = RegQueryValueEx(hKey, KeyValueName, 0, KeyDateType, strTempVal, KeyValSize)


    If (Asc(Mid(strTempVal, KeyValSize, 1)) = 0) Then
        strTempVal = Left(strTempVal, KeyValSize - 1)
    Else
        strTempVal = Left(strTempVal, KeyValSize)
    End If


    Select Case KeyDateType
    Case 1, 3:
        GetKeyDataValue = strTempVal
    Case 4:
        For lngI = Len(strTempVal) To 1 Step -1
            GetKeyDataValue = Format(Hex(Asc(Mid(strTempVal, lngI, 1))), "00")
        Next
        GetKeyDataValue = Format$("&h" + GetKeyDataValue)
    End Select
    OpenKey = RegCloseKey(hKey)
End Function




Private Sub SetKeyDataValue(RegKeyRoot As Long, RegKeyName As String, KeyDataType As Long, KeyValueName As String, KeyValueDate As Variant)
    Dim OpenKey As Long, SetValue As Long, hKey As Long
    OpenKey = RegOpenKeyEx(RegKeyRoot, RegKeyName, 0, KEY_ALL_ACCESS, hKey)
    If (OpenKey <> 0) Then
        Call RegCreateKey(RegKeyRoot, RegKeyName, hKey)
    End If
    Select Case KeyDataType
    Case 1:
        SetValue = RegSetValueEx(hKey, KeyValueName, 0&, KeyDataType, ByVal CStr(KeyValueDate & Chr$(0)), Len(KeyValueDate))
    Case 3:
        SetValue = RegSetValueEx(hKey, KeyValueName, 0&, KeyDataType, ByVal CStr(KeyValueDate & Chr$(0)), Len(KeyValueDate))
    Case 4:
        SetValue = RegSetValueEx(hKey, KeyValueName, 0&, KeyDataType, CLng(KeyValueDate), 4)
    End Select
    SetValue = RegCloseKey(hKey)
End Sub


Public Sub DeleteRegKey(RegKeyRoot As Long, RegKeyName As String)
    Dim DeleteKey As Long
    DeleteKey = RegDeleteKey(RegKeyRoot, RegKeyName)
End Sub


Public Sub DeleteRegValue(RegKeyRoot As Long, RegKeyName As String, KeyValueName As String)
    Dim DeleteKeyValue As Long, hKey As Long
    DeleteKeyValue = RegOpenKeyEx(RegKeyRoot, RegKeyName, 0, KEY_ALL_ACCESS, hKey)
    DeleteKeyValue = RegDeleteValue(hKey, KeyValueName)
End Sub

Vận dụng để tạo key, xóa DataName (key vẫn tồn tại), xóa Key, đọc DataValue lần lượt là:

Mã:
Public Sub addDataKey()
    Call SetKeyDataValue(MyHKEY, MyKey_Name, MyData_Type, MyData_Name, [COLOR=#ff0000]255[/COLOR])
End Sub
Public Sub DelData()
    DeleteRegValue MyHKEY, MyKey_Name, MyData_Name
End Sub
Sub Delkey()
   DeleteRegKey MyHKEY, MyKey_Name
End Sub
Sub GetDataValue()
   MsgBox GetKeyDataValue(MyHKEY, MyKey_Name, MyData_Type, MyData_Name)
End Sub

Tôi đã thử chạy tốt trên WinXP 32bits, Win7 64bits, riêng với Win7 chỉ chạy được trên nhánh HKEY_CURRENT_USER (MyHKEY = &H80000001) còn nhánh HKLM (MyHKEY = &H80000002) phải tạo file exe rồi chạy bằng Run as Adminítrator mới được.

Bạn, à quên cháu thay các giá trị màu đỏ để thử nghiệm.
 
Upvote 0
Mã:
........
Bạn thử chạy sub WriteValue xem thông báo thế nào
.............

@Chú siwtom!
Cháu rất cảm ơn Chú đã dành chút thời gian quý giá để giúp đỡ cháu!
Cháu đã thử sub WriteValue trên nên win 8.1-64 bit trước khi thử cháu cũng có tắt UAC sau đó khởi động lại win.
Trước khi chạy code:
Mã:
Public Sub WriteValue()
Dim hkey As LongPtr, value_ As Long, lCreate As Long, tSA As SECURITY_ATTRIBUTES
    If RegCreateKeyEx(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\USBSTOR", 0, "", _
            0, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, tSA, hkey, lCreate) = ERROR_SUCCESS Then
[COLOR=#ff0000][B]        value_ = 3[/B][/COLOR]
        RegSetValueEx hkey, "Start", 0, REG_DWORD, value_, LenB(value_)
        RegCloseKey hkey
    End If
End Sub
Cháu đã đặt thông số Start khác 3 để xem kết quả.Và kết quả cuối cùng sau những lần chạy code là không có phản ứng gì.(không báo lỗi, nhưng giá trị vẫn không thay đổi bằng 3 theo ý muốn của code.
Hix,...làm phiền Chú nhiều quá ạ.

-----
Vận dụng để tạo key, xóa DataName (key vẫn tồn tại), xóa Key, đọc DataValue lần lượt là:

Mã:
Public Sub addDataKey()
    Call SetKeyDataValue(MyHKEY, MyKey_Name, MyData_Type, MyData_Name, [COLOR=#ff0000]255[/COLOR])
End Sub
Public Sub DelData()
    DeleteRegValue MyHKEY, MyKey_Name, MyData_Name
End Sub
Sub Delkey()
   DeleteRegKey MyHKEY, MyKey_Name
End Sub
Sub GetDataValue()
   MsgBox GetKeyDataValue(MyHKEY, MyKey_Name, MyData_Type, MyData_Name)
End Sub

Tôi đã thử chạy tốt trên WinXP 32bits, Win7 64bits, riêng với Win7 chỉ chạy được trên nhánh HKEY_CURRENT_USER (MyHKEY = &H80000001) còn nhánh HKLM (MyHKEY = &H80000002) phải tạo file exe rồi chạy bằng Run as Adminítrator mới được.

Bạn, à quên cháu thay các giá trị màu đỏ để thử nghiệm.
@ Chú thanhlanh!
Cháu cảm ơn Chú đã giúp cháu!Nhưng cháu chưa thể test được vì còn gặp một vướng mắc dưới đây.
Phiền Chú cùng các Thầy trong GPE chỉ cho cháu cái này với ạ:
phải tạo file exe rồi chạy bằng Run as Adminítrator mới được.
 
Upvote 0
@ Chú thanhlanh!
Cháu cảm ơn Chú đã giúp cháu!Nhưng cháu chưa thể test được vì còn gặp một vướng mắc dưới đây.
Phiền Chú cùng các Thầy trong GPE chỉ cho cháu cái này với ạ:

Thế bạn đã test với nhánh HKEY_CURRENT_USER (trên các loại Win) chưa? kết quả ra sao?. theo bài #1 bạn đặt vấn đề với nhánh này mà!

Còn nhánh HKEY_LOCAL_MACHINE tôi chưa có cách để add hoặc edit key của nó bằng VBA (với Win 7 trở lên). Vì vậy, tôi buộc phải viết code này trên VB6, biên dịch thành file .exe mới xong. Có thể tôi chưa làm được bằng VBA trong môi trường Win7 nhưng các cao thủ thì làm được, he he.
 
Upvote 0
Thế bạn đã test với nhánh HKEY_CURRENT_USER (trên các loại Win) chưa? .

Nhánh HKEY_CURRENT_USER thì giải quyết xong từ lâu rồi.
Tôi chỉ có chút tò mò. Tập tin của bạn chạy được trên Win 64 bit? Tất nhiên tôi nói về nhánh HKEY_CURRENT_USER thôi.

Tôi hỏi thế vì bạn nói mấy lần là bạn đã thử trên nhiều Windows. Như thế chỉ cần định nghĩa, khai báo theo 1 kiểu thì chạy được trên mọi Windows?

Tôi không có nhiều Windows để mục sở thị nên hỏi để biết thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
@Chú siwtom!
Cháu rất cảm ơn Chú đã dành chút thời gian quý giá để giúp đỡ cháu!
Cháu đã thử sub WriteValue trên nên win 8.1-64 bit trước khi thử cháu cũng có tắt UAC sau đó khởi động lại win.
Trước khi chạy code:
Mã:
Public Sub WriteValue()
Dim hkey As LongPtr, value_ As Long, lCreate As Long, tSA As SECURITY_ATTRIBUTES
    If RegCreateKeyEx(HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\USBSTOR", 0, "", _
            0, KEY_ALL_ACCESS Or KEY_WOW64_64KEY, tSA, hkey, lCreate) = ERROR_SUCCESS Then
[COLOR=#ff0000][B]        value_ = 3[/B][/COLOR]
        RegSetValueEx hkey, "Start", 0, REG_DWORD, value_, LenB(value_)
        RegCloseKey hkey
    End If
End Sub
Cháu đã đặt thông số Start khác 3 để xem kết quả.Và kết quả cuối cùng sau những lần chạy code là không có phản ứng gì.(không báo lỗi, nhưng giá trị vẫn không thay đổi bằng 3 theo ý muốn của code.
Hix,...làm phiền Chú nhiều quá ạ.

Nếu nói về nhánh HKEY_LOCAL_MACHINE trên Win 8 64 bit thì nếu phải dùng Script thì tôi hiện thời đầu hàng.
Chuyện viết EXE tôi không xét vì ta muốn giải quyết bằng script chạy trong Excel mà.
 
Upvote 0
Nhánh HKEY_CURRENT_USER thì giải quyết xong từ lâu rồi.
Tôi chỉ có chút tò mò. Tập tin của bạn chạy được trên Win 64 bit? Tất nhiên tôi nói về nhánh HKEY_CURRENT_USER thôi.
Đúng vậy anh ạ!
Ở nhà máy tính em sử dụng hai ổ cứng (vật lý), một ổ cài WinXP, một ổ cài Win7 64 bít, máy thường xuyên mở nắp sẵn để thay dây từ Maiboand vào ổ cứng cho nhanh, để ... nghịch. Còn máy cơ quan em cài Win7 32 bits. Em chưa có máy cấu hình cao để cài Win8.

Tôi hỏi thế vì bạn nói mấy lần là bạn đã thử trên nhiều Windows. Như thế chỉ cần định nghĩa, khai báo theo 1 kiểu thì chạy được trên mọi Windows?
Vì vậy em cũng muốn bạn ấy test gìum xem KQ ra sao, mặc dù ngoài máy em, em cũng đã test trên máy người khác (32và 64bits)
 
Lần chỉnh sửa cuối:
Upvote 0
Đúng vậy anh ạ!
Ở nhà máy tính em sử dụng hai ổ cứng (vật lý), một ổ cài WinXP, một ổ cài Win7 64 bít, máy thường xuyên mở nắp sẵn để thay dây từ Maiboand vào ổ cứng cho nhanh, để ... nghịch. Còn máy cơ quan em cài Win7 32 bits. Em chưa có máy cấu hình cao để cài Win8.


Vì vậy em cũng muốn bạn ấy test gìum xem KQ ra sao, mặc dù ngoài máy em, em cũng đã test trên máy người khác (32và 64bits)

Chết. Tôi hôm nay hơi lú lẫn.
Chính ra là tôi định hỏi là bạn đã thử với Excel 32 và 64 bit phải không. Thế mà lại nhầm Excel thành Windows
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom