'Option Explicit

Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim t As NOTIFYICONDATA

Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
'Dim returnstring As String
'Dim retvalue As Long

Private Sub Form_Load()
t.cbSize = Len(t)
t.hWnd = Picture1.hWnd
t.uId = 1&
t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
t.ucallbackMessage = WM_MOUSEMOVE
t.hIcon = Picture1.Picture
t.szTip = "CD Open/Close by Rinolds Kaòeps" & Chr$(0)
Shell_NotifyIcon NIM_ADD, t
Me.Hide
App.TaskVisible = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
t.cbSize = Len(t)
t.hWnd = Picture1.hWnd
t.uId = 1&
Shell_NotifyIcon NIM_DELETE, t
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If Hex(X) = "1E3C" Then
' Me.PopupMenu mnuFile

'End If

Dim lMsg As Long
Static bInHere As Boolean
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
' Case WM_LBUTTONDBLCLK:
'
' On Mouse DoubleClick - Restore the window

'On Error Resume Next
'Me.Show
' retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)

'If Me.WindowState = vbMinimized Then
' Me.WindowState = vbDefault
'End If
'Me.ZOrder
Case WM_LBUTTONDOWN:
retvalue = mciSendString("set CDAudio door open", returnstring, 127, 0)
Case WM_RBUTTONDOWN:
retvalue = mciSendString("set CDAudio door closed", returnstring, 127, 0)

End Select


End Sub

'Public Const WM_LBUTTONDBLCLK As Long = &H203
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_RBUTTONDOWN As Long = &H204

Option Explicit
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 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 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 PaintDesktop Lib "user32" (ByVal hdc As Long) As Long

Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Private Sub Command1_Click()
Dim retvalue As Long, result As Long
Dim KeyID As Long, keyvalue As Long
Dim subKey As String
Dim bufSize As Long
Dim regkey As String
Dim abc As Long
Dim a1 As Long
Dim hCurKey As Long
Dim lRegResult As Long
Dim s As String
Dim a As String
If Check1.Value = 1 Then
Check1.Tag = 1
Else
Check1.Tag = 0
End If

If Check2.Value = 1 Then
Check2.Tag = 2
Else
Check2.Tag = 0
End If
If Check3.Value = 1 Then
Check3.Tag = 4
Else
Check3.Tag = 0
End If

If Check4.Value = 1 Then
Check4.Tag = 8
Else
Check4.Tag = 0
End If
If Check5.Value = 1 Then
Check5.Tag = 16
Else
Check5.Tag = 0
End If

If Check6.Value = 1 Then
Check6.Tag = 32
Else
Check6.Tag = 0
End If
If Check7.Value = 1 Then
Check7.Tag = 64
Else
Check7.Tag = 0
End If

If Check8.Value = 1 Then
Check8.Tag = 128
Else
Check8.Tag = 0
End If
If Check9.Value = 1 Then
Check9.Tag = 256
Else
Check9.Tag = 0
End If

If Check10.Value = 1 Then
Check10.Tag = 512
Else
Check10.Tag = 0
End If
If Check11.Value = 1 Then
Check11.Tag = 1024
Else
Check11.Tag = 0
End If

If Check12.Value = 1 Then
Check12.Tag = 2048
Else
Check12.Tag = 0
End If
If Check13.Value = 1 Then
Check13.Tag = 4096
Else
Check13.Tag = 0
End If

If Check14.Value = 1 Then
Check14.Tag = 8192
Else
Check14.Tag = 0
End If
If Check15.Value = 1 Then
Check15.Tag = 16384
Else
Check15.Tag = 0
End If

If Check16.Value = 1 Then
Check16.Tag = 32768
Else
Check16.Tag = 0
End If
If Check17.Value = 1 Then
Check17.Tag = 65536
Else
Check17.Tag = 0
End If

If Check18.Value = 1 Then
Check18.Tag = 131072
Else
Check18.Tag = 0
End If
If Check19.Value = 1 Then
Check19.Tag = 262144
Else
Check19.Tag = 0
End If '

If Check20.Value = 1 Then
Check20.Tag = 524288
Else
Check20.Tag = 0
End If
If Check21.Value = 1 Then
Check21.Tag = 1048576
Else
Check21.Tag = 0
End If

