unitclassextract.pas

本代码实现在bmp中隐藏文件的功能

{*******************************************************}
{                                                       }
{       eulB's 魔法BMP                                  }
{                                                       }
{       提取文件类                                      }
{                                                       }
{       2001年10月20日                                  }
{                                                       }
{*******************************************************}

unit unitClassExtract;

interface

uses
  windows,Gauges,unitClass,SysUtils,Dialogs;

const
  NONE_MOD=0;
  ONE_MOD=1; 
  TWO_MOD=2;

type
  TExtract=class(Tprocfunc)
    private
      FBMPName: string;
      FGauge: TGauge;
      FOpenDialog: TOpenDialog;
      procedure FExtract(filename: string;bmpname: string;pb: TGauge);
      procedure FExtract_Hi(filename: string;bmpname: string;pb: TGauge);
      procedure FBits2Bytes(bits: array of byte;var bytes: array of byte;Flag:integer);
      procedure FExtractFromRGB(var p_byte_bufs: array of byte;var f_bit_buf: byte;Flag: integer);
      procedure FSetBMPName(value: string);
      procedure FSetGauge(value: TGauge);
      procedure FSetOpenDialog(value: TOpenDialog);
      function  FGetPassword(bmpfile: string): string;
      function  FGetUsePassword: Boolean;
      function  FGetBMPSize: integer;
    public
      function Extract: Boolean;   //用来表示opendialog执行是否成功(即有无按取消键)
      function Validate :Boolean;  //所选文件中有隐藏文件吗？
      function GetPassword: string;
      procedure EraseHiddenFile;   //销毁BMP中隐藏的文件
      procedure DelBMP;            //删除已隐藏过文件的BMP
      constructor create;
    published
      property BMPName: string write FSetBMPName;
      property BMPSize: integer read FGetBMPSize;
      property UsePassword: Boolean read FGetUsePassword Default false;
      property GaugeInstance: TGauge write FSetGauge;
      property OpenDialog: TOpenDialog write FSetOpenDialog;
    end;

implementation
constructor TExtract.create;
begin
end;

procedure TExtract.FSetBMPName(value: string);
begin
  FBMPName:=value;
end;

procedure TExtract.FSetGauge(value: TGauge);
begin
  FGauge:=value;
end;

function  TExtract.FGetPassword(bmpfile: string): string;
var
  p: hfile;
  i: integer;
  psw_bit_bufs:  array[0..4] of byte;
  psw_byte_bufs,p_byte_bufs: array[0..3] of byte;
begin
  p:=_lopen(PChar(bmpfile),OF_READ);
  _llseek(p,strtoint(GetBMPInfo(bmpfile,BMPDataOffset)),0);
  for i:=0 to 3 do
  begin
    _lread(p,@p_byte_bufs,3);
    FExtractFromRGB(p_byte_bufs,psw_bit_bufs[i],NONE_MOD);
  end;
  FBits2Bytes(psw_bit_bufs,psw_byte_bufs,NONE_MOD);
  for i:=0 to 2 do result:=result+chr(psw_byte_bufs[i]);
  for i:=0 to 3 do
  begin
    _lread(p,@p_byte_bufs,3);
    FExtractFromRGB(p_byte_bufs,psw_bit_bufs[i],NONE_MOD);
  end;
  FBits2Bytes(psw_bit_bufs,psw_byte_bufs,NONE_MOD);
  for i:= 0 to 2 do result := result + chr(psw_byte_bufs[i]);
  result := Trim(result);
end;

function TExtract.GetPassword: string;
begin
  result:=FGetPassword(FBMPName);
end;

function  TExtract.FGetUsePassword: Boolean;
begin
  if GetBMPInfo(FBMPName,BMPFilePswAdded) = 'P' then
    result:=true
  else
    result:=false;
end;

procedure TExtract.FSetOpenDialog(value: TOpenDialog);
begin
  FOpenDialog:=value;
end;

function  TExtract.FGetBMPSize: integer;
begin
  result:=GetFileSize(FBMPName) div 1024;
end;

procedure TExtract.DelBMP;
begin
  DeleteFile(FBMPName);
end;

procedure TExtract.FExtract(filename: string;bmpname: string;pb: TGauge);
var
  i,file_len,len: Integer;
  f,b: hfile;
  byte_buf: byte;
  byte_bufs: array[0..7] of byte;
begin
  pb.MinValue :=0;
  b:=_lopen(pchar(bmpname),OF_READWRITE);
  f:=_lcreat(pchar(filename),0);
  len:=0;   

  //从图像头部偏移2处读取被隐藏文件长度
  _llseek(b,2,0);
  _lread(b,@file_len,4);

  //定位读写指针到图像的位图阵列+24处
  _llseek(b,strtoint(GetBMPInfo(bmpname,BMPDataOffset))+24,0);

  pb.MaxValue :=file_len;
  pb.Visible :=true;
  //开始读取
  while (len< file_len) do
  begin
    inc(len);
    pb.Progress :=len;
    byte_buf:=0;
    _lread(b,@byte_bufs,8);
    for i:=0 to 7 do
      if (byte_bufs[i] and 1 ) = 1 then
        byte_buf:= byte_buf or mask[i];
    _lwrite(f,@byte_buf,1);
  end;

  _lclose(f);
  _lclose(b);
  pb.Visible :=false;
end;

procedure TExtract.FBits2Bytes(bits: array of byte;var bytes: array of byte;Flag:integer);
begin
  case Flag of
    NONE_MOD:
    begin
      bytes[0]:=(bits[0] shl 2) or (bits[1] shr 4);
      bytes[1]:=(bits[1] shl 4) or (bits[2] shr 2);
      bytes[2]:=(bits[2] shl 6) or  bits[3];
    end;
    ONE_MOD:
    begin
      bytes[0]:=(bits[0] shl 2) or  bits[1];
    end;
    TWO_MOD:
    begin
      bytes[0]:=(bits[0] shl 2) or (bits[1] shr 4);
      bytes[1]:=(bits[1] shl 4) or  bits[2];
    end;
  end;
end;

procedure TExtract.FExtractFromRGB(var p_byte_bufs: array of byte;var f_bit_buf: byte;Flag: integer);
const
  R=0;
  G=1;
  B=2;
begin
  case Flag of
    NONE_MOD:
    begin
      //R    取低2位                3--0000 0011
      f_bit_buf:=p_byte_bufs[R] and 3;
      //G    取低1位
      f_bit_buf:=f_bit_buf or ((p_byte_bufs[G] and 1) shl 2);
      //B    取低3位                               7--0000 0111
      f_bit_buf:=f_bit_buf or ((p_byte_bufs[B] and 7) shl 3);
    end;
    ONE_MOD:
    begin
      //直接取R的低2位     f_bit_buf:=0000 00xx
      f_bit_buf:=p_byte_bufs[R] and 3;
    end;
    TWO_MOD:
    begin
      //取R的低2位         f_bit_buf:=0000 xxxx
      f_bit_buf:=p_byte_bufs[R] and 3;
      //G    取低1位
      f_bit_buf:=f_bit_buf or ((p_byte_bufs[G] and 1) shl 2);
      //B    取低1位 !!
      f_bit_buf:=f_bit_buf or ((p_byte_bufs[B] and 1) shl 3);
    end;
  end;

end;

procedure TExtract.FExtract_Hi(filename: string;bmpname: string;pb: TGauge);
var
  f,p:hfile;
  i,iTemp:integer;
  file_len,len:integer;
  f_byte_bufs:array[0..2] of byte;
  f_bit_bufs:array[0..3] of byte;
  p_byte_bufs:array[0..2] of byte;
begin
  pb.MinValue :=0;
  p:=_lopen(pchar(bmpname),OF_READWRITE);
  f:=_lcreat(pchar(filename),0);
  len:=0;

  //从图像头部偏移2处读取被隐藏文件长度
  _llseek(p,2,0);
  _lread(p,@file_len,4);
  iTemp:=file_len;

  //定位读写指针到图像的位图阵列开始处
  _llseek(p,strtoint(GetBMPInfo(bmpname,BMPDataOffset))+24,0);

  file_len:=file_len div 3;
  pb.MaxValue :=file_len;
  pb.Visible :=true;
  //开始读取图像文件p
  while (len < file_len) do
  begin
    inc(len);
    pb.Progress:=len;
    for i:=0 to 3 do
    begin
      _lread(p,@p_byte_bufs,3);
      FExtractFromRGB(p_byte_bufs,f_bit_bufs[i],NONE_MOD);
    end;
    FBits2Bytes(f_bit_bufs,f_byte_bufs,NONE_MOD);
    _lwrite(f,@f_byte_bufs,3);
  end;

  case (iTemp mod 3) of
    1://file 还剩一个byte-->f_bit_bufs[0]、f_bit_bufs[1](0000 00xx)
    begin
      _lread(p,@p_byte_bufs,3);
      //f_bit_bufs[0]中有file最后一个byte的高6位
      FExtractFromRGB(p_byte_bufs,f_bit_bufs[0],NONE_MOD);
      _lread(p,@p_byte_bufs,1);
      //f_bit_bufs[1]中有file最后一个byte的低2位
      FExtractFromRGB(p_byte_bufs,f_bit_bufs[1],ONE_MOD);
      //合并成file的最后一个byte
      FBits2Bytes(f_bit_bufs,f_byte_bufs,ONE_MOD);
      _lwrite(f,@f_byte_bufs,1);
    end;
    2://file 还剩二个byte-->f_bit_bufs[0]、f_bit_bufs[1]、f_bit_bufs[2](0000 xxxx)
    begin
      _lread(p,@p_byte_bufs,3);
      FExtractFromRGB(p_byte_bufs,f_bit_bufs[0],NONE_MOD);
      _lread(p,@p_byte_bufs,3);
      FExtractFromRGB(p_byte_bufs,f_bit_bufs[1],NONE_MOD);
      _lread(p,@p_byte_bufs,3);
      FExtractFromRGB(p_byte_bufs,f_bit_bufs[2],TWO_MOD);
      //合并成file的最后二个bytes
      FBits2Bytes(f_bit_bufs,f_byte_bufs,TWO_MOD);
      _lwrite(f,@f_byte_bufs,2);
    end;
  end;
  _lclose(f);
  _lclose(p);
  pb.Visible :=false;
end;

function TExtract.Validate :Boolean;
begin
  if GetBMPInfo(FBMPName,BMPFilePushed) <> 'J' then
    result:=false
  else
    result:=true;
end;

procedure TExtract.EraseHiddenFile;
var
  p: hfile;
  byte_buf: byte;
  i: shortint;
begin
  p:=_lopen(pchar(FBMPName),OF_READWRITE);
  //消除7h处的'P'标志位
  SetBMPFlag(FBMPName,UN_BMPFilePswAdded);

  //消除6h处的'J'标志位
  SetBMPFlag(FBMPName,UN_BMPFilePushed);

  //销毁密码
  _llseek(p,strtoint(GetBMPInfo(FBMPName,BMPDataOffset)),0);
  for i:=1 to 12 do
  begin
    _lread(p,@byte_buf,1);
    byte_buf:=byte_buf and $FE;
    _llseek(p,-1,FILE_CURRENT);
    _lwrite(p,@byte_buf,1);
  end;

  //定位读写指针到图像的位图阵列开始处
  _llseek(p,strtoint(GetBMPInfo(FBMPName,BMPDataOffset))+24,0);

  //破坏隐藏文件的前66个字节
  for i:=1 to 66 do
  begin
    _lread(p,@byte_buf,1);
    byte_buf:=byte_buf and $FE;
    _llseek(p,-1,FILE_CURRENT);
    _lwrite(p,@byte_buf,1);
  end;
  _lclose(p);
end;

function TExtract.Extract;
var
  s:string;   //开始时暂时用来存放Filter,然后用来暂时存放Filename,最后用来存放'.tmp'文件路径
  position:shortint;
begin
  try
    //为了只利用一个变量s,注意以下执行的顺序!!!
    //弹出Savedialog给用户选择存放输出文件的路径和文件名
    s:=ExtractFileExt(GetFileNameFromBMP(FBMPName));
    FOpenDialog.DefaultExt:=s;
    position:=pos('.',s);     //消除'.'
    Delete(s,position,1);
    s:='All Files  (*.*)|*.*|'+s+' Files  (*.'+s+')|*.'+Uppercase(s);
    FOpenDialog.Filter:=s;   //到此变量s使用完毕
    FOpenDialog.FilterIndex:=2;
    FOpenDialog.FileName:=ExtractFileName(GetFileNameFromBMP(FBMPName));

    //产生临时输出文件,以'.tmp' 为后缀,这里再次用到变量s
    s:=ChangeFileExt(ExtractFilePath(FBMPName)+
      GetFileNameFromBMP(FBMPName),'.tmp');

    FExtract_Hi(s,FBMPName,FGauge);

    FOpenDialog.Title:='保存文件';
    if FOpenDialog.Execute then
    begin
      MoveFile(pchar(s),pchar(FOpenDialog.FileName));
      result:=true;          //执行成功,可凭此在界面中使plExtractPsw不可见
      FOpenDialog.Title:='打开';
    end else
    begin                    //摁取消键后,删除临时文件
      FOpenDialog.Title:='打开';
      DeleteFile(s);
      result:=false;         //执行失败
    end;
  except
    on E:Exception do
    begin
      E.Create(E.Message);
      result:=false;
    end;
  end;
end;

end.