IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası
  sohbet

Yeni Konu aç Cevapla
 
LinkBack Seçenekler Stil
Alt 21 Temmuz 2008, 18:17   #1
Çevrimdışı
Yardımcı Admin
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
IF Ticaret Sayısı: (0)
IF Ticaret Yüzdesi:(%)
Cd-Rom Açma ve Kapama




Alıntıdır

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
' This module reads and writes registry keys.  Unlike the
internal registry access methods of VBit can read and
' write any registry keys with string values.

Option Explicit
Dim State As String
Dim Result
'
---------------------------------------------------------------
'-Registry API Declarations...
'
---------------------------------------------------------------
Private Declare Function 
RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As LongByVal lpSubKey As StringByVal Reserved As LongByVal lpClass As StringByVal dwOptions As LongByVal samDesired As LongByRef lpSecurityAttributes As SECURITY_ATTRIBUTESByRef phkResult As LongByRef lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As LongByVal lpSubKey As StringByVal ulOptions As LongByVal samDesired As LongByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As LongByVal lpValueName As StringByVal lpReserved As LongByRef lpType As LongByVal lpData As StringByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As LongByVal lpValueName As StringByVal Reserved As LongByVal dwType As LongByVal lpData As StringByVal cbData As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As StringByVal lpstrReturnString As StringByVal uReturnLength As LongByVal hwndCallback As Long) As Long
'---------------------------------------------------------------
'
Registry Api Constants...
'---------------------------------------------------------------
Reg Data Types...
Const 
REG_SZ 1                         ' Unicode nul terminated string
Const REG_EXPAND_SZ = 2                  ' 
Unicode nul terminated string
Const REG_DWORD 4                      ' 32-bit number

Reg Create Type Values...
Const 
REG_OPTION_NON_VOLATILE 0       ' Key is preserved when system is rebooted

Reg Key Security Options...
Const 
READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ KEY_QUERY_VALUE KEY_ENUMERATE_SUB_KEYS KEY_NOTIFY READ_CONTROL
Const KEY_WRITE KEY_SET_VALUE KEY_CREATE_SUB_KEY READ_CONTROL
Const KEY_EXECUTE KEY_READ
Const KEY_ALL_ACCESS KEY_QUERY_VALUE KEY_SET_VALUE _
                       KEY_CREATE_SUB_KEY 
KEY_ENUMERATE_SUB_KEYS _
                       KEY_NOTIFY 
KEY_CREATE_LINK READ_CONTROL
                     
' Reg Key ROOT Types...
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004

Return Value...
Const 
ERROR_NONE 0
Const ERROR_BADKEY 2
Const ERROR_ACCESS_DENIED 8
Const ERROR_SUCCESS 0

'---------------------------------------------------------------
'
Registry Security Attributes TYPE...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

The resource string will be loaded into a control's property as follows:
Object      Property
' Form        Caption
Menu        Caption
' TabStrip    Caption, ToolTipText
Toolbar     ToolTipText
' ListView    ColumnHeader.Text

Sub LoadResStrings(frm As Form)
  On Error Resume Next
  
  Dim ctl As Control
  Dim obj As Object
  
  '
set the form's caption
  If IsNumeric(frm.Tag) Then
    frm.Caption = LoadResString(CInt(frm.Tag))
  End If
  
  '
set the controls' captions using the caption
  '
property for menu items and the Tag property
  
'for all other controls
  For Each ctl In frm.Controls
    Err.Clear
    If TypeName(ctl) = "Menu" Then
      If IsNumeric(ctl.Caption) Then
        If Err = 0 Then
          ctl.Caption = LoadResString(CInt(ctl.Caption))
        End If
      End If
    ElseIf TypeName(ctl) = "TabStrip" Then
      For Each obj In ctl.Tabs
        Err.Clear
        If IsNumeric(obj.Tag) Then
          obj.Caption = LoadResString(CInt(obj.Tag))
        End If
        '
check for a tooltip
        
