lock_dialog.pas
上传用户:zhkydz
上传日期:2013-04-26
资源大小:44k
文件大小:6k
- 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
- +'邮 箱:mantousoft@sina.com',
- mtCustom,[mbOk],0)
- else
- inherited;
- end;
- end;
- end.