Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 142
  • Last Modified:

Create a new Registry in System

Hi Expert,

If I want to create a System Registry, Value type is "DWORD" through VB, how can i do that?

I just know the valid value for that DWORD type is 0 or 1

Thanks very much
0
kchoed
Asked:
kchoed
1 Solution
 
TimCotteeCommented:
You need to use some Registry api calls. These can either be achieved using straight API, a class that wraps these (many are available on the internet just search for them) or alternatively you can use the windows Shell scripting functions that have some registry support:

Dim wshShell As Object
Set wshShell = CreateObject("WScript.Shell")
wshShell.RegWrite "HKLM\Software\YourCompany\YourSection\YourKey",1
Set wshShell = Nothing
0
 
TimCotteeCommented:
Here is an API solution:

'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    'retrieve nformation about the key
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
            'Create a buffer
            strBuf = String(lDataBufSize, Chr$(0))
            'retrieve the key's content
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                'Remove the unnecessary chr$(0)'s
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
        End If
    End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    'Open the key
    RegOpenKey hKey, strPath, Ret
    'Get the key's content
    GetString = RegQueryStringValue(Ret, strValue)
    'Close the key
    RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Save a string to the key
    RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
    'close the key
    RegCloseKey Ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Set the key's value
    RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
    'close the key
    RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    'Delete the key's value
    RegDeleteValue Ret, strValue
    'close the key
    RegCloseKey Ret
End Sub
Private Sub Command1_Click()
    Dim strString As String
    'Ask for a value
    strString = InputBox("Please enter a value between 0 and 255 to be saved as a binary value in the registry.", App.Title)
    If strString = "" Or Val(strString) > 255 Or Val(strString) < 0 Then
        MsgBox "Invalid value entered ...", vbExclamation + vbOKOnly, App.Title
        Exit Sub
    End If
    'Save the value to the registry
    SaveStringLong HKEY_CURRENT_USER, "KPD-Team", "BinaryValue", CByte(strString)
End Sub
Private Sub Command2_Click()
    'Get a string from the registry
    Ret = GetString(HKEY_CURRENT_USER, "KPD-Team", "BinaryValue")
    If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
    MsgBox "The value is " + Ret, vbOKOnly + vbInformation, App.Title
End Sub
Private Sub Command3_Click()
    'Delete the setting from the registry
    DelSetting HKEY_CURRENT_USER, "KPD-Team", "BinaryValue"
    MsgBox "The value was deleted ...", vbInformation + vbOKOnly, App.Title
End Sub
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Command1.Caption = "Set Value"
    Command2.Caption = "Get Value"
    Command3.Caption = "Delete Value"
End Sub
0
 
kchoedAuthor Commented:
Hi TimCottee,

What about if I want to create a new value which field type is DWORD?

Thanks
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
Richie_SimonettiIT OperationsCommented:
DWORD is actually long type to us, read the code posted by Tim (by the way, from the same source that i have ;)
0
 
DanRollinsCommented:
Hi kchoed,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Accept TimCottee's comment(s) as an answer.

kchoed, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept this comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
0
 
SpideyModCommented:
per recommendation

SpideyMod
Community Support Moderator @Experts Exchange
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Tackle projects and never again get stuck behind a technical roadblock.
Join Now