⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 morphine.dpr

📁 File Protector Morphine
💻 DPR
📖 第 1 页 / 共 5 页
字号:
if (sectionh.Name[0] <> '.') and (sectionh.Name[1] <> 'i') and (sectionh.Name[2] <> 'd') and (sectionh.Name[3] <> 'a') and (sectionh.Name[4] <> 't') and (sectionh.Name[5] <> 'a') then WriteLn('Import Table can''t be protected !');
if (sectionh.Name[0] <> '.') and (sectionh.Name[1] <> 'i') and (sectionh.Name[2] <> 'd') and (sectionh.Name[3] <> 'a') and (sectionh.Name[4] <> 't') and (sectionh.Name[5] <> 'a') then Exit;
IStart:=sectionh.PointerToRawData;
ISize:=sectionh.SizeOfRawData;
I:=IStart;
repeat
  MemStr.Seek(I, 1);
  MemStr.Read(Buff, SizeOf(Buff));
  if (Buff[0] = '.') and (Buff[1] = 'd') and (Buff[2] = 'l') and (Buff[3] = 'l') and (Byte(Buff[0]) = $00) then
  begin
    I1:=I;
    repeat
      Dec(I1);
      MemStr.Seek(I1, 1);
      MemStr.Read(Buff2, SizeOf(Buff2));
      if (Byte(Buff[0]) = $00) and (Byte(Buff[1]) = $00) then
      begin
        IStart:=I1+2;
        I1:=IStart;
        I:=(IStart+ISize)-1;
      end;
    until I1 = IStart;
  end;
  Inc(I);
until I = (IStart+ISize);
WriteLn('Import Table protected Successfuly !');
end;


procedure APackFile(Source, Destination:Pointer; Size:Integer);
var
AL:TaPLib;
RSize:Integer;
begin
WriteLn('Packing File!, Please be patient !');
RSize:=Size;
AL:=TaPLib.Create(nil);
AL.Source:=Source;
AL.Length:=RSize;
AL.CallBack:=nil;
AL.Pack;
PackedSize:=AL.Length;
TotalFileSize:=PackedSize;
MainRealSize:=PackedSize;
MainSize:=PackedSize+Cardinal(Random(250)+10);
MainRealSize4:=PackedSize;
if MainRealSize4 mod 4<>0 then Inc(MainRealSize4,4-MainRealSize4 mod 4);
ZeroMemory(Destination, RSize);
MoveMemory(Destination, AL.Destination, PackedSize);
AL.Free;
WriteLn('File Packed Successfuly!');
end;

function VirtAddrToPhysAddr(ANtHeaders:PImageNtHeaders;AVirtAddr:Pointer):Pointer;
//this one is to support tls loading mechanism
//returns pointer to raw data in old pe of data on VA specified by AVirtAddr
//or nil if no section contains this data
var
 LI:Integer;
 LPSection:PImageSectionHeader;
 LAddr:Cardinal;
begin
 Result:=nil;
 LAddr:=Cardinal(AVirtAddr)-ANtHeaders^.OptionalHeader.ImageBase;
 LPSection:=Pointer(Cardinal(@ANtHeaders^.OptionalHeader)+ANtHeaders^.FileHeader.SizeOfOptionalHeader);
 for LI:=0 to ANtHeaders^.FileHeader.NumberOfSections-1 do
 begin
  if (LPSection^.VirtualAddress<=Cardinal(LAddr)) and (LPSection^.VirtualAddress+LPSection^.SizeOfRawData>Cardinal(LAddr)) and (LPSection^.SizeOfRawData<>0) then
  begin
   Result:=Pointer(Cardinal(LPSection^.PointerToRawData)+LAddr-LPSection^.VirtualAddress);
   Break;
  end;
  Inc(LPSection);
 end;
end;

function RVA2RAW(ANtHeader,AVirtImage:Pointer;ARVA:Cardinal):Pointer;
//converts RVA to RAW pointer
var
 LPB:PByte;
begin
 Result:=nil;
 LPB:=VirtAddrToPhysAddr(ANtHeader,Pointer(ARVA+PImageNtHeaders(ANtHeader)^.OptionalHeader.ImageBase));
 if LPB=nil then Exit;
 Inc(LPB,Cardinal(AVirtImage));
 Result:=LPB;
end;

function GetTlsCallbacksLen(ACallbacks:Pointer):Cardinal;
//counts size of tls callbacks array
var
 LPC:PCardinal;
begin
 Result:=4;
 LPC:=ACallbacks;
 while LPC^<>0 do
 begin
  Inc(Result,4);
  Inc(LPC);
 end;
end;

function RoundSize(ASize,AAlignment:Cardinal):Cardinal;
//does rounding up 
begin
 Result:=(ASize+AAlignment-1) div AAlignment*AAlignment;
end;

