lock_main.pas
上传用户:zhkydz
上传日期:2013-04-26
资源大小:44k
文件大小:14k
- 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.