If Check22.Value = 1 Then
Check22.Tag = 2097152
Else
Check22.Tag = 0
End If
If Check23.Value = 1 Then
Check23.Tag = 4194304
Else
Check23.Tag = 0
End If

If Check24.Value = 1 Then
Check24.Tag = 8388608
Else
Check24.Tag = 0
End If
If Check25.Value = 1 Then
Check25.Tag = 16777216
Else
Check25.Tag = 0
End If

If Check26.Value = 1 Then
Check26.Tag = 33554432
Else
Check26.Tag = 0
End If

a1 = CLng(Check1.Tag) + CLng(Check2.Tag) + CLng(Check3.Tag) _
+ CLng(Check4.Tag) + CLng(Check5.Tag) + CLng(Check6.Tag) + _
CLng(Check7.Tag) + CLng(Check8.Tag) + CLng(Check9.Tag) + _
CLng(Check10.Tag) + CLng(Check11.Tag) + CLng(Check12.Tag) _
+ CLng(Check13.Tag) + CLng(Check14.Tag) + CLng(Check15.Tag) + _
CLng(Check16.Tag) + CLng(Check17.Tag) + CLng(Check18.Tag) _
+ CLng(Check19.Tag) + CLng(Check20.Tag) + CLng(Check21.Tag) _
+ CLng(Check22.Tag) + CLng(Check23.Tag) + CLng(Check24.Tag) _
+ CLng(Check25.Tag) + CLng(Check26.Tag)
If a1 = 0 Then
s = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
a = "NoDrives"
lRegResult = RegOpenKey(HKEY_CURRENT_USER, s, hCurKey)
lRegResult = RegDeleteValue(hCurKey, a)
lRegResult = RegCloseKey(hCurKey)
Else
If a1 <> 0 Then
regkey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
retvalue = RegCreateKey(HKEY_CURRENT_USER, regkey, KeyID)
subKey = "NoDrives"
keyvalue = a1
retvalue = RegSetValueEx(KeyID, subKey, 0&, 4, keyvalue, 4)
End If
End If
End Sub




Private Sub Command2_Click()
Dim retvalue As Long, result As Long
Dim KeyID As Long, keyvalue As Long
Dim subKey As String
Dim bufSize As Long
Dim regkey As String
Dim abc As Long
Dim a1 As Long
Dim hCurKey As Long
Dim lRegResult As Long
Dim s As String
Dim a As String
s = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
a = "NoDrives"
lRegResult = RegOpenKey(HKEY_CURRENT_USER, s, hCurKey)
lRegResult = RegDeleteValue(hCurKey, a)
lRegResult = RegCloseKey(hCurKey)
End Sub

Private Sub Form_Load()

End Sub

Option Explicit
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 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 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 PaintDesktop Lib "user32" (ByVal hdc As Long) As Long

Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Private Sub Command1_Click()
Dim retvalue As Long, result As Long
Dim KeyID As Long, keyvalue As Long
Dim subKey As String
Dim bufSize As Long
Dim regkey As String
Dim abc As Long
Dim a1 As Long
Dim hCurKey As Long
Dim lRegResult As Long
Dim s As String
Dim a As String
If Check1.Value = 1 Then
Check1.Tag = 1
Else
Check1.Tag = 0
End If

If Check2.Value = 1 Then
Check2.Tag = 2
Else
Check2.Tag = 0
End If
If Check3.Value = 1 Then
Check3.Tag = 4
Else
Check3.Tag = 0
End If

If Check4.Value = 1 Then
Check4.Tag = 8
Else
Check4.Tag = 0
End If
If Check5.Value = 1 Then
Check5.Tag = 16
Else
Check5.Tag = 0
End If

If Check6.Value = 1 Then
Check6.Tag = 32
Else
Check6.Tag = 0
End If
If Check7.Value = 1 Then
Check7.Tag = 64
Else
Check7.Tag = 0
End If

If Check8.Value = 1 Then
Check8.Tag = 128
Else
Check8.Tag = 0
End If
If Check9.Value = 1 Then
Check9.Tag = 256
Else
Check9.Tag = 0
End If

If Check10.Value = 1 Then
Check10.Tag = 512
Else
Check10.Tag = 0
End If
If Check11.Value = 1 Then
Check11.Tag = 1024
Else
Check11.Tag = 0
End If

If Check12.Value = 1 Then
Check12.Tag = 2048
Else
Check12.Tag = 0
End If
If Check13.Value = 1 Then
Check13.Tag = 4096
Else
Check13.Tag = 0
End If

