process.pas

wbs43open-src.zip 数字隐藏工具

  InitializeRandomGenerators;
  LAction.Caption:=ml.GetCodeString('Process',3);{'Encrypting ...'; }  // code003
  Application.ProcessMessages;
  AssignFile(OldFile,temppath+'~wbstego.in');
  AssignFile(NewFile,temppath+'~wbstego.i2');
  Reset(OldFile);
  ReWrite(NewFile);
  {Read over size & control byte}
  For i:=1 To 4 Do Begin
    Read(OldFile,Data);
    Write(NewFile,Data);
  End;
  While Not(EOF(OldFile)) Do Begin
    Read(OldFile,Data);
    Data:=Data Xor NextRandomValue;
    Write(NewFile,Data);
  End;
  CloseFile(OldFile);
  CloseFile(NewFile);
  StrPCopy(XChar,temppath+'~wbstego.in');
  DeleteFile(XChar);
  RenameFile(temppath+'~wbstego.i2',temppath+'~wbstego.in');
end;

procedure TForm16.Decrypt;
var
  OldFile:      File Of Byte;
  NewFile:      File Of Byte;
  Data:         Byte;
begin
  InitializeRandomGenerators;
  LAction.Caption:=ml.GetCodeString('Process',4);{'Reconstructing data ...'; }  // code004
  Application.ProcessMessages;
  AssignFile(OldFile,temppath+'~wbstego.out');
  Reset(OldFile);
  {Read control byte}
  Read(OldFile,Data);
  If (Data And $80)=$80 Then Begin
    AssignFile(NewFile,temppath+'~wbstego.ou2');
    ReWrite(NewFile);
    Write(NewFile,Data);
    While Not(EOF(OldFile)) Do Begin
      Read(OldFile,Data);
      Data:=Data Xor NextRandomValue;
      Write(NewFile,Data);
    End;
    CloseFile(OldFile);
    CloseFile(NewFile);
    StrPCopy(XChar,temppath+'~wbstego.out');
    DeleteFile(XChar);
    RenameFile(temppath+'~wbstego.ou2',temppath+'~wbstego.out');
  End
  Else CloseFile(OldFile);
end;

procedure TForm16.UnMixThrough;
var
  Uebrig:      Longint;
  OldFile:     File of Byte;
  NewFile:     File Of Byte;
  FPos:        Longint;
  FSize:       Longint;
  Col:         Byte;
  Row:         Byte;
  PwC:         Byte;
  PwR:         Byte;
  PwL:         Byte;
  Matrix:      Array[0..15,0..15] Of Byte;
  i,j:         Byte;
  Data:        Byte;
