Обфускатор кода, защита программы - VB

Формулировка задачи:

Собственно в поисках обфускатор(а) кода visual basic 6.0 Вопрос по защите от распространения Сделал на скорую руку защиту в виде файл ключа Первая программа собирает информации о пк, шифрует, сохраняет в файл Файл передают мне, я генерирую ключ В ключе содержится информация о ПК Продаваемая программа при старте сверяет данные вызов сообщения о ключе вывел в таймер, что бы нельзя было отследить условие запуска Проверка осуществляется на отдельной форме Как защититься от виртуальных машин? Рассматривать вариант сравнивать железо (с стандартным железом виртуалок) не дело, т.к. виртуалок разных много, у них разное железо, да и железо виртуальное - поменять не проблема

Решение задачи: «Обфускатор кода, защита программы»

textual
                            Листинг программы 
                        

                            Option Explicit
 
Private Type DllCall
    lpszLibName As Long
    lpszFncName As Long
End Type
 
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryW" (ByVal lpLibFileName As Long) As Long
Private Declare Function ideDllFunctionCall Lib "vba6" Alias "DllFunctionCall" (lpLibFileName As DllCall) As Long
Private Declare Function DllFunctionCall Lib "msvbvm60" (lpLibFileName As DllCall) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetMem8 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Declare Function GetMem1 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
 
Private Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private Const PAGE_READWRITE = 4&
 
Dim Dat(7)  As Byte, Jmp(7) As Byte
Dim hMod    As Long
Dim lpFnc   As Long
Dim inIDE   As Boolean
 
' Г”ГіГ*ГЄГ¶ГЁГї ГЇГҐГ°ГҐГµГўГ*ГІГ*
Private Function CallBackDllFunctionCall(inf As DllCall) As Long
    Dim lib As String, func As String, n As Long
    ' Г‘Г*ГЁГ¬Г*ГҐГ¬ ГЇГҐГ°ГҐГµГўГ*ГІ Г·ГІГ®ГЎГ» ГўГ»Г§Г»ГўГ*ГІГј ГўГ*ГіГІГ°ГЁ API, Г°Г*Г§Г°ГҐГёГ*ГҐГ¬ Г§Г*ГЇГЁГ±Гј Гў Г¤Г*Г*Г*Г»ГҐ ГЁГ§ Declare
    Call Unpatch: VirtualProtect inf, 8, PAGE_READWRITE, 0
    ' ГЏГ®Г«ГіГ·Г*ГҐГ¬ ГЁГ¬Гї ГЎГЁГЎГ«ГЁГ®ГІГҐГЄГЁ ГЁ ГґГіГ*ГЄГ¶ГЁГЁ
    n = lstrlen(ByVal inf.lpszLibName): lib = Space(n): lstrcpy ByVal lib, ByVal inf.lpszLibName
    n = lstrlen(ByVal inf.lpszFncName): func = Space(n): lstrcpy ByVal func, ByVal inf.lpszFncName
    ' ГЏГ°ГҐГ®ГЎГ°Г*Г§Г®ГўГ»ГўГ*ГҐГ¬ ГЁГµ Гў Г*Г*Г±ГІГ®ГїГ№ГЁГҐ
    Decode lib, func: inf.lpszLibName = StrPtr(lib): inf.lpszFncName = StrPtr(func)
    ' Г‚Г»Г§Г»ГўГ*ГҐГ¬ Г®Г°ГЁГЈГЁГ*Г*Г«ГјГ*ГіГѕ ГґГіГ*ГЄГ¶ГЁГѕ
    If inIDE Then
        CallBackDllFunctionCall = ideDllFunctionCall(inf)
    Else: CallBackDllFunctionCall = DllFunctionCall(inf)
    End If
    ' Г‚Г®Г±Г±ГІГ*Г*Г*ГўГ«ГЁГўГ*ГҐГ¬ ГЇГҐГ°ГҐГµГўГ*ГІ
    Patch
End Function
' Г€Г*ГЁГ¶ГЁГ*Г«ГЁГ§Г*Г¶ГЁГї
Public Function Init() As Boolean
    Dim lib As String
    Debug.Assert MakeTrue(inIDE)
    ' Г‚ Г§Г*ГўГЁГ±ГЁГ¬Г®Г±ГІГЁ Г®ГІ Г±ГЁГІГіГ*Г¶ГЁГЁ ГўГ»ГЎГЁГ°Г*ГҐГ¬ ГІГі ГЁГ«ГЁ ГЁГ*ГіГѕ ГЎГЁГЎГ«ГЁГ®ГІГҐГЄГі
    If inIDE Then lib = "vba6" Else lib = "msvbvm60"
    hMod = LoadLibrary(StrPtr(lib)): If hMod = 0 Then Exit Function Else lpFnc = GetProcAddress(hMod, "DllFunctionCall")
    ' ГђГ*Г§Г°ГҐГёГ*ГҐГ¬ Г§Г*ГЇГЁГ±Гј Гў ГІГҐГ«Г® ГґГіГ*ГЄГ¶ГЁГЁ
    VirtualProtect ByVal lpFnc, 8, PAGE_EXECUTE_READWRITE, 0: GetMem8 ByVal lpFnc, Dat(0): Patch
    Init = True
End Function
Public Function Deinit() As Boolean
    Call Unpatch: Deinit = True
End Function
Private Sub Decode(lib As String, fnc As String)
    Select Case lib
    Case "The trick", "Z80": lib = StrConv("user32", vbFromUnicode)
    Case Else: lib = StrConv(lib, vbFromUnicode)
    End Select
    Select Case fnc
    Case "ZX Spectrum", "VECTOR-06C": fnc = StrConv("MessageBoxA", vbFromUnicode)
    Case Else: fnc = StrConv(fnc, vbFromUnicode)
    End Select
End Sub
Private Sub Patch()
    GetMem4 getAddr(AddressOf CallBackDllFunctionCall) - lpFnc - 5, Jmp(1):  Jmp(0) = &HE9
    GetMem8 Jmp(0), ByVal lpFnc
End Sub
Private Sub Unpatch()
    GetMem8 Dat(0), ByVal lpFnc
End Sub
Private Function getAddr(ByVal Value As Long) As Long
    getAddr = Value
End Function
Private Function MakeTrue(Value As Boolean) As Boolean
    MakeTrue = True: Value = True
End Function
                        