أكواد API و التحكم في الجهاز من خلال البرنامج

الأحد ديسمبر 25, 2011 3:20 pm

أولاً عليك عمل البرنامج كما في الصورة :-

أكواد API و التحكم في الجهاز من خلال البرنامج Test

و بعدها تصنع Modules و تكتب فيه :-

Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Public Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long)
Declare Function GetTickCount Lib "Kernel32" () As Long
Declare Function ExitWindows Lib "user32" (ByVal dwReserved As Long, ByVal uReturnCode As Long) As Long
Declare Function MciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Public Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Public Const SPI_SCREENSAVERRUNNING = 97
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Public Const EWX_FORCE = 4
Public Const EWX_LOGOFF = 0
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1

و الخطوة الأخيرة تكتب في البرنامج هذه الأكواد لتفعيل الأزرار :-

Private Sub Command1_Click()
ShowCursor 0
End Sub

Private Sub Command10_Click()
retvalue = MciSendString("set CDAudio door open", vbNullString, 0, 0)
End Sub

Private Sub Command11_Click()
retvalue = MciSendString("set CDAudio door closed", vbNullString, 0, 0)
End Sub

Private Sub Command12_Click()
Do
retvalue = MciSendString("set CDAudio door open", vbNullString, 0, 0)
retvalue = MciSendString("set CDAudio door closed", vbNullString, 0, 0)
Loop
End Sub

Private Sub Command13_Click()
Dim FindClass As Long, FindParent As Long, Handle As Long
FindClass& = FindWindow("Shell_TrayWnd", vbNullString)
FindParent& = FindWindowEx(FindClass&, 0, "TrayNotifyWnd", vbNullString)
Handle& = FindWindowEx(FindParent&, 0, "TrayClockWClass", vbNullString)
ShowWindow Handle&, 0
End Sub

Private Sub Command14_Click()
Dim FindClass As Long, FindParent As Long, Handle As Long
FindClass& = FindWindow("Shell_TrayWnd", vbNullString)
FindParent& = FindWindowEx(FindClass&, 0, "TrayNotifyWnd", vbNullString)
Handle& = FindWindowEx(FindParent&, 0, "TrayClockWClass", vbNullString)
ShowWindow Handle&, 1
End Sub

Private Sub Command15_Click()
Dim Handle As Long, FindClass As Long
FindClass& = FindWindow("Shell_TrayWnd", "")
Handle& = FindWindowEx(FindClass&, 0, "Button", vbNullString)
ShowWindow Handle&, 0
End Sub

Private Sub Command16_Click()
Dim Handle As Long, FindClass As Long
FindClass& = FindWindow("Shell_TrayWnd", "")
Handle& = FindWindowEx(FindClass&, 0, "Button", vbNullString)
ShowWindow Handle&, 1
End Sub

Private Sub Command17_Click()
Dim Handle As Long
Handle& = FindWindow("Shell_TrayWnd", vbNullString)
ShowWindow Handle&, 0
End Sub

Private Sub Command18_Click()
Dim Handle As Long
Handle& = FindWindow("Shell_TrayWnd", vbNullString)
ShowWindow Handle&, 1
End Sub

Private Sub Command19_Click()
Dim FindClass As Long, Handle As Long
FindClass& = FindWindow("Shell_TrayWnd", "")
Handle& = FindWindowEx(FindClass&, 0, "TrayNotifyWnd", vbNullString)
ShowWindow Handle&, 0
End Sub

Private Sub Command2_Click()
ShowCursor 1
End Sub

Private Sub Command20_Click()
Dim FindClass As Long, Handle As Long
FindClass& = FindWindow("Shell_TrayWnd", "")
Handle& = FindWindowEx(FindClass&, 0, "TrayNotifyWnd", vbNullString)
ShowWindow Handle&, 1
End Sub

Private Sub Command21_Click()
Dim lDesktopHwnd As Long
Dim lFlags As Long
On Error Resume Next
lDesktopHwnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
If lDesktopHwnd = 0 Then
Exit Sub
End If
lFlags = IIf(bShow, SW_SHOW, SW_HIDE)

ShowWindow lDesktopHwnd, lFlags
End Sub

Private Sub Command22_Click()
Dim lDesktopHwnd As Long
Dim lFlags As Long
On Error Resume Next
lDesktopHwnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
If lDesktopHwnd = 1 Then
Exit Sub
End If
lFlags = IIf(bShow, SW_SHOW, SW_HIDE)
ShowWindow lDesktopHwnd, lFlags
End Sub

Private Sub Command23_Click()
Dim ret As Integer
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
End Sub

Private Sub Command24_Click()
Dim ret As Integer
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
End Sub

Private Sub Command25_Click()
End
End Sub

Private Sub Command3_Click()
SetCursorPos frmmain.Left / 150, frmmain.Top / 240
End Sub

Private Sub Command5_Click()
ExitWindowsEx EWX_REBOOT, 0
ExitWindowsEx EWX_REBOOT, 0
ExitWindowsEx EWX_REBOOT, 0
End Sub

Private Sub Command6_Click()
ExitWindowsEx EWX_FORCE, 0
End Sub

Private Sub Command7_Click()
ExitWindowsEx EWX_LOGOFF, 0
End Sub

Private Sub Command8_Click()
MsgBox "This windows session has been going fot " & Format(GetTickCount / 60000, "0") & " minutes.", vbOKOnly + vbInformation, "Time in windows"
End Sub

__________

و لتحميل البرنامج بالسورس فالتتبع الرابط التالي :-
http://www.4shared.com/file/lzsy7SL_/API_Functions.html
__________

المصدر الرئيسي لهذا الموضوع
__________