process.pas

wbs43open-src.zip 数字隐藏工具

unit Process;

{this is the process routine

 of wbStego99 Ver. 4.00 Pro

 which supports cryptographic functions}

interface

uses
  SysUtils, {WinTypes, WinProcs, Messages,} Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls,
  Bitmaps, FFCopy, Palettes, wbsData, Bin32Hdl, {LiveChk,} MultiLang;

type
  TAction=(AEncode,ADecode);
  TForm16 = class(TForm)
    LAction: TLabel;
    Button1: TButton;
    LPercent: TLabel;
    Panel1: TPanel;
    ProBar: TImage;
    Timer1: TTimer;
    procedure Prepare;
    procedure MixThrough;
    procedure InitializeRandomGenerators;
    function NextRandomValue: Byte;
    procedure Encrypt;
    procedure Decrypt;
    procedure UnMixThrough;
    procedure HandleResult;
    procedure EncodeBMP;
    procedure EncodeTXT;
    procedure EncodeHTM;
    procedure EncodePDF;
    procedure DecodeBMP;
    procedure DecodeTXT;
    procedure DecodeHTM;
    procedure DecodePDF;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form16:      TForm16;
  anAction:    TAction;
 { Header:     BMPHeader;
  Palette:     BMPPalette;
  ColorUsage:  BMPColorUsage;   }
  IncCD:       Boolean;
  Percent:     Byte;
  InProg:      Boolean;
  ExitNow:     Boolean;
  FID:         Integer;
  PwdValid:    Boolean;
  {Crypto}
  {BBS}
  var_p:       Longint;
  var_q:       Longint;
  var_n:       Longint;
  var_z:       Longint;
  {MLK}
  var_m:       Longint;
  {------}

implementation

{$R *.DFM}

procedure TForm16.Prepare;
var
  Source:    File Of Byte;
  Dest:      File Of Byte;
  Data:      Byte;
  Dat2:      Byte;
  Len:       Longint;
  Ext:       String[4];
  i,j:       Longint;
  FLen:      Longint;
  FPos:      Longint;
  BCount:    Longint;
  ParPwd:    Boolean;
  ConByte:   Byte;
  PwdChar:   Byte;
  CDif:      Byte;
  LastPwd:   Byte;
  Pwc:       Byte;
  translen:  Longint;
begin
  LAction.Caption:=ml.GetCodeString('Process',1);{'Reading data ...'; }     // code001
  Application.ProcessMessages;
  AssignFile(Source,InDatName);
  Reset(Source);
  Len:=FileSize(Source);
  {The actual size is
        Len       ...  size of source
      + 3         ...  file extension
      + 1 (0)     ...  control byte (if applicable)
      + n (0)     ...  length of transmitted password (if applicable)
      ----------
        translen  ...  length of transmitted data
  }
  translen:=Len+3;
  If Crypt Or Mix Then Inc(translen,1);
  If (Crypt Or Mix) And Transmit Then Inc(translen,Length(Pwd));
  AssignFile(Dest,temppath+'~wbstego.in');
  ReWrite(Dest);
  Data:=(translen) And $000000FF;
  Write(Dest,Data);
  Data:=((translen) And $0000FF00) Shr 8;
  Write(Dest,Data);
  Data:=((translen) And $00FF0000) Shr 16;
  Write(Dest,Data);
  {Control byte}
  If Crypt Or Mix Then Begin
    ConByte:=0;
    { - 2 msbs}
    If Crypt Then ConByte:=ConByte Or $80;
    If Mix Then ConByte:=ConByte Or $40;
    { - random fill}
    Randomize;
    i:=Random(2);
    If i=1 Then ConByte:=ConByte Or $20;
    i:=Random(2);
    If i=1 Then ConByte:=ConByte Or $10;
    i:=Random(2);
    If i=1 Then ConByte:=ConByte Or $8;
    i:=Random(2);
    If i=1 Then ConByte:=ConByte Or $4;
    i:=Random(2);
    If i=1 Then ConByte:=ConByte Or $2;
    { - parity of pwd string}
    ParPwd:=False;
    For i:=1 To Length(Pwd) Do Begin
      If (Ord(Pwd[i]) And $01)=$01 Then ParPwd:=Not(ParPwd);
    End;
    If Not(Transmit) Then ParPwd:=Not(ParPwd);
    If ParPwd Then ConByte:=ConByte Or $1;
    Write(Dest,ConByte);
  End;
  Ext:=ExtractFileExt(InDatName);
  Data:=Ord(Ext[2]);
  Write(Dest,Data);
  Data:=Ord(Ext[3]);
  Write(Dest,Data);
  Data:=Ord(Ext[4]);
  Write(Dest,Data);
  If (Crypt Or Mix) And Transmit Then Begin
    PwdChar:=1;
    LastPwd:=0;
    CDif:=Ord(Pwd[PwdChar]) And $3F;
  End;
  For i:=1 To Len Do Begin
    Read(Source,Data);
    Application.ProcessMessages;
    If ExitNow Then Break;
    {mix in pwd characters}
    If (Crypt Or Mix) And Transmit Then Begin
      If i=LastPwd+CDif Then Begin
        Pwc:=Ord(Pwd[PwdChar]);
        Write(Dest,Pwc);
        If PwdChar>Length(Pwd) Then Begin
          CDif:=0;
          LastPwd:=i-1;
        End
        Else Begin
          Inc(PwdChar);
          LastPwd:=i;
          CDif:=Ord(Pwd[PwdChar]) And $3F;
        End;
      End;
    End;
    { --------------------------------- }
    Write(Dest,Data);
  End;
  If (Crypt Or Mix) And Transmit Then Begin
   If PwdChar<Length(Pwd) Then Begin
    Repeat
      Pwc:=Ord(Pwd[PwdChar]);
      Write(Dest,Pwc);
      Inc(PwdChar);
    Until PwdChar>Length(Pwd);
   End;
  End;
  Data:=0;
  CloseFile(Source);
  CloseFile(Dest);
end;

