› ›

Getting a program to start with windows

didanididani
in Evil Scripting
There are serveral ways to start a program when windows starts. The easiest way to make and remove is the start menu/programs/startup section. Place a link to the program you would like to run and the boot adjustment is ready
The second option is the c:/windows/win.ini . This file contains a line (second or third) which says RUN= . This line should be altered to RUN="c:[programdir][programname].exe" . If you place the file in one of the environmental variables declared in autoexec.bat (SET=C:WINDOWS;C:WINDOWSCOMMAND) In this case (and just about any case) C:windows or C:windowscommand, you could leave the "C:[programdir]" section out of the line. Done!
The third line is to write a string to the registry, in the [HKEY_LOCAL_MACHINESOFTWAREMICROSOFTWINDOWSCURRENTVERSIONRUN] section. Write a string value, with the name you would like to display (Like "Windows Essentials") and assign the program dir and name as the value. Again, if the program is in an environmental variable directory, the directory is not necessary.
But, how is this done? Quite simple, get a registry acces API, or use regedit :D :
[code]Public Function install(app As String, name As String)
Open "temp.reg" For Output As #1
Print #1, "REGEDIT4"
Print #1, ""
Print #1, "[HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersionRun]"
Print #1, Chr(34) & name & Chr(34) & "=" & Chr(34) & app & Chr(34)
Print #1, ""
Print #1, ""
Close #1
Shell "regedit /s temp.reg"
Kill "temp.reg"
End Function[/code]
As you see, this is a quite simple function, and it only requires the fake name to display, and the program path.
That's about all I know about computer booting.
EtHeO out...

