elmimeviewer_binary.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 372 行

// File Version: 2004-04-16
unit ElMimeViewer_Binary;

// _HexEditor_
{$i ElMimeViewer_Options.inc}

interface

uses
  // System units:
  SysUtils, Classes,
  // ElMime units:
  SBMIMETypes,
  SBMIMEUtils,
  SBMIMEClasses,
  SBMIMEStream,
  SBMIME,
  {$IFDEF DELPHI_NET}
  System.Threading,
  {$ENDIF}
  // ElMime Demo units:
  ElMimeViewer_DataCommon,
  {$IFDEF _HexEditor_}
  MPHexEditor, MPHexEditorEx,
  {$IFDEF D_6_UP}
  VarUtils,
  {$ENDIF}
  ComObj,
  {$ELSE}
  //ComCtrls, // TRichEdit
  {$ENDIF IFDEF _HexEditor_}
  // other units:
  Windows, Messages, {$IFDEF D_6_UP}Variants,{$ENDIF} Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type

  {$IFDEF _HexEditor_}
  THexEditor = TMPHexEditorEx;
  {$ELSE}
  THexEditor = TMemo;
  //THexEditor = TRichEdit;
  {$ENDIF IFDEF _HexEditor_}

  TFrame = TElMimePlugFrame;

  TfraBinary = class(TFrame)
  private
    { Private declarations }
    {$IFNDEF _HexEditor_}
    fFillHexDumpThread: TThread;
    procedure StopFillDumpThread(bDestroy: Boolean);
    {$ENDIF}
    procedure btnTools_SaveBinaryClick(Sender: TObject);
  protected
    { Protected declarations }
    pTools: TPanel;
    btnTools_SaveBinary: TButton;
    pContainer: TPanel;
    fData :TBytes;
    HexEditor: THexEditor;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function IsSupportedThisMessapePart(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean; override;
    function GetCaption: string; override;
  protected
    procedure Init(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean); override;
  end;

implementation

{$IFNDEF _HexEditor_}

type
  TFillHexDumpThread = class(TThread)
  private
   fOwner: TfraBinary;
   sm: TAnsiStringStream;
   procedure AddDumpToView;
  public
   procedure Execute; override;
  end;

procedure TFillHexDumpThread.AddDumpToView;
begin
  if not Terminated then
  begin
    fOwner.HexEditor.Lines.BeginUpdate;
    fOwner.HexEditor.Lines.Add(sm.AnsiData);
    fOwner.HexEditor.Lines.EndUpdate;
  end;
end;

procedure TFillHexDumpThread.Execute;
var
  i, iLine, iOffs, iOffsCnt, iBlock: integer;
  S, T: AnsiString;
const
  cLineLimit = 16;
  cMemoLineLimit = 5000;
  //cBlockLines = 50;
  cBlockLines = cMemoLineLimit*2;
begin
  try
    sm := TAnsiStringStream.Create;
    try
     iLine := 0;
     iOffs := 0;
     iBlock := 0;
     iOffsCnt := Length(IntToHex(Length(fOwner.fData), 0));
     S := '';
     T := '';
     for i:=0 to Length(fOwner.fData)-1 do
     begin
       inc(iLine);
       S := S +IntToHex(fOwner.fData[i], 2);
       case AnsiChar(fOwner.fData[i]) of
         #0,#9,#10,#13:
           T := T+'.';
         else
           T := T+AnsiChar(fOwner.fData[i]);
       end;
       if i mod 2 =1 then
         S := S + ' ';
       if (iLine=cLineLimit) then
       begin
         if Terminated then
           exit;
         inc(iBlock);
         iLine := 0;
         S := '0x' + IntToHex(iOffs, iOffsCnt)+' | '+ S + ' | ' + T;// + #13#10;
         WriteStringToStream(S, sm);
         S := '';
         T := '';
         iOffs := i+1;

         if iBlock < cBlockLines then
           WriteStringToStream(#13#10, sm);

         if iBlock >= cBlockLines then
         begin
           iBlock := 0;
           sm.Size := sm.Size - 2; // remore last line break
           Synchronize(AddDumpToView);
           sm.Clear;
         end;

         if iOffs > cMemoLineLimit then
         begin
           S := #13#10#13#10'~~~  Memo Line Limitation ~~~';
           WriteStringToStream(S, sm);
           Synchronize(AddDumpToView);
           exit;
         end;

       end;
     end;
     if iLine>0 then
     begin
       inc(iOffs);
       for i:=1to iOffs do
       begin
         S := S + ' ';
         T := T + ' ';
       end;
       S := '0x' + IntToHex(iOffs, iOffsCnt)+' | '+ S + ' | ' + T + #13#10;
       WriteStringToStream(S, sm);
       Synchronize(AddDumpToView);
     end;

    finally
      sm.Free;
    end;
  except
  end;
end;

{$ENDIF IFNDEF _HexEditor_}

{ TfraBinary }

class function TfraBinary.IsSupportedThisMessapePart(mp: TElMessagePart;
  TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean;
begin
  Result := False;
  if (TagInfo<>tiBody) or (Node=nil) or (mp=nil) or (mp.IsMultipart) then
    exit;
  Result := True;
end;

procedure TfraBinary.btnTools_SaveBinaryClick(Sender: TObject);
var
  SD: TSaveDialog;
  sm: TAnsiStringStream;
begin
  SD := TSaveDialog.Create(nil);
  try
    SD.InitialDir := '.';
    SD.Filter := 'All Files (*.*)|*.*';
    SD.Options := [ofOverwritePrompt,ofHideReadOnly,ofPathMustExist,ofEnableSizing];
    SD.FileName := Self.fElMessagePart.FileName;
    if SD.Execute then
    begin
      sm := TAnsiStringStream.Create;
      try
        sm.Memory := fData;
        sm.SaveToFile( SD.FileName );
      finally
        sm.Free;
      end;
    end;
  finally
    SD.Free;
  end;
end;

constructor TfraBinary.Create(AOwner: TComponent);
begin
  inherited;

  // Common

  pTools := TPanel.Create(Self);
  pTools.Height := 41;
  pTools.Align := alTop;
  pTools.BevelInner := bvLowered;
  pTools.TabOrder := 0;
  pTools.Visible := False;
  pTools.Parent := Self;

  btnTools_SaveBinary := TButton.Create(Self);
  btnTools_SaveBinary.Caption := 'Save To File';
  btnTools_SaveBinary.Left := 7;
  btnTools_SaveBinary.Top := pTools.Height - btnTools_SaveBinary.Height - 10;
  btnTools_SaveBinary.Parent := pTools;
  btnTools_SaveBinary.OnClick := btnTools_SaveBinaryClick;
  btnTools_SaveBinary.Visible := True;

  pTools.Visible := True;

  pContainer := TPanel.Create(Self);
  pContainer.Align := alClient;
  pContainer.BevelOuter := bvNone;
  pContainer.TabOrder := 1;
  pContainer.Parent := Self;

  {$IFDEF _HexEditor_}
  HexEditor := THexEditor.Create(Self);
  HexEditor.Align := alClient;
  //HexEditor.DoubleBuffered := True;
  HexEditor.Parent := pContainer;
  HexEditor.ReadOnlyView := True;
  HexEditor.ReadOnlyFile := False;
  HexEditor.NoSizeChange := False;
  HexEditor.AllowInsertMode := True;
  HexEditor.CreateBackup := False;
  {$ELSE}
  HexEditor := THexEditor.Create(Self);
  HexEditor.Align := alClient;
  HexEditor.WordWrap := False;
  HexEditor.Font.Name := 'Courier New';//'Lucida Console';
  HexEditor.Font.Size := 10;
  HexEditor.Font.Style := [fsBold];
  HexEditor.Parent := pContainer;
  HexEditor.ScrollBars := ssBoth;
  HexEditor.ReadOnly := True;
  HexEditor.Color := clBlue;//clBlack;//clBlue;//clNavy;
  HexEditor.Font.Color := clWhite;
  {$ENDIF IFDEF _HexEditor_}
end;

destructor TfraBinary.Destroy;
begin
  {$IFNDEF _HexEditor_}
  StopFillDumpThread(True);
  {$ENDIF}
  inherited;
end;

function TfraBinary.GetCaption: string;
begin
  Result := 'Binary Data Part';
end;

{$IFNDEF _HexEditor_}

procedure TfraBinary.StopFillDumpThread(bDestroy: Boolean);
begin
   if Assigned(fFillHexDumpThread) then
   begin
     fFillHexDumpThread.Priority := tpHigher;
     fFillHexDumpThread.Terminate;
     fFillHexDumpThread.WaitFor;
     FreeAndNil(fFillHexDumpThread);
   end;
   if bDestroy then
     SetLength(fData, 0);
end;

{$ENDIF IFNDEF _HexEditor_}

procedure TfraBinary.Init(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean);
var
  DataSize: Integer;
  {$IFDEF _HexEditor_}
  sm: TAnsiStringStream;
  {$ELSE}
  th :TFillHexDumpThread;
  {$ENDIF}
begin
  inherited;
  if (mp = nil) or (not bShow) then
  begin
    {$IFNDEF _HexEditor_}
    StopFillDumpThread(True);
    {$ENDIF}
    exit;
  end;

  {$IFNDEF _HexEditor_}
  if Assigned(fFillHexDumpThread) then
    StopFillDumpThread(False);
  {$ENDIF}

  {$IFNDEF _HexEditor_}
  HexEditor.Lines.Clear;
  {$ENDIF}

  mp.GetDataSize(DataSize);
  SetLength(fData, DataSize);
  mp.GetData(fData, DataSize);

  {$IFDEF _HexEditor_}
    sm := TAnsiStringStream.Create;
    try
      sm.Memory := fData;
      // debug: sm.SaveToFile('binary_data.tmp')
      HexEditor.BeginUpdate;
      HexEditor.ResetSelection(False);
      if HexEditor.DataSize>0 then
      begin
        HexEditor.SelStart := 0;
        HexEditor.SelEnd := 0;
      end;
      HexEditor.Modified := False;
      HexEditor.AsText := '';
      if sm.Size>0 then
        HexEditor.LoadFromStream(sm);
    finally
      HexEditor.EndUpdate;
      sm.Free;
      SetLength(fData, 0);
    end;
  {$ELSE}
    th := TFillHexDumpThread.Create(True);
    fFillHexDumpThread := th;
    th.fOwner := Self;
    {$IFDEF DELPHI_NET}
    th.Priority := TThreadPriority.tpLowest;
    {$ELSE}
    th.Priority := tpIdle;
    {$ENDIF}
    th.Resume;
  {$ENDIF IFDEF _HexEditor_}
end;

initialization
  TfraBinary.RegisterClass(TfraBinary);
end.