شغل برنامج علي اي جهاز من دون تنصيب الدوت نت فرام ورك

السلام عليكم ورحمة الله

في البداية : أتقدم بالشكر لكل الأعضاء الذين ساهموا في نشر
علوم البرمجة والعلوم الأخرى

وأقول لهم ( أن جهدكم لن يضيع بسهولة )

وتحت هذا الشعار فإني أقدم لكم مجموعة من الأكواد والأفكار


بسم الله نبدأ :

1 : فتح صفحة إنترنت من داخل برنامجك

CODE

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Label1_Click()
Dim lapi As Long
a$ = App.Path & "index.html"
lapi = ShellExecute(Me.hwnd, "open", a$, vbNull, vbNull, 5)
End Sub



الطريقة الثانية

CODE

Shell ("explorer http://arabteam.nicmatic.com"), vbNormalNoFocus



2 : تنفيذ الكود بعد فترة زمنية

CODE

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub cmd_Click()
MsgBox Time
Sleep 10000
MsgBox Time
End Sub




3 : فتح وغلق السي دي

CODE

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

Private Sub فتح_Click()
Call mciSendString("Set CDAudio Door Open", "", 0, 0)
End Sub

Private Sub غلق_Click()
Call mciSendString("Set CDAudio Door Closed", "", 0, 0)
End Sub




4 : تغيير خلفية الجهاز

CODE

Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Const SPI_SETDESKWALLPAPER = 20


Private Sub Command1_Click()
Dim lngSuccess As Long
Dim strBitmapImage As String

strBitmapImage = "c:windowsstraw.bmp"
lngSuccess = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, strBitmapImage, 0)

End Sub




5 : تشغيل ملف صوتي

CODE

Private Declare Function sndPlaySound Lib "winmm.dll" Alias _
"sndPlaySoundA" (ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long

Private Sub Command1_Click ()
sndPlaySond "c:MySound.wav" , 1
End Sub




6 : تحريك الفورم بمفاتيح الأسهم في لوحة المفاتيح

CODE

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal v As Long) As Integer

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If GetAsyncKeyState(37) Then 'يسار
Left = Left - 15
End If

If GetAsyncKeyState(38) Then 'أعلى
Top = Top - 15
End If

If GetAsyncKeyState(39) Then 'يمين
Left = Left + 15
End If

If GetAsyncKeyState(40) Then 'أسفل
Top = Top + 15
End If
End Sub




7 : رسم مؤشر الماوس على الفورم

CODE

Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function GetCursor Lib "user32" () As Long
Private Sub Form_Paint()
DrawIcon Me.hdc, 30, 30, GetCursor
End Sub




8 : إضافة أيقونة البرنامج في شريط المهام

CODE

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _
Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA) As Longprivate
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 WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const NIM_MODIFY = &H1
Private Const NIF_ICON = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_TIP = &H4
Private Ic As NOTIFYICONDATA 'هنا تعريف المتغير من نوع NotifyIcon
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''
Private Sub Load_Form()
Ic.cbSize = Len(Ic)
Ic.hwnd = Me.hwnd 'مقبض النافذة
Ic.uID = 1&
Ic.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE 'يحتوي على : ايقون + ملاحظات + رسائل الفأرة
Ic.uCallbackMessage = WM_RBUTTONDOWN Or WM_RBUTTONUP Or WM_RBUTTONDBLCLK 'رسائل الفأرة النشطة
Ic.hIcon = Picture 'ضع هنا الايقونه
Ic.szTip = "My Program First" 'الملاجظات الخاصة للبرنامج او ما يسمىToolTipText
Shell_NotifyIcon NIM_ADD, Ic 'الأمر اضافة للأيقونة
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
Private Sub Form_Unload()
Ic.cbSize = Len(Ic)
Ic.hwnd = Me.hwnd
Ic.uID = 1&
Shell_NotifyIcon NIM_DELETE, Ic 'الأمر حذف للأيقونة
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''
Private Sub Timer1_Timer()
Ic.szTip = "My Program Second"
Shell_NotifyIcon NIM_MODIFY, Ic 'الأمر تعديل في الأيقونة وهنا كان التعديل فقط على الملاحظات
End Sub




9 : تجميد برنامج وإعادة تنشيطة

CODE

Private Declare Function CreateProcessBynum Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, ByVal lpProcessAttributes As _
Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles _
As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, lpStartupInfo As _
STARTUPINFO, lpProcesstInfrmation As PROCESS_INFORMATION) As Long

Private Declare Function SuspendThread Lib "kernel32" _
(ByVal hThread As Long) As Long

Private Declare Function ResumeThread Lib "kernel32" _
(ByVal hThread As Long) As Long

'PROCESS_INFORMATION و STARTUPINFO البنيتين
' Process التي نحتاجها لانشاء الـ
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Const NORMAL_PRIORITY_CLASS = &H20

Dim Ret&, PrInf As PROCESS_INFORMATION
Dim stInf As STARTUPINFO

Private Sub Command1_Click()
'من الافضل ضبطها
With stInf
.cb = Len(stInf)
.lpReserved = vbNullString
.lpDesktop = vbNullString
.lpTitle = vbNullString
.dwFlags = 0
End With
'Process انشاء الـ
Ret = CreateProcessBynum("C:Windowscalc.exe", vbNullString, 0, 0, _
True, NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, stInf, PrInf)
End Sub

Private Sub Command2_Click()
'Thread تجميد الـ
SuspendThread PrInf.hThread
End Sub

Private Sub Command3_Click()
'Thread اعادة تنشيط الـ
ResumeThread PrInf.hThread
End Sub




10 : جعل البرنامج يعمل مع بدء تشغيل وندوز

CODE

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 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 RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Sub Form_Load()
Dim lRegKey As Long
Dim sApp As String
sApp = App.Path + IIf(Right(App.Path, 1) <> "", "", "") + App.EXEName + ".exe"
If RegOpenKey(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionRun", lRegKey) = 0 Then
If RegSetValueEx(lRegKey, "My Program", 0, 1, ByVal sApp, Len(sApp)) Then
MsgBox "There was a Problem Adding This Program to the Registry", vbExclamation, "Error"
End If
Call RegCloseKey(lRegKey)
End If
End Sub