procedure GenerateRandomBuffer(ABuf:PByte;ASize:Cardinal);
//generates a buffer of pseudo-random values from 1 to 255
var
 LI:Integer;
begin
 for LI:=0 to ASize-1 do
 begin
  ABuf^:=Random($FE)+1;
  Inc(ABuf);
 end;
end;

procedure GenerateKey(AKey:PByte;ASize:Word);
//generetes a key for encoding data
//key is pseudo-random buffer ending with 0
begin
 GenerateRandomBuffer(AKey,ASize);
 PByte(Cardinal(AKey)+Cardinal(ASize)-1)^:=0;
end;

procedure ThrowTheDice(var ADice:Cardinal;ASides:Cardinal=6); overload;
//throw the dice
begin
 ADice:=Random(ASides)+1;
end;

procedure ThrowTheDice(var ADice:Word;ASides:Word=6); overload;
//throw the dice
begin
 ADice:=Random(ASides)+1;
end;

procedure ThrowTheDice(var ADice:Byte;ASides:Byte=6); overload;
//throw the dice
begin
 ADice:=Random(ASides)+1;
end;

function RandomReg32All:Byte;
//select one of eax,ecx,edx,ebx,esp,ebp,esi,edi
begin
 Result:=Random(Reg32Count);
end;

function RandomReg16All:Byte;
//select one of ax,cx,dx,bx,sp,bp,si,di
begin
 Result:=Random(Reg16Count);
end;

function RandomReg8ABCD:Byte;
//select one of al,cl,dl,bl,ah,ch,dh,bh
begin
 Result:=Random(Reg8Count);
end;

function RandomReg32Esp:Byte;
//select one of eax,ecx,edx,ebx,-,ebp,esi,edi
begin
 Result:=Random(Reg32Count-1);
 if Result=REG_ESP then Result:=7;
end;

function RandomReg32EspEbp:Byte;
//select one of eax,ecx,edx,ebx,-,-,esi,edi
begin
 Result:=Random(Reg32Count-2);
 if Result=REG_ESP then Result:=6
 else if Result=REG_EBP then Result:=7;
end;

procedure PutRandomBuffer(var AMem:PByte;ASize:Cardinal);
begin
 GenerateRandomBuffer(AMem,ASize);
 Inc(AMem,ASize);
end;

function Bswap(var AMem:PByte;AReg:Byte):Byte;
begin
 Result:=2;
 AMem^:=$0F;                           //bswap
 Inc(AMem);
 AMem^:=$C8+AReg;                      //reg32
 Inc(AMem);
end;

function Pushad(var AMem:PByte):Byte;
begin
 Result:=1;
 AMem^:=$60;
 Inc(AMem);
end;

function Stosd(var AMem:PByte):Byte;
begin
 Result:=1;
 AMem^:=$AB;                           //stosd
 Inc(AMem);
end;

function Movsd(var AMem:PByte):Byte;
begin
 Result:=1;
 AMem^:=$A5;                           //movsd
 Inc(AMem);
end;

function Ret(var AMem:PByte):Byte;
begin
 Result:=1;
 AMem^:=$C3;                           //ret
 Inc(AMem);
end;

procedure Ret16(var AMem:PByte;AVal:Word);
begin
 AMem^:=$C2;                           //ret
 Inc(AMem);
 PWord(AMem)^:=AVal;                   //retval
 Inc(AMem,2);
end;

procedure RelJmpAddr32(var AMem:PByte;AAddr:Cardinal);
begin
 AMem^:=$E9;                           //jmp
 Inc(AMem);
 PCardinal(AMem)^:=AAddr;
 Inc(AMem,4);
end;

procedure RelJmpAddr8(var AMem:PByte;AAddr:Byte);
begin
 AMem^:=$EB;                           //jmp
 Inc(AMem);
 AMem^:=AAddr;                         //Addr8
 Inc(AMem);
end;


procedure RelJzAddr32(var AMem:PByte;AAddr:Cardinal);
begin
 AMem^:=$0F;                           //conditional jump
 Inc(AMem);
 AMem^:=$84;                           //if zero
 Inc(AMem);
 PCardinal(AMem)^:=AAddr;
 Inc(AMem,4);
end;

procedure RelJnzAddr32(var AMem:PByte;AAddr:Cardinal);
begin
 AMem^:=$0F;                           //conditional jump
 Inc(AMem);
 AMem^:=$85;                           //if not zero
 Inc(AMem);
 PCardinal(AMem)^:=AAddr;
 Inc(AMem,4);
end;

procedure RelJbAddr32(var AMem:PByte;AAddr:Cardinal);
begin
 AMem^:=$0F;                           //conditional jump
 Inc(AMem);
 AMem^:=$82;                           //if below
 Inc(AMem);
 PCardinal(AMem)^:=AAddr;
 Inc(AMem,4);
end;

procedure RelJzAddr8(var AMem:PByte;AAddr:Byte);
begin
 AMem^:=$74;                           //jz
 Inc(AMem);
 AMem^:=AAddr;                         //addr8
 Inc(AMem);
