Visual Basic'te API Windows Bilgileri

KONU : API Windows Bilgileri

Sub listele(adres As String)
Dim valuename As String
Dim valuelen As Long
Dim datatype As Long
Dim data(0 To 254) As Byte
Dim datalen As Long
Dim datastring As String
Dim hKey As Long
Dim index As Long
Dim c As Long
Dim retval As Long
retval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, adres, 0, KEY_QUERY_VALUE, hKey)
If retval <> 0 Then
MsgBox "Register açılamadı"
End
End If

index = 0
While retval = 0
valuename = Space(255)
valuelen = 255
datalen = 255
retval = RegEnumValue(hKey, index, valuename, valuelen, ByVal 0, datatype, data(0), datalen)
If retval = 0 Then
valuename = Left(valuename, valuelen)
a$ = valuename
Select Case datatype
Case REG_SZ
datastring = Space(datalen - 1)
CopyMemory ByVal datastring, data(0), datalen - 1
List1.AddItem a$ & ":" & vbTab & datastring
Case REG_BINARY
b$ = ""
For c = 0 To datalen - 1
datastring = Hex(data(c))
If Len(datastring) < 2 Then datastring = String(Len(datastring), "0") & datastring
b$ = b$ + " " & datastring
Next c
List1.AddItem a$ & ":" & vbTab & b$
Case Else
MsgBox "Data cinsi belirlenemedi"
End Select
End If
index = index + 1
Wend
retval = RegCloseKey(hKey)
End Sub

Private Sub Command1_Click()
Dim adres$
List1.Clear
adres = "Software\Microsoft\Windows\CurrentVersion"
d$ = "Versiyon : " & QueryValue(HKEY_LOCAL_MACHINE, adres, "Version")
List1.AddItem d$
d$ = "Versiyon no: " & QueryValue(HKEY_LOCAL_MACHINE, adres, "VersionNumber")
List1.AddItem d$
d$ = "Ürününün adı: " & QueryValue(HKEY_LOCAL_MACHINE, adres, "ProductName")
List1.AddItem d$
d$ = "Ürününün anahtarı: " & QueryValue(HKEY_LOCAL_MACHINE, adres, "ProductKey")
List1.AddItem d$
d$ = "Ürününün kodu: " & QueryValue(HKEY_LOCAL_MACHINE, adres, "ProductId")
List1.AddItem d$
d$ = "Kayıtlı kişi adı: " & QueryValue(HKEY_LOCAL_MACHINE, adres, "RegisteredOwner")
List1.AddItem d$
d$ = "Şirketi: " & QueryValue(HKEY_LOCAL_MACHINE, adres, "RegisteredOrganization")
List1.AddItem d$
End Sub


'NOT=MODUL OLUŞTURUN AŞAĞIDAKİ KODU MODUL'UN İÇİNE YAZIN

'Herbir fonksiyona örnek:
'yeni anahtar oluştur:
'CreateNewKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"

'TestKey\SubKey1 anahtarında ki "Test" 'i "Testing, Testing" değerini ver
'SetKeyValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test", "Testing, Testing", REG_SZ

'TestKey\SubKey1 anahtarındaki Test in değerini al
'MsgBox QueryValue(HKEY_CURRENT_USER, "TestKey\SubKey1", "Test")

'TestKey\SubKey1\SubKey2 anahtarını ve altındakileri sil
'DeleteKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"

'TestKey\SubKey1 deki Test değerini sil
'DeleteValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test"

Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259

Global Const KEY_ALL_ACCESS = &H3F

Global Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) 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 RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
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 Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
' Bu Fonksiyon anahtarı siler
'
' Yazımı
' DeleteKey Konum, Anahtar
'
' Konum : HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS a eşit olmalı
'
' Anahtar : silinecek anahtar, alt anhtar da olabilir (example "Key1\SubKey1")

Dim lRetVal As Long 'SetValueEx fonksiyonu sonucu
Dim hKey As Long 'açılan anahtar tutamağı

'belirtilen anahtarı aç

'lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
'RegCloseKey (hKey)
End Function

Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
' Tanımı:
' Bu Fonksiyorn bir değeri siler
'
' Yazımı:
' DeleteValue Konum, AnahtarAdı, DeğerAdı
'
' Konum: HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' veya HKEY_USERS olmalı
'
' AnahtarAdı: silinecek değerin anahtarı
' , altanahtarlar da olabilir (örn: "Key1\SubKey1")
'
' DeğerAdı: silmek istediğiniz değer

Dim lRetVal As Long 'SetValueEx fonk. sonucu
Dim hKey As Long 'anahtar tutamağı

'belirtilen anahtarı aç

lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String

Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select

End Function





Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

' okunacak datanın tipi ve genişliği belirlenir

lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5

Select Case lType
' dizi için
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If

' DWORDS için
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'diğer tüm data tipleri için
lrc = -1
End Select

QueryValueExExit:

QueryValueEx = lrc
Exit Function

QueryValueExError:

Resume QueryValueExExit

End Function
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
' Tanım:
' Bu fonksiyon yeni bir anahtar oluşturur
'
' Yazım:
' QueryValue Konum, AnahtarAdı
'
' Konum : HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' veya HKEY_USERS olmalı
'
' AnahtarAdı : oluşacak anahtarın adı,
' alt anahtarlar da olabilir (örn: "Key1\SubKey1")

Dim hNewKey As Long 'yeni anahtarın tutamağı
Dim lRetVal As Long 'RegCreateKeyEx fonksiyonu sonucu

lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function




Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
' Anahtardaki Değer'e veri girer
' Yazım:
' QueryValue Location, KeyName, ValueName, ValueSetting, ValueType
'
' Location : HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' , HKEY_USERS
' KeyName : (örn: "Key1\SubKey1")
' ValueName : (example: "ValueTest")
' ValueSetting : ValueTest ' i eşitleyeceğimiz değer
' ValueType REG_SZ (a string) veya REG_DWORD (an integer)

Dim lRetVal As Long
Dim hKey As Long

lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Function

Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
' Tanım:
' Bu fonksiyon belirtilen konumdaki anahtarın değerini verir
'
' Yazım:
' Değişken = QueryValue(Konum, AnahtarAdı, DeğerAdı)
'
' Konum: HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
' veya HKEY_USERS olmalı
'
' AnahtarAdı: Konumdaki anahtarın adı (örn: "Software\Microsoft\Windows\CurrentVersion\Explore r")
'
' DeğerAdı: değerini istediğmiz DeğerAdı (örn: "link")

Dim lRetVal As Long 'fonksiyonun sonucu
Dim hKey As Long 'anahtar tutamağı
Dim vValue As Variant 'değeri alınacak değer adı


lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
'MsgBox vValue
QueryValue = vValue
RegCloseKey (hKey)
End Function