begin
 LAction.Caption:=ml.GetCodeString('Process',5);{'Reconstructing data sequence ...'; }  // code005
 Application.ProcessMessages;
 AssignFile(OldFile,temppath+'~wbstego.out');
 Reset(OldFile);
 FSize:=FileSize(OldFile);
 {Read control byte}
 Read(OldFile,Data);
 If (Data And $40)=$40 Then Begin
  AssignFile(NewFile,temppath+'~wbstego.ou2');
  Rewrite(NewFile);
  Write(NewFile,Data);
  FPos:=1;
  Seek(OldFile,FPos);
  Uebrig:=FSize-FPos;
  PwL:=Length(Pwd);
  PwC:=1;
  PwR:=PwL;
  Col:=Ord(Pwd[PwC]) And $0F;
  Row:=Ord(Pwd[PwR]) And $0F;
  While Not(Uebrig<((Col+1)*(Row+1))) Do Begin
    {reset matrix}
    For i:=0 To 15 Do
      For j:=0 To 15 Do Matrix[i,j]:=0;
    {fill matrix}
    Reset(OldFile);
    Seek(OldFile,FPos);
    For j:=0 To Row Do
      For i:=Col DownTo 0 Do Read(OldFile,Matrix[i,j]);
    {empty matrix & write file}
    For i:=0 To Col Do
      For j:=0 To Row Do Begin
        Write(NewFile,Matrix[i,j]);
        Inc(FPos);
      End;
    {prepare next loop execution}
    Reset(OldFile);
    Uebrig:=FSize-FPos;
    If PwC<Int(Pwl/2) Then Inc(PwC)
    Else Begin
      If (Odd(PwL)) And (PwC=Int(PwL/2)) Then Inc(PwC)
      Else PwC:=1;
    End;
    If PwR>Int(Pwl/2)+1 Then Dec(PwR)
    Else Begin
      If (Odd(PwL)) And (PwR=Int(PwL/2)+1) Then Dec(PwR)
      Else PwR:=PwL;
    End;
    Col:=Ord(Pwd[PwC]) And $0F;
    Row:=Ord(Pwd[PwR]) And $0F;
    Application.ProcessMessages;
  End;
  Seek(OldFile,FPos);
  Col:=Ord(Pwd[1]);
  For i:=1 To Uebrig Do Begin
    Read(OldFile,Data);
    Data:=(Data-Col) Mod 256;
    Write(NewFile,Data);
    Inc(FPos);
  End;
  CloseFile(OldFile);
  CloseFile(NewFile);
  StrPCopy(XChar,temppath+'~wbstego.out');
  DeleteFile(XChar);
  RenameFile(temppath+'~wbstego.ou2',temppath+'~wbstego.out');
 End
 Else CloseFile(OldFile);
end;

procedure TForm16.HandleResult;
var
  Source:      File Of Byte;
  Dest:        File Of Byte;
  Data:        Byte;
  Dat2:        Byte;
  FN:          String;
  Ext:         String;
  FPos:        Longint;
  FLen:        Longint;
  i,j:         Longint;
  BCount:      Longint;
  ParPwd:      Boolean;
  NewPPar:     Boolean;
  PwdStr:      String;
  PwdChar:     Byte;
  CDif:        Byte;
  LastPwd:     Byte;
  FindPwd:     Boolean;
  WrongPW:     Boolean;
begin
  WrongPW:=False;
  LAction.Caption:=ml.GetCodeString('Process',6);{'Saving result ...';  }  // code006
  ProBar.Width:=200;
  LPercent.Caption:=ml.GetCodeString('Process',7);{'100%'; }  // code007
  Application.ProcessMessages;
  AssignFile(Source,temppath+'~wbstego.out');
  Reset(Source);
  FindPwd:=False;
  If Pwd<>'' Then Begin
    Read(Source,Data);
    If (Data And $01)=$01 Then ParPwd:=True Else ParPwd:=False;
    NewPPar:=False;
    For i:=1 To Length(Pwd) Do Begin
      If (Ord(Pwd[i]) And $01)=$01 Then NewPPar:=Not(NewPPar);
    End;
    If NewPPar=ParPwd Then FindPwd:=True;
  End;
  If Not(WrongPW) Then Begin
  Ext:='.xxx';
  Ext[1]:='.';
  Read(Source,Data);
  Ext[2]:=Chr(Data);
  Read(Source,Data);
  Ext[3]:=Chr(Data);
  Read(Source,Data);
  Ext[4]:=Chr(Data);
  FN:=OutDatName+Ext;
  AssignFile(Dest,FN);
  ReWrite(Dest);
  PwdChar:=1;
  LastPwd:=0;
  If FindPwd Then CDif:=Ord(Pwd[PwdChar]) And $3F;
  i:=0;
  PwdStr:='';
  Repeat
    Inc(i);
    Read(Source,Data);
    Application.ProcessMessages;
    If ExitNow Then Break;
    If FindPwd Then Begin
      If i=LastPwd+CDif Then Begin
        PwdStr:=PwdStr+Chr(Data);
        If PwdChar<Length(Pwd) Then Begin
          Inc(PwdChar);
          LastPwd:=i+1;
          CDif:=Ord(Pwd[PwdChar]) And $3F;
        End
        Else Begin
          Inc(PwdChar);
          LastPwd:=i-1;
          CDif:=0;
        End;
      End
      Else Begin
        If (FileSize(Source)-FilePos(Source)=Length(Pwd)-PwdChar) Then Begin
          PwdStr:=PwdStr+Chr(Data);
          Inc(PwdChar);
          While Not(PwdChar>Length(Pwd)) Do Begin
            Read(Source,Data);
            PwdStr:=PwdStr+Chr(Data);
            Inc(PwdChar);
          End;
        End
        Else Write(Dest,Data);
      End;
    End
    Else Write(Dest,Data);
  Until Eof(Source);
  CloseFile(Dest);
  End;
  CloseFile(Source);
  StrPCopy(XChar,temppath+'~wbstego.out');
  DeleteFile(XChar);
  {compare password}
  If Pwd<>PwdStr Then WrongPw:=True;
  If FindPwd And WrongPw Then Begin
    StrPCopy(XChar,FN);
    DeleteFile(XChar);
    MessageDlg(ml.GetCodeString('Process',8){'The password is invalid.'},mtError,[mbOK],250);    // code008
    Close;
  End;
