Registro di Windows

[visodont]

1) Sareste così gentili da dirmi se posso scrivere leggere e cancellare dei dati che scrivo nel registro di Windows senza causare problemi al PC e se si, quali ?

SaveSetting
GetSetting
DeleteSetting

Come far spengere il PC da programma in VB6 ?

Grazie.
Visodont.

[xegallo]

1) con le funz che hai elencato non fai danni poichè vanno a scrivere in aree dedicate ai programmi vb e vba

2) dimmi per che os ti serve

[visodont]

Grazie,

Dovrei scriverci i dati del collega al quale darò il programma. Non è un' esperto ma sa che con un appropriato programma è possibile leggerlo e modificarlo, se sta sull' exe.

E siccome non mi fido dei colleghi che con le dovute manovre potrebbero cambiare il nome e dare il programma ad altri, vorrei limitare questa possibilità, anche se so bene che non c'è nulla di sicuro.

Tutto si copia a tutto si Cracca !

O conosci qualche altro "machiavello" adatto allo scopo ?
Grazie,
Visodont

[matpez]

Ecco a te il metodo giusto che nn importa che OS stai utilizzando

Buon divertimento...

'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: [email protected]
    Command1.Caption = "Set Value"
    Command2.Caption = "Get Value"
    Command3.Caption = "Delete Value"
End Sub

[xegallo]

Originariamente inviato da matpez
Ecco a te il metodo giusto che nn importa che OS stai utilizzando

io lo chiedevo per lo spegnimento del pc

[matpez]

Questo va bene per tutti...

Devi usare la funzione ExitWindows

Option Explicit

Private Const EWX_FORCE = 4
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const VER_PLATFORM_WIN32_NT = 2

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO
  dwOSVersionInfoSize     As Long
  dwMajorVersion          As Long
  dwMinorVersion          As Long
  dwBuildNumber           As Long
  dwPlatformId            As Long
  szCSDVersion            As String * 128
End Type

Private Type LUID
   UsedPart                     As Long
   IgnoredForNowHigh32BitPart   As Long
End Type

Private Type TOKEN_PRIVILEGES
  PrivilegeCount          As Long
  TheLuid                 As LUID
  Attributes              As Long
End Type

Public Enum EXIT_WINDOWS
  EWX_LOGOFF = 0        'cambio utente
  EWX_SHUTDOWN = 1      'ShutDown del sistema
  EWX_REBOOT = 2        'Reboot del sistema
  EWX_POWEROFF = 8      'Spengo pc (ATX)
End Enum

Public Sub ExitWindows(ByVal ExitWindows As EXIT_WINDOWS)
  
  'se l'OS è un WinNT attivo il processo di ShutDown
  If IsWinNT Then EnableShutDown

  Select Case ExitWindows
    Case EWX_LOGOFF: ExitWindowsEx (EWX_LOGOFF Or EWX_FORCE), &HFFFF
    Case EWX_REBOOT: ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE Or EWX_REBOOT), &HFFFF
    Case EWX_SHUTDOWN: ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE), &HFFFF
    Case EWX_POWEROFF: ExitWindowsEx (EWX_POWEROFF Or EWX_FORCE), &HFFFF
  End Select
  
End Sub

Public Function IsWinNT() As Boolean

  Dim myOS As OSVERSIONINFO
  
  
  myOS.dwOSVersionInfoSize = Len(myOS)
  
  Call GetVersionEx(myOS)
  
  IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
  
End Function

Private Sub EnableShutDown()
  
  Const TOKEN_ADJUST_PRIVILEGES = &H20
  Const TOKEN_QUERY = &H8
  
  Dim hdlProcessHandle      As Long
  Dim hdlTokenHandle        As Long
  Dim lBufferNeeded         As Long
  Dim tmpLuid               As LUID
  Dim tkp                   As TOKEN_PRIVILEGES
  Dim tkpNewButIgnored      As TOKEN_PRIVILEGES


  hdlProcessHandle = GetCurrentProcess()
  
  OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle

  LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

  tkp.PrivilegeCount = 1
  tkp.TheLuid = tmpLuid
  tkp.Attributes = SE_PRIVILEGE_ENABLED

  AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
    
End Sub