⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 本代码实现在bmp中隐藏文件的功能
💻 PAS
字号:
unit Main;

interface

uses
  Windows, Messages, SysUtils,Controls, Forms,
  Dialogs,  jpeg, ComCtrls, StdCtrls, Buttons, Gauges,shellapi,
  Classes, ExtCtrls;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    stPushBMP: TStaticText;
    stPushFile: TStaticText;
    TabSheet3: TTabSheet;
    OpenDialog1: TOpenDialog;
    stExtractBMP: TStaticText;
    sbPushStart: TSpeedButton;
    sbPushExit: TSpeedButton;
    sbExtractStart: TSpeedButton;
    sbExtractExit: TSpeedButton;
    StatusBar1: TStatusBar;
    Gauge1: TGauge;
    plPsw: TPanel;
    sbPswOk: TSpeedButton;
    sbPswExit: TSpeedButton;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Panel1: TPanel;
    cbCreateBMPBak: TCheckBox;
    cbDelAftHide: TCheckBox;
    SpeedButton1: TSpeedButton;
    Bevel5: TBevel;
    editPswInput: TEdit;
    editPswConfirm: TEdit;
    GroupBox2: TGroupBox;
    sbPushBMPOpen: TSpeedButton;
    sbPushFileOpen: TSpeedButton;
    Label6: TLabel;
    Label7: TLabel;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    sbExtractOpen: TSpeedButton;
    GroupBox4: TGroupBox;
    rbDefault: TRadioButton;
    rbEraseHideFile: TRadioButton;
    rbDelBMP: TRadioButton;
    Image1: TImage;
    L1: TLabel;
    Label3: TLabel;
    L2: TLabel;
    L3: TLabel;
    L4: TLabel;
    L5: TLabel;
    Timer1: TTimer;
    LMail: TLabel;
    plExtractPsw: TPanel;
    GroupBox5: TGroupBox;
    editExtractPsw: TEdit;
    sbExtractPswOK: TSpeedButton;
    sbExtractPswExit: TSpeedButton;
    procedure sbPushBMPOpenClick(Sender: TObject);
    procedure sbPushFileOpenClick(Sender: TObject);
    procedure sbExtractOpenClick(Sender: TObject);
    procedure sbPushExitClick(Sender: TObject);
    procedure sbPushStartClick(Sender: TObject);
    procedure sbExtractStartClick(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure sbPswExitClick(Sender: TObject);
    procedure sbPswSetClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure editPswInputExit(Sender: TObject);
    procedure editPswInputKeyPress(Sender: TObject; var Key: Char);
    procedure sbPswOkClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure LMailClick(Sender: TObject);
    procedure sbExtractPswExitClick(Sender: TObject);
    procedure sbExtractPswOKClick(Sender: TObject);
    procedure editExtractPswKeyPress(Sender: TObject; var Key: Char);
    procedure editPswConfirmKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Psw:string;

implementation

uses unitClassExtract, unitClassPush;

{$R *.dfm}

procedure TForm1.sbPushBMPOpenClick(Sender: TObject);
var
  myPush:TPush;
begin
  OpenDialog1.Filter :='BMP Files (*.bmp)|*.bmp';
  if OpenDialog1.Execute then
  begin
    myPush:=Tpush.create;  //注意这里!!!
    myPush.BMPName:=Opendialog1.FileName;
    if myPush.Validate then
    begin
      stPushBMP.Caption := OpenDialog1.FileName;
      if canvas.TextWidth(OpenDialog1.FileName) > stPushBMP.Width then
      begin
        stPushBMP.ShowHint:=true;
        stPushBMP.Hint:=OpenDialog1.FileName;
      end;
      Statusbar1.Panels[0].Text:='BMP:'+inttostr(myPush.BMPSize)+'K';
      Statusbar1.Panels[0].Width:=canvas.TextWidth(Statusbar1.Panels[0].Text);
      Statusbar1.Panels[1].Text:='可隐藏:'+inttostr(myPush.MaxHideFileSize)+'K';
      Statusbar1.Panels[1].Width:=canvas.TextWidth(Statusbar1.Panels[1].Text);
      Gauge1.Width:=Statusbar1.Width-Statusbar1.Panels[1].Width-Statusbar1.Panels[0].Width;
    end else
    begin
      showmessage('对不起,本版本目前还只支持24位真彩色的bmp文件,请重新选择24位的bmp文件');
    end;
  end;
end;

procedure TForm1.sbPushFileOpenClick(Sender: TObject);
begin
  opendialog1.Filter :='All Files (*.*)|*.*';
  if OpenDialog1.Execute then begin
    stPushFile.Caption  := OpenDialog1.FileName;
    if canvas.TextWidth(OpenDialog1.FileName) > stPushFile.Width then
      stPushBMP.Hint:=OpenDialog1.FileName;
  end;
end;

procedure TForm1.sbExtractOpenClick(Sender: TObject);
var
  myExtract: TExtract;
begin
  OpenDialog1.Filter :='BMP File(*.bmp)|*.bmp';
  if OpenDialog1.Execute then
  begin
    myExtract:=TExtract.create;
    myExtract.BMPName:=OpenDialog1.FileName;

    //如果所选文件中没有隐藏文件
    if not myExtract.Validate then
    begin
      showmessage('对不起,此bmp文件中并没有隐藏文件,请重新选择!!!');
      stExtractBMP.Caption:='';
      exit;
    end;

    stExtractBMP.Caption:= OpenDialog1.FileName;
    if canvas.TextWidth(OpenDialog1.FileName) > stPushBMP.Width then
    begin
      stPushBMP.ShowHint:=true;
      stPushBMP.Hint:=OpenDialog1.FileName;
    end;
    
    Statusbar1.Panels[0].Text:='BMP:'+inttostr(myExtract.BMPSize)+'K';
    Statusbar1.Panels[0].Width:=canvas.TextWidth(Statusbar1.Panels[0].Text);
    if myExtract.UsePassword then
      Statusbar1.Panels[1].Text:='密码保护:有'
    else
      Statusbar1.Panels[1].Text:='密码保护:无';
    Statusbar1.Panels[1].Width:=canvas.TextWidth(Statusbar1.Panels[1].Text);
    Gauge1.Width:=Statusbar1.Width-Statusbar1.Panels[1].Width-Statusbar1.Panels[0].Width;
  end;
end;

procedure TForm1.sbPushExitClick(Sender: TObject);
begin
  application.Terminate ;
end;

procedure TForm1.sbPushStartClick(Sender: TObject);
var
  myPush:TPush;
begin
  if stPushFile.Caption = '' then begin
    showmessage('请选择想要隐藏的文件!!!');
    exit;
  end;
  if stPushBMP.Caption = ''  then begin
    showmessage('请选择BMP格式的图片文件!!!');       
    exit;
  end;

try
  try
  myPush:=TPush.create;
  myPush.BMPName:=stPushBMP.Caption;
  myPush.FileName:=stPushFile.Caption;

  //先判断bmp中是否已有隐藏文件
  if myPush.FileHided then
    if messagedlg('此bmp文件中已有隐藏文件,要覆盖吗?',mtConfirmation,[mbYes, mbNo], 0) = mrNO then
    begin
      stPushBMP.Caption:= '';
      stPushFile.Caption:='';
      Statusbar1.Panels[0].Text:='';
      Statusbar1.Panels[1].Text:='';
      exit;
    end;

  //判断需隐藏的文件能否放入bmp中
  if not myPush.IsFileCanBePushed(PUSH_NORMAL) then
  begin
    showmessage('对不起,您要隐藏的文件太大了,您可先对其进行压缩,然后再进行隐藏操作!');
    stPushFile.Caption := '';
    exit;
  end;

  //要进行密码设置吗?
  if Psw <> '' then
  begin
    myPush.Password:=Psw;
  end;

  //开始隐藏
  myPush.GaugeInstance:=Gauge1;
  if cbCreateBMPBak.Checked = true then myPush.BMPBackup;
  myPush.Push;

  //隐藏后是否删除原文件  ???
  if cbDelAftHide.Checked=true then
    myPush.DelHidedFile;

  messagebox(handle,'   :) 隐藏成功!    ','eulb''s   魔法BMP',MB_OK or MB_ICONINFORMATION);
except
  on E:Exception do
    windows.messagebox(handle,pchar(E.Message),'error!',MB_OK or MB_ICONEXCLAMATION);
end;
finally
  stPushFile.Caption:= '';
  stPushBMP.Caption:= '';
  Statusbar1.Panels[0].Text:='';
  Statusbar1.Panels[1].Text:='';
end;
end;

procedure TForm1.sbExtractStartClick(Sender: TObject);
var
  myExtract:TExtract;
begin
  if stExtractBMP.Caption = '' then begin
    showmessage('请选择bmp文件!!!');
    exit;
  end;

  try
    myExtract:=TExtract.create;
    myExtract.BMPName:=stExtractBMP.Caption;
    if myExtract.UsePassword then
    begin
      PageControl1.Enabled:=false;
      plExtractPsw.Visible:=true;
      editExtractPsw.SetFocus;
    end else
    begin
      myExtract.GaugeInstance:=Gauge1;
      myExtract.OpenDialog:=OpenDialog1;
      myExtract.Extract;
    end;
  except
    on E:Exception do
    begin
      Windows.MessageBox(handle,pchar(E.Message),'error!!!',MB_OK or MB_ICONEXCLAMATION);
      stExtractBMP.Caption:='';
    end;
  end;
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  Gauge1.Parent:=StatusBar1;
  Gauge1.Left:=Rect.Left;
  Gauge1.Top:=Rect.Top;
  Gauge1.Height:=Rect.Bottom-Rect.Top;
  Gauge1.Visible :=false;
end;

procedure TForm1.sbPswExitClick(Sender: TObject);
begin
  plPsw.Visible :=false;
  PageControl1.Enabled:=true;
end;

procedure TForm1.sbPswSetClick(Sender: TObject);
begin
  plPsw.Visible :=true;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  plPsw.Visible:=true;
  editPswInput.Text:='';
  editPswConfirm.Text:='';
  editPswInput.SetFocus;
  PageControl1.Enabled:=false;
end;

procedure TForm1.editPswInputExit(Sender: TObject);
begin
  if length(editPswInput.Text) > 6 then begin
    showmessage('对不起,密码最长为6位');
    editPswInput.Text:='';
    editPswInput.SetFocus;
  end;
end;

procedure TForm1.editPswInputKeyPress(Sender: TObject; var Key: Char);
begin
  if ((ord(Key)< 48) or (ord(Key)>122) or ((ord(Key)>57) and (ord(Key)<65)) or
       ((ord(Key)>90) and (ord(Key)<97))) and (ord(key)<> 8) then
    Key:=#0;   //8代表Del
end;

procedure TForm1.sbPswOkClick(Sender: TObject);
begin
  if Trim(editPswInput.Text)='' then
  begin
    showmessage('   请输入密码!!!   ');
    exit;
  end;
  if Trim(editPswConfirm.Text)='' then
  begin
    showmessage('   请确认密码!!!   ');
    exit;
  end;
  if Trim(editPswInput.Text) <> Trim(editPswConfirm.Text) then
  begin
    showmessage('密码输入有误,请重试!!!');
    editPswInput.Text:='';
    editPswConfirm.Text:='';
    editPswInput.SetFocus;
    exit;
  end;
  Psw:=editPswInput.Text;
  plPsw.Visible:=false;
  PageControl1.Enabled:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Psw:='';
  PageControl1.ActivePageIndex:=0;
  plPsw.Left:=64;
  plPsw.Top:=32;
  plExtractPsw.Left:=32;
  plExtractPsw.Top:=24;
  plExtractPsw.Parent:=form1;
end;



procedure TForm1.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePageIndex=2 then
  begin
    Image1.Top:=167;
    L1.Top:=167;
    L2.Top:=16+167;
    L3.Top:=32+167;
    L4.Top:=48+167;
    L5.Top:=64+167;
    Timer1.Enabled:=true;
    LMail.Visible:=false;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled:=false;
  Image1.Top:=Image1.Top-10;
  L1.Top:=L1.Top-10;
  L2.Top:=L2.Top-10;
  L3.Top:=L3.Top-10;
  L4.Top:=L4.Top-10;
  L5.Top:=L5.Top-10;
  if L1.Top<13 then
  begin
    LMail.Visible:=true;
    exit;
  end;
  Timer1.Enabled:=true;
end;

procedure TForm1.LMailClick(Sender: TObject);
begin
  try
    ShellExecute(
    handle,
    nil,
    'mailto:eulb@sohu.com',
    nil,
    nil,
    SW_SHOWDEFAULT);
  except
    on E:Exception do
    messagebox(handle,pchar(E.Message),'error!!!',MB_OK+MB_ICONEXCLAMATION);
  end;
end;

procedure TForm1.sbExtractPswExitClick(Sender: TObject);
begin
  plExtractPsw.Visible:=false;
  PageControl1.Enabled:=true;
end;

procedure TForm1.sbExtractPswOKClick(Sender: TObject);
var
  myExtract:TExtract;
begin
  myExtract:=TExtract.create;
  myExtract.BMPName:=stExtractBMP.Caption;
  if Trim(editExtractPsw.Text) = myExtract.GetPassword then
  begin
    try
      try
        editExtractPsw.Text:='';
        plExtractPsw.Visible:=false;
        myExtract.GaugeInstance:=Gauge1;
        myExtract.OpenDialog:=OpenDialog1;
        if myExtract.Extract then  //执行成功
        begin
          if rbEraseHideFile.Checked = true then
            myExtract.EraseHiddenFile;
          if rbDelBMP.Checked = true then
            myExtract.DelBMP;
          messagebox(handle,'   :) 提取成功!    ','eulb''s   魔法BMP',MB_OK or MB_ICONINFORMATION);
        end;
      except
        on E:Exception do
        begin
          Windows.MessageBox(form1.handle,pchar(E.Message),'error!!!',MB_OK or MB_ICONEXCLAMATION);
          sbExtractPswExit.Click;
        end;
      end;
    finally
      stExtractBMP.Caption:='';
      Statusbar1.Panels[0].Text:='';
      Statusbar1.Panels[1].Text:='';
      PageControl1.Enabled:=true;
    end;
  end else
  begin
    editExtractPsw.Text:='';
    showmessage('对不起,您的密码输入有错,请重试!!!');
    //stExtractBMP.Caption:='';
  end;
end;


procedure TForm1.editExtractPswKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = chr(13)) and (Length(editExtractPsw.Text) >= 1) then
  begin
    sbExtractPswOk.Click;
  end;
end;

procedure TForm1.editPswConfirmKeyPress(Sender: TObject; var Key: Char);
begin
  if Key=chr(13) then sbPswOK.Click;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -