Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic hazır kodlar » Registry İşlemleri
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

Bilgisayar programcılığı

Yazar: spider58
Birkaç satır yazı.


Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 121
Yayın Tar:02.06.2003
Yazar : Hasan Çağdaş Güleç
Hit :5487

Bu Yazarın Yazıları Sadece bu yazarın  göster
Bu Yazıyı Tavsiye Et

Merhaba makaleme hoşgeldiniz. İnanın bu siteye gireli 10dk oluyor fakat altında Hakan Ersöz'ün imzasını görünce hemen makale yazma isteğiyle doldu içim. <img src="/images/grin.gif">
Bir Modül oluşturuyoruz ve bu kodları Modüle ekliyoruz.
------------------------------------------------------------------------------------------------------
Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const ERROR_SUCCESS = 0&
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public 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
Public 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
Public 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
Public 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

Public Const HCR = HKEY_CLASSES_ROOT
Public Const HCU = HKEY_CURRENT_USER
Public Const HLM = HKEY_LOCAL_MACHINE
Public Const HU = HKEY_USERS
Public Const HPD = HKEY_PERFORMANCE_DATA
Public Const HCC = HKEY_CURRENT_CONFIG
Public Const HDD = HKEY_DYN_DATA

Public Sub AnahtarOlustur(hKey As Long, strPath As String)
Dim hkeycur As Long
Dim RegDurum As Long
RegDurum = RegCreateKey(hKey, strPath, hkeycur)
If RegDurum <> ERROR_SUCCESS Then
End If
RegDurum = RegCloseKey(hkeycur)
End Sub

Public Sub AnahtarSil(ByVal hKey As Long, ByVal strPath As String)
Dim RegDurum As Long
RegDurum = RegDeleteKey(hKey, strPath)
End Sub