If Check14.Value = 1 Then
Check14.Tag = 8192
Else
Check14.Tag = 0
End If
If Check15.Value = 1 Then
Check15.Tag = 16384
Else
Check15.Tag = 0
End If

If Check16.Value = 1 Then
Check16.Tag = 32768
Else
Check16.Tag = 0
End If
If Check17.Value = 1 Then
Check17.Tag = 65536
Else
Check17.Tag = 0
End If

If Check18.Value = 1 Then
Check18.Tag = 131072
Else
Check18.Tag = 0
End If
If Check19.Value = 1 Then
Check19.Tag = 262144
Else
Check19.Tag = 0
End If '

If Check20.Value = 1 Then
Check20.Tag = 524288
Else
Check20.Tag = 0
End If
If Check21.Value = 1 Then
Check21.Tag = 1048576
Else
Check21.Tag = 0
End If

If Check22.Value = 1 Then
Check22.Tag = 2097152
Else
Check22.Tag = 0
End If
If Check23.Value = 1 Then
Check23.Tag = 4194304
Else
Check23.Tag = 0
End If

If Check24.Value = 1 Then
Check24.Tag = 8388608
Else
Check24.Tag = 0
End If
If Check25.Value = 1 Then
Check25.Tag = 16777216
Else
Check25.Tag = 0
End If

If Check26.Value = 1 Then
Check26.Tag = 33554432
Else
Check26.Tag = 0
End If

a1 = CLng(Check1.Tag) + CLng(Check2.Tag) + CLng(Check3.Tag) _
+ CLng(Check4.Tag) + CLng(Check5.Tag) + CLng(Check6.Tag) + _
CLng(Check7.Tag) + CLng(Check8.Tag) + CLng(Check9.Tag) + _
CLng(Check10.Tag) + CLng(Check11.Tag) + CLng(Check12.Tag) _
+ CLng(Check13.Tag) + CLng(Check14.Tag) + CLng(Check15.Tag) + _
CLng(Check16.Tag) + CLng(Check17.Tag) + CLng(Check18.Tag) _
+ CLng(Check19.Tag) + CLng(Check20.Tag) + CLng(Check21.Tag) _
+ CLng(Check22.Tag) + CLng(Check23.Tag) + CLng(Check24.Tag) _
+ CLng(Check25.Tag) + CLng(Check26.Tag)
If a1 = 0 Then
s = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
a = "NoDrives"
lRegResult = RegOpenKey(HKEY_CURRENT_USER, s, hCurKey)
lRegResult = RegDeleteValue(hCurKey, a)
lRegResult = RegCloseKey(hCurKey)
Else
If a1 <> 0 Then
regkey = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
retvalue = RegCreateKey(HKEY_CURRENT_USER, regkey, KeyID)
subKey = "NoDrives"
keyvalue = a1
retvalue = RegSetValueEx(KeyID, subKey, 0&, 4, keyvalue, 4)
End If
End If
End Sub




Private Sub Command2_Click()
Dim retvalue As Long, result As Long
Dim KeyID As Long, keyvalue As Long
Dim subKey As String
Dim bufSize As Long
Dim regkey As String
Dim abc As Long
Dim a1 As Long
Dim hCurKey As Long
Dim lRegResult As Long
Dim s As String
Dim a As String
s = "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer"
a = "NoDrives"
lRegResult = RegOpenKey(HKEY_CURRENT_USER, s, hCurKey)
lRegResult = RegDeleteValue(hCurKey, a)
lRegResult = RegCloseKey(hCurKey)
End Sub

Private Sub Form_Load()

End Sub

Private Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, ByVal lpdirectory As String, ByVal lpResult As String) As Long
Private Const MAX_FILENAME_LEN = 256

Public Function FindExecutable(s As String) As String
Dim i As Integer
Dim s2 As String

s2 = String(MAX_FILENAME_LEN, 32) & Chr$(0)

i = FindExecutableA(s & Chr$(0), vbNullString, s2)

If i > 32 Then
FindExecutable = Left$(s2, InStr(s2, Chr$(0)) - 1)
Else
FindExecutable = ""
End If

End Function

Private Sub Image1_Click()
CM.ShowOpen
Text1 = CM.FileName
Text2 = FindExecutable(Text1)