procedure TForm16.MixThrough;
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',2);{'Mixing data ...'; }  // code002
  Application.ProcessMessages;
  AssignFile(OldFile,temppath+'~wbstego.in');
  AssignFile(NewFile,temppath+'~wbstego.i2');
  Reset(OldFile);
  ReWrite(NewFile);
  FSize:=FileSize(OldFile);
  FPos:=4;
  For i:=1 To 4 Do Begin
    Read(OldFile,Data);
    Write(NewFile,Data);
  End;
  {Read over first four bytes = size + control byte}
  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 i:=0 To Col Do
      For j:=0 To Row Do Read(OldFile,Matrix[i,j]);
    {empty matrix & write file}
    Seek(NewFile,FPos);
    For j:=0 To Row Do
      For i:=Col DownTo 0 Do Begin
        Write(NewFile,Matrix[i,j]);
        Inc(FPos);
        Seek(NewFile,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;
    Seek(NewFile,FPos);
    Write(NewFile,Data);
    Inc(FPos);
    Seek(OldFile,FPos);
  End;
  CloseFile(OldFile);
  CloseFile(NewFile);
  StrPCopy(XChar,temppath+'~wbstego.in');
  DeleteFile(XChar);
  RenameFile(temppath+'~wbstego.i2',temppath+'~wbstego.in');
end;

procedure TForm16.InitializeRandomGenerators;
var
  l:          Byte;
  i,j,d:      Byte;
  leaveout:   Array[1..255,0..7] Of Boolean;
  no_left:    Byte;
  row_left:   Byte;
begin
  {Value m for MAK and p,q for BBS}
  var_m:=0;
  var_p:=0;
  var_q:=0;
  l:=Length(Pwd);
  For i:=1 To l Do
    For j:=0 To 7 Do leaveout[i,j]:=False;
  If l>=32 Then Begin
    For i:=1 To l Do
      For j:=1 To 7 Do leaveout[i,j]:=True;
    no_left:=l-32;
    If no_left>0 Then Begin
      For i:=1 To no_left Do Begin
        j:=Round(i*Int(l/no_left));
        leaveout[j,0]:=True;
      End;
    End;
  End
  Else Begin
    If l>=4 Then Begin
      row_left:=Round(8-Int(32/l));
      If Not(l In [4,8,16]) Then Dec(row_left);
      row_left:=8-row_left;
      If row_left<7 Then
        For i:=1 To l Do
          For j:=7 DownTo row_left Do leaveout[i,j]:=True;
      no_left:=l-(32 mod l*row_left);
      If no_left>0 Then Begin
        For i:=1 To no_left Do Begin
          j:=Round(i*Int(l/no_left));
          leaveout[j,row_left]:=True;
        End;
      End;
    End
    Else Begin
      no_left:=32-(l*8);
      For i:=31-no_left To 31 Do var_m:=SetBitIn32Word(var_m,i,True);
    End;
  End;
  d:=0;
  For i:=l Downto 1 Do
    For j:=0 To 7 Do
      If Not(leaveout[i,j]) Then Begin
        If (Ord(Pwd[i]) And ($01 Shl j))=($01 Shl j) Then var_m:=SetBitIn32Word(var_m,d,True);
        Inc(d);
      End;
  {Extract p,q from m}
  d:=0;
  For i:=31 DownTo 0 Do Begin
    If Odd(i) Then var_p:=SetBitIn32Word(var_p,d,GetBitOf32Word(var_m,i))
    Else Begin
      var_q:=SetBitIn32Word(var_q,d,GetBitOf32Word(var_m,i));
      Inc(d);
    End;
  End;
  {Finalize m}
  var_m:=SetBitIn32Word(var_m,31,False);
  {Finalize p,q}
  var_p:=var_p+(3-(var_p mod 4));
  var_q:=var_q+(3-(var_q mod 4));
  {Value z0 for BBS}
  var_z:=var_m;
  var_z:=var_z+(0-(var_z mod 4));
  {Finalize n}
  var_n:=var_p*var_q;
end;

function TForm16.NextRandomValue: Byte;
var
  i:       Byte;
  newval:  Boolean;
  outval:  Byte;
begin
  {BBS}
  var_z:=(var_z*var_z) mod var_n;
  {MAK}
  newval:=GetBitOf32Word(var_m,0) Xor GetBitOf32Word(var_m,19);
  For i:=1 To 31 Do SetBitIn32Word(var_m,i-1,GetBitOf32Word(var_m,i));
  SetBitIn32Word(var_m,31,newval);
  {Hash}
  outval:=0;
  If (GetBitOf32Word(var_z,13) Xor GetBitOf32Word(var_m,7)) Then outval:=outval Or $01;
  If GetBitOf32Word(var_z,31) Then outval:=outval Or $02;
  If (GetBitOf32Word(var_z,10) And GetBitOf32Word(var_m,30)) Then outval:=outval Or $04;
  If (GetBitOf32Word(var_z,23) Or (GetBitOf32Word(var_m,19) Xor GetBitOf32Word(var_m,19))) Then outval:=outval Or $08;
  If ((GetBitOf32Word(var_z,17) And GetBitOf32Word(var_z,27)) Xor GetBitOf32Word(var_m,16)) Then outval:=outval Or $10;
  If GetBitOf32Word(var_m,13) Then outval:=outval Or $20;
  If (GetBitOf32Word(var_z,20) Xor GetBitOf32Word(var_m,25)) Then outval:=outval Or $40;
  If GetBitOf32Word(var_z,26) Then outval:=outval Or $80;
  NextRandomValue:=outval;
end;

procedure TForm16.Encrypt;
var
  OldFile:      File Of Byte;
  NewFile:      File Of Byte;
  Data:         Byte;
  i:            Byte;
begin