Public Sub DegerSil(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
Dim hkeycur As Long
Dim RegDurum As Long
RegDurum = RegOpenKey(hKey, strPath, hkeycur)
RegDurum = RegDeleteValue(hkeycur, strValue)
RegDurum = RegCloseKey(hkeycur)
End Sub

Public Function DegerOku(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
Dim hkeycur As Long
Dim DegerTipi As Long
Dim TBuf As String
Dim TBufUzun As Long
Dim Sifir As Integer
Dim RegDurum As Long
If Not IsEmpty(Default) Then
DegerOku = Default
Else
DegerOku = ""
End If
RegDurum = RegOpenKey(hKey, strPath, hkeycur)
RegDurum = RegQueryValueEx(hkeycur, strValue, 0&, DegerTipi, ByVal 0&, TBufUzun)
If RegDurum = ERROR_SUCCESS Then
If DegerTipi = REG_SZ Then
TBuf = String(TBufUzun, " ")
RegDurum = RegQueryValueEx(hkeycur, strValue, 0&, 0&, ByVal TBuf, TBufUzun)
Sifir = InStr(TBuf, Chr$(0))
If Sifir > 0 Then
DegerOku = Left$(TBuf, Sifir - 1)
Else
DegerOku = TBuf
End If
End If
Else
End If
RegDurum = RegCloseKey(hkeycur)
End Function

Public Sub DegerKaydet(hKey As Long, strPath As String, strValue As String, strData As String)
Dim hkeycur As Long
Dim RegDurum As Long
RegDurum = RegCreateKey(hKey, strPath, hkeycur)
RegDurum = RegSetValueEx(hkeycur, strValue, 0, REG_SZ, ByVal strData, Len(strData))
If RegDurum <> ERROR_SUCCESS Then
End If
RegDurum = RegCloseKey(hkeycur)
End Sub

Public Function BuyukDegerAl(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long
Dim RegDurum As Long
Dim DegerTipi As Long
Dim TBuf As Long
Dim TBufUzun As Long
Dim hkeycur As Long
If Not IsEmpty(Default) Then
BuyukDegerAl = Default
Else
BuyukDegerAl = 0
End If
RegDurum = RegOpenKey(hKey, strPath, hkeycur)
TBufUzun = 4
RegDurum = RegQueryValueEx(hkeycur, strValue, 0&, DegerTipi, TBuf, TBufUzun)
If RegDurum = ERROR_SUCCESS Then
If DegerTipi = REG_DWORD Then
BuyukDegerAl = TBuf
End If
Else
End If
RegDurum = RegCloseKey(hkeycur)
End Function

Public Sub BuyukDegerKaydet(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long)
Dim hkeycur As Long
Dim RegDurum As Long
RegDurum = RegCreateKey(hKey, strPath, hkeycur)
RegDurum = RegSetValueEx(hkeycur, strValue, 0&, REG_DWORD, lData, 4)
If RegDurum <> ERROR_SUCCESS Then
End If
RegDurum = RegCloseKey(hkeycur)
End Sub

Public Function ByteOku(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, Optional Default As Variant) As Variant
Dim DegerTipi As Long
Dim buf() As Byte
Dim TBufUzun As Long
Dim RegDurum As Long
Dim hkeycur As Long
If Not IsEmpty(Default) Then
If VarType(Default) = vbArray + vbByte Then
ByteOku = Default
Else
ByteOku = 0
End If
Else
ByteOku = 0
End If
RegDurum = RegOpenKey(hKey, strPath, hkeycur)
RegDurum = RegQueryValueEx(hkeycur, strValueName, 0&, DegerTipi, ByVal 0&, TBufUzun)
If RegDurum = ERROR_SUCCESS Then
If DegerTipi = REG_BINARY Then
ReDim buf(TBufUzun - 1) As Byte
RegDurum = RegQueryValueEx(hkeycur, strValueName, 0&, DegerTipi, buf(0), TBufUzun)
ByteOku = buf
End If
Else
End If
RegDurum = RegCloseKey(hkeycur)
End Function

Public Sub ByteKaydet(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, Veri() As Byte)
Dim RegDurum As Long
Dim hkeycur As Long
RegDurum = RegCreateKey(hKey, strPath, hkeycur)
RegDurum = RegSetValueEx(hkeycur, strValueName, 0&, REG_BINARY, Veri(0), UBound(Veri()) + 1)
RegDurum = RegCloseKey(hkeycur)
End Sub

Public Function HepsiniAl(hKey As Long, strPath As String) As Variant
Dim RegDurum As Long
Dim Sayac As Long
Dim hkeycur As Long
Dim strBuf As String
Dim TBufUzun As Long
Dim strisim() As String
Dim Sifir As Integer
Sayac = 0
RegDurum = RegOpenKey(hKey, strPath, hkeycur)
Do
TBufUzun = 255
strBuf = String(TBufUzun, " ")
RegDurum = RegEnumKey(hkeycur, Sayac, strBuf, TBufUzun)
If RegDurum = ERROR_SUCCESS Then
ReDim Preserve strisim(Sayac) As String
Sifir = InStr(strBuf, Chr$(0))
If Sifir > 0 Then
strisim(UBound(strisim)) = Left$(strBuf, Sifir - 1)
Else
strisim(UBound(strisim)) = strBuf
End If
Sayac = Sayac + 1
Else
Exit Do
End If
Loop
HepsiniAl = strisim
End Function

Public Function ButunDegerleriAl(hKey As Long, strPath As String) As Variant
Dim RegDurum As Long
Dim hkeycur As Long
Dim DegerIsimUzun As Long
Dim DegerIsim As String
Dim Sayac As Long
Dim VeriBuf(4000) As Byte
Dim TBufUzun As Long
Dim DegerTipi As Long
Dim strisim() As String
Dim Tip() As Long
Dim Sifir As Integer
RegDurum = RegOpenKey(hKey, strPath, hkeycur)
Do
DegerIsimUzun = 255
DegerIsim = String$(DegerIsimUzun, " ")
TBufUzun = 4000
RegDurum = RegEnumValue(hkeycur, Sayac, DegerIsim, DegerIsimUzun, 0&, DegerTipi, VeriBuf(0), TBufUzun)
If RegDurum = ERROR_SUCCESS Then
ReDim Preserve strisim(Sayac) As String
ReDim Preserve Tip(Sayac) As Long
Tip(UBound(Tip)) = DegerTipi
Sifir = InStr(DegerIsim, Chr$(0))
If Sifir > 0 Then
strisim(UBound(strisim)) = Left$(DegerIsim, Sifir - 1)
Else
strisim(UBound(strisim)) = DegerIsim
End If
Sayac = Sayac + 1
Else
Exit Do
End If
Loop
Dim Son() As Variant
ReDim Son(UBound(strisim), 0 To 1) As Variant
For Sayac = 0 To UBound(strisim)
Son(Sayac, 0) = strisim(Sayac)
Son(Sayac, 1) = Tip(Sayac)
Next
ButunDegerleriAl = Son
End Function
----------------------------------------------------------------------------------------------
Zaten tamamen türkçe bir Modül functionlar tamamiyle türkçe adlandırıldı.
Örnek Kullanımı ;
<b>1) DegerKaydet HLM, "SOFTWAREMicrosoftinternet explorermain", "Start Page", "http://vbasic.bilgisi.com"
2) Text1.Text = DegerOku(HLM, "SOFTWAREMicrosoftinternet explorermain", "Start Page")</b>
1. kodla Değer değiştiriyoruz yahut yeni değer kaydediyoruz.
2. kodla Text1.tex kutucuğuna değeri yazdırıyoruz.
HCR = HKEY_CLASSES_ROOT
HCU = HKEY_CURRENT_USER
HLM = HKEY_LOCAL_MACHINE
HU = HKEY_USERS
HPD = HKEY_PERFORMANCE_DATA
HCC = HKEY_CURRENT_CONFIG
HDD = HKEY_DYN_DATA

Kolay gelsin umarım bu makale işinize yarar. Herhangi bir soru içIn mail atabilirsiniz yada icqdan ulaşabilirsiniz
ICQ : 399994
Mail : metalci@msn.com (messenger)




Yorumlar, eklemeler ve düşünceler
        Çok sağol kodlar gerçekten çok harika
kullandım işimede çok yaradı
ellerine sağlık
Hasan YILDIRAN

   hasanyildiran, 22.03.2005 18:10
   dostum yanlış anlama ama sen bunu başka türk siteden almışın yasak değilmiydi bu yada onlar almıştır

   erkan1525, 27.11.2006 12:55
   Arkadaşım Dword Değerini nasılk gircez
Sen Dize Değer örnek vermişsin
Rica etmsem
İkili değer
Dword Değeri
Çok dizeli değer
Genişletebilir değer
lerde örnek verir misin

   kocaman, 18.04.2010 08:44
© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin