bmpreplace.pas

wbs43open-src.zip 数字隐藏工具

unit BMPReplace;

interface

   uses CarrierFile, DataFile, Classes
   ,BMPPalettes, BMPUtils , Sysutils, MultiLang
{$IFDEF CLX}
   ,QForms
{$ELSE}
   ,Forms
{$ENDIF}
   ;

   type
     TBMPReplace = class(TCarrierFile)
   public
     constructor Create; override;
     destructor Destroy; override;
     function GetAvailSize: Longint; virtual;
     function CreateFromCarrierFile(cf: TCarrierFile): Boolean; virtual;
     function ExportToCarrierFile(cf: TCarrierFile): Boolean; virtual;
     function EnoughSpaceToHide(n: Longint): Boolean; virtual;
     function Encode(ToHide: TDataFile): Boolean; virtual;
     function Decode(ResultFile: TDataFile): Boolean; virtual;
     function GetColorDepth: Byte;
     function isUsable: String;
   protected
     col:       Byte;
     bfHeader:  TBitmapFileHeader;
     biHeader:  TBitmapInfoHeader;
     bmPalette: TBMPPalette;
     ImgData:   TStream;
     function UsedColors: Integer; virtual;
     function GetHisto: THistogram; virtual;
     function GetHistoRLE: THistogram; virtual;
     function GetAvailSizeRLE: Longint; virtual;
     function Encode24(ToHide: TDataFile): Boolean; virtual;
     function Decode24(ResultFile: TDataFile): Boolean; virtual;
     function Encode8(ToHide: TDataFile): Boolean; virtual;
     function Decode8(ResultFile: TDataFile): Boolean; virtual;
     function Encode4(ToHide: TDataFile): Boolean; virtual;
     function Decode4(ResultFile: TDataFile): Boolean; virtual;
     function Encode8RLE(ToHide: TDataFile): Boolean; virtual;
     function Decode8RLE(ResultFile: TDataFile): Boolean; virtual;
     function Encode4RLE(ToHide: TDataFile): Boolean; virtual;
     function Decode4RLE(ResultFile: TDataFile): Boolean; virtual;
     function CreateNewPalette: TPaletteHashTable; virtual;
   end;

implementation

   constructor TBMPReplace.Create;
   begin
     inherited Create;
     bmPalette:=TBMPPalette.Create;
     bfHeader:=TBitmapFileHeader.Create;
     biHeader:=TBitmapInfoHeader.Create;
     ImgData:=TMemoryStream.Create;
     col:=0;
   end;

   destructor TBMPReplace.Destroy;
   begin
     bmPalette.Free;
     bfHeader.Free;
     biHeader.Free;    
     ImgData.Free;
     inherited Destroy;
   end;

   function TBMPReplace.GetAvailSize: Longint;
   var
     space:      Longint;
   begin
     Percent:=0;
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     inherited GetAvailSize;
     space:=0;
     if biHeader.Compression=0 then begin
       if biHeader.BitCount=4 then begin
         if UsedColors<9 then space:=2*ImgData.Size else space:=0;
       end;
       if biHeader.BitCount=8 then begin
         if UsedColors<129 then space:=ImgData.Size else space:=0;
       end;
       if biHeader.BitCount=24 then begin
         space:=ImgData.Size;
       end;
     end
     else begin
       if biHeader.BitCount=4 then begin
         if UsedColors<9 then space:=GetAvailSizeRLE else space:=0;
       end;
       if biHeader.BitCount=8 then begin
         if UsedColors<129 then space:=GetAvailSizeRLE else space:=0;
       end;
     end;
     GetAvailSize:=space div 8;
   end;

   function TBMPReplace.CreateFromCarrierFile(cf: TCarrierFile): Boolean;
   begin
     if cf.GetFileType='BMP' then begin
       Data.Clear;
       cf.SaveToStream(Data);
       bfHeader.Read(Data,0);
       biHeader.Read(Data,14);
       bmPalette.SetBitPixel(biHeader.BitCount);
       bmPalette.ReadFromStream(Data,14+biHeader.Size);
       Data.Seek(bfHeader.Offset,soFromBeginning);
       ImgData.Free;
       ImgData:=TMemoryStream.Create;
       ImgData.CopyFrom(Data,Data.Size-bfHeader.Offset);
       SetFileType(cf.GetFileType,col);
       Percent:=cf.Percent;
       CreateFromCarrierFile:=True;
     end
     else CreateFromCarrierFile:=False;
   end;

   function TBMPReplace.ExportToCarrierFile(cf: TCarrierFile): Boolean;
   begin
     Data.Free;
     Data:=TMemoryStream.Create;
     bfHeader.Write(Data,0);
     biHeader.Write(Data,14);
     bmPalette.Write(Data,54);
     Data.Seek(bfHeader.Offset,soFromBeginning);
     ImgData.Seek(0,soFromBeginning);
     Data.CopyFrom(imgData,ImgData.Size);
     cf.LoadFromStream(Data);
     cf.SetFileType('BMP',col);   
     ExportToCarrierFile:=True;
   end;

   function TBMPReplace.EnoughSpaceToHide(n: Longint): Boolean;
   begin
     if n>GetAvailSize then EnoughSpaceToHide:=False else EnoughSpaceToHide:=True;
   end;

   function TBMPReplace.Encode(ToHide: TDataFile): Boolean;
   var
     ht:    TPaletteHashTable;
   begin
     Encode:=False;
     if biHeader.BitCount=24 then Encode:=Encode24(ToHide);
     if (biHeader.BitCount=8) and (biHeader.Compression=0) then Encode:=Encode8(ToHide);
     if (biHeader.BitCount=4) and (biHeader.Compression=0) then Encode:=Encode4(ToHide);
     if (biHeader.BitCount=8) and (biHeader.Compression=1) then Encode:=Encode8RLE(ToHide);
     if (biHeader.BitCount=4) and (biHeader.Compression=2) then Encode:=Encode4RLE(ToHide);
   end;

   function TBMPReplace.Decode(ResultFile: TDataFile): Boolean;
   begin
     Decode:=False;
     if biHeader.BitCount=24 then Decode:=Decode24(ResultFile);
     if (biHeader.BitCount=8) and (biHeader.Compression=0) then Decode:=Decode8(ResultFile);
     if (biHeader.BitCount=4) and (biHeader.Compression=0) then Decode:=Decode4(ResultFile);
     if (biHeader.BitCount=8) and (biHeader.Compression=1) then Decode:=Decode8RLE(ResultFile);
     if (biHeader.BitCount=4) and (biHeader.Compression=2) then Decode:=Decode4RLE(ResultFile);
   end;

   function TBMPReplace.isUsable: String;
   var
     retMsg:    String;
   begin
     retMsg:='OK';
     if bfheader.BM<>'BM' then retMsg:=ml.GetCodeString('BMPReplace',1);
     if not(biHeader.BitCount in [1,4,8,24]) then retMsg:=Inttostr(biHeader.BitCount)+
        ml.GetCodeString('BMPReplace',2);
     if biHeader.BitCount=1 then retMsg:=ml.GetCodeString('BMPReplace',3);
     isUsable:=retMsg;
   end;

   function TBMPReplace.GetColorDepth: Byte;
   begin
     GetColorDepth:=col;
   end;

   function TBMPReplace.UsedColors: Integer;
   var
     i:               Integer;
     Count:           Integer;
     Histo:           THistogram;
   begin
     if biHeader.Compression=0 then Histo:=GetHisto
     else Histo:=GetHistoRLE;
     Count:=0;
     i:=0;
     for i:=0 to ((1 shl biHeader.BitCount)-1) do begin
       if Histo[i]>0 then Inc(Count);
     end;
     UsedColors:=Count;
     //ShowMessage('histogram: '+inttostr(count)+' colors used');
   end;

   function TBMPReplace.GetHisto: THistogram;
   var
     BytesRead:       Integer;
     Buffer:          Array[0..1023] of Byte;
     Histo:           THistogram;
     i:               Integer;
     p:               Integer;
     Cancel:          Boolean;
   begin
     Cancel:=False;
     Percent:=0;
     Action:=ml.GetCodeString('BMPReplace',4);
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     if Assigned(FActionChange) then FActionChange(self,Action);
     Application.ProcessMessages;
     for i:=0 to 255 do Histo[i]:=0;
     ImgData.Seek(0,soFromBeginning);
     BytesRead:=1024;
     p:=Trunc(ImgData.Size/1024);
     while (BytesRead=1024) and not(Cancel) do begin
       BytesRead:=ImgData.Read(Buffer,1024);
       for i:=0 to BytesRead-1 do begin
         if biHeader.BitCount=4 then begin
           Inc(Histo[(Buffer[i] and $F0) shr 4]);
           Inc(Histo[(Buffer[i] and $0F)]);
         end;
         if biHeader.BitCount=8 then Inc(Histo[Buffer[i]]);
       end;
       Percent:=Percent+p;
       if Assigned(FPercentChange) then FPercentChange(self,Percent);
       if Assigned(FWantCancel) then FWantCancel(self,Cancel);
       Application.ProcessMessages;
     end;
     Percent:=100;
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     GetHisto:=Histo;
   end;

   function TBMPReplace.GetHistoRLE: THistogram;
   var
     CRead:     Integer;
     CBuffer:   Array[0..1023] of Byte;
     Avail:     Longint;
     i:         Integer;
     Skip:      Integer;
     Esc:       Boolean;
     Col:       Integer;
     Histo:     THistogram;
     p:         Integer;
     Cancel:    Boolean;
   begin
     Percent:=0;
     Cancel:=False;
     Action:=ml.GetCodeString('BMPReplace',4);
     if Assigned(FActionChange) then FActionChange(self,Action);
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     Avail:=0;
     CRead:=1024;
     ESC:=False;
     Col:=0;
     Skip:=0;
     for i:=0 to 255 do Histo[i]:=0;
     ImgData.Seek(0,soFromBeginning);
     p:=Trunc(ImgData.Size/1024);
     while (CRead=1024) and not(Cancel) do begin
       CRead:=ImgData.Read(CBuffer,1024);
       for i:=0 to CRead-1 do begin
         if Skip>0 then begin
           Dec(Skip);
           if Col>0 then begin
             if biHeader.BitCount=8 then begin
               Inc(Histo[CBuffer[i]]);
               Dec(Col);
             end
             else begin
               Inc(Histo[(CBuffer[i] and $F0) shr 4]);
               Dec(Col);
               if Col>0 then begin
                 Inc(Histo[(CBuffer[i] and $0F)]);
                 Dec(Col);
               end;
             end;
           end;
         end
         else begin
           Col:=0;
           if not(ESC) then begin
             if CBuffer[i]=0 then ESC:=True
             else begin
               Inc(Avail);
               Col:=1;
               if biHeader.BitCount=4 then begin
                 Inc(Avail);
                 Inc(col);
               end;
               Skip:=1;
             end;
           end
           else begin
             ESC:=False;
             if CBuffer[i]=2 then Skip:=2;
             if CBuffer[i]>2 then begin
               Inc(Avail,CBuffer[i]);
               Col:=CBuffer[i];
               if biHeader.BitCount=8 then Skip:=CBuffer[i]*2
               else Skip:=CBuffer[i];
               if (Skip mod 4)>0 then Skip:=Skip+4-(Skip mod 4);
               Skip:=Trunc(Skip/2);
             end;
           end;
         end;
       end;
       Percent:=Percent+p;
       if Assigned(FPercentChange) then FPercentChange(self,Percent);
       if Assigned(FWantCancel) then FWantCancel(self,Cancel);
       Application.ProcessMessages;
     end;
     Percent:=100;
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     GetHistoRLE:=Histo;
   end;

   function TBMPReplace.GetAvailSizeRLE: Longint;
   var
     CRead:     Integer;
     CBuffer:   Array[0..1023] of Byte;
     Avail:     Longint;
     i:         Integer;
     Skip:      Integer;
     Esc:       Boolean;
     p:         Integer;
     Cancel:    Boolean;
   begin
     Percent:=0;
     Cancel:=False;
     Action:=ml.GetCodeString('BMPReplace',5);
     if Assigned(FActionChange) then FActionChange(self,Action);
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     Avail:=0;
     CRead:=1024;
     ESC:=False;
     Skip:=0;
     ImgData.Seek(0,soFromBeginning);
     p:=Trunc(ImgData.Size/1024);
     while (CRead=1024) and not(Cancel) do begin
       CRead:=ImgData.Read(CBuffer,1024);
       for i:=0 to CRead do begin
         if Skip>0 then Dec(Skip) else
         begin
           if not(ESC) then begin
             if CBuffer[i]=0 then ESC:=True
             else begin
               Inc(Avail);
               if biHeader.BitCount=4 then Inc(Avail);
               Skip:=1;
             end;
           end
           else begin
             ESC:=False;
             if CBuffer[i]=2 then Skip:=2;
             if CBuffer[i]>2 then begin
               Inc(Avail,CBuffer[i]);
               if biHeader.BitCount=8 then Skip:=CBuffer[i]*2
               else Skip:=CBuffer[i];
               if (Skip mod 4)>0 then Skip:=Skip+4-(Skip mod 4);
               Skip:=Trunc(Skip/2);
             end;
           end;
         end;
       end;
       Percent:=Percent+p;
       if Assigned(FPercentChange) then FPercentChange(self,Percent);
       if Assigned(FWantCancel) then FWantCancel(self,Cancel);
       Application.ProcessMessages;
     end;
     Percent:=100;
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     GetAvailSizeRLE:=Avail;
   end;

   function TBMPReplace.Encode24(ToHide: TDataFile): Boolean;
   var
     CBuffer:      Array[0..1023] of Byte;
     DBuffer:      Array[0..1023] of Byte;
     CRead:        Integer;
     CPos:         Integer;
     DStream:      TStream;
     DRead:        Integer;
     i, j:         Integer;
     Modified:     TStream;
     p:            Integer;
     Cancel:       Boolean;
   begin
     Cancel:=False;
     Percent:=0;
     Action:=ml.GetCodeString('BMPReplace',6);
     if Assigned(FActionChange) then FActionChange(self,Action);
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     DStream:=TMemoryStream.Create;
     ToHide.SaveToStream(DStream);
     DStream.Seek(0,soFromBeginning);
     ImgData.Seek(0,soFromBeginning);
     CRead:=ImgData.Read(CBuffer,1024);
     CPos:=0;
     Modified:=TMemoryStream.Create;
     DRead:=1024;
     p:=Trunc(DStream.Size/1024);
     while (DRead=1024) and not(Cancel) do begin
       DRead:=DStream.Read(DBuffer,1024);
       for i:=0 to DRead-1 do begin
         for j:=7 downto 0 do begin
           if (DBuffer[i] and (1 shl j))=$00 then CBuffer[CPos]:=CBuffer[CPos] and $FE
           else CBuffer[CPos]:=CBuffer[CPos] or $01;
           //CBuffer[CPos]:=CBuffer[CPos] and ($FE or (((DBuffer[i] and (1 shl j)) shr j)and 1));
           if CPos<CRead-1 then Inc(CPos)
           else begin
             Modified.Write(CBuffer,CRead);
             CRead:=ImgData.Read(CBuffer,1024);
             CPos:=0;
           end;
         end;
       end;
       Percent:=Percent+p;
       if Assigned(FPercentChange) then FPercentChange(self,Percent);
       if Assigned(FWantCancel) then FWantCancel(self,Cancel);
       Application.ProcessMessages;
     end;
     // copy remaining data
     Modified.Write(CBuffer,CRead);
     if ImgData.Size>ImgData.Position then Modified.CopyFrom(ImgData,ImgData.Size-ImgData.Position);
     ImgData.Free;
     ImgData:=Modified;
     DStream.Free;
     Percent:=100;
     if Assigned(FPercentChange) then FPercentChange(self,Percent);
     Application.ProcessMessages;
     Encode24:=True;
   end;

   function TBMPReplace.Decode24(ResultFile: TDataFile): Boolean;
   var
     DBuffer:      Array[0..1023] of Byte;
     CBuffer:      Array[0..1023] of Byte;
     DStream:      TMemoryStream;
     CPos:         Integer;