main.pas

EXE文件加密码,ASP压缩处理.比较实用,大家拿去

    S.Free;
    T.Free;
    C.Free;
  end;
end;

procedure Tfrm_Main.StatusText(sMsg_Error:String);
begin
  StatusBar1.Panels[1].Text:=sMsg_Error;
end;

function LockFile(P:pointer):Longint;stdcall;
begin
  with frm_Main do
  begin
    BuzyForm;
    StatusText(Msg_BeginLock);
    LockFileStream(sOpFileName,CheckBox_BackUp.Checked);
    StatusText(Msg_EndLock);
    CheckOpFile(sOpFileName);
  end;
  Result:=-1;
end;

function UnLockFile(P:pointer):Longint;stdcall;
begin
  with frm_Main do
  begin
    BuzyForm;
    StatusText(Msg_BeginUnLock);
    UnLockFileStream(sOpFileName,sPassWord);
    StatusText(Msg_EndUnLock);
    CheckOpFile(sOpFileName);
  end;
  Result:=-1;
end;

procedure Tfrm_Main.Button_GoClick(Sender: TObject);
var
  hThread:Thandle;
  ThreadID:DWord;
begin
  if not FileExists(Edit_FileName.Text) then
  begin
    MessageBox(Handle,Error_FileNotExists,'信息',MB_OK);
    exit;
  end;
  if Edit_Pass.Text='' then
  begin
    MessageBox(Handle,Error_NoPass,'信息',MB_OK);
    exit;
  end;
  if Edit_Pass.Text<>Edit_Pass1.Text then
  begin
    MessageBox(Handle,Error_PassNotSame,'信息',MB_OK);
    exit;
  end;
  if Edit_Caption.Text='' then
  begin
    Edit_Caption.Text:=Msg_DefaultCaption;
  end;

  sOpFileName:=Edit_FileName.Text;
  sPassWord:=Edit_Pass.Text;
  sCaption:=Edit_Caption.Text;
  hThread:=CreateThread(nil,0,@LockFile,nil,0,ThreadID);
  if hThread=0 then LockFile(nil);  { not use thread }
end;

procedure Tfrm_Main.Btn_ExitClick(Sender: TObject);
begin
  Close;
end;

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

procedure Tfrm_Main.Button_UnGoClick(Sender: TObject);
var
  hThread:THandle;
  ThreadID:DWord;
begin
  if not FileExists(Edit_FileName.Text) then
  begin
    MessageBox(Handle,Error_FileNotExists,'信息',MB_OK);
    exit;
  end;
  if Edit_Pass.Text='' then
  begin
    MessageBox(Handle,Error_NoPass,'信息',MB_OK);
    exit;
  end;
  
  sOpFileName:=Edit_FileName.Text;
  sPassWord:=Edit_Pass.Text;
  hThread:=CreateThread(nil,0,@UnLockFile,nil,0,ThreadID);
  if hThread=0 then UnLockFile(nil);
end;

procedure Tfrm_Main.FormCreate(Sender: TObject);
begin
  { check need password }
  if NeedPass(True,False) then
  begin
    frm_Login:=Tfrm_Login.Create(Application);
    frm_Login.ShowModal;
  end;
  { enable dragfile }
  DragAcceptFiles(Handle, True);
  if (ParamCount>0)and(ParamStr(1)<>'') then
  begin
    Edit_FileName.Text:=ParamStr(1);
    CheckOpFile(ParamStr(1));
  end;
  { check sth. }
  cb_Assoc.Checked:=AssocExeFile(True,True,AssocString);
  cb_NeedPass.Checked:=NeedPass(True,True);
  rb_Comp.Checked:=GetCompress(True,True);
  rb_Speed.Checked:=not rb_Comp.Checked;
  { initialize size }
  Constraints.MinHeight:=Height;
  Constraints.MinWidth:=Width;
  Edit_Caption.Text:=Msg_DefaultCaption;
  Edit_Pass.MaxLength:=PassSize;
  Edit_Pass1.MaxLength:=PassSize;
  lb_Ver.Caption:=Ver;
  StatusText(Msg_Ready);
end;

procedure Tfrm_Main.Button_DirectoryClick(Sender: TObject);
var
  SDirectory:String;
