içindeki bir butonla programınızın başlangıçta çalışıp çalışmamasını doğrulamak istiyorsunuz,
Kod:
Option Explicit
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_FILE_NOT_FOUND = 2&
Public Const ERROR_MORE_DATA = 234
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Declare Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _
ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, _
lpType As Long, lpData As Byte, lpcbData As Long) As Long
Declare Function RegQueryInfoKey Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, _
lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, _
lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, _
lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, _
lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" _
(ByVal hKey As Long, ByVal lpValueName As String) _
As Long
Declare Function RegDeleteKey Lib "advapi32.dll" _
Alias "RegDeleteKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String) As Long
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
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, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
lpdwDisposition As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpszValueName As String, _
ByVal lpdwReserved As Long, lpdwType As Long, _
lpData As Any, lpcbData As Long) As Long
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
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Declare Function GetPrivateProfileSection Lib "kernel32" _
Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal _
lpFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString _
As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) _
As Long
Declare Function GetPrivateProfileInt Lib "kernel32" _
Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName _
As String) As Long
Public Function fDeleteKey(ByVal sTopKey As String, ByVal sSubKey As String, ByVal sKeyName As String) As Long
Dim lTopKey As Long
Dim lHandle As Long
Dim lResult As Long
On Error GoTo fDeleteKeyError
lResult = 99
lTopKey = fTopKey(sTopKey)
If lTopKey = 0 Then GoTo fDeleteKeyError
lResult = RegOpenKeyEx(lTopKey, sSubKey, 0, KEY_CREATE_SUB_KEY, lHandle)
If lResult = ERROR_SUCCESS Then
lResult = RegDeleteKey(lHandle, sKeyName)
End If
If lResult = ERROR_SUCCESS Or lResult = ERROR_FILE_NOT_FOUND Then
fDeleteKey = ERROR_SUCCESS
Else
fDeleteKey = lResult
End If
Exit Function
fDeleteKeyError:
MsgBox "DEĞER SİLİNDİ key.", vbExclamation, "fDeleteKey"
fDeleteKey = lResult
End Function
Public Function fDeleteValue(ByVal sTopKeyOrFile As String, ByVal sSubKeyOrSection As String, ByVal sValueName As String) As Long
Dim lTopKey As Long
Dim lHandle As Long
Dim lResult As Long
On Error GoTo fDeleteValueError
lResult = 99
lTopKey = fTopKey(sTopKeyOrFile)
If lTopKey = 0 Then GoTo fDeleteValueError
If lTopKey = 1 Then
lResult = WritePrivateProfileString(sSubKeyOrSection, sValueName, "", sTopKeyOrFile)
Else
lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_SET_VALUE, lHandle)
If lResult = ERROR_SUCCESS Then
lResult = RegDeleteValue(lHandle, sValueName)
End If
If lResult = ERROR_SUCCESS Or lResult = ERROR_FILE_NOT_FOUND Then
fDeleteValue = ERROR_SUCCESS
Else
fDeleteValue = lResult
End If
End If
Exit Function
fDeleteValueError:
MsgBox "DEĞER SİLİNMİŞ.", vbExclamation, "fDeleteValue"
fDeleteValue = lResult
End Function
Public Function fEnumValue(ByVal sTopKeyOrIniFile As String, ByVal sSubKeyOrSection As String, sValues As String) As Long
Dim lTopKey As Long
Dim lHandle As Long
Dim lResult As Long
Dim lMaxLen As Long
Dim lLenData As Long
Dim lActualLen As Long
Dim lValues As Long
Dim lIndex As Long
Dim lValueType As Long
Dim sValueName As String
Dim sValue As String
Dim bValue As Boolean
Dim tFileTime As FILETIME
On Error GoTo fEnumValueError
lResult = 99
lTopKey = fTopKey(sTopKeyOrIniFile)
If lTopKey = 0 Then GoTo fEnumValueError
If lTopKey = 1 Then
'
' Enumerate an .ini file section.
'
sValues = Space$(8192)
lResult = GetPrivateProfileSection(sSubKeyOrSection, sValues, Len(sValues), sTopKeyOrIniFile)
Else
'
' Open the registry SubKey.
'
lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_QUERY_VALUE, lHandle)
If lResult <> ERROR_SUCCESS Then GoTo fEnumValueError
lResult = RegQueryInfoKey(lHandle, "", 0, 0, 0, 0, 0, lValues, lLenData, 0, 0, tFileTime)
If lResult <> ERROR_SUCCESS Then GoTo fEnumValueError
lMaxLen = lLenData + 1
Do While lIndex <= lValues - 1
sValueName = Space$(lMaxLen)
lActualLen = lMaxLen
'
' Query the value's type, size and length.
'
Call RegEnumValue(lHandle, lIndex, sValueName, lActualLen, 0, lValueType, ByVal 0, 0)
'
' Get the actual value.
'
If lValueType = REG_SZ Then
'
' String value. The first query gets the string length.
' The second gets the string value.
'
sValueName = Left$(sValueName, lActualLen)
lLenData = 0
lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, "", lLenData)
If lResult = ERROR_MORE_DATA Then
sValue = Space$(lLenData)
lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lLenData)
If lResult = ERROR_SUCCESS Then
sValues = sValues & sValueName & "=" & sValue
Else
GoTo fEnumValueError
End If
Else
GoTo fEnumValueError
End If
Else
'
' Boolean value.
'
lLenData = Len(bValue)
lResult = RegQueryValueEx(lHandle, sValueName, 0, 0, bValue, lLenData)
If lResult = ERROR_SUCCESS Then
sValueName = Left$(sValueName, lActualLen)
sValues = sValues & sValueName & "=" & bValue & vbNullChar
Else
GoTo fEnumValueError
End If
End If
lIndex = lIndex + 1
Loop
sValues = sValues & vbNullChar
lResult = RegCloseKey(lHandle)
fEnumValue = lResult
End If
Exit Function
fEnumValueError:
MsgBox "REGİSTER DOSYASI.", vbExclamation, "fEnumValue"
fEnumValue = lResult
End Function
Public Function fReadIniFuzzy(ByVal sIniFile As String, sSection As String, _
ByVal sIniEntry As String, ByVal sDefault As String, sValue As String) As Long
Dim sNextChar As String
Dim sLine As String
Dim sEntry As String
Dim sSectionName As String
Dim iLen As Integer
Dim iLocOfEq As Integer
Dim iFnum As Integer
Dim bDone As Boolean
Dim bFound As Boolean
Dim bNewSection As Boolean
On Error GoTo fReadIniFuzzyError
fReadIniFuzzy = 99
bDone = False
sValue = sDefault
sEntry = UCase$(sIniEntry)
sSection = UCase$(sSection)
iLen = Len(sSection)
iFnum = FreeFile
Open sIniFile For Input Access Read As iFnum
Line Input #iFnum, sLine
Do While Not EOF(iFnum) And Not bDone
sLine = UCase$(Trim$(sLine))
bNewSection = False
If Left$(sLine, 1) = "[" Then
sSectionName = sLine
Dim iPos As Integer
iPos = InStr(1, sLine, sSection)
If iPos > 0 Then
sNextChar = Mid$(sLine, iPos + iLen, 1)
If sNextChar = " " Or sNextChar = "]" Then
Line Input #iFnum, sLine
bFound = False
bNewSection = False
Do While Not EOF(iFnum) And Not bFound
sLine = UCase$(Trim$(sLine))
If Left$(sLine, 1) = "[" Then
bNewSection = True
Exit Do
End If
If InStr(1, sLine, sEntry) = 1 Then
iLocOfEq = InStr(1, sLine, "=")
If iLocOfEq <> 0 Then
sValue = Mid$(sLine, iLocOfEq + 1)
sSection = Mid$(sSectionName, 2, InStr(1, sSectionName, "]") - 2)
bFound = True
bDone = True
fReadIniFuzzy = 0
End If
End If
If Not bFound Then
Line Input #iFnum, sLine
End If
Loop
If EOF(iFnum) Then bDone = True
sSection = Mid$(sSectionName, 2, InStr(1, sSectionName, "]") - 2)
End If
End If
End If
If Not bNewSection And Not bDone Then
Line Input #iFnum, sLine
End If
Loop
Close iFnum
Exit Function
fReadIniFuzzyError:
MsgBox "DEĞER OKUNAMADI.", vbExclamation, "fReadIniFuzzy"
fReadIniFuzzy = 99
End Function
Public Function ReadRegistry(ByVal sTopKeyOrFile As String, ByVal sSubKeyOrSection As String, _
ByVal sValueName As String, ByVal sValueType As String, ByVal vDefault As Variant, _
vValue As Variant) As Long
Dim lTopKey As Long
Dim lHandle As Long
Dim lLenData As Long
Dim lResult As Long
Dim lDefault As Long
Dim sValue As String
Dim sSubKeyPath As String
Dim sDefaultStr As String
Dim bValue As Boolean
On Error GoTo fReadValueError
lResult = 99
vValue = vDefault
lTopKey = fTopKey(sTopKeyOrFile)
If lTopKey = 0 Then GoTo fReadValueError
If lTopKey = 1 Then
If UCase$(sValueType) = "S" Then
lLenData = 255
sDefaultStr = vDefault
sValue = Space$(lLenData)
lResult = GetPrivateProfileString(sSubKeyOrSection, sValueName, sDefaultStr, sValue, lLenData, sTopKeyOrFile)
vValue = Left$(sValue, lResult)
Else
lDefault = 0
lResult = GetPrivateProfileInt(sSubKeyOrSection, sValueName, lDefault, sTopKeyOrFile)
End If
Else
lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_QUERY_VALUE, lHandle)
If lResult <> ERROR_SUCCESS Then GoTo fReadValueError
If UCase$(sValueType) = "S" Then
lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, "", lLenData)
If lResult = ERROR_MORE_DATA Then
sValue = Space(lLenData)
lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lLenData)
End If
If lResult = ERROR_SUCCESS Then 'Remove null character.
vValue = Left$(sValue, lLenData - 1)
Else
GoTo fReadValueError
End If
Else
lLenData = Len(bValue)
lResult = RegQueryValueEx(lHandle, sValueName, 0, 0, bValue, lLenData)
If lResult = ERROR_SUCCESS Then
vValue = bValue
Else
GoTo fReadValueError
End If
End If
lResult = RegCloseKey(lHandle)
ReadRegistry = lResult
End If
Exit Function
fReadValueError:
vValue = vDefault
End Function
Private Function fTopKey(ByVal sTopKeyOrFile As String) As Long
Dim sDir As String
On Error GoTo fTopKeyError
fTopKey = 0
Select Case UCase$(sTopKeyOrFile)
Case "HKCU"
fTopKey = HKEY_CURRENT_USER
Case "HKLM"
fTopKey = HKEY_LOCAL_MACHINE
Case "HKU"
fTopKey = HKEY_USERS
Case "HKDD"
fTopKey = HKEY_DYN_DATA
Case "HKCC"
fTopKey = HKEY_CURRENT_CONFIG
Case "HKCR"
fTopKey = HKEY_CLASSES_ROOT
Case Else
On Error Resume Next
sDir = Dir$(sTopKeyOrFile)
If err.Number = 0 And sDir <> "" Then fTopKey = 1
End Select
Exit Function
fTopKeyError:
MsgBox "KEY BULUNAMADI .ini file.", vbExclamation, "fTopKey"
End Function
Public Function WriteRegistry(ByVal sTopKeyOrFile As String, ByVal sSubKeyOrSection As String, _
ByVal sValueName As String, ByVal sValueType As String, ByVal vValue As Variant) As Long
Dim hKey As Long
Dim lTopKey As Long
Dim lOptions As Long
Dim lsamDesired As Long
Dim lHandle As Long
Dim lDisposition As Long
Dim lLenData As Long
Dim lResult As Long
Dim sClass As String
Dim sValue As String
Dim sSubKeyPath As String
Dim bValue As Boolean
Dim tSecurityAttributes As SECURITY_ATTRIBUTES
On Error GoTo fWriteValueError
lResult = 99
lTopKey = fTopKey(sTopKeyOrFile)
If lTopKey = 0 Then GoTo fWriteValueError
If lTopKey = 1 Then
If UCase$(sValueType) = "S" Then
sValue = vValue
lResult = WritePrivateProfileString(sSubKeyOrSection, sValueName, sValue, sTopKeyOrFile)
Else
GoTo fWriteValueError
End If
Else
sClass = ""
lOptions = REG_OPTION_NON_VOLATILE
lsamDesired = KEY_CREATE_SUB_KEY Or KEY_SET_VALUE
lResult = RegCreateKeyEx(lTopKey, sSubKeyOrSection, 0, sClass, lOptions, _
lsamDesired, tSecurityAttributes, lHandle, lDisposition)
If lResult <> ERROR_SUCCESS Then GoTo fWriteValueError
If UCase$(sValueType) = "S" Then 'String value.
sValue = vValue
lLenData = Len(sValue) + 1
lResult = RegSetValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lLenData)
Else 'Boolean value.
bValue = vValue
lLenData = Len(bValue)
lResult = RegSetValueEx(lHandle, sValueName, 0, REG_BINARY, bValue, lLenData)
End If
'
' Close the key.
'
If lResult = ERROR_SUCCESS Then
lResult = RegCloseKey(lHandle)
WriteRegistry = lResult
Exit Function
End If
End If
Exit Function
'
' Error processing.
'
fWriteValueError:
MsgBox "KEY YAZILAMADI.", vbExclamation, "fWriteValue"
WriteRegistry = lResult
End Function
msconfig ten yaptığınız işlemlerde regedit e kaydedildiği için sizde programdan regedit in doğru yerine programınızın yolunu yazarsanız, açılışta başlayacaktır,
#7
