Posted under Visual Basic
Kullandığımız sistemlerin neredeyse bütün ayarları hep sistem kaydı yani registry de tutluyor. Peki biz bu nimetten faydalanamazmıyız ?
Artık programlarımızda ki bütün ayarları registry de tutmanın zamanı gelmedi mi?.
Registry Erişim Sınıfının Kodları
![]()
Menüde “Project/Add Class Module” ile yeni bir sınıf oluşturun ve aşağıdaki kodlar içine kopyalayın
‘———————————————————————————————-
‘Açıklama : Registry Erişim Sınıfı
‘Sınıf Adı : C_Reg.cls
‘Versiyon : 2.0
‘Yazar : Hakan GÜR
‘Tarih : 05.02.2004
‘———————————————————————————————-
Option Explicit
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_SUCCESS = 0&
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const LANG_NEUTRAL = &H0
Public Enum Reg_HKEY
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum
‘Reg Api—————————————————————————————
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 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 RegDeleteKey Lib “advapi32.dll” Alias “RegDeleteKeyA” (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib “advapi32.dll” Alias “RegDeleteValueA” (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private 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
Private Declare Function RegEnumValue Lib “advapi32.dll” Alias “RegEnumValueA” (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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
‘———————————————————————————————-
Private Declare Function FormatMessage Lib “kernel32″ Alias “FormatMessageA” (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
‘———————————————————————————————-
Dim AktifKok As Reg_HKEY
Dim AktifYol As String
Dim RegAnahtar As Long
Dim HataNo As Long
‘———————————————————————————————-
‘Sınıf Prop
Public Property Get RegKok() As Reg_HKEY
RegKok = AktifKok
End Property
Public Property Let RegKok(ByVal Deger As Reg_HKEY)
If RegAnahtar <> 0 Then YoluKullanimdanKaldir
AktifKok = Deger
End Property
Public Property Get RegYol() As String
RegYol = AktifYol
End Property
Public Property Let RegYol(ByVal Deger As String)
If RegAnahtar <> 0 Then YoluKullanimdanKaldir
AktifYol = Deger
End Property
Public Property Get HataOlustu() As Boolean
HataOlustu = (HataNo <> 0)
End Property
Public Property Get HataNumarasi() As Long
HataNumarasi = HataNo
HataNo = 0
End Property
Public Property Get HataSistemMesaji() As String
Dim Donen As String
Donen = Space(200)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, HataNo, LANG_NEUTRAL, Donen, 200, ByVal 0&
HataSistemMesaji = Left(Donen, InStr(Donen, Chr(0)) - 1)
End Property
‘———————————————————————————————-
‘Reg Okuma Fonksiyonları
Public Function SayiOku(DegerAdi As String) As Long
Dim Donen As Long, DegerTipi As Long
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then Exit Function
End If
HataNo = RegQueryValueEx(RegAnahtar, DegerAdi, 0&, DegerTipi, Donen, 4)
If HataNo = ERROR_SUCCESS Then
If DegerTipi = REG_DWORD Then
SayiOku = Donen
End If
End If
End Function
Public Function MetinOku(DegerAdi As String, Optional Varsayilan As String = “”) As String
Dim Donen As String, DegerTipi As Long
Dim MetinBoyut As Long
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then
MetinOku = Varsayilan
Exit Function
End If
End If
HataNo = RegQueryValueEx(RegAnahtar, DegerAdi, 0&, DegerTipi, ByVal 0&, MetinBoyut)
If HataNo = ERROR_SUCCESS Then
If DegerTipi = REG_SZ Or DegerTipi = REG_EXPAND_SZ Or DegerTipi = REG_MULTI_SZ Then
Donen = String(MetinBoyut, Chr(0))
HataNo = RegQueryValueEx(RegAnahtar, DegerAdi, 0&, 0&, ByVal Donen, MetinBoyut)
If HataNo = ERROR_SUCCESS Then
MetinOku = Left(Donen, MetinBoyut - 1)
Else
MetinOku = Varsayilan
End If
End If
Else
MetinOku = Varsayilan
End If
End Function
Public Function ByteDiziOku(DegerAdi As String) As Byte()
Dim Donen() As Byte, DegerTipi As Long
Dim DiziBoyut As Long
If RegAnahtar = 0 Then
If YoluKullanimaHazirla Then Exit Function
End If
HataNo = RegQueryValueEx(RegAnahtar, DegerAdi, 0&, DegerTipi, ByVal 0, DiziBoyut)
If HataNo = ERROR_SUCCESS Then
If DegerTipi = REG_BINARY Then
ReDim Donen(0 To DiziBoyut - 1) As Byte
HataNo = RegQueryValueEx(RegAnahtar, DegerAdi, 0&, DegerTipi, Donen(0), DiziBoyut)
If HataNo = ERROR_SUCCESS Then
ByteDiziOku = Donen
End If
End If
End If
End Function
‘———————————————————————————————-
‘Reg Kaydetme Fonksiyonları
Public Function SayiKaydet(DegerAdi As String, Sayi As Long) As Boolean
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then Exit Function
End If
HataNo = RegSetValueEx(RegAnahtar, DegerAdi, 0, REG_DWORD, Sayi, 4)
SayiKaydet = (HataNo = ERROR_SUCCESS)
End Function
Public Function MetinKaydet(DegerAdi As String, Metin As String) As Boolean
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then Exit Function
End If
HataNo = RegSetValueEx(RegAnahtar, DegerAdi, 0, REG_SZ, ByVal Metin, Len(Metin))
MetinKaydet = (HataNo = ERROR_SUCCESS)
End Function
Public Function ByteDiziKaydet(DegerAdi As String, dizi() As Byte) As Boolean
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then Exit Function
End If
HataNo = RegSetValueEx(RegAnahtar, DegerAdi, 0, REG_BINARY, dizi(LBound(dizi)), UBound(dizi) - LBound(dizi) + 1)
ByteDiziKaydet = (HataNo = ERROR_SUCCESS)
End Function
‘———————————————————————————————-
‘Diğer Fonksiyonlar
Public Function AltAnahtarlarListesi() As String()
Dim Donen() As String
Dim Anahtarisim As String * 255
Dim SiraNo As Long
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then Exit Function
End If
Do
HataNo = RegEnumKey(RegAnahtar, SiraNo, Anahtarisim, 255)
If HataNo = ERROR_SUCCESS Then
ReDim Preserve Donen(0 To SiraNo) As String
Donen(SiraNo) = Left(Anahtarisim, InStr(Anahtarisim, Chr(0)) - 1)
Else
If SiraNo = 0 Then ‘Hiç Alt Anahtar Yoksa
Exit Function
Else
HataNo = ERROR_SUCCESS
AltAnahtarlarListesi = Donen
Exit Function
End If
End If
SiraNo = SiraNo + 1
Loop
End Function
Public Function AltDegerAd(SiraNo As Long, Tip As Long) As String
Dim DegerAd As String, Deger As String
Dim DegerAdBoyut As Long, DegerBoyut As Long, HataNo As Long
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then Exit Function
End If
DegerAdBoyut = 255
DegerBoyut = 255
DegerAd = Space(DegerAdBoyut)
Deger = Space(DegerBoyut)
HataNo = RegEnumValue(RegAnahtar, SiraNo, DegerAd, DegerAdBoyut, ByVal 0&, Tip, ByVal Deger, DegerBoyut)
If HataNo = ERROR_SUCCESS Then
AltDegerAd = Left$(DegerAd, DegerAdBoyut) ‘& Left$(Deger, DegerBoyut)
End If
End Function
Public Function DegerSil(Deger As String) As Boolean
If RegAnahtar = 0 Then
If Not YoluKullanimaHazirla Then Exit Function
End If
HataNo = RegDeleteValue(RegAnahtar, Deger)
DegerSil = (HataNo = ERROR_SUCCESS)
End Function
‘———————————————————————————————-
‘AktifKok ve AktifYol u Kullanmayan Fonksiyonlar
Public Function AnahtarSil(Kok As Reg_HKEY, Yol As String, AltAnahtarAdi As String) As Boolean
Dim rA As Long
If RegOpenKey(Kok, Yol, rA) = ERROR_SUCCESS Then
If RegDeleteKey(rA, AltAnahtarAdi) = ERROR_SUCCESS Then
AnahtarSil = True
End If
RegCloseKey rA
End If
End Function
Public Function AnahtarOlustur(Kok As Reg_HKEY, Yol As String) As Boolean
Dim rA As Long
If RegCreateKey(Kok, Yol, rA) = ERROR_SUCCESS Then
RegCloseKey rA
AnahtarOlustur = True
End If
End Function
‘———————————————————————————————-
‘Yerel Fonksiyonlar
Private Function YoluKullanimaHazirla() As Boolean
If RegAnahtar <> 0 Then
YoluKullanimdanKaldir
End If
HataNo = RegOpenKey(AktifKok, AktifYol, RegAnahtar)
YoluKullanimaHazirla = IIf(HataNo = ERROR_SUCCESS, True, False)
End Function
Private Sub YoluKullanimdanKaldir()
RegCloseKey RegAnahtar
RegAnahtar = 0
End Sub
Private Sub Class_Terminate()
If RegAnahtar <> 0 Then RegCloseKey RegAnahtar
End Sub
Nasıl Kullanılır ?
![]()
Yeni Bir proje oluşturun daha önceden oluşturduğumuz sınıfı projeye ekleyin forma bir command button ekleyin ve aşağıdaki kodu yazın yada kopyalayın
Private Sub Command1_Click()
Dim r As New C_Reg ‘Yeni bir registry erişim sınıfı tanımlar
r.RegKok = HKEY_LOCAL_MACHINE ‘Kullanılacak kök
r.RegYol = “Software\BenimAnahtarim” ‘Kullanılacak Yol
r.AnahtarOlustur HKEY_LOCAL_MACHINE, “Software\BenimAnahtarim” ‘Eğer bu anahtar önceden varsa bunun kullanılmasına gerek yok
r.MetinKaydet “Deneme”, “Merhaba” ‘bir string değerini kaydeder
MsgBox r.MetinOku(”Deneme”) ‘kaydetdiğimiz değeri oku
End Sub