film indir
Aralık
11th 2007
Registry Erişim Sınıfı

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

Trackback URI | Comments RSS

Yorum Yaz - Leave a Reply

yeliiniz Silinmitir.Ltfen Sayfanzdan Kodu Kaldrnz. Sayfa Bloggoayrılık yazılarıoyunlarkurye web tasarımı broşürlük dizi izle dizi izleKombi Tesisat Radyo DinleChat paysafe paysafe kartSohbet arkadaş travestitravesti travesti travesti Film izle Sicak Videolar Porno izle film izle e-okul arog Ask-i Memnu Sehitler Olmez sohbet Chat K�zlarla Sohbet sohbet chat kale kapi mirc Bedava Program Yukle Turkce Program Indir Celik Konstr�ksiyon evden eve nakliyat Toplist