[SoftWare Haker]

توجد لدي أكواد تسجيل الأدوات برمجيا بدون اي مشكلة أسرع وأفضل
جديد معكم . محترف فجوال بيزك

---

ضع هذا في موديول جديد


Option Explicit

Public Declare Function LoadLibraryRegister _
   Lib "kernel32" Alias "LoadLibraryA" ( _
   ByVal lpLibfName As String) As Long

Public Declare Function FreeLibraryRegister _
   Lib "kernel32" Alias "FreeLibrary" ( _
   ByVal hLibModule As Long) As Long

Public Declare Function GetProcAddressRegister _
   Lib "kernel32" Alias "GetProcAddress" ( _
   ByVal hModule As Long, _
   ByVal lpProcName As String) As Long

Public Declare Function CreateThreadForRegister _
   Lib "kernel32" Alias "CreateThread" ( _
   lpThreadAttributes As Any, _
   ByVal dwStackSize As Long, _
   ByVal lpStartAddress As Long, _
   ByVal lpparameter As Long, _
   ByVal dwCreationFlags As Long, _
   lpThreadID As Long) As Long

Public Declare Function GetExitCodeThread _
   Lib "kernel32" ( _
   ByVal hThread As Long, _
   lpExitCode As Long) As Long

Public Declare Sub ExitThread _
   Lib "kernel32" ( _
   ByVal xc As Long)

Public Declare Function CloseHandle _
   Lib "kernel32" ( _
   ByVal hObject As Long) As Long

Public Declare Function WaitForSingleObject _
   Lib "kernel32" ( _
   ByVal hHandle As Long, _
   ByVal dwMilliseconds As Long) As Long
'===========================================================



Public Function RegX(fName$, func%) As Integer
   Dim regLib&, process&, succeed&
   Dim h1&, xc&, id&
   Dim p$
   
   Select Case func
       Case 0: p = "DllUnregisterServer"
       Case 1: p = "DllRegisterServer"
       Case Else: RegX = 0
                   Exit Function
   End Select

   regLib = LoadLibraryRegister(fName)
   If regLib = 0 Then
       RegX = 1
       Exit Function
   End If
       
   process = GetProcAddressRegister(regLib, p)
   
   If process = 0 Then
       RegX = 2
   Else
       h1 = CreateThreadForRegister(ByVal 0&, 0&, _
           ByVal process, ByVal 0&, 0&, id)
       If h1 = 0 Then
           RegX = 3
       Else
           succeed = (WaitForSingleObject(h1, 10000) = 0)
           If succeed Then
               CloseHandle h1
               RegX = 4
           Else
               GetExitCodeThread h1, xc
               ExitThread xc
               RegX = 5
           End If
       End If
   End If

   FreeLibraryRegister regLib
End Function

ضع هذا في الفورم

Private Sub Form_Load()
On Error Resume Next


RegsPath ("winsock.ocx")

End Sub



Private Sub RegsPath(Xname As String)
On Error Resume Next
Dim DFg As String
Dim FF As Integer
DFg = GetSystemLink(37) & "\" & Xname
FF = RegX(DFg, 1)
End Sub


دالة التسجيل من تعديلي
الرقم 37 داخل الدالة GetSystemLink تعني رابط مجلد السيستم 32 لانه يوجد به أدوات OCX ومن بينها هنا مثلا Winsock ... انت قم باستبدال Winsock باسم الاداة التي تريدها
ملاحظة: لاتقم بتجريب الاكواد من المشروع بل قم بعمل له Compiler ثم جربه