livechk.pas

wbs43open-src.zip 数字隐藏工具

{unit LiveChk;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Bitmaps, StdCtrls, ExtCtrls, wbsData, MultiLang;

type
  TLiveCheck = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);

    procedure Init(CFName, DFName, FType: String; CptPlace: Byte);
    procedure SetCarrier(c: String);
    procedure SetData(d: String);
    procedure SetFileType(f: String);
    procedure SetCryptRes(c: Byte);
    function GetCryptRes: Byte;

    function DoCheck: Boolean;

    function CheckBitmap: Boolean;
    function CheckASCII: Boolean;
    function CheckHTML: Boolean;
    function CheckPDF: Boolean;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
  end;

  var
   Header:        BMPHeader;
   Palette:       BMPPalette;
   ColorUsage:    BMPColorUsage;
   Carrier:       String;
   Data:          String;
   Filetype:      String;
   CryptRes:      Byte;
   ErrorMsg:      String;
   Result:        Boolean;
   LiveCheck:     TLiveCheck;
   ToDoNow:       Byte;

implementation

{$R *.DFM}


procedure TLiveCheck.FormCreate(Sender: TObject);
begin
  // ml support
  Label1.Caption:=ml.GetComponentString('LiveChk.Label1.Caption');
  Label2.Caption:=ml.GetComponentString('LiveChk.Label2.Caption');
  LiveCheck.Caption:=ml.GetComponentString('LiveChk.LiveCheckWait.Caption');
  /////////////////////////////////////////////////////////////////////////////
  Init('','','',6);
end;

procedure TLiveCheck.FormShow(Sender: TObject);
begin
  ToDoNow:=1;
  Timer1.Enabled:=True;
end;

