lock_dialog.pas
上传用户:zhkydz
上传日期:2013-04-26
资源大小:44k
文件大小:6k
源码类别:

破解

开发平台:

Asm

  1. unit lock_dialog;
  2. interface
  3. uses
  4.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  5.   ExtCtrls, StdCtrls, TFlatEditUnit, TFlatButtonUnit, Buttons, ShellAPI;
  6.                     
  7. type
  8.   TForm1 = class(TForm)
  9.     Label1: TLabel;
  10.     Button1: TFlatButton;
  11.     Button2: TFlatButton;
  12.     Edit1: TFlatEdit;
  13.     procedure Button2Click(Sender: TObject);
  14.     procedure Button1Click(Sender: TObject);
  15.     procedure Edit1KeyDown(Sender: TObject; var Key: Word;
  16.       Shift: TShiftState);
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  19.   private
  20.     OpFileName:String;
  21.     CheckTimes:Byte;
  22.     procedure WMSysCommand(var Message: TWMSysCommand); message wm_SysCommand;
  23.     procedure RunLockFile(FileName: String);
  24.     { Private declarations }
  25.   public
  26.     { Public declarations }
  27.   end;
  28. const
  29.   Error_Thread='程序内部错误,系统可能不对。';
  30.   Error_PassWrong='密码错误,还有0%d次操作机会。';
  31.   Error_Flag='加密标志错误,文件已经损坏。';
  32.   cm_About=$00A0;
  33. var
  34.   Form1: TForm1;
  35. implementation
  36. {$R *.DFM}
  37. function WinExecAndWait32(FileName:String;Visibility:Integer):Cardinal;
  38. var
  39.   WorkDir:String;
  40.   StartupInfo: TStartupInfo;
  41.   ProcessInfo: TProcessInformation;
  42. begin
  43.   GetDir(0,WorkDir);
  44.   FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  45.   StartupInfo.cb := Sizeof(StartupInfo);
  46.   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  47.   StartupInfo.wShowWindow := Visibility;
  48.   if not CreateProcess(nil,
  49.     PChar(FileName),               { pointer to command line string }
  50.     nil,                           { pointer to process security attributes }
  51.     nil,                           { pointer to thread security attributes }
  52.     True,                          { handle inheritance flag }
  53.     CREATE_NEW_CONSOLE or          { creation flags }
  54.     NORMAL_PRIORITY_CLASS,
  55.     nil,                           { pointer to new environment block }
  56.     PChar(WorkDir),                { pointer to current directory name, PChar}
  57.     StartupInfo,                   { pointer to STARTUPINFO }
  58.     ProcessInfo)                   { pointer to PROCESS_INF }
  59.     then Result := INFINITE {-1} else
  60.   begin
  61.     Application.MainForm.Hide;
  62.     SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
  63.     Application.ProcessMessages;
  64.     WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
  65.     GetExitCodeProcess(ProcessInfo.hProcess, Result);
  66.     CloseHandle(ProcessInfo.hProcess);  { to prevent memory leaks }
  67.     CloseHandle(ProcessInfo.hThread);
  68.     Application.MainForm.Close;         { exit application }
  69.   end;
  70. end;
  71. procedure TForm1.RunLockFile(FileName:String);
  72.   function jjm(S:String):String;
  73.   var
  74.     i:Byte;
  75.   begin
  76.     for i:=1 to Length(S) do
  77.       S[i]:=Char(ord(S[i]) xor (i+3));
  78.     jjm:=S;
  79.   end;
  80. var
  81.   iSourceFile,iTargetFile:Integer;
  82.   NumRead,NumWritten:Integer;
  83.   MyBuf:packed array[0..2047]of Char;
  84.   GetFlag,Flag:String[7];
  85.   LockedFile:record
  86.     Name:ShortString;
  87.     Size:Integer;
  88.     PassWord:String[15];
  89.     Encrypted:Boolean;
  90.   end;
  91.   FileStart,FileEnd:Integer;
  92. begin
  93.   Flag:='@@#%#@@';
  94.   try
  95.     iSourceFile:=FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  96.     FileSeek(iSourceFile,-SizeOf(Flag),soFromEnd);
  97.     FileRead(iSourceFile,GetFlag,SizeOf(GetFlag));
  98.     if GetFlag=Flag then
  99.     begin
  100.       FileSeek(iSourceFile,-Sizeof(LockedFile)-SizeOf(Flag),soFromEnd);
  101.       FileRead(iSourceFile,LockedFile,SizeOf(LockedFile));
  102.       if LockedFile.PassWord=jjm(Edit1.Text) then
  103.       begin
  104.         FileStart:=LockedFile.Size+SizeOf(Flag);
  105.         FileEnd:=SizeOf(LockedFile)+SizeOf(Flag);
  106.         OpFileName:=LockedFile.Name+'_';
  107.         try
  108.           iTargetFile:=FileCreate(OpFileName);
  109.           FileSeek(iSourceFile,-FileStart,soFromEnd);
  110.           repeat
  111.             NumRead:=FileRead(iSourceFile,MyBuf,SizeOf(MyBuf));
  112.             if NumRead=SizeOf(MyBuf)then
  113.               NumWritten:=FileWrite(iTargetFile,MyBuf,NumRead) else
  114.               NumWritten:=FileWrite(iTargetFile,MyBuf,NumRead-FileEnd);
  115.           until (NumRead=0) or (NumWritten<>NumRead);
  116.           FileSetAttr(OpFileName,faHidden);
  117.         finally
  118.           FileClose(iTargetFile);
  119.         end;
  120.         if ParamStr(1)<>#0 then OpFileName:=OpFileName+' '+ParamStr(1);
  121.         WinExecAndWait32(OpFileName,SW_SHOWNORMAL);
  122.       end else
  123.       begin
  124.         if CheckTimes>=3 then
  125.         begin
  126.           FileClose(iSourceFile);
  127.           Close;
  128.         end else
  129.         begin
  130.           inc(CheckTimes);
  131.           Label1.Caption:=Format(Error_PassWrong,[4-CheckTimes]);
  132.           Edit1.Text:='';
  133.         end;
  134.       end;
  135.     end else Label1.Caption:=Error_Flag;
  136.   finally
  137.     FileClose(iSourceFile);
  138.   end;
  139. end;
  140. procedure TForm1.Button2Click(Sender: TObject);
  141. begin
  142.   Close;
  143. end;
  144. procedure TForm1.Button1Click(Sender: TObject);
  145. begin
  146.   RunLockFile(Application.ExeName);
  147. end;
  148. procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  149.   Shift: TShiftState);
  150. begin
  151.   if Key=13 then Button1Click(Sender);
  152. end;
  153. procedure TForm1.FormCreate(Sender: TObject);
  154. var
  155.   MyMenu:HMenu;
  156. begin
  157.   MyMenu:=GetSystemMenu(Handle,False);
  158.   AppendMenu(MyMenu,MF_STRING,cm_About,'关于(&A)');
  159.   CheckTimes:=1;
  160.   OpFileName:=Format(' %s',[ExtractFileName(ParamStr(0))]);
  161. end;
  162. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  163. begin
  164.   if FileExists(OpFileName) then DeleteFile(OpFileName);
  165. end;
  166. procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
  167. begin
  168.   case Message.CmdType of
  169.     cm_About:MessageDlg('作  者:万  重  -  版  本:1.62'+#13
  170.                        +'主  页:mantousoft.51.net'+#13
  171.                        +'邮  箱:mantousoft@sina.com',
  172.                        mtCustom,[mbOk],0)
  173.   else
  174.     inherited;
  175.   end;
  176. end;
  177. end.