lock_dialog.pas

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

unit lock_dialog;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, TFlatEditUnit, TFlatButtonUnit, Buttons, ShellAPI;
                    
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TFlatButton;
    Button2: TFlatButton;
    Edit1: TFlatEdit;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    OpFileName:String;
    CheckTimes:Byte;
    procedure WMSysCommand(var Message: TWMSysCommand); message wm_SysCommand;
    procedure RunLockFile(FileName: String);
    { Private declarations }
  public
    { Public declarations }
  end;

const
  Error_Thread='程序内部错误，系统可能不对。';
  Error_PassWrong='密码错误，还有0%d次操作机会。';
  Error_Flag='加密标志错误，文件已经损坏。';

  cm_About=$00A0;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function WinExecAndWait32(FileName:String;Visibility:Integer):Cardinal;
var
  WorkDir:String;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  GetDir(0,WorkDir);
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    PChar(FileName),               { pointer to command line string }
    nil,                           { pointer to process security attributes }
    nil,                           { pointer to thread security attributes }
    True,                          { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    PChar(WorkDir),                { pointer to current directory name, PChar}
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo)                   { pointer to PROCESS_INF }
    then Result := INFINITE {-1} else
  begin
    Application.MainForm.Hide;
    SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
    Application.ProcessMessages;
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Result);
    CloseHandle(ProcessInfo.hProcess);  { to prevent memory leaks }
    CloseHandle(ProcessInfo.hThread);
    Application.MainForm.Close;         { exit application }
  end;
end;

procedure TForm1.RunLockFile(FileName:String);
  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
  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;
begin
  Flag:='@@#%#@@';
  try
    iSourceFile:=FileOpen(FileName,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(Edit1.Text) then
      begin
        FileStart:=LockedFile.Size+SizeOf(Flag);
        FileEnd:=SizeOf(LockedFile)+SizeOf(Flag);
        OpFileName:=LockedFile.Name+'_';
        try
          iTargetFile:=FileCreate(OpFileName);
          FileSeek(iSourceFile,-FileStart,soFromEnd);
          repeat
            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);
          FileSetAttr(OpFileName,faHidden);
        finally
          FileClose(iTargetFile);
        end;
        if ParamStr(1)<>#0 then OpFileName:=OpFileName+' '+ParamStr(1);
        WinExecAndWait32(OpFileName,SW_SHOWNORMAL);
      end else
      begin
        if CheckTimes>=3 then
        begin
          FileClose(iSourceFile);
          Close;
        end else
        begin
          inc(CheckTimes);
          Label1.Caption:=Format(Error_PassWrong,[4-CheckTimes]);
          Edit1.Text:='';
        end;
      end;
    end else Label1.Caption:=Error_Flag;
  finally
    FileClose(iSourceFile);
  end;
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunLockFile(Application.ExeName);
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=13 then Button1Click(Sender);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  MyMenu:HMenu;
begin
  MyMenu:=GetSystemMenu(Handle,False);
  AppendMenu(MyMenu,MF_STRING,cm_About,'关于(&A)');

  CheckTimes:=1;
  OpFileName:=Format(' %s',[ExtractFileName(ParamStr(0))]);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FileExists(OpFileName) then DeleteFile(OpFileName);
end;

procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
  case Message.CmdType of
    cm_About:MessageDlg('作  者：万  重  -  版  本：1.62'+#13
                       +'主  页：mantousoft.51.net'+#13
                       +'邮  箱：[e-mail]',
                       mtCustom,[mbOk],0)
  else
    inherited;
  end;
end;

end.