If IsNumeric(obj.ToolTipTextThen
          
If Err 0 Then
            obj
.ToolTipText LoadResString(CInt(obj.ToolTipText))
          
End If
        
End If
      
Next
    
ElseIf TypeName(ctl) = "Toolbar" Then
      
For Each obj In ctl.Buttons
        Err
.Clear
        
If IsNumeric(obj.TagThen
          obj
.ToolTipText LoadResString(CInt(obj.Tag))
        
End If
      
Next
    
ElseIf TypeName(ctl) = "ListView" Then
      
For Each obj In ctl.ColumnHeaders
        Err
.Clear
        
If IsNumeric(obj.TagThen
          obj
.Text LoadResString(CInt(obj.Tag))
        
End If
      
Next
    
Else
      If 
IsNumeric(ctl.TagThen
        
If Err 0 Then
          ctl
.Caption LoadResString(CInt(ctl.Tag))
        
End If
      
End If
      
'check for a tooltip
      If IsNumeric(ctl.ToolTipText) Then
        If Err = 0 Then
          ctl.ToolTipText = LoadResString(CInt(ctl.ToolTipText))
        End If
      End If
    End If
  Next

End Sub

'
-------------------------------------------------------------------------------------------------
'sample usage - Debug.Print UpodateKey(HKEY_CLASSES_ROOT, "keyname", "newvalue")
'
-------------------------------------------------------------------------------------------------
Public Function 
UpdateKey(KeyRoot As LongKeyName As StringSubKeyName As StringSubKeyValue As String) As Boolean
    Dim rc 
As Long                                      ' Return Code
    Dim hKey As Long                                    ' 
Handle To A Registry Key
    Dim hDepth 
As Long                                  '
    Dim lpAttr As SECURITY_ATTRIBUTES                   ' 
Registry Security Type
    
    lpAttr
.nLength 50                                 ' Set Security Attributes To Defaults...
    lpAttr.lpSecurityDescriptor = 0                     ' 
...
    
lpAttr.bInheritHandle True                        ' ...

    '
------------------------------------------------------------
    
'- Create/Open Registry Key...
    '
------------------------------------------------------------
    
rc RegCreateKeyEx(KeyRootKeyName_
                        0
REG_SZ_
                        REG_OPTION_NON_VOLATILE
KEY_ALL_ACCESSlpAttr_
                        hKey
hDepth)                   ' Create/Open //KeyRoot//KeyName
    
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' 
Handle Errors...
    
    
'------------------------------------------------------------
    '
Create/Modify Key Value...
    
'------------------------------------------------------------
    If (SubKeyValue = "") Then SubKeyValue = " "        ' 
A Space Is Needed For RegSetValueEx() To Work...
    
    
' Create/Modify Key Value
    rc = RegSetValueEx(hKey, SubKeyName, _
                       0, REG_SZ, _
                       SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
                       
    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' 
Handle Error
    
'------------------------------------------------------------
    '
Close Registry Key...
    
'------------------------------------------------------------
    rc = RegCloseKey(hKey)                              ' 
Close Key
    
    UpdateKey 
True                                    ' Return Success
    Exit Function                                       ' 
Exit
CreateKeyError:
    
UpdateKey False                                   ' Set Error Return Code
    rc = RegCloseKey(hKey)                              ' 
Attempt To Close Key
End 
Function

'-------------------------------------------------------------------------------------------------
'
sample usage Debug.Print GetKeyValue(HKEY_CLASSES_ROOT"COMCTL.ListviewCtrl.1\CLSID""")
'-------------------------------------------------------------------------------------------------
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
    Dim i As Long                                           ' 
Loop Counter
    Dim rc 
As Long                                          ' Return Code
    Dim hKey As Long                                        ' 
Handle To An Open Registry Key
    Dim hDepth 
As Long                                      '
    Dim sKeyVal As String
    Dim lKeyValType As Long                                 ' 
Data Type Of A Registry Key
    Dim tmpVal 
As String                                    ' Tempory Storage For A Registry Key Value
    Dim KeyValSize As Long                                  ' 
Size Of Registry Key Variable
    
    
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
    '
------------------------------------------------------------
    
rc RegOpenKeyEx(KeyRootKeyName0KEY_ALL_ACCESShKey' Open Registry Key
    
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 
Handle Error...
    
    
tmpVal String$(10240)                             ' Allocate Variable Space
    KeyValSize = 1024                                       ' 
Mark Variable Size
    
    
'------------------------------------------------------------
    ' 
Retrieve Registry Key Value...
    
'------------------------------------------------------------
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         lKeyValType, tmpVal, KeyValSize)    ' 
Get/Create Key Value
                        
    
If (rc <> ERROR_SUCCESSThen GoTo GetKeyError          ' Handle Errors
      
    tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)

    '
------------------------------------------------------------
    
' Determine Key Value Type For Conversion...
    '
------------------------------------------------------------
    
Select Case lKeyValType                                  ' Search Data Types...
    Case REG_SZ, REG_EXPAND_SZ                              ' 
String Registry Key Data Type
        sKeyVal 
tmpVal                                     ' Copy String Value
    Case REG_DWORD                                          ' 
Double Word Registry Key Data Type
        
For Len(tmpValTo 1 Step -1                    ' Convert Each Bit
            sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' 
Build Value CharBy Char.
        
Next
        sKeyVal 
Format$("&h" sKeyVal)                     ' Convert Double Word To String
    End Select
    
    GetKeyValue = sKeyVal                                   ' 
Return Value
    rc 
RegCloseKey(hKey)                                  ' Close Registry Key
    Exit Function                                           ' 
Exit
    
GetKeyError:    ' Cleanup After An Error Has Occured...
    GetKeyValue = vbNullString                              ' 
Set Return Val To Empty String
    rc 
RegCloseKey(hKey)                                  ' Close Registry Key
End Function

Private Sub Command1_Click()

If (GetKeyValue(HKEY_CURRENT_USER, "Software\Microsoft\Omal\VB Programs\CD_ROM", "State") = "") Then
    UpdateKey HKEY_CURRENT_USER, "Software\Microsoft\Omal\VB Programs\CD_ROM", "State", "1"
    State = "1"
Else
    State = GetKeyValue(HKEY_CURRENT_USER, "Software\Microsoft\Omal\VB Programs\CD_ROM", "State")
End If
Result = mciSendString("close all", 0, 0, hWnd)
Result = mciSendString("open cdaudio alias cd wait shareable", 0, 0, hWnd)
If (State = "1") Then
    Result = mciSendString("set cd door open", 0, 0, hWnd)
    UpdateKey HKEY_CURRENT_USER, "Software\Microsoft\Omal\VB Programs\CD_ROM", "State", "2"

ElseIf (State = "2") Then
    Result = mciSendString("set cd door closed", 0, 0, hWnd)
    UpdateKey HKEY_CURRENT_USER, "Software\Microsoft\Omal\VB Programs\CD_ROM", "State", "1"
End If
'
MsgBox State
End Sub 


__________________
[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]

[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]
 
Alıntı ile Cevapla

IRCForumlari.NET Reklamlar
sohbet odaları sohbet odaları Benimmekan Mobil Sohbet
Cevapla

Etiketler
acma, cdrom, kapama


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 
Seçenekler
Stil

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Kapalı
Pingbacks are Açık
Refbacks are Açık


Benzer Konular
Konu Konuyu Başlatan Forum Cevaplar Son Mesaj
Açma kapama cezası kalkıyor Desmont Haber Arşivi 0 17 Aralık 2014 19:07
kanalı +M açma kapama Zalimsin mIRC Scripting Sorunları 7 28 Temmuz 2014 23:49
Ozelde Karsılama Acma-Kapama!!! Heavenly mIRC Scripting Sorunları 5 01 Ekim 2011 22:18
İnput acma kapama TİGeR mIRC Scripting Sorunları 7 01 Haziran 2010 22:23
Joinpart koruması açma kapama erdem55 mIRC Scripting Sorunları 8 03 Haziran 2005 11:48