Comments

  • markblue777markblue777
    There is another way in a module and the code is this.
    [code]
    Enum RegHive
    HKEY_CLASSES_ROOT = &H80000000
    HK_CR = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HK_CU = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HK_LM = &H80000002
    HKEY_USERS = &H80000003
    HK_US = &H80000003
    HKEY_CURRENT_CONFIG = &H80000005
    HK_CC = &H80000005
    HKEY_DYN_DATA = &H80000006
    HK_DD = &H80000006
    End Enum

    Enum RegType
    REG_SZ = 1 'Unicode nul terminated string
    REG_BINARY = 3 'Free form binary
    REG_DWORD = 4 '32-bit number
    End Enum

    Public Const ERROR_SUCCESS = 0&
    Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
    Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Public 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
    Public 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
    Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

    Public Function DelRegValue(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String)
    Dim hCurKey As Long
    Dim lRegResult As Long
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegDeleteValue(hCurKey, strValue)
    lRegResult = RegCloseKey(hCurKey)
    End Function

    Public Function DelRegKey(ByVal hKey As RegHive, ByVal strPath As String) As Long
    Dim lRegResult As Long
    lRegResult = RegDeleteKey(hKey, strPath)
    DelRegKey = lRegResult
    End Function

    Public Function CreateRegKey(hKey As RegHive, strPath As String)
    Dim hCurKey As Long
    Dim lRegResult As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    If lRegResult <> ERROR_SUCCESS Then
    'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
    End Function
    Public Function GetRegString(hKey As RegHive, strPath As String, strValue As String, Optional Default As String) As String
    Dim hCurKey As Long
    Dim lResult As Long
    Dim lValueType As Long
    Dim strBuffer As String
    Dim lDataBufferSize As Long
    Dim intZeroPos As Integer
    Dim lRegResult As Long
    'Set up default value
    If Not IsEmpty(Default) Then
    GetRegString = Default
    Else
    GetRegString = ""
    End If
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
    If lRegResult = ERROR_SUCCESS Then
    If lValueType = REG_SZ Then
    strBuffer = String(lDataBufferSize, " ")
    lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
    intZeroPos = InStr(strBuffer, Chr$(0))
    If intZeroPos > 0 Then
    GetRegString = Left$(strBuffer, intZeroPos - 1)
    Else
    GetRegString = strBuffer
    End If
    End If
    Else
    'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
    End Function

    Public Function SaveRegString(hKey As RegHive, strPath As String, strValue As String, strData As String)
    Dim hCurKey As Long
    Dim lRegResult As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    If lRegResult <> ERROR_SUCCESS Then
    'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
    End Function

    Public Function GetRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long
    Dim lRegResult As Long
    Dim lValueType As Long
    Dim lBuffer As Long
    Dim lDataBufferSize As Long
    Dim hCurKey As Long
    'Set up default value
    If Not IsEmpty(Default) Then
    GetRegLong = Default
    Else
    GetRegLong = 0
    End If
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lDataBufferSize = 4 '4 bytes = 32 bits = long
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, lDataBufferSize)
    If lRegResult = ERROR_SUCCESS Then
    If lValueType = REG_DWORD Then
    GetRegLong = lBuffer
    End If
    Else
    'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
    End Function

    Public Function SaveRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long)
    Dim hCurKey As Long
    Dim lRegResult As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4)
    If lRegResult <> ERROR_SUCCESS Then
    'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
    End Function

    Public Function GetRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, Optional Default As Variant) As Variant
    Dim lValueType As Long
    Dim byBuffer() As Byte
    Dim lDataBufferSize As Long
    Dim lRegResult As Long
    Dim hCurKey As Long
    If Not IsEmpty(Default) Then
    If VarType(Default) = vbArray + vbByte Then
    GetRegByte = Default
    Else
    GetRegByte = 0
    End If
    Else
    GetRegByte = 0
    End If
    lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufferSize)
    If lRegResult = ERROR_SUCCESS Then
    If lValueType = REG_BINARY Then
    ReDim byBuffer(lDataBufferSize - 1) As Byte
    lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, byBuffer(0), lDataBufferSize)
    GetRegByte = byBuffer
    End If
    Else
    'there is a problem
    End If
    lRegResult = RegCloseKey(hCurKey)
    End Function

    Public Function SaveRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, byData() As Byte)
    Dim lRegResult As Long
    Dim hCurKey As Long
    lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    lRegResult = RegSetValueEx(hCurKey, strValueName, 0&, REG_BINARY, byData(0), UBound(byData()) + 1)
    lRegResult = RegCloseKey(hCurKey)
    End Function

    Public Function CopyRegByte(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    ByVal From_strKeyName As String, ByVal To_strPath As String, _
    Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)

    If To_hKey = 0 Then
    To_hKey = From_hKey
    Else
    To_hKey = To_hKey
    End If
    If To_strKeyName = "" Then
    To_strKeyName = From_strKeyName
    Else
    To_strKeyName = To_strKeyName
    End If

    Dim mybytes As Variant
    mybytes = GetRegByte(From_hKey, From_strPath, From_strKeyName)
    thelen = UBound(mybytes)
    Dim x() As Byte
    ReDim x(thelen)
    For i = 0 To UBound(mybytes)
    x(i) = mybytes(i)
    Next i
    rslt = SaveRegByte(To_hKey, To_strPath, To_strKeyName, x)
    End Function

    Public Function CopyRegString(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    ByVal From_strKeyName As String, ByVal To_strPath As String, _
    Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)

    If To_hKey = 0 Then
    To_hKey = From_hKey
    Else
    To_hKey = To_hKey
    End If
    If To_strKeyName = "" Then
    To_strKeyName = From_strKeyName
    Else
    To_strKeyName = To_strKeyName
    End If

    Dim mystring As String
    mystring = GetRegString(From_hKey, From_strPath, From_strKeyName)
    rslt = SaveRegString(To_hKey, To_strPath, To_strKeyName, mystring)

    End Function

    Public Function CopyRegLong(ByVal hKey As RegHive, ByVal From_strPath As String, _
    ByVal From_strKeyName As String, ByVal To_strPath As String, _
    Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)

    If To_hKey = 0 Then
    To_hKey = From_hKey
    Else
    To_hKey = To_hKey
    End If
    If To_strKeyName = "" Then
    To_strKeyName = From_strKeyName
    Else
    To_strKeyName = To_strKeyName
    End If

    Dim mylong As Long
    mylong = GetRegLong(From_hKey, From_strPath, From_strKeyName)
    rslt = SaveRegLong(To_hKey, To_strPath, To_strKeyName, mylong)

    End Function
    Public Function GetRegSubKeyList(ByVal hKey As RegHive, ByVal strPath As String)
    On Error Resume Next
    Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long
    Dim sValue As String, td As Double, i As Long, Ret As Boolean, tmprst()
    Do Until Ret = True
    lResult = RegOpenKey(hKey, strPath, lKeyValue)
    sValue = Space$(2048)
    lValueLength = Len(sValue)
    lResult = RegEnumKey(lKeyValue, i, sValue, lValueLength)
    If (lResult = 0) And (Err.Number = 0) Then
    ReDim Preserve tmprst(i)
    tmprst(i) = Left$(sValue, InStr(sValue, Chr(0)) - 1)
    Else
    Ret = True
    End If
    lResult = RegCloseKey(lKeyValue)
    i = i + 1
    Loop
    GetRegSubKeyList = tmprst
    End Function
    [/code]
    Just wack it in a module and it is done
    from
    mark
  • didanididani
    : There is another way in a module and the code is this.
    : [code]
    : Enum RegHive
    : HKEY_CLASSES_ROOT = &H80000000
    : HK_CR = &H80000000
    : HKEY_CURRENT_USER = &H80000001
    : HK_CU = &H80000001
    : HKEY_LOCAL_MACHINE = &H80000002
    : HK_LM = &H80000002
    : HKEY_USERS = &H80000003
    : HK_US = &H80000003
    : HKEY_CURRENT_CONFIG = &H80000005
    : HK_CC = &H80000005
    : HKEY_DYN_DATA = &H80000006
    : HK_DD = &H80000006
    : End Enum
    :
    : Enum RegType
    : REG_SZ = 1 'Unicode nul terminated string
    : REG_BINARY = 3 'Free form binary
    : REG_DWORD = 4 '32-bit number
    : End Enum
    :
    : Public Const ERROR_SUCCESS = 0&
    : Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    : Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    : Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    : Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
    : Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    : Public 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
    : Public 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
    : Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
    :
    : Public Function DelRegValue(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String)
    : Dim hCurKey As Long
    : Dim lRegResult As Long
    : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : lRegResult = RegDeleteValue(hCurKey, strValue)
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    :
    : Public Function DelRegKey(ByVal hKey As RegHive, ByVal strPath As String) As Long
    : Dim lRegResult As Long
    : lRegResult = RegDeleteKey(hKey, strPath)
    : DelRegKey = lRegResult
    : End Function
    :
    : Public Function CreateRegKey(hKey As RegHive, strPath As String)
    : Dim hCurKey As Long
    : Dim lRegResult As Long
    : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : If lRegResult <> ERROR_SUCCESS Then
    : 'there is a problem
    : End If
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    : Public Function GetRegString(hKey As RegHive, strPath As String, strValue As String, Optional Default As String) As String
    : Dim hCurKey As Long
    : Dim lResult As Long
    : Dim lValueType As Long
    : Dim strBuffer As String
    : Dim lDataBufferSize As Long
    : Dim intZeroPos As Integer
    : Dim lRegResult As Long
    : 'Set up default value
    : If Not IsEmpty(Default) Then
    : GetRegString = Default
    : Else
    : GetRegString = ""
    : End If
    : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
    : If lRegResult = ERROR_SUCCESS Then
    : If lValueType = REG_SZ Then
    : strBuffer = String(lDataBufferSize, " ")
    : lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
    : intZeroPos = InStr(strBuffer, Chr$(0))
    : If intZeroPos > 0 Then
    : GetRegString = Left$(strBuffer, intZeroPos - 1)
    : Else
    : GetRegString = strBuffer
    : End If
    : End If
    : Else
    : 'there is a problem
    : End If
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    :
    : Public Function SaveRegString(hKey As RegHive, strPath As String, strValue As String, strData As String)
    : Dim hCurKey As Long
    : Dim lRegResult As Long
    : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    : If lRegResult <> ERROR_SUCCESS Then
    : 'there is a problem
    : End If
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    :
    : Public Function GetRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long
    : Dim lRegResult As Long
    : Dim lValueType As Long
    : Dim lBuffer As Long
    : Dim lDataBufferSize As Long
    : Dim hCurKey As Long
    : 'Set up default value
    : If Not IsEmpty(Default) Then
    : GetRegLong = Default
    : Else
    : GetRegLong = 0
    : End If
    : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : lDataBufferSize = 4 '4 bytes = 32 bits = long
    : lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, lDataBufferSize)
    : If lRegResult = ERROR_SUCCESS Then
    : If lValueType = REG_DWORD Then
    : GetRegLong = lBuffer
    : End If
    : Else
    : 'there is a problem
    : End If
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    :
    : Public Function SaveRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long)
    : Dim hCurKey As Long
    : Dim lRegResult As Long
    : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4)
    : If lRegResult <> ERROR_SUCCESS Then
    : 'there is a problem
    : End If
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    :
    : Public Function GetRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, Optional Default As Variant) As Variant
    : Dim lValueType As Long
    : Dim byBuffer() As Byte
    : Dim lDataBufferSize As Long
    : Dim lRegResult As Long
    : Dim hCurKey As Long
    : If Not IsEmpty(Default) Then
    : If VarType(Default) = vbArray + vbByte Then
    : GetRegByte = Default
    : Else
    : GetRegByte = 0
    : End If
    : Else
    : GetRegByte = 0
    : End If
    : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufferSize)
    : If lRegResult = ERROR_SUCCESS Then
    : If lValueType = REG_BINARY Then
    : ReDim byBuffer(lDataBufferSize - 1) As Byte
    : lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, byBuffer(0), lDataBufferSize)
    : GetRegByte = byBuffer
    : End If
    : Else
    : 'there is a problem
    : End If
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    :
    : Public Function SaveRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, byData() As Byte)
    : Dim lRegResult As Long
    : Dim hCurKey As Long
    : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : lRegResult = RegSetValueEx(hCurKey, strValueName, 0&, REG_BINARY, byData(0), UBound(byData()) + 1)
    : lRegResult = RegCloseKey(hCurKey)
    : End Function
    :
    : Public Function CopyRegByte(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    : ByVal From_strKeyName As String, ByVal To_strPath As String, _
    : Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
    :
    : If To_hKey = 0 Then
    : To_hKey = From_hKey
    : Else
    : To_hKey = To_hKey
    : End If
    : If To_strKeyName = "" Then
    : To_strKeyName = From_strKeyName
    : Else
    : To_strKeyName = To_strKeyName
    : End If
    :
    : Dim mybytes As Variant
    : mybytes = GetRegByte(From_hKey, From_strPath, From_strKeyName)
    : thelen = UBound(mybytes)
    : Dim x() As Byte
    : ReDim x(thelen)
    : For i = 0 To UBound(mybytes)
    : x(i) = mybytes(i)
    : Next i
    : rslt = SaveRegByte(To_hKey, To_strPath, To_strKeyName, x)
    : End Function
    :
    : Public Function CopyRegString(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    : ByVal From_strKeyName As String, ByVal To_strPath As String, _
    : Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
    :
    : If To_hKey = 0 Then
    : To_hKey = From_hKey
    : Else
    : To_hKey = To_hKey
    : End If
    : If To_strKeyName = "" Then
    : To_strKeyName = From_strKeyName
    : Else
    : To_strKeyName = To_strKeyName
    : End If
    :
    : Dim mystring As String
    : mystring = GetRegString(From_hKey, From_strPath, From_strKeyName)
    : rslt = SaveRegString(To_hKey, To_strPath, To_strKeyName, mystring)
    :
    : End Function
    :
    : Public Function CopyRegLong(ByVal hKey As RegHive, ByVal From_strPath As String, _
    : ByVal From_strKeyName As String, ByVal To_strPath As String, _
    : Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
    :
    : If To_hKey = 0 Then
    : To_hKey = From_hKey
    : Else
    : To_hKey = To_hKey
    : End If
    : If To_strKeyName = "" Then
    : To_strKeyName = From_strKeyName
    : Else
    : To_strKeyName = To_strKeyName
    : End If
    :
    : Dim mylong As Long
    : mylong = GetRegLong(From_hKey, From_strPath, From_strKeyName)
    : rslt = SaveRegLong(To_hKey, To_strPath, To_strKeyName, mylong)
    :
    : End Function
    : Public Function GetRegSubKeyList(ByVal hKey As RegHive, ByVal strPath As String)
    : On Error Resume Next
    : Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long
    : Dim sValue As String, td As Double, i As Long, Ret As Boolean, tmprst()
    : Do Until Ret = True
    : lResult = RegOpenKey(hKey, strPath, lKeyValue)
    : sValue = Space$(2048)
    : lValueLength = Len(sValue)
    : lResult = RegEnumKey(lKeyValue, i, sValue, lValueLength)
    : If (lResult = 0) And (Err.Number = 0) Then
    : ReDim Preserve tmprst(i)
    : tmprst(i) = Left$(sValue, InStr(sValue, Chr(0)) - 1)
    : Else
    : Ret = True
    : End If
    : lResult = RegCloseKey(lKeyValue)
    : i = i + 1
    : Loop
    : GetRegSubKeyList = tmprst
    : End Function
    : [/code]
    : Just wack it in a module and it is done
    : from
    : mark
    :
    Thanks mate, but i'll stick to my way :P it seems a bit more easy to me :P
    EtHeO out...

  • netmseshunetmseshu
    : : There is another way in a module and the code is this.
    : : [code]
    : : Enum RegHive
    : : HKEY_CLASSES_ROOT = &H80000000
    : : HK_CR = &H80000000
    : : HKEY_CURRENT_USER = &H80000001
    : : HK_CU = &H80000001
    : : HKEY_LOCAL_MACHINE = &H80000002
    : : HK_LM = &H80000002
    : : HKEY_USERS = &H80000003
    : : HK_US = &H80000003
    : : HKEY_CURRENT_CONFIG = &H80000005
    : : HK_CC = &H80000005
    : : HKEY_DYN_DATA = &H80000006
    : : HK_DD = &H80000006
    : : End Enum
    : :
    : : Enum RegType
    : : REG_SZ = 1 'Unicode nul terminated string
    : : REG_BINARY = 3 'Free form binary
    : : REG_DWORD = 4 '32-bit number
    : : End Enum
    : :
    : : Public Const ERROR_SUCCESS = 0&
    : : Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    : : Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    : : Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    : : Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
    : : Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    : : Public 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
    : : Public 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
    : : Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
    : :
    : : Public Function DelRegValue(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String)
    : : Dim hCurKey As Long
    : : Dim lRegResult As Long
    : : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : : lRegResult = RegDeleteValue(hCurKey, strValue)
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : :
    : : Public Function DelRegKey(ByVal hKey As RegHive, ByVal strPath As String) As Long
    : : Dim lRegResult As Long
    : : lRegResult = RegDeleteKey(hKey, strPath)
    : : DelRegKey = lRegResult
    : : End Function
    : :
    : : Public Function CreateRegKey(hKey As RegHive, strPath As String)
    : : Dim hCurKey As Long
    : : Dim lRegResult As Long
    : : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : : If lRegResult <> ERROR_SUCCESS Then
    : : 'there is a problem
    : : End If
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : : Public Function GetRegString(hKey As RegHive, strPath As String, strValue As String, Optional Default As String) As String
    : : Dim hCurKey As Long
    : : Dim lResult As Long
    : : Dim lValueType As Long
    : : Dim strBuffer As String
    : : Dim lDataBufferSize As Long
    : : Dim intZeroPos As Integer
    : : Dim lRegResult As Long
    : : 'Set up default value
    : : If Not IsEmpty(Default) Then
    : : GetRegString = Default
    : : Else
    : : GetRegString = ""
    : : End If
    : : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : : lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
    : : If lRegResult = ERROR_SUCCESS Then
    : : If lValueType = REG_SZ Then
    : : strBuffer = String(lDataBufferSize, " ")
    : : lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
    : : intZeroPos = InStr(strBuffer, Chr$(0))
    : : If intZeroPos > 0 Then
    : : GetRegString = Left$(strBuffer, intZeroPos - 1)
    : : Else
    : : GetRegString = strBuffer
    : : End If
    : : End If
    : : Else
    : : 'there is a problem
    : : End If
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : :
    : : Public Function SaveRegString(hKey As RegHive, strPath As String, strValue As String, strData As String)
    : : Dim hCurKey As Long
    : : Dim lRegResult As Long
    : : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : : lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    : : If lRegResult <> ERROR_SUCCESS Then
    : : 'there is a problem
    : : End If
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : :
    : : Public Function GetRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long
    : : Dim lRegResult As Long
    : : Dim lValueType As Long
    : : Dim lBuffer As Long
    : : Dim lDataBufferSize As Long
    : : Dim hCurKey As Long
    : : 'Set up default value
    : : If Not IsEmpty(Default) Then
    : : GetRegLong = Default
    : : Else
    : : GetRegLong = 0
    : : End If
    : : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : : lDataBufferSize = 4 '4 bytes = 32 bits = long
    : : lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, lDataBufferSize)
    : : If lRegResult = ERROR_SUCCESS Then
    : : If lValueType = REG_DWORD Then
    : : GetRegLong = lBuffer
    : : End If
    : : Else
    : : 'there is a problem
    : : End If
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : :
    : : Public Function SaveRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long)
    : : Dim hCurKey As Long
    : : Dim lRegResult As Long
    : : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : : lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4)
    : : If lRegResult <> ERROR_SUCCESS Then
    : : 'there is a problem
    : : End If
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : :
    : : Public Function GetRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, Optional Default As Variant) As Variant
    : : Dim lValueType As Long
    : : Dim byBuffer() As Byte
    : : Dim lDataBufferSize As Long
    : : Dim lRegResult As Long
    : : Dim hCurKey As Long
    : : If Not IsEmpty(Default) Then
    : : If VarType(Default) = vbArray + vbByte Then
    : : GetRegByte = Default
    : : Else
    : : GetRegByte = 0
    : : End If
    : : Else
    : : GetRegByte = 0
    : : End If
    : : lRegResult = RegOpenKey(hKey, strPath, hCurKey)
    : : lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufferSize)
    : : If lRegResult = ERROR_SUCCESS Then
    : : If lValueType = REG_BINARY Then
    : : ReDim byBuffer(lDataBufferSize - 1) As Byte
    : : lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, byBuffer(0), lDataBufferSize)
    : : GetRegByte = byBuffer
    : : End If
    : : Else
    : : 'there is a problem
    : : End If
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : :
    : : Public Function SaveRegByte(ByVal hKey As RegHive, ByVal strPath As String, ByVal strValueName As String, byData() As Byte)
    : : Dim lRegResult As Long
    : : Dim hCurKey As Long
    : : lRegResult = RegCreateKey(hKey, strPath, hCurKey)
    : : lRegResult = RegSetValueEx(hCurKey, strValueName, 0&, REG_BINARY, byData(0), UBound(byData()) + 1)
    : : lRegResult = RegCloseKey(hCurKey)
    : : End Function
    : :
    : : Public Function CopyRegByte(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    : : ByVal From_strKeyName As String, ByVal To_strPath As String, _
    : : Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
    : :
    : : If To_hKey = 0 Then
    : : To_hKey = From_hKey
    : : Else
    : : To_hKey = To_hKey
    : : End If
    : : If To_strKeyName = "" Then
    : : To_strKeyName = From_strKeyName
    : : Else
    : : To_strKeyName = To_strKeyName
    : : End If
    : :
    : : Dim mybytes As Variant
    : : mybytes = GetRegByte(From_hKey, From_strPath, From_strKeyName)
    : : thelen = UBound(mybytes)
    : : Dim x() As Byte
    : : ReDim x(thelen)
    : : For i = 0 To UBound(mybytes)
    : : x(i) = mybytes(i)
    : : Next i
    : : rslt = SaveRegByte(To_hKey, To_strPath, To_strKeyName, x)
    : : End Function
    : :
    : : Public Function CopyRegString(ByVal From_hKey As RegHive, ByVal From_strPath As String, _
    : : ByVal From_strKeyName As String, ByVal To_strPath As String, _
    : : Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
    : :
    : : If To_hKey = 0 Then
    : : To_hKey = From_hKey
    : : Else
    : : To_hKey = To_hKey
    : : End If
    : : If To_strKeyName = "" Then
    : : To_strKeyName = From_strKeyName
    : : Else
    : : To_strKeyName = To_strKeyName
    : : End If
    : :
    : : Dim mystring As String
    : : mystring = GetRegString(From_hKey, From_strPath, From_strKeyName)
    : : rslt = SaveRegString(To_hKey, To_strPath, To_strKeyName, mystring)
    : :
    : : End Function
    : :
    : : Public Function CopyRegLong(ByVal hKey As RegHive, ByVal From_strPath As String, _
    : : ByVal From_strKeyName As String, ByVal To_strPath As String, _
    : : Optional ByVal To_hKey As RegHive, Optional ByVal To_strKeyName As String)
    : :
    : : If To_hKey = 0 Then
    : : To_hKey = From_hKey
    : : Else
    : : To_hKey = To_hKey
    : : End If
    : : If To_strKeyName = "" Then
    : : To_strKeyName = From_strKeyName
    : : Else
    : : To_strKeyName = To_strKeyName
    : : End If
    : :
    : : Dim mylong As Long
    : : mylong = GetRegLong(From_hKey, From_strPath, From_strKeyName)
    : : rslt = SaveRegLong(To_hKey, To_strPath, To_strKeyName, mylong)
    : :
    : : End Function
    : : Public Function GetRegSubKeyList(ByVal hKey As RegHive, ByVal strPath As String)
    : : On Error Resume Next
    : : Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long
    : : Dim sValue As String, td As Double, i As Long, Ret As Boolean, tmprst()
    : : Do Until Ret = True
    : : lResult = RegOpenKey(hKey, strPath, lKeyValue)
    : : sValue = Space$(2048)
    : : lValueLength = Len(sValue)
    : : lResult = RegEnumKey(lKeyValue, i, sValue, lValueLength)
    : : If (lResult = 0) And (Err.Number = 0) Then
    : : ReDim Preserve tmprst(i)
    : : tmprst(i) = Left$(sValue, InStr(sValue, Chr(0)) - 1)
    : : Else
    : : Ret = True
    : : End If
    : : lResult = RegCloseKey(lKeyValue)
    : : i = i + 1
    : : Loop
    : : GetRegSubKeyList = tmprst
    : : End Function
    : : [/code]
    : : Just wack it in a module and it is done
    : : from
    : : mark
    : :
    : Thanks mate, but i'll stick to my way :P it seems a bit more easy to me :P
    : EtHeO out...
    :
    :

    ___________________________________

    can you tell me in which langauge did you do this code and how to complie it that all i am new to this sites


Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Sign In Register

Categories

In this Discussion