uaddshell.pas

有密码的加壳源码.只是简单的介绍下壳方法.牛人见笑了

unit UAddShell;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ShellAPI, ExtCtrls, Buttons, ShlObj, Menus, 
  UnitLockConst, RzLabel, bsSkinCtrls, BusinessSkinForm;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    ButtonOpenFile: TSpeedButton;
    ButtonEncrypt: TBitBtn;
    EditPassword1: TEdit;
    EditPassword2: TEdit;
    ButtonUnEncrypt: TBitBtn;
    EditFileName: TEdit;
    CheckBox1: TCheckBox;
    LabelPassword1: TLabel;
    LabelPassword2: TLabel;
    LabelFileName: TLabel;
    bsBusinessSkinForm1: TbsBusinessSkinForm;
    bsSkinLabel1: TbsSkinLabel;
    RzLabel1: TRzLabel;
    procedure ButtonEncryptClick(Sender: TObject);
    procedure ButtonOpenFileClick(Sender: TObject);
    procedure ButtonUnEncryptClick(Sender: TObject);
  private
    sExeFilename, sPassword: string;{被加壳的文件名，密码}
    procedure LockFile;
    procedure UnLockFile;
    procedure BusyStatus;
    procedure CopyFile(FromFile, ToFile: string);
    procedure FileAddShellOrNot(FileName: string);
    function StringEncrypt(S: string): string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{设置控件无效，表示正忙}
procedure TForm1.BusyStatus;
begin
  EditPassword1.Enabled  := False;
  EditPassword2.Visible  := False;
  LabelPassword2.Visible := False;
  buttonEncrypt.Enabled  := False;
  ButtonUnEncrypt.Enabled:= False;
  EditFileName.Enabled   := False;
  ButtonOpenFile.Enabled := False;
end;

{自定义的加密运算，对密码进行简单的加密}
function TForm1.StringEncrypt(S: string): string;
var
  i: Byte;
begin
  for i := 1 to Length(S) do
    S[i] := Char(i or $75 xor ord(S[i]));
  Result := S;
end;

{拷贝文件}
procedure TForm1.CopyFile(FromFile, ToFile: string);
var
  OpStruc: TSHFileOpStruct;
  FromBuf, ToBuf: packed array[0..MaxBufferSize - 1] of char;
begin
  fillchar(frombuf, sizeof(frombuf), 0);
  fillchar(tobuf, sizeof(tobuf), 0);
  StrpCopy(frombuf, fromfile);
  StrpCopy(tobuf, tofile);
  with OpStruc do
  begin
    wnd := handle;
    wFunc := FO_COPY;
    pfrom := @frombuf;
    pto := @tobuf;
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
    lpszProgressTitle := nil;
  end;
  {拷贝文件Shell操作}
  ShFileOperation(OpStruc);
end;

{取文件的大小}
function GetFileSize2(filename:string):integer;
var
   sr:TSearchRec;
begin
   if (findfirst(filename,faAnyfile and not faDirectory,sr)<>0) then result:=0
   else result:=sr.size;
   findclose(sr);
end;

{加壳}
procedure TForm1.LockFile;
var
  FsName, FtName, FbName, FCode: string;
  iTargetFile, iSourceFile: Integer;
  MyBuf: array[0..MaxBufferSize - 1] of Char;
  LockedFile: TLockedFile;
  NumRead, NumWritten: Integer;
  bSuccessed: Boolean;
begin
    BusyStatus;{设置按钮无效，表示正忙}
    FsName := sExeFilename;{被加壳的文件名}
    FbName := FsName + '.TMP'; {被加壳文件的备份文件名}
    {附加代码的文件名}
    FCode := ExtractFilePath(paramstr(0))+'DialogPass.exe';
    if not fileexists(FCode) then
       raise exception.create(FCode+'文件没找到.');

    {如果需要备份文件}
    if CheckBox1.Checked then
    begin
      CopyFile(FsName, FbName);
    end;
    iSourceFile := FileOpen(FsName, fmOpenRead or fmShareDenyNone);
    try
      with LockedFile do
      begin
        Flag := CFlag;{自定义的标志}
        Name := ExtractFileName(FsName);{文件名}
        Caption := '';{标题，保留没有使用}
        Password := StringEncrypt(sPassword);{密码}
        AdditionalCodeLen := GetFileSize2(FCode);{附加代码的长度}
      end;
      {临时文件是在被加壳文件名前加"__"}
      FtName := ExtractFilePath(FsName) + '__' + LockedFile.Name;
      CopyFile(FCode, FtName);{先拷贝附加代码}

      {在附加代码之后写被加壳文件}
      bSuccessed := False;
      iTargetFile := FileOpen(FtName, fmOpenReadWrite);
      try
        {定位至目标文件的末尾}
        FileSeek(iTargetFile, 0, soFromEnd);
        repeat
          NumRead := FileRead(iSourceFile, MyBuf, SizeOf(MyBuf));
          NumWritten := FileWrite(iTargetFile, MyBuf, NumRead);
        until (NumRead = 0) or (NumWritten <> NumRead);
        {最后写上密码等信息}
        FileWrite(iTargetFile, LockedFile, SizeOf(LockedFile));
        bSuccessed := True;
        showmessage('文件加密完成');
      finally
        FileClose(iTargetFile);
      end;
    finally
      FileClose(iSourceFile);
    end;
    if bSuccessed then
    begin
      {删除被加壳的文件}
      DeleteFile(FsName);
      {把临时文件重命名为被加壳的文件}
      RenameFile(FtName, FsName);
    end;
    {重新检查文件是否已加壳}
    FileAddShellOrNot(EditFileName.Text);
end;

{脱壳}
procedure TForm1.UnLockFile;
var
  FsName, FtName: string;
  iSourceFile, iTargetFile: Integer;
  NumRead, NumWritten: Integer;
  MyBuf: array[0..MaxBufferSize - 1] of Byte;
  LockedFile: TLockedFile;
  bSuccessed: Boolean;
begin
  bSuccessed := False;
  with Form1 do
  begin
    BusyStatus;
    FsName := sExeFilename;{已加壳的文件名}
    iSourceFile := FileOpen(FsName, fmOpenRead or fmShareDenyNone);
    try
      {定位到密码等信息的结构}
      FileSeek(iSourceFile, -SizeOf(LockedFile), soFromEnd);
      {读取密码等信息}
      FileRead(iSourceFile, LockedFile, SizeOf(LockedFile));
      {如果密码正确}
      if LockedFile.Password = StringEncrypt(sPassword) then
      begin   
        {临时文件是在已加壳文件名前加"__"}
        FtName := ExtractFilePath(FsName) + '__' + LockedFile.Name;
        iTargetFile := FileCreate(FtName);{创建临时文件}
        try
          {定位到加壳前原文件的起始位置}
          FileSeek(iSourceFile, LockedFile.AdditionalCodeLen , 
             soFromBeginning);
          {把属于原文件的内容拷贝到临时文件中}
          repeat
            NumRead := FileRead(iSourceFile, MyBuf, SizeOf(MyBuf));
            NumWritten := FileWrite(iTargetFile, MyBuf, NumRead);
          until (NumRead = 0) or (NumWritten <> NumRead);
          bSuccessed := True;
          showmessage('文件解密完成');
        finally
          {最后SizeOf(LockedFile)字节是密码等信息,不需要读取到临时文件中}
          FileSeek(iTargetFile, -SizeOf(LockedFile), soFromEnd);
          SetEndOfFile(iTargetFile);
          FileClose(iTargetFile);
        end;
      end else
      begin
        ShowMessage('密码不正确.');
      end;
    finally
      FileClose(iSourceFile);
    end;
    if bSuccessed then
    begin
      {删除已加壳的文件}
      DeleteFile(FsName);
      {把临时文件改为已加壳}
      RenameFile(FtName, FsName);
    end;
    {重新检查文件是否已加壳的文件}
    FileAddShellOrNot(sExeFilename);
  end;
end;

{点击"加壳"时}
procedure TForm1.ButtonEncryptClick(Sender: TObject);
begin
  if not FileExists(EditFileName.Text) then
  begin
    showmessage('文件不存在.');
    exit;
  end;
  if EditPassword1.Text = '' then
  begin
    showmessage('密码不能为空.');
    exit;
  end;
  if EditPassword1.Text <> EditPassword2.Text then
  begin
    showmessage('两次输入的密码不一致');
    exit;
  end;
  sExeFilename := EditFileName.Text;
  sPassword := EditPassword1.Text;
  {加壳}
  LockFile;
end;

{选择可执行文件}
procedure TForm1.ButtonOpenFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    EditFileName.Text := OpenDialog1.FileName;
    FileAddShellOrNot(EditFileName.Text);{检查是否已加壳}
  end;
end;

{点击"脱壳"时}
procedure TForm1.ButtonUnEncryptClick(Sender: TObject);
begin
  if not FileExists(EditFileName.Text) then
  begin
    showmessage('文件不存在.');
    exit;
  end;
  if EditPassword1.Text = '' then
  begin
    showmessage('密码不能为空.');
    exit;
  end;
  sExeFilename := EditFileName.Text;
  sPassword := EditPassword1.Text;
  {脱壳}
  UnLockFile;
end;

{检查文件是否已加壳}
procedure TForm1.FileAddShellOrNot(FileName: string);
var
  iOpFile: Integer;
  LockedFile: TLockedFile;
  FileExt: string;
  FileAttr: Integer;
begin
  {恢复控件的状态}
  EditPassword1.Enabled := True;
  EditPassword2.Visible := True;
  LabelPassword2.Visible        := True;
  buttonEncrypt.Enabled := True;
  ButtonUnEncrypt.Enabled := True;
  EditFileName.Enabled := True;
  ButtonOpenFile.Enabled := True;
  CheckBox1.Enabled := True;

  FileExt := ExtractFileExt(FileName);
  {如果不是可执行文件}
  if StrUpper(PChar(FileExt)) <> '.EXE' then
  begin
    showmessage(FileName+'文件不是EXE文件');
    EditFileName.Text := '';
    exit;
  end;
  FileAttr := FileGetAttr(FileName);
  {如果文件属性是只读属性}
  if FileAttr and faReadOnly > 0 then
  begin
     {设置文件属性}
     if FileSetAttr(FileName,faArchive)<>0 then
     begin
       showmessage('设置'+FileName+'文件的属性出错!');
       EditFileName.Text := '';
       exit;
     end;
  end;
  {打开待加壳或脱壳的文件}
  iOpFile := FileOpen(FileName, fmOpenRead);
  try
    {定位到加密结构}
    FileSeek(iOpFile, -SizeOf(LockedFile), soFromEnd);
    {读密码等信息}
    FileRead(iOpFile, LockedFile, SizeOf(LockedFile));
    {检查标志，判断是否已加壳}
    if LockedFile.Flag = CFlag then
    begin
       {设置"脱壳"按钮等控件无效}
       buttonEncrypt.Enabled := False;
       EditPassword2.Visible := False;
       LabelPassword2.Visible:= False;
       CheckBox1.Enabled     := False;
    end
    else
       {设置"加壳"按钮无效}
       ButtonUnEncrypt.Enabled := False;
  finally
    FileClose(iOpFile);
  end;
end;

end.