{--}

  procedure TLiveCheck.Init(CFName, DFName, FType: String; CptPlace: Byte);
  begin
    Carrier:=CFName;
    Data:=DFName;
    FileType:=FType;
    CryptRes:=CptPlace;
  end;

  procedure TLiveCheck.SetCarrier(c: String);
  begin
    Carrier:=c;
  end;

  procedure TLiveCheck.SetData(d: String);
  begin
    Data:=d;
  end;

  procedure TLiveCheck.SetFileType(f: String);
  begin
    FileType:=f;
  end;

  procedure TLiveCheck.SetCryptRes(c: Byte);
  begin
    CryptRes:=c;
  end;

  function TLiveCheck.GetCryptRes: Byte;
  begin
    GetCryptRes:=CryptRes;
  end;

  function TLiveCheck.DoCheck: Boolean;
  var
    RetVal:      Boolean;
    IsChecked:   Boolean;
  begin
    IsChecked:=False;
    If FileType='BMP' Then Begin
      IsChecked:=True;
      RetVal:=CheckBitmap;
    End;
    If FileType='TXT' Then Begin
      IsChecked:=True;
      RetVal:=CheckASCII;
    End;
    If FileType='HTM' Then Begin
      IsChecked:=True;
      RetVal:=CheckHTML;
    End;
    If FileType='PDF' Then Begin
      IsChecked:=True;
      RetVal:=CheckPDF;
    End;
    If IsChecked Then
      DoCheck:=RetVal
    Else Begin
      DoCheck:=False;
      ErrorMsg:=ml.GetCodeString('LiveChk',1);{'Filetype is unknown.';}      // code001
    End;
  end;

  function TLiveCheck.CheckBitmap: Boolean;
  var
    RetVal:         Boolean;
    XFile:          File Of Byte;
    SpaceNeeded:    Longint;
    SpaceAvailable: Longint;
  begin
    RetVal:=True;
    AssignFile(XFile,Data);
    Reset(XFile);
    SpaceNeeded:=FileSize(XFile)+CryptRes;
    CloseFile(XFile);
    ReadBMPHeader(Carrier,Header);
    If Header.ColDepth>=24 Then SpaceAvailable:=Trunc(Header.Width*Header.Height*3/8)
    Else Begin
      SpaceAvailable:=Trunc(Header.Width*Header.Height/8);
      Case Header.ColDepth Of
        1:  Begin
              RetVal:=False;
              ErrorMsg:=ml.GetCodeString('LiveChk',2);{'A bitmap with only 2 colors cannot be used.';  } // code002
            End;
        4:  Palette.Colors:=15;
        8:  Palette.Colors:=255;
      End;
      ReadBMPPalette(Carrier,Palette);
      GetNoOfUsedColors(Carrier,Header,Palette,ColorUsage);
      If (ColorUsage.Number>((Palette.Colors+1)/2)) Then Begin
        RetVal:=False;
        ErrorMsg:=ml.GetCodeString('LiveChk',3);{'The carrier file cannot take the selected data.'+
        'If you want to take the risk, convert to a higher color depth.'; }  // code003
      End;
    End;
    If SpaceNeeded>SpaceAvailable Then Begin
      RetVal:=False;
      ErrorMsg:=ml.GetCodeString('LiveChk',4);{'Too much data for carrier file.'; }   // code004
    End;
    CheckBitmap:=RetVal;
  end;

  function TLiveCheck.CheckASCII: Boolean;
  var
    RetVal:         Boolean;
    XFile:          File Of Byte;
    SpaceNeeded:    Longint;
    SpaceAvailable: Longint;
    i:              Longint;
    Buf:            Array[1..10240] Of Byte;
    NumRead:        Longint;
  begin
    RetVal:=True;
    AssignFile(XFile,Data);
    Reset(XFile);
    SpaceNeeded:=FileSize(XFile)+CryptRes;
    CloseFile(XFile);
    AssignFile(XFile,Carrier);
    Reset(XFile);
    SpaceAvailable:=0;
    Repeat
      BlockRead(XFile, Buf, SizeOf(Buf), NumRead);
      For i:=1 To NumRead Do
        If (Buf[i]=$00) Or (Buf[i]=$20) Then Inc(SpaceAvailable);
    Until (NumRead = 0);
    CloseFile(XFile);
    SpaceNeeded:=SpaceNeeded*8;
    If SpaceNeeded>SpaceAvailable Then Begin
      RetVal:=False;
      ErrorMsg:=ml.GetCodeString('LiveChk',5);{'Too much data for selected carrier file.';  }  // code005
    End;
    CheckASCII:=RetVal;
  end;

  function TLiveCheck.CheckHTML: Boolean;
  var
    RetVal:         Boolean;
    XFile:          File Of Byte;
    SpaceNeeded:    Longint;
    SpaceAvailable: Longint;
    i:              Longint;
    Buf:            Array[1..10240] Of Byte;
    Last:           Byte;
    NumRead:        Longint;
  begin
    RetVal:=True;
    AssignFile(XFile,Data);
    Reset(XFile);
    SpaceNeeded:=FileSize(XFile)+CryptRes;
    CloseFile(XFile);
    AssignFile(XFile,Carrier);
    Reset(XFile);
    SpaceAvailable:=0;
    Last:=$00;
    Repeat
      BlockRead(XFile, Buf, SizeOf(Buf), NumRead);
      For i:=1 To NumRead Do Begin
        If (Buf[i]=$0A) And (Last=$0D) Then Inc(SpaceAvailable);
        Last:=Buf[i];
      End;
    Until (NumRead = 0);
    CloseFile(XFile);
    If SpaceNeeded>SpaceAvailable Then Begin
      RetVal:=False;
      ErrorMsg:=ml.GetCodeString('LiveChk',6); {'Too much data for selected carrier file.'; }    // code006
    End;
    CheckHTML:=RetVal;
  end;

  function TLiveCheck.CheckPDF: Boolean;
  var
    RetVal:         Boolean;
    XFile:          File Of Byte;
    SpaceNeeded:    Longint;
    SpaceAvailable: Longint;
    i:              Longint;
    Buf:            Array[1..10240] Of Byte;
    NumRead:        Longint;
    InObjTag:       Boolean;
    TagStr:         String;
    StrInBuild:     Boolean;
  begin
    RetVal:=True;
    InObjTag:=False;
    StrInBuild:=False;
    AssignFile(XFile,Data);
    Reset(XFile);
    SpaceNeeded:=FileSize(XFile)+CryptRes;
    CloseFile(XFile);
    AssignFile(XFile,Carrier);
    Reset(XFile);
    SpaceAvailable:=0;
    Repeat
      BlockRead(XFile, Buf, SizeOf(Buf), NumRead);
      For i:=1 To NumRead Do Begin
        If InObjTag Then Begin
          If StrInBuild Then Begin
            TagStr:=TagStr+Chr(Buf[i]);
            If LowerCase(TagStr)='endobj' Then InObjTag:=False;
            If Length(TagStr)>5 Then StrInBuild:=False;
          End;
          If ((Buf[i]=Ord('e')) Or (Buf[i]=Ord('E'))) Then Begin
            StrInBuild:=True;
            TagStr:=Chr(Buf[i]);
          End;
        End
        Else Begin
          If StrInBuild Then Begin
            TagStr:=TagStr+Chr(Buf[i]);
            If LowerCase(TagStr)='obj' Then InObjTag:=True;
            If Length(TagStr)>2 Then StrInBuild:=False;
          End;
          If ((Buf[i]=Ord('o')) Or (Buf[i]=Ord('O'))) Then Begin
            StrInBuild:=True;
            TagStr:=Chr(Buf[i]);
          End;
          If ((Buf[i]=$0D) And Not(InObjTag)) Then Inc(SpaceAvailable);
        End;
      End;
    Until (NumRead = 0);
    CloseFile(XFile);
    If SpaceNeeded>SpaceAvailable Then Begin
      RetVal:=False;
      ErrorMsg:=ml.GetCodeString('LiveChk',7);{'Too much data for selected carrier file.';  }   // code007
    End;
    CheckPDF:=RetVal;
  end;

procedure TLiveCheck.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled:=False;
  If ToDoNow=1 Then Begin
    Result:=DoCheck;
    ToDoNow:=0;
    Timer1.Enabled:=True;
  End
  Else Begin
    LCResult:=Result;
    LCErrorMsg:=ErrorMsg;
    Close;
  End;
end;

end.