السلام عليكم الموضوع هوى :
عندي برنامج وخلصت من كل شيء فية
وبعدها وضعت وصلت تشفير للبرنامج بحيث انة الان اذهب الى قاعدة البيانات تبعي واغير الرقم (100)الى ارقام ثانية هيا هيا العملية لية ماني عارف
والكود هوى كالتالي:
'في موديل
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Declare Function sendmessagebystring Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Declare Function getwindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Declare Sub RaiseException Lib "kernel32" (ByVal dwExceptionCode As Long, ByVal dwExceptionFlags As Long, ByVal nNumberOfArguments As Long, lpArguments As Long) Public Const WM_CLOSE = &H10 Public Const GW_HWNDNEXT = 2 Public Const GW_OWNER = 4 Public Const EXCEPTION_ACCESS_VIOLATION = &HC0000005 Public Const NoOfAppClassMonitored As Integer = 4 Public AppClassName(NoOfAppClassMonitored) As String Public Sub FillClassName() Dim i As Integer For i = 0 To NoOfAppClassMonitored AppClassName(i) = "" Next i AppClassName(0) = "HexWorks" 'Hex Workshop 3.1 AppClassName(1) = "OWL_Window" 'WinDasm AppClassName(2) = "NMSCMW" 'for various versions of Numega Smart Check AppClassName(3) = "Winamp" 'WinAmp Playlist, WinAmp Mnibrowser, WinAmp version x.x, Winamp Equaliser AppClassName(4) = "Notepad" 'Notepad End Sub 'FillClassName() Public Function AppPresent(TgtClassName As String, frmName As Object) As Long AppPresent = SearchAppsByClassName(TgtClassName, frmName) End Function 'AppPresent(TgtClassName As String, frmName As Object) As Long Function SearchAppsByClassName(TgtClassName As String, frmName As Object) Dim ThisAppHandle As Long Dim NextAppHandle As Long Dim AppClassName As String ThisAppHandle = getwindow(frmName.hwnd, GW_OWNER) NextAppHandle = ThisAppHandle Do While NextAppHandle <> 0 DoEvents NextAppHandle = getwindow(NextAppHandle, GW_HWNDNEXT) AppClassName = GetAppClassName(NextAppHandle) If InStr(1, LCase(Trim(AppClassName)), LCase(Trim(TgtClassName))) <> 0 Then SearchAppsByClassName = NextAppHandle Exit Do Exit Function End If Loop End Function 'SearchAppsByClassName(TgtClassName As String, frmName As Object) Private Function GetAppClassName(HwndWindow As Long) As String Dim BufferAll& Dim WindowClassName$ 'Get the Window's Class Name WindowClassName$ = String(100, Chr(0)) BufferAll& = GetClassName(HwndWindow, WindowClassName$, 100) GetAppClassName = Left(WindowClassName$, BufferAll&) DoEvents End Function 'GetAppClassName(HwndWindow As Long) As String Public Sub KillWin(hwnd As Long) Dim dummy dummy = sendmessagebystring(hwnd, WM_CLOSE, 0, 0) If frmCheck.chkFound = 1 Then RaiseException EXCEPTION_ACCESS_VIOLATION, 0, 0, 0 End If End Sub 'KillWin(hwnd As Long)
'في نموذج
Option Explicit
Private Sub Timer1_Timer()
Dim dummyval As Long
Dim HwndDasm As Long
Dim hwnd As Long
Dim i As Integer
FillClassName
For i = 0 To NoOfAppClassMonitored
hwnd = AppPresent(Trim(AppClassName(i)), frmCheck)
If hwnd <> 0 Then
KillWin hwnd
End If
Next i
End Sub 'Timer1_Timer()
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Me
Set frmCheck = Nothing
End Sub 'Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
الشرح تبع الكود:
اعمل anti لاي برنامج تريد ,
انا وضعت
Numega Smart Check debugger (all versions), W32Dasm Deassembler & Hex Workshop
و وضعت note pad و winamp كأمثلة ويمكنك اضافة اي برنامج تريد
لاتنسى ان تضع check box بأسم "chkFound" واسم الform
"frmCheck" وايضا اضف timer وضع لل interval القيمة 100
أفيدونا