end;

procedure RelJnzAddr8(var AMem:PByte;AAddr:Byte);
begin
 AMem^:=$75;                           //jnz
 Inc(AMem);
 AMem^:=AAddr;                         //addr8
 Inc(AMem);
end;

function JmpRegMemIdx8(var AMem:PByte;AReg,AIdx:Byte):Byte;
begin
 Result:=3;
 AMem^:=$FF;                           //jmp
 Inc(AMem);
 AMem^:=$60+AReg;                      //regmem
 InC(AMem);
 if AReg=REG_ESP then
 begin
  Inc(Result);
  AMem^:=$24;                          //esp
  Inc(AMem);
 end;
 AMem^:=AIdx;                          //idx8
 Inc(AMem);
end;

function PushRegMem(var AMem:PByte;AReg:Byte):Byte;
begin
 Result:=2;
 AMem^:=$FF;                           //push
 Inc(AMem);
 if AReg=REG_EBP then
 begin
  Inc(Result);
  AMem^:=$75;                          //ebp
  Inc(AMem);
  AMem^:=$00;                          //+0
 end else AMem^:=$30+AReg;             //regmem
 Inc(AMem);
 if AReg=REG_ESP then
 begin
  Inc(Result);
  AMem^:=$24;                          //esp
  Inc(AMem);
 end;
end;

procedure PushReg32(var AMem:PByte;AReg:Byte);
begin
 AMem^:=$50+AReg;                      //push reg
 Inc(AMem);
end;

function PushReg32Rand(var AMem:PByte):Byte;
begin
 Result:=RandomReg32Esp;
 PushReg32(AMem,Result);
end;

procedure PopReg32(var AMem:PByte;AReg:Byte);
begin
 AMem^:=$58+AReg;                      //pop reg
 Inc(AMem);
end;

function PopReg32Idx(var AMem:PByte;AReg:Byte;AIdx:Cardinal):Byte;
begin
 Result:=6;
 AMem^:=$8F;                           //pop
 Inc(AMem);
 AMem^:=$80+AReg;                      //reg32
 Inc(AMem);
 if AReg=REG_ESP then
 begin
  AMem^:=$24;                          //esp
  Inc(AMem);
  Inc(Result);
 end;
 PCardinal(AMem)^:=AIdx;               //+ idx
 InC(AMem,4);
end;

procedure RelCallAddr(var AMem:PByte;AAddr:Cardinal);
begin
 AMem^:=$E8;                           //call
 Inc(AMem);
 PCardinal(AMem)^:=AAddr;              //Addr
 Inc(AMem,4);
end;

procedure MovReg32Reg32(var AMem:PByte;AReg1,AReg2:Byte);
begin
 AMem^:=$89;                           //mov
 Inc(AMem);
 AMem^:=AReg2*8+AReg1+$C0;             //reg32,reg32
 Inc(AMem);
end;

procedure AddReg32Reg32(var AMem:PByte;AReg1,AReg2:Byte);
begin
 AMem^:=$01;                           //add
 Inc(AMem);
 AMem^:=AReg2*8+AReg1+$C0;             //reg32,reg32
 Inc(AMem);
end;

function AddReg32RegMem(var AMem:PByte;AReg1,AReg2:Byte):Byte;
begin
 Result:=2;
 AMem^:=$03;                           //add
 Inc(AMem);
 if AReg2=REG_EBP then
 begin
  Inc(Result);
  AMem^:=AReg1*8+$45;                  //reg32,ebp
  Inc(AMem);
  AMem^:=$00;                          //+0
 end else AMem^:=AReg1*8+AReg2;        //reg32,regmem
 Inc(AMem);
 if AReg2=REG_ESP then
 begin
  Inc(Result);
  AMem^:=$24;                          //esp
  Inc(AMem);
 end;
end;

function AddRegMemReg32(var AMem:PByte;AReg1,AReg2:Byte):Byte;
begin
 Result:=2;
 AMem^:=$01;                           //add
 Inc(AMem);
 if AReg1=REG_EBP then
 begin
  Inc(Result);
  AMem^:=AReg2*8+$45;                  //regmem,ebp
  Inc(AMem);
  AMem^:=$00;                          //+0
 end else AMem^:=AReg2*8+AReg1;        //regmem,reg
 Inc(AMem);
 if AReg1=REG_ESP then
 begin
  Inc(Result);
  AMem^:=$24;                          //esp
  Inc(AMem);
 end;
end;



procedure AddReg32Num8(var AMem:PByte;AReg,ANum:Byte);
begin
 AMem^:=$83;                           //add
 Inc(AMem);
 AMem^:=$C0+AReg;                      //reg32
 Inc(AMem);
 AMem^:=ANum;                          //num8
 Inc(AMem);
end;

procedure MovReg32

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -