lock_main.pas

EXELOCK 1.83 EXE文件加密器的源代码

unit lock_main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TFlatButtonUnit, StdCtrls, TFlatEditUnit, ComCtrls, ShellAPI,
  TFlatCheckBoxUnit, TFlatHintUnit, ExtCtrls;

type
  TForm1 = class(TForm)
    Button_Go: TFlatButton;
    Button_Exit: TFlatButton;
    OpenDialog1: TOpenDialog;
    Edit_Pass: TFlatEdit;
    ProgressBar1: TProgressBar;
    StaticText1: TStaticText;
    Button_OpenFile: TFlatButton;
    StaticText2: TStaticText;
    Edit_Pass1: TFlatEdit;
    Button_About: TFlatButton;
    StaticText_Pass1: TStaticText;
    Edit_FileName: TFlatEdit;
    CheckBox_BackUp: TFlatCheckBox;
    FlatHint1: TFlatHint;
    Button_UnGo: TFlatButton;
    Panel1: TPanel;
    Label_Msg: TLabel;
    Button_Directory: TFlatButton;
    procedure Button_GoClick(Sender: TObject);
    procedure Button_ExitClick(Sender: TObject);
    procedure Button_OpenFileClick(Sender: TObject);
    procedure Button_AboutClick(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);
  private
    CheckTimes:Byte;
    procedure ResetForm;
    procedure BusyForm;
    procedure DoLock;
    procedure DoUnLock;
    procedure CopyLockedFile(var FromFile, ToFile: String);
    procedure GetPassDialogFile(FileName: String);
    procedure CheckOpFile(FileName: String);
    procedure WMDropFiles(var Msg:TWMDropFiles); message WM_DROPFILES;

    { Private declarations }
  public
    { Public declarations }
  end;

const
  Error_FileNotExists='对不起，选的文件不存在，不能继续。';
  Error_NoPass='对不起，密码不能为空，请输入密码。';
  Error_PassNotSame='两次密码不一致，请检查并重新输入。';
  Error_FileLocked='文件[%s]已经加密，不能继续。';
  Error_FileNotLocked='文件[%s]没有加密，不能继续。';
  Error_Thread='对不起，建立多线程错误，不能继续。';
  Error_PassWrong='密码错误，还有%d次操作机会。';
  Error_FileType='文件[%s]类型不是EXE，加密后可能出错。';
  Error_FileAttribute='文件[%s]属性只读，不能继续。';
  Msg_DoLock='文件[%s]没有加密，可以加密。';
  Msg_DoUnLock='文件[%s]已经加密，可以解密。';
  Msg_Over='密码3次错误，程序将自动退出。';
  Msg_BeginLock='开始加密[%s]文件，请稍后！';
  Msg_BeginUnLock='开始解密[%s]文件，请稍后！';
  Msg_EndLock='文件[%s]加密完成，谢谢使用。';
  Msg_EndUnLock='文件[%s]解密完成，谢谢使用。';
  Msg_BeginBackUpFile='正在备份[%s]文件，请稍后！';

var
  Form1: TForm1;

implementation

uses lock_about;

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

procedure TForm1.ResetForm;
begin
  CheckTimes:=1;
  ProgressBar1.Position:=0;
  Label_Msg.Caption:='信息';
  Edit_Pass.Enabled:=True;
  Edit_Pass1.Enabled:=True;
  Edit_Pass.Text:=#0;
  Edit_Pass1.Text:=#0;
  Button_Go.Enabled:=True;
  Button_UnGo.Enabled:=True;
  Button_Exit.Enabled:=True;
  Edit_FileName.Enabled:=True;
  Button_OpenFile.Enabled:=True;
  Button_Directory.Enabled:=True;
  CheckBox_BackUp.Enabled:=True;
  StaticText_Pass1.Enabled:=True;
end;

procedure TForm1.BusyForm;
begin
  Edit_Pass.Enabled:=False;
  Edit_Pass1.Enabled:=False;
  Button_Go.Enabled:=False;
  Button_UnGo.Enabled:=False;
  Button_Exit.Enabled:=False;
  Edit_FileName.Enabled:=False;
  Button_OpenFile.Enabled:=False;
  Button_Directory.Enabled:=False;
end;

procedure TForm1.CopyLockedFile(var FromFile,ToFile:String);
var
  OpStruc:TSHFileOpStruct;
  FromBuf,ToBuf:packed array[0..2047]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;
  ShFileOperation(OpStruc);
end;

procedure TForm1.GetPassDialogFile(FileName:String);
var
  ExeRes:TResourceStream;
begin
  ExeRes:=TResourceStream.Create(Hinstance,'PassDialogFile','EXEFILE');
  ExeRes.SavetoFile(FileName);
  ExeRes.Free;
end;

function LockFile(P:pointer):Longint;stdcall;
  function jjm(S:String):String;
  var
    i:Byte;
  begin
    for i:=1 to Length(S) do
      S[i]:=Char(ord(S[i]) xor (i+3));
    jjm:=S;
  end;
var
  FsName,FtName,FbName:String;
  iTargetFile,iSourceFile:Integer;
  GetFlag,Flag:String[7];
  MyBuf:packed array[0..2047]of Char;
  NumRead,NumWritten:Integer;
  LockedFile:record
    Name:ShortString;
    Size:Integer;
    PassWord:String[15];
    Encrypted:Boolean;
  end;
  Successed:Boolean;
begin
  Flag:='@@#%#@@';
  Successed:=False;
  with Form1 do
  begin
    BusyForm;
    FsName:=Edit_FileName.Text;
    FbName:=FsName+'.BAK';
    try
      iSourceFile:=FileOpen(FsName,fmOpenRead or fmShareDenyNone);
      { get flag from file which will be encrypted }
      FileSeek(iSourceFile,-SizeOf(Flag),soFromEnd);
      FileRead(iSourceFile,GetFlag,SizeOf(GetFlag));
      if GetFlag<>Flag then
      begin
        { check whether backup file }
        if CheckBox_BackUp.Checked then
        begin
          Label_Msg.Caption:=Format(Msg_BeginBackUpFile,[ExtractFileName(FsName)]);
          CopyLockedFile(FsName,FbName);
        end;
        { begin lock }
        with LockedFile do
        begin
          Name:=ExtractFileName(FsName);
          Size:=FileSeek(iSourceFile,0,soFromEnd)+SizeOf(LockedFile);
          PassWord:=jjm(Edit_Pass.Text);
          Encrypted:=False;
        end;
        { get passdialogfile to currect directory }
        FtName:=ExtractFilePath(FsName)+'_'+LockedFile.Name;
        GetPassDialogFile(FtName);
        { set progressbar }
        ProgressBar1.Max:=LockedFile.Size div SizeOf(MyBuf);
        ProgressBar1.Position:=0;
        Label_Msg.Caption:=Format(Msg_BeginLock,[LockedFile.Name]);
        { begin copy }
        iTargetFile:=FileOpen(FtName,fmOpenReadWrite);
        FileSeek(iSourceFile,0,soFromBeginning);
        FileSeek(iTargetFile,0,soFromEnd);
        repeat
          ProgressBar1.Position:=ProgressBar1.Position+1;
          NumRead:=FileRead(iSourceFile,MyBuf,SizeOf(MyBuf));
          NumWritten:=FileWrite(iTargetFile,MyBuf,NumRead);
        until (NumRead=0) or (NumWritten<>NumRead);
        FileWrite(iTargetFile,LockedFile,SizeOf(LockedFile));
        FileWrite(iTargetFile,Flag,SizeOf(Flag));
        Successed:=True;
        { end copy }
        Label_Msg.Caption:=Format(Msg_EndLock,[LockedFile.Name]);
      end else
      begin
        Label_Msg.Caption:=Format(Error_FileLocked,[ExtractFileName(FsName)]);
      end;
    finally
      FileClose(iSourceFile);
      FileClose(iTargetFile);
    end;
    if Successed then
    begin
      DeleteFile(FsName);
      RenameFile(FtName,FsName);
    end;
    Sleep(1000);
    CheckOpFile(Edit_FileName.Text);
  end;
end;

function UnLockFile(P:pointer):Longint;stdcall;
  function jjm(S:String):String;
  var
    i:Byte;
  begin
    for i:=1 to Length(S) do
      S[i]:=Char(ord(S[i]) xor (i+3));
    jjm:=S;
  end;
var
  FsName,FtName:String;
  iSourceFile,iTargetFile:Integer;
  NumRead,NumWritten:Integer;
  MyBuf:packed array[0..2047]of Char;
  GetFlag,Flag:String[7];
  LockedFile:record
    Name:ShortString;
    Size:Integer;
    PassWord:String[15];
    Encrypted:Boolean;
  end;
  FileStart,FileEnd:Integer;
  Successed:Boolean;
begin
  Flag:='@@#%#@@';
  Successed:=False;
  with Form1 do
  begin
    BusyForm;
    FsName:=Edit_FileName.Text;
    try
      iSourceFile:=FileOpen(FsName,fmOpenRead or fmShareDenyNone);
      FileSeek(iSourceFile,-SizeOf(Flag),soFromEnd);
      FileRead(iSourceFile,GetFlag,SizeOf(GetFlag));
      if GetFlag=Flag then
      begin
        FileSeek(iSourceFile,-Sizeof(LockedFile)-SizeOf(Flag),soFromEnd);
        FileRead(iSourceFile,LockedFile,SizeOf(LockedFile));
        if LockedFile.PassWord=jjm(Edit_Pass.Text) then
        begin
          { set progressbar }
          ProgressBar1.Max:=LockedFile.Size div SizeOf(MyBuf);
          ProgressBar1.Position:=0;
          Label_Msg.Caption:=Format(Msg_BeginUnLock,[LockedFile.Name]);

          FileStart:=LockedFile.Size+SizeOf(Flag);
          FileEnd:=SizeOf(LockedFile)+SizeOf(Flag);
          try
            FtName:=ExtractFilePath(FsName)+'_'+LockedFile.Name;
            iTargetFile:=FileCreate(FtName);
            FileSeek(iSourceFile,-FileStart,soFromEnd);
            repeat
              ProgressBar1.Position:=ProgressBar1.Position+1;
              NumRead:=FileRead(iSourceFile,MyBuf,SizeOf(MyBuf));
              if NumRead=SizeOf(MyBuf)then
                NumWritten:=FileWrite(iTargetFile,MyBuf,NumRead) else
                NumWritten:=FileWrite(iTargetFile,MyBuf,NumRead-FileEnd);
            until (NumRead=0) or (NumWritten<>NumRead);
            Successed:=True;
            Label_Msg.Caption:=Format(Msg_EndUnLock,[LockedFile.Name]);
          finally
            FileClose(iTargetFile);
          end;
        end else
        begin
          inc(CheckTimes);
          Label_Msg.Caption:=Format(Error_PassWrong,[4-CheckTimes]);
        end;
      end else Label_Msg.Caption:=Format(Error_FileNotLocked,[ExtractFileName(FsName)]);
    finally
      FileClose(iSourceFile);
    end;
    if Successed then
    begin
      DeleteFile(FsName);
      RenameFile(FtName,FsName);
    end;
    Sleep(1000);
    CheckOpFile(Edit_FileName.Text);
  end;
end;

procedure TForm1.Button_GoClick(Sender: TObject);
var
  hThread:Thandle;
  ThreadID:DWord;
begin
  if not FileExists(Edit_FileName.Text) then
  begin
    Label_Msg.Caption:=Error_FileNotExists;
    exit;
  end;
  if Edit_Pass.Text='' then
  begin
    Label_Msg.Caption:=Error_NoPass;
    exit;
  end;
  if Edit_Pass.Text<>Edit_Pass1.Text then
  begin
    Label_Msg.Caption:=Error_PassNotSame;
    exit;
  end;

  hThread:=CreateThread(nil,0,@LockFile,nil,0,ThreadID);
  if hThread=0 then Label_Msg.Caption:=Error_Thread;
end;

procedure TForm1.Button_ExitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Button_OpenFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Edit_FileName.Text:=OpenDialog1.FileName;
    CheckOpFile(Edit_FileName.Text);
  end;
end;

procedure TForm1.Button_AboutClick(Sender: TObject);
begin
  Application.CreateForm(Tfrm_about, frm_about);
  frm_about.ShowModal;
end;

procedure TForm1.Button_UnGoClick(Sender: TObject);
var
  hThread:THandle;
  ThreadID:DWord;
begin
  if not FileExists(Edit_FileName.Text) then
  begin
    Label_Msg.Caption:=Error_FileNotExists;
    exit;
  end;
  if Edit_Pass.Text='' then
  begin
    Label_Msg.Caption:=Error_NoPass;
    exit;
  end;
  if CheckTimes>=3 then
  begin
    Close;
  end else
  begin
    hThread:=CreateThread(nil,0,@UnLockFile,nil,0,ThreadID);
    if hThread=0 then Label_Msg.Caption:=Error_Thread;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { enable dragfile }
  DragAcceptFiles(Handle, True);

  CheckTimes:=1;
end;

procedure TForm1.Button_DirectoryClick(Sender: TObject);
var
  SDirectory:String;
begin
  if not FileExists(Edit_FileName.Text) then
  begin
    Label_Msg.Caption:=Error_FileNotExists;
    exit;
  end;
  SDirectory:=ExtractFilePath(Edit_FileName.Text);
  ShellExecute(Handle,nil,PChar(SDirectory),nil,nil,SW_SHOWNORMAL);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not Button_Exit.Enabled then CanClose:=False;
end;

procedure TForm1.DoLock;
var
  DoFileName:String;
begin
  DoFileName:=ExtractFileName(Edit_FileName.Text);
  Label_Msg.Caption:=Format(Msg_DoLock,[DoFileName]);
  Button_UnGo.Enabled:=False;
end;

procedure TForm1.DoUnLock;
var
  DoFileName:String;
begin
  DoFileName:=ExtractFileName(Edit_FileName.Text);
  Label_Msg.Caption:=Format(Msg_DoUnLock,[DoFileName]);
  Button_Go.Enabled:=False;
  Edit_Pass1.Enabled:=False;
  CheckBox_BackUp.Enabled:=False;
  StaticText_Pass1.Enabled:=False;
end;

procedure TForm1.CheckOpFile(FileName:String);
var
  iOpFile:Integer;
  GetFlag,Flag:String[7];
  LockedFile:record
    Name:ShortString;
    Size:Integer;
    PassWord:String[15];
    Encrypted:Boolean;
  end;
  FileExt:String;
  FileAttr:Integer;
begin
  ResetForm;
  Flag:='@@#%#@@';
  FileExt:=ExtractFileExt(FileName);
  if StrUpper(PChar(FileExt))<>'.EXE' then
  begin
    label_Msg.Caption:=Format(Error_FileType,[ExtractFileName(FileName)]);
    Sleep(1000);
  end;
  FileAttr:=FileGetAttr(FileName);
  if FileAttr and faReadOnly>0 then
  begin
    label_Msg.Caption:=Format(Error_FileAttribute,[ExtractFileName(FileName)]);
    Label_Msg.Hint:=Label_Msg.Caption;
    exit;
  end;
  try
    iOpFile:=FileOpen(FileName,fmOpenRead);
    FileSeek(iOpFile,-SizeOf(Flag),soFromEnd);
    FileRead(iOpFile,GetFlag,SizeOf(GetFlag));
    if GetFlag=Flag then
    begin
      DoUnLock;
    end else
    begin
      DoLock;
    end;
    Label_Msg.Hint:=Label_Msg.Caption;
  finally
    FileClose(iOpFile);
  end;
end;

procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
  CFileName: array[0..MAX_PATH] of Char;
begin
  try
    if DragQueryFile(Msg.Drop,0,CFileName,MAX_PATH)>0 then
    begin
      Edit_FileName.Text:=CFileName;
      CheckOpFile(CFileName);
    end;
  finally
    DragFinish(Msg.Drop);
  end;
end;

procedure TForm1.Edit_FileNameChange(Sender: TObject);
begin
  Edit_FileName.Hint:=Edit_FileName.Text;
end;

end.