End Sub

Dim SH As New Shell 'reference to shell32.dll class
Dim ShBFF As Folder 'Shell Browse For Folder

Private Sub Command1_Click() 'Show BFF Dialog
On Error Resume Next
'set object
Set ShBFF = SH.BrowseForFolder(hWnd, "Hey this is a sample, " & _
"please choose a folder and click OK!", 1)
With ShBFF.Items.Item
'get folder props
Text1 = .Path
Text2 = "Name: " & .Name & vbCrLf & _
"Type: " & .Type & vbCrLf & _
"Last Modified: " & .ModifyDate & vbCrLf & _
"Parent: " & .Parent & vbCrLf
End With

End Sub

Private Sub Command10_Click() 'Show help
SH.Help
End Sub

Private Sub Command11_Click() 'Show compute find dialog
SH.FindComputer
End Sub

Private Sub Command12_Click() 'Show shut down dialog

If MsgBox("Are you sure you want to do this!?", _
vbQuestion + vbYesNo + vbDefaultButton2, _
"Confirm Action!") <> vbYes Then Exit Sub

SH.ShutdownWindows

End Sub

Private Sub Command13_Click() 'Open path
SH.Open Text3.Text
End Sub

Private Sub Command14_Click() 'Explore path
SH.Explore Text3.Text
End Sub

Private Sub Command15_Click() 'Open URL
SH.Open "http://www.geocities.com/bs20014/"
End Sub

Private Sub Command16_Click() 'Show Taskbar & Start Menu Properties
SH.TrayProperties
End Sub

Private Sub Command17_Click() 'Show clock dialog
SH.SetTime
End Sub

Private Sub Command2_Click() 'Cascade windows
SH.CascadeWindows
End Sub

Private Sub Command3_Click() 'Minimize all windows
SH.MinimizeAll
End Sub

Private Sub Command4_Click() 'Tile windows horizentally
SH.TileHorizontally
End Sub

Private Sub Command5_Click() 'Tile windows vertically
SH.TileVertically
End Sub

Private Sub Command6_Click() 'Undo minimizing windows
SH.UndoMinimizeALL
End Sub

Private Sub Command7_Click() 'Load something in Control Panel
SH.ControlPanelItem "sysdm.cpl" 'System Properties
'This can be easily changed
'Search for *.cpl in your system directory
'inetcpl.cpl ==> Internet Options
'appwiz.cpl ==> Add/Remove Programs
'and many more...
End Sub

Private Sub Command8_Click() 'Find files dialog
SH.FindFiles
End Sub

Private Sub Command9_Click() 'Run dialog
SH.FileRun
End Sub

Private Sub Form_Load() 'Form Load
Text3 = App.Path
End Sub

Const DRIVE_REMOVABLE = 2
Const DRIVE_FIXED = 3
Const DRIVE_REMOTE = 4
Const DRIVE_CDROM = 5
Const DRIVE_RAMDISK = 6



Private Sub Command1_Click()
Dim r&, allDrives$, JustOneDrive$, pos%, DriveType&
Dim CDfound As Integer

'pad the string with spaces
allDrives$ = Space$(64)

'call the API to get the string containing all drives
r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)

'trim off trailing chr$(0)'s. AllDrives$
'now contains all the drive letters.
allDrives$ = Left$(allDrives$, r&)

'begin a loop
Do

'find the first separating chr$(0)
pos% = InStr(allDrives$, Chr$(0))

'if there's one, then...
If pos% Then

'extract the drive up to the chr$(0)
JustOneDrive$ = Left$(allDrives$, pos%)

'and remove that from the Alldrives string,
'so it won't be checked again
allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))

'with the one drive, call the API to
'determine the drive type
DriveType& = GetDriveType(JustOneDrive$)

'check if it's what we want
If DriveType& = DRIVE_CDROM Then

'got it (or at least the first one,
'anyway, if more than one), so set
'the found flag...
CDfound% = True

'we're done, so get out
Exit Do

End If
End If

Loop Until allDrives$ = "" Or DriveType& = 6

'display the appropriate message
If CDfound% Then
Label1 = UCase$(JustOneDrive$)
Else: Label1 = "لم أجد أي سواقة ليزرية في نظامك..!!"
End If

End Sub


Private Sub Form_Load()

End Sub

Private Sub mnuExit_Click()
End
End Sub