begin
  if not FileExists(Edit_FileName.Text) then
  begin
    MessageBox(Handle,Error_FileNotExists,'信息',MB_OK);
    exit;
  end;
  SDirectory:=ExtractFilePath(Edit_FileName.Text);
  ShellExecute(Handle,nil,PChar(SDirectory),nil,nil,SW_SHOWNORMAL);
end;

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

procedure Tfrm_Main.DoLock;
begin
  StatusText(Msg_DoLock);
  Button_UnGo.Enabled:=False;
  Button_Go.Default:=True;
end;

procedure Tfrm_Main.DoUnLock;
begin
  StatusText(Msg_DoUnLock);
  Button_Go.Enabled:=False;
  Button_UnGo.Default:=True;
  Button_Preview.Enabled:=False;
  Edit_Pass1.Enabled:=False;
  Edit_Caption.Enabled:=False;
  CheckBox_BackUp.Enabled:=False;
  StaticText_Pass1.Enabled:=False;
  StaticText_Caption.Enabled:=False;
end;

procedure Tfrm_Main.CheckOpFile(FileName:String);
var
  iOpFile:Integer;
  LockedFile:TLockedFile;
  FileAttr:Integer;
begin
  ResetForm;
  if CompareText(ExtractFileExt(FileName),'.lnk')=0 then
  begin
    FileName:=GetShortcutTarget(FileName);
    Edit_FileName.Text:=FileName;
  end;
  if CompareText(ExtractFileExt(FileName),'.exe')<>0 then
    MessageBox(Handle,Error_FileType,'警告',MB_OK);

  FileAttr:=FileGetAttr(FileName);
  if FileAttr and faReadOnly>0 then
  begin
    if MessageBox(Handle,Error_FileAttribute,'信息',MB_YESNO)=IDNO then
    begin
      Edit_FileName.Text:='';
      exit;
    end else
      FileSetAttr(FileName,FileAttr - faReadOnly);
  end;

  iOpFile:=FileOpen(FileName,fmOpenRead);
  try
    FileSeek(iOpFile,-SizeOf(LockedFile),2);
    FileRead(iOpFile,LockedFile,SizeOf(LockedFile));
    if LockedFile.Flag=CFlag then
    begin
      DoUnLock;
    end else
    begin
      DoLock;
    end;
  finally
    FileClose(iOpFile);
  end;
end;

procedure Tfrm_Main.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(Edit_FileName.Text);
    end;
  finally
    DragFinish(Msg.Drop);
  end;
end;

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

procedure Tfrm_Main.emailClick(Sender: TObject);
begin
  ShellExecute(Self.Handle,'Open',PChar('mailto:[e-mail]?Subject=关于EXE文件加密器'),nil,nil,1);
end;

procedure Tfrm_Main.homepageClick(Sender: TObject);
begin
  ShellExecute(Self.Handle,'Open',PChar('http://www.2ccc.com'),nil,nil,1);
end;

procedure Tfrm_Main.updateClick(Sender: TObject);
begin
  ShellExecute(Self.Handle,'Open',PChar('http://www.2ccc.com/downloads'),nil,nil,1);
end;

procedure Tfrm_Main.btn_ApplyClick(Sender: TObject);
begin
  AssocExeFile(False,cb_Assoc.Checked,AssocString);
  NeedPass(False,cb_NeedPass.Checked);
  GetCompress(False,rb_Comp.Checked);
  btn_Apply.Enabled:=False;
end;

procedure Tfrm_Main.Button_PreviewClick(Sender: TObject);
begin
  Application.CreateForm(Tfrm_Preview, frm_Preview);
  if Edit_Caption.Text='' then
    Edit_Caption.Text:=Msg_DefaultCaption;
  sCaption:=Edit_Caption.Text;
  if FileExists(Edit_FileName.Text) then
  begin
    frm_Preview.Icon.Handle:=ExtractIcon(Application.Handle,PChar(Edit_FileName.Text),0);
  end;
  frm_Preview.Label1.Caption:=sCaption;
  frm_Preview.ShowModal;
end;

procedure Tfrm_Main.Button1Click(Sender: TObject);
begin
  Application.CreateForm(Tfrm_PassWord, frm_PassWord);
  frm_PassWord.ShowModal;
end;

procedure Tfrm_Main.cb_OptionClick(Sender: TObject);
begin
  btn_Apply.Enabled:=True;
end;

end.