end;

procedure TForm16.EncodeBMP;
var
  BytePos:     Longint;
  NewBPos:     Longint;
  BitPos:      Byte;
  BMPFile:     File Of Byte;
  NewBMP:      File Of Byte;
  DataFile:    File Of Byte;
  Data:        Byte;
  CVal:        Byte;
  NewVal:      Byte;
  Size:        Longint;
  Transf:      BMPTransPalette;
  BitLeft:     Byte;
begin
 LAction.Caption:=ml.GetCodeString('Process',9);{'Encoding ...'; }     // code009
 AssignFile(DataFile,temppath+'~wbstego.in');
 Reset(DataFile);
 Size:=FileSize(DataFile);
 Case Header.ColDepth Of
     4:    Begin
             CreateNewPal(Palette,ColorUsage,Transf);
             AssignFile(BMPFile,InBMPName);
             Reset(BMPFile);
             Size:=FileSize(BMPFile);
             AssignFile(NewBMP,OutBMPName);
             ReWrite(NewBMP);
             CloseFile(NewBMP);
             WriteBMPHeader(OutBMPName,Header);
             WriteBMPPalette(OutBMPName,Palette);
             AssignFile(NewBMP,OutBMPName);
             Reset(NewBMP);
             BytePos:=118;
             While Not(EOF(BMPFile)) Do Begin
               If Not(EOF(DataFile)) Then Begin
                 Read(DataFile,Data);
                 For BitPos:=3 Downto 0 Do Begin
                   Seek(BMPFile,BytePos);
                   Read(BMPFile,CVal);
                   If Data And (1 Shl (2*BitPos+1))=$00 Then CVal:=((CVal And $0F) Or $F0) And
                         (((Transf[((CVal And $F0) Shr 4) And $0F].Even) Shl 4) Or $0F)
                   Else CVal:=((CVal And $0F) Or $F0) And (((Transf[((CVal And $F0) Shr 4) And $0F].Odd) Shl 4) Or $0F);
                   If Data And (1 Shl (2*BitPos))=$00 Then CVal:=((CVal And $F0) Or $0F) And
                         ((Transf[CVal And $0F].Even) Or $F0)
                   Else CVal:=((CVal And $F0) Or $0F) And ((Transf[CVal And $0F].Odd) Or $F0);
                   Seek(NewBMP,BytePos);
                   Write(NewBMP,CVal);
                   Inc(BytePos);
                 End;
               End
               Else Begin
                 Seek(BMPFile,BytePos);
                 Read(BMPFile,CVal);
                 Randomize;
                 If Random(2)=0 Then CVal:=((CVal And $0F) Or $F0) And
                       (((Transf[((CVal And $F0) Shr 4) And $0F].Even) Shl 4) Or $0F)
                 Else CVal:=((CVal And $0F) Or $F0) And (((Transf[((CVal And $F0) Shr 4) And $0F].Odd) Shl 4) Or $0F);
                 Randomize;
                 If Random(2)=0 Then CVal:=((CVal And $F0) Or $0F) And
                       ((Transf[CVal And $0F].Even) Or $F0)
                 Else CVal:=((CVal And $F0) Or $0F) And ((Transf[CVal And $0F].Odd) Or $F0);
                 Seek(NewBMP,BytePos);
                 Write(NewBMP,CVal);
                 Inc(BytePos);
               End;
               Percent:=Trunc((BytePos/Size)*100);
               LPercent.Caption:=IntToStr(Percent)+'%';
               ProBar.Width:=Percent*2;
               Application.ProcessMessages;
             End;
             CloseFile(BMPFile);
             CloseFile(NewBMP);
             If OutBMPName='~wbstego.tmp' Then Begin
               FileCopy(OutBMPName,InBMPName);
               StrPCopy(XChar,OutBMPName);
               DeleteFile(XChar);
               OutBMPName:=InBMPName;
             End;
           End;
     8:    Begin
             CreateNewPal(Palette,ColorUsage,Transf);
             AssignFile(BMPFile,InBMPName);
             Reset(BMPFile);
             Size:=FileSize(BMPFile);
             AssignFile(NewBMP,OutBMPName);
             ReWrite(NewBMP);
             CloseFile(NewBMP);
             WriteBMPHeader(OutBMPName,Header);
             WriteBMPPalette(OutBMPName,Palette);
             AssignFile(NewBMP,OutBMPName);
             Reset(NewBMP);
             BytePos:=1078;
             While Not(EOF(BMPFile)) Do Begin
               If Not(EOF(DataFile)) Then Begin
                 Read(DataFile,Data);
                 For BitPos:=7 Downto 0 Do Begin
                   Seek(BMPFile,BytePos);
                   Read(BMPFile,CVal);
                   If (Data And (1 Shl BitPos))=$00 Then CVal:=Transf[CVal].Even
                   Else CVal:=Transf[CVal].Odd;
                   Seek(NewBMP,BytePos);
                   Write(NewBMP,CVal);
                   Inc(BytePos);
                 End;
               End
               Else Begin
                 Seek(BMPFile,BytePos);
                 Read(BMPFile,CVal);
                 Randomize;
                 If Random(2)=0 Then CVal:=Transf[CVal].Even
                 Else CVal:=Transf[CVal].Odd;
                 Seek(NewBMP,BytePos);
                 Write(NewBMP,CVal);
                 Inc(BytePos);
               End;
               Percent:=Trunc((BytePos/Size)*100);
               LPercent.Caption:=IntToStr(Percent)+'%';
               ProBar.Width:=Percent*2;
               Application.ProcessMessages;
               If ExitNow Then Break;
             End;
             CloseFile(BMPFile);
             CloseFile(NewBMP);
             If OutBMPName='~wbstego.tmp' Then Begin
               FileCopy(OutBMPName,InBMPName);
               StrPCopy(XChar,OutBMPName);
               DeleteFile(XChar);
               OutBMPName:=InBMPName;
             End;
           End;
     24:   Begin
             BytePos:=54;
             FileCopy(InBMPName,OutBMPName);
             AssignFile(BMPFile,OutBMPName);
             Reset(BMPFile);
             While Not(EOF(DataFile)) Do Begin
               Read(DataFile,Data);
               For BitPos:=7 Downto 0 Do Begin
                 Seek(BMPFile,BytePos);
                 Read(BMPFile,CVal);
                 If (Data And (1 Shl BitPos))=$00 Then CVal:=CVal And $FE
                 Else CVal:=CVal Or $01;
                 Seek(BMPFile,BytePos);
                 Write(BMPFile,CVal);
                 Inc(BytePos);
                 Percent:=Trunc((((BytePos-54)/8)/Size)*100);
                 LPercent.Caption:=IntToStr(Percent)+'%';