main.pas

EXE文件加密码,ASP压缩处理.比较实用,大家拿去

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ShellAPI, ExtCtrls, Buttons, Menus;

type
  Tfrm_Main = class(TForm)
    OpenDialog1: TOpenDialog;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Button_Directory: TSpeedButton;
    Button_OpenFile: TSpeedButton;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText_Pass1: TStaticText;
    Edit_FileName: TEdit;
    Edit_Pass: TEdit;
    Edit_Pass1: TEdit;
    Button_Go: TBitBtn;
    Button_UnGo: TBitBtn;
    TabSheet3: TTabSheet;
    lb_email: TLabel;
    lb_HomePage: TLabel;
    homepage: TLabel;
    email: TLabel;
    update: TLabel;
    lb_UpData: TLabel;
    lb_Author: TLabel;
    Edit_Caption: TEdit;
    StaticText_Caption: TStaticText;
    GroupBox1: TGroupBox;
    cb_Assoc: TCheckBox;
    btn_Apply: TButton;
    cb_NeedPass: TCheckBox;
    Button_Preview: TSpeedButton;
    Panel2: TPanel;
    Button1: TButton;
    StaticText3: TStaticText;
    StaticText5: TStaticText;
    rb_Speed: TRadioButton;
    rb_Comp: TRadioButton;
    CheckBox_BackUp: TCheckBox;
    lb_Ver: TLabel;
    Bevel1: TBevel;
    procedure Button_GoClick(Sender: TObject);
    procedure Btn_ExitClick(Sender: TObject);
    procedure Button_OpenFileClick(Sender: TObject);
    procedure Button_UnGoClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button_DirectoryClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Edit_FileNameChange(Sender: TObject);
    procedure emailClick(Sender: TObject);
    procedure homepageClick(Sender: TObject);
    procedure updateClick(Sender: TObject);
    procedure btn_ApplyClick(Sender: TObject);
    procedure Button_PreviewClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure cb_OptionClick(Sender: TObject);
  private
    sOpFileName,sPassWord,sCaption:String;
    procedure ResetForm;
    procedure BuzyForm;
    procedure DoLock;
    procedure DoUnLock;
    procedure CheckOpFile(FileName: String);
    procedure WMDropFiles(var Msg:TWMDropFiles); message WM_DROPFILES;
    procedure StatusText(sMsg_Error: String);
    procedure LockFileStream(SFName: String; BBackup: Boolean);
    procedure UnLockFileStream(SFName, PassWord: String);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  Ver='2.11';

  PassSize=18;
  CFlag='...FILE..LOCK...';

  { 用AsPack2.1压缩 }
  FileIconStart=$20C1C;
  FileExeStart=$21000;

  AssocString='用&EXELOCK加密';

  Error_FileNotExists='对不起，选的文件不存在，不能继续。';
  Error_NoPass='对不起，密码不能为空，请输入密码。';
  Error_PassNotSame='两次密码不一致，请检查并重新输入。';
  Error_FileLocked='文件已经加密，不能继续。';
  Error_FileNotLocked='文件没有加密，不能继续。';
  Error_PassWrong='密码错误，不能解密文件。';
  Error_FileType='文件类型不是EXE，加密后可能出错。';
  Error_FileAttribute='文件属性只读，是否改变属性继续。';
  Error_FileDelete='文件删除失败，可能被加密的程序正在使用。';
  Msg_DoLock='文件没有加密，可以加密。';
  Msg_DoUnLock='文件已经加密，可以解密。';
  Msg_BeginLock='开始加密文件，请稍后！';
  Msg_BeginUnLock='开始解密文件，请稍后！';
  Msg_EndLock='文件加密完成，谢谢使用。';
  Msg_EndUnLock='文件解密完成，谢谢使用。';
  Msg_BeginBackUpFile='正在备份文件，请稍后！';
  Msg_BeginLH='正在压缩加密文件，请稍后！';
  Msg_BeginUnLH='正在解压缩加密文件，请稍后！';
  Msg_Ready='准备就绪！';
  Msg_DefaultCaption='文件已经加密->输入解密密码';

type
  TLockedFile=record
    Flag:String[Length(CFlag)];
    PassWord:String[PassSize];
    Caption:String[52];
    Compressed:Boolean;
  end;

var
  frm_Main: Tfrm_Main;

implementation

{$R *.DFM}
{$R 1.RES}

uses Func, Encrypt_Base64, Compress_LH5, Preview, Password, Login;

procedure Tfrm_Main.ResetForm;
begin
  StatusText(Msg_Ready);
  Edit_Pass.Enabled:=True;
  Edit_Pass1.Enabled:=True;
  Edit_Caption.Enabled:=True;
  Edit_Pass.Text:=#0;
  Edit_Pass1.Text:=#0;
  Button_Go.Enabled:=True;
  Button_Go.Default:=False;
  Button_UnGo.Enabled:=True;
  Button_UnGo.Default:=False;
  Edit_FileName.Enabled:=True;
  Button_OpenFile.Enabled:=True;
  Button_Directory.Enabled:=True;
  Button_Preview.Enabled:=True;
  CheckBox_BackUp.Enabled:=True;
  StaticText_Pass1.Enabled:=True;
  StaticText_Caption.Enabled:=True;
  StatusText(Msg_Ready);
end;

procedure Tfrm_Main.BuzyForm;
begin
  Edit_Pass.Enabled:=False;
  Edit_Pass1.Enabled:=False;
  Edit_Caption.Enabled:=False;
  Button_Go.Enabled:=False;
  Button_UnGo.Enabled:=False;
  Edit_FileName.Enabled:=False;
  Button_OpenFile.Enabled:=False;
  Button_Directory.Enabled:=False;
  Button_Preview.Enabled:=False;
  CheckBox_BackUp.Enabled:=False;
end;

procedure Tfrm_Main.LockFileStream(SFName:String;BBackup:Boolean);
var
  S,T,C:TMemoryStream;
  LockedFile:TLockedFile;
  procedure GetPassDialogFile(tStream:TStream);
  var
    m1,m2:TMemoryStream;
    ExeRes:TResourceStream;
    bb:Byte;r,s:Integer;
    sIcon:TIcon;
  begin
    ExeRes:=TResourceStream.Create(Hinstance,'File1','EXEFILE');
    sIcon:=TIcon.Create;
    try
      sIcon.Handle:=ExtractIcon(Application.Handle,PChar(SFName),0);
      if sIcon.Handle<>0 then
      begin
        m1:=TMemoryStream.Create;
        m2:=TMemoryStream.Create;
        try
          sIcon.SaveToStream(m1);
  //        sIcon.SaveToFile('test.ico');
          m2.LoadFromStream(ExeRes);
          s:=m1.Seek(0,2);
          m1.seek($16,0);
          m2.seek(FileIconStart+$14,0);
          repeat
            r:=m1.Read(bb,SizeOf(bb));
            m2.write(bb,r);
          until m1.seek(0,1)=s;
          m2.SaveToStream(tStream);
        finally
          m1.Free;
          m2.Free;
        end;
      end else
        ExeRes.SaveToStream(tStream);
    finally
      sIcon.Free;
      ExeRes.Free;
    end;
  end;
begin
  S:=TMemoryStream.Create;
  T:=TMemoryStream.Create;
  C:=TMemoryStream.Create;
  try
    S.LoadFromFile(SFName);
    if BBackUp then
    begin
      StatusText(Msg_BeginBackUpFile);
      S.SaveToFile(ChangeFileExt(SFName,'.BAK'));
    end;
    with LockedFile do
    begin
      Flag:=CFlag;
      Caption:=sCaption;
      PassWord:=Base64Encode(sPassWord);
      Compressed:=rb_Comp.Checked;
    end;
    GetPassDialogFile(T);
    S.Position:=0;
    T.Seek(0,2);
    StatusText(Msg_BeginLH);
    if LockedFile.Compressed then
    begin
      C.Position:=0;
      LHACompress(S,C);
      C.Position:=0;
      T.CopyFrom(C,C.Size);
    end else T.CopyFrom(S,S.Size);
    T.Write(LockedFile,SizeOf(LockedFile));
    if DeleteFile(SFName) then
    begin
      T.SaveToFile(SFName);
      MessageBox(Handle,Msg_EndLock,'信息',MB_OK);
    end else
      MessageBox(Handle,Error_FileDelete,'错误',MB_OK);
  finally
    S.Free;
    T.Free;
    C.Free;
  end;
end;

procedure Tfrm_Main.UnLockFileStream(SFName, PassWord:String);
var
  S,T,C:TMemoryStream;
  LockedFile:TLockedFile;
begin
  S:=TMemoryStream.Create;
  T:=TMemoryStream.Create;
  C:=TMemoryStream.Create;
  try
    S.LoadFromFile(SFName);
    S.Seek(-SizeOf(LockedFile),2);
    S.Read(LockedFile,SizeOf(LockedFile));
    if Base64Decode(LockedFile.PassWord)=PassWord then
    begin
      S.Position:=FileExeStart;
      T.Position:=0;
      StatusText(Msg_BeginUnLH);
      if LockedFile.Compressed then
      begin
        C.Position:=0;
        C.CopyFrom(S,S.Size-FileExeStart-SizeOf(LockedFile));
        C.Position:=0;
        LHAExpand(C,T);
      end else T.CopyFrom(S,S.Size-FileExeStart-SizeOf(LockedFile));
      if DeleteFile(SFName) then
      begin
        T.SaveToFile(SFName);
        MessageBox(Handle,Msg_EndUnLock,'信息',MB_OK);
      end else
        MessageBox(Handle,Error_FileDelete,'错误',MB_OK);
    end else
      MessageBox(Handle,Error_PassWrong,'警告',MB_OK);
  finally