{*******************************************************}
{                                                       }
{       eulB's 魔法BMP                                  }
{                                                       }
{       基本函數和過程的類封裝                          }
{                                                       }
{       2001年10月19日                                  }
{                                                       }
{*******************************************************}


unit unitClass;

interface

uses
  classes,Windows, SysUtils;

const
  //用于GetBMPInfo
  BMPFlag=1;
  BMPSize=2;
  BMPBitsperPixel=3;
  BMPDataOffset=4;
  //用于SetBMPFlag
  BMPFilePushed=5;
  BMPFilePswAdded=6;
  UN_BMPFilePswAdded=7;
  UN_BMPFilePushed=8;
  mask:array[0..7] of byte=(1,2,4,8,16,32,64,128);

//基本過程和函數類
type
  Tprocfunc=class(Tobject)
    protected
      procedure SetBMPFlag(bmpname:string;Flag:integer);
      procedure AddFileName(bmpfile:string;FileName:string);

      function  GetBMPInfo(bmpname:string;Flag:integer):string;
      function  GetFileSize(filename:string):integer;
      function  GetFileNameFromBMP(bmpfile:string):string;
    public
      constructor create;
  end;

//提取隱藏文件類

implementation
constructor Tprocfunc.create;
begin
end;

function Tprocfunc.GetBMPInfo(bmpname:string;Flag:integer):string;
var
  p: Hfile;
  wTemp: WORD;
  dwTemp: DWORD;
begin
  p:=_lopen(pchar(bmpname),OF_READ);
  case Flag of
  BMPFlag :
    begin
      _lread(p,@wTemp,1);
      result:=chr(wTemp);
      _lread(p,@wTemp,1);
      result:=result+chr(wTemp);
      _lclose(p);
    end;
  BMPSize :
    begin
      _llseek(p,2,FILE_BEGIN);
      _lread(p,@dwTemp,4);
      _lclose(p);
      result:=inttostr(dwTemp);
    end;
  BMPBitsperPixel:
    begin
      _llseek(p,28,FILE_BEGIN);
      _lread(p,@wTemp,2);
      _lclose(p);
      result:=inttostr(wTemp);
    end;
  BMPDataOffset:
    begin
      _llseek(p,10,FILE_BEGIN);
      _lread(p,@dwTemp,4);
      _lclose(p);
      result:=inttostr(dwTemp);
    end;
  BMPFilePushed:         //'J'
    begin
      _llseek(p,6,0);
      _lread(p,@wTemp,1);
      _lclose(p);
      result:=chr(wTemp xor ord('B'));
    end;
  BMPFilePswAdded:       //'P'
    begin
      _llseek(p,7,0);
      _lread(p,@wTemp,1);
      _lclose(p);
      result:=chr(wTemp xor ord('B'));
    end;
  end;
end;

function Tprocfunc.GetFileSize(filename:string):integer;
var
  f:file of byte;
begin
  AssignFile(f, filename);
  Reset(f);
  result:=filesize(f);
  CloseFile(f);
end;

function Tprocfunc.GetFileNameFromBMP(bmpfile: string): string;
var
  p: hfile;
  name_len,i,j: shortint;
  Offset,file_len: integer;
  byte_buf: byte;
  byte_bufs: array[0..7] of byte;
begin
  Offset:=strtoint(GetBMPInfo(bmpfile,BMPDataOffset));
  p:=_lopen(pchar(bmpfile),OF_READ);

  //從圖像頭部偏移2處讀取被隱藏文件長度
  _llseek(p,2,0);
  _lread(p,@file_len,4);

  //讀取文件名長度
  _llseek(p,8,0);
  _lread(p,@name_len,1);

  //計算放入文件名的偏移量
  case (file_len Mod 3) of
    0: Offset:=Offset + 24 + (file_len div 3) * 12;
    1: Offset:=Offset + 24 + (file_len div 3) * 12 + 6;
    2: Offset:=Offset + 24 + (file_len div 3) * 12 + 9;
  end;

  //定位致文件名開始處
  _llseek(p,Offset,0);
  for i:= 1 to name_len do
  begin
    byte_buf:=0;
    _lread(p,@byte_bufs,8);
  for j:=0 to 7 do
    if (byte_bufs[j] and 1 ) = 1 then
      byte_buf:= byte_buf or mask[j];
  result:=result+chr(byte_buf);
  end;
  _lclose(p);
end;

procedure Tprocfunc.AddFileName(bmpfile: string;FileName: string);
var
  p:hfile;
  file_len,Offset,j:integer;
  temp:byte;
  name_len,i:shortint;
  byte_bufs:array[0..7] of byte;
begin
  Offset:=strtoint(GetBMPInfo(bmpfile,BMPDataOffset));
  p:=_lopen(pchar(bmpfile),OF_READWRITE);

  //從圖像頭部偏移2處讀取被隱藏文件長度
  _llseek(p,2,0);
  _lread(p,@file_len,4);

  //在0008h處寫入shortint(8bit)類型的文件名長度
  _llseek(p,8,0);
  name_len:=length(FileName);
  _lwrite(p,@name_len,1);

  //計算放入文件名的偏移量
  case (file_len Mod 3) of
    0: Offset:=Offset + 24 + (file_len div 3) * 12;
    1: Offset:=Offset + 24 + (file_len div 3) * 12 + 6;
    2: Offset:=Offset + 24 + (file_len div 3) * 12 + 9;
  end;

  //定位讀寫指針
  _llseek(p,Offset,0);
  for i:=1 to name_len do
  begin
    //temp:=ord(FileName[i]);
    _lread(p,@byte_bufs,8);
    for j:=0 to 7 do
      if (ord(FileName[i]) and mask[j]) >j then
        byte_bufs[j]:=byte_bufs[j] or 1
      else
        byte_bufs[j]:=byte_bufs[j] and $FE;
    _llseek(p,-8,FILE_CURRENT);
    for j:=0 to 7 do
      _lwrite(p,@byte_bufs[j],1);
  end;
  _lclose(p);
end;

procedure Tprocfunc.SetBMPFlag(bmpname:string;Flag:integer);
var
  p:hfile;
  temp:byte;
begin
  p:=_lopen(pchar(bmpname),OF_WRITE);
  case Flag of
  BMPFilePushed:
    begin
      temp:=ord('J') xor ord('B');  // 作XOR處理，以增加保密性
      _llseek(p,6,0);
      _lwrite(p,@temp,1);
    end;
  BMPFilePswAdded:
    begin
      temp:=ord('P') xor ord('B');
      _llseek(p,7,0);
      _lwrite(p,@temp,1);
    end;
  UN_BMPFilePswAdded:
    begin
      temp:=ord('.'); //若已經置有'P',則改寫為'.'
      _llseek(p,7,0);
      _lwrite(p,@temp,1);
    end;
  UN_BMPFilePushed:
    begin
      temp:=0;
      _llseek(p,6,0);
      _lwrite(p,@temp,1);
    end;
  end;
  _lclose(p);
end;

end.