Diğer projeler biraz daha kapsamlı, anlatılması zor ve fazla nesne icerdiği icin şimdilik bununla idare edeceksiniz
İşte programdan bir gorunum... ( numaralandırılmış kısımlar kodlama aşamasında adı gectiği icin o nesneler uzerinde bazı oynamalar yapacağız, resmin altında acıkladım )
[IMG]http://img130.**************/img130/508/67846109.png[/IMG]
1. Tur : Label Name: lbldurum
2. Tur: Checkbox Name: Check1
3. Tur: CommandButton Name: Command2 Caption: Cıkış
4. Tur: CommandButton Name: Command1 Caption: Kaydet
Not: Projeye bir modul ekleyin kodlar aşağıda (Module1)
Şimdi gelelim kodlara....
Module1 ;
Kod:
Option Explicit Dim lisansX As Boolean 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 Dim SifreliVeri As String Dim SifresizVeri As String Dim DataTmp Dim DataTmp1 Dim EncCnt As Long Dim CrtCnt As Long Dim Ad As Long 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
Form Load ;
Kod:
Dim durum As String durum = DegerOku(HLM, "SOFTWAREMicrosoftWindows LiveMessenger", "MultipleInstances") If durum = "1" Then lbldurum.Caption = "Coklu msn acık" Check1.Value = 1 Else lbldurum.Caption = "Coklu msn kapalı" Check1.Value = 0 End If 'Label5.Caption = "Copyright © 2009 | Sceenmewar"
Command1 Click ;
Kod:
If Check1.Value = 1 Then DegerKaydet HLM, "SOFTWAREMicrosoftWindows LiveMessenger", "MultipleInstances", "1" lbldurum.Caption = "Coklu msn acık" Else DegerSil HLM, "SOFTWAREMicrosoftWindows LiveMessenger", "MultipleInstances" lbldurum.Caption = "Coklu msn kapalı" End If
Command2 Click ;
Kod:
Unload Me
Hepsi bukadar arkadaşlar... Oldukca basit bi program ama maksat paylaşım olsun
Selametle...
__________________