elmimeviewer_image.pas

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

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

// _GraphicEx_
{$i ElMimeViewer_Options.inc}

interface

uses
  // System units:
  SysUtils, Classes,
  // ElMime units:
  SBMIMETypes,
  SBMIMEUtils,
  SBMIMEClasses,
  SBMIMEStream,
  SBMIME,
  // ElMime Demo units:
  ElMimeViewer_DataCommon,
  ElMimeViewer_Binary,
  // graph units:
  {$IFNDEF DELPHI_NET}
  JPEG,
  {$ENDIF}
  {$IFDEF _GraphicEx_} JPG, GraphicEx, {$ENDIF}
  // other units:
  Windows, Messages, {$IFDEF D_6_UP}Variants,{$ENDIF} Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type

  TFrame = TfraBinary; // inherit from binary viewer for allow view image as binary data.

  TfraImage = class(TFrame)
    procedure cbShowBinaryClick(Sender: TObject);
    procedure btnShowBinaryClick(Sender: TObject);
  private
    { Private declarations }
    ScrollBox: TScrollBox;
    Image: TImage;
    stError: TStaticText;
    cbShowBinary: TCheckBox;
    btnShowBinary: TButton;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    class function IsSupportedThisMessapePart(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean; override;
    class function SetNodeImageIndex(Node: TTreeNodeInfo; mp: TElMessagePart): Boolean; override;
    function GetCaption: string; override;
  protected
    procedure Init(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean); override;
  end;

implementation

uses ElMimeViewer_PlainText;

{ TfraImage }

class function TfraImage.IsSupportedThisMessapePart(mp: TElMessagePart;
  TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean;
//var
  //wsContentSubtype: TWideString;
  //wsName: TWideString;
  //sName: AnsiString;
  function BinaryAutodetect: Boolean;
  var
    sm: TElMemoryStream;
    DataSize: Integer;
    vBuff: TBytes;
  begin
    Result := False;
    try
    sm := TElMemoryStream.Create;
    try
      Screen.Cursor := crHourGlass;
      mp.GetDataSize(DataSize);
      if DataSize < 10 then
        exit;
      SetLength(vBuff, DataSize);
      mp.GetData(vBuff, DataSize);
      sm.Memory := vBuff;
      {$IFDEF _GraphicEx_}
        if Assigned(FileFormatList.GraphicFromContent(sm)) then
        begin
          Result := True;
          exit;
        end;
        sm.Position := 0;
      {$ENDIF IFDEF _GraphicEx_}
      // JPEG:
      if
        ( // JFIF
          (AnsiChar(sm.Memory[6]) = 'J') and (AnsiChar(sm.Memory[7]) = 'F') and
          (AnsiChar(sm.Memory[8]) = 'I') and (AnsiChar(sm.Memory[9]) = 'F')
        ) or
        ( // Exif
          (AnsiChar(sm.Memory[6]) = 'E') and (AnsiChar(sm.Memory[7]) = 'x') and
          (AnsiChar(sm.Memory[8]) = 'i') and (AnsiChar(sm.Memory[9]) = 'f')
        )
      then
        Result := True
      else
      // BMP:
      if
        (AnsiChar(sm.Memory[0]) = 'B') and (AnsiChar(sm.Memory[1]) = 'M')
        // and (AnsiChar(sm.Memory[2]) in ['6', 'B', 'z', ':'])
      then
        Result := True
      else
      // ICO:
      if
        (sm.Memory[0] = 0) and (sm.Memory[1] = 0) and
        (sm.Memory[2] = 1) and (sm.Memory[3] = 0) and
        (sm.Memory[4] = 1) and (sm.Memory[5] = 0)
      then
        Result := True
      else
      {
      // x-ICON:
      if
        (sm.Memory[0] = 32) and (sm.Memory[1] = 32) and
        (sm.Memory[2] = 01) and (sm.Memory[3] = 32) and
        (sm.Memory[4] = 01) and (sm.Memory[5] = 32)
      then
        Result := True
      else
      }
      if sm.Size > 60 then
      begin
        // WMF:
        if
          (AnsiChar(sm.Memory[55]) = 'W') and (AnsiChar(sm.Memory[56]) = 'M') and
          (AnsiChar(sm.Memory[57]) = 'F')
        then
          Result := True
      end;
    finally
      sm.Free;
      Screen.Cursor := crDefault;
    end;
    except
    end;
  end;
begin
  Result := False;
  if (TagInfo<>tiBody) or (Node=nil) or (mp=nil) or (mp.IsMultipart) then
    exit;
  if mp.IsImage or ( mp.IsApplication and WideSameText(mp.ContentSubtype, 'octet-stream') ) then
    Result := BinaryAutodetect;
  (*
  Result := mp.IsImage;
  if not Result then
  begin
    if mp.IsApplication then
    begin
      wsContentSubtype := mp.ContentSubtype;
      if WideSameText(wsContentSubtype, 'octet-stream') then
      begin

        wsName := mp.FileName;
        DeleteQuotationMarks(wsName);
        sName := LowerCase(Trim(ExtractFileExtension(wsName)));
        if wsName <> '' then
        begin
          if PosExSafe('\'+sName+'\',
            '\gif\jpg\jpeg\jpe\jfif\png\bmp\bitmap\wmf\emf\ico\') > 0 then
          begin
            Result := True;
            exit;
          end;
        end;

      end;//of: if WideSameText(wsContentSubtype, 'octet-stream')
    end;//of: if mp.IsApplication
  end;//of: if not Result
  //*)
end;

class function TfraImage.SetNodeImageIndex(Node: TTreeNodeInfo;
  mp: TElMessagePart): Boolean;
begin
  Result := False;
  if (Node=nil) then
    exit;
  Result := True;
  Node.ImageIndex := 14;
  Node.SelectedIndex := 14;
end;

function TfraImage.GetCaption: string;
begin
  if HexEditor.Visible then
    Result := inherited GetCaption
  else
    Result := 'Image Part Data';
end;

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

  HexEditor.Visible := False;
  btnTools_SaveBinary.Visible := False;

  ScrollBox := TScrollBox.Create(Self);
  ScrollBox.Align := alClient;
  ScrollBox.Parent := pContainer;

  Image := TImage.Create(Self);
  Image.Left := 2;
  Image.Top := 2;
  Image.AutoSize := True;
  Image.Parent := ScrollBox;

  stError := TStaticText.Create(Self);
  stError.Align := alClient;
  stError.Caption := 'Error: Unsupported image format';
  stError.Font.Charset := DEFAULT_CHARSET;
  stError.Font.Color := clMaroon;
  stError.Font.Height := -13;
  stError.Font.Name := 'MS Sans Serif';
  stError.Font.Style := [fsBold];
  stError.Visible := False;
  stError.Parent := Self;

  cbShowBinary := TCheckBox.Create(Self);
  cbShowBinary.Caption := 'Show Binary';
  cbShowBinary.Left := 7;
  cbShowBinary.Top := pTools.Height - cbShowBinary.Height - 10;
  cbShowBinary.OnClick := cbShowBinaryClick;
  cbShowBinary.Parent := pTools;

  btnShowBinary := TButton.Create(Self);
  btnShowBinary.Visible := False;
  btnShowBinary.Caption := 'Show Binary';
  btnShowBinary.Left := btnTools_SaveBinary.Left + btnTools_SaveBinary.Width + 7;
  btnShowBinary.Top := pTools.Height - btnShowBinary.Height - 10;
  btnShowBinary.OnClick := btnShowBinaryClick;
  btnShowBinary.Parent := pTools;

  pTools.Visible := True;

  {$IFNDEF _GraphicEx_}
  cbShowBinary.Checked := True;
  {$ENDIF}

end;

function DateTimeToStrEx(DateTime: TDateTime; const Format: String = ''): String;
begin
  DateTimeToString(Result, Format, DateTime);
end;

procedure TfraImage.Init(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean);
var
  sm: TElMemoryStream;
  DataSize: Integer;
  vBuff: TBytes;
  {$IFDEF _GraphicEx_}
  GraphicClass: TGraphicExGraphicClass;
  Graphic: TGraphic;
  {$ENDIF IFDEF _GraphicEx_}
  S: String;
  sExt: String;
  procedure LoadDefImage;
  var
    Graphic: TGraphic;
  begin
    sExt := LowerCase(Trim(ExtractFileExtension(mp.FileName)));
    if (Length(sExt) = 0) and (sm.Size>=10) then
    begin
    // Binary autodetect:
      // JPEG:
      if
        ( // JFIF
          (AnsiChar(sm.Memory[6]) = 'J') and (AnsiChar(sm.Memory[7]) = 'F') and
          (AnsiChar(sm.Memory[8]) = 'I') and (AnsiChar(sm.Memory[9]) = 'F')
        ) or
        ( // Exif
          (AnsiChar(sm.Memory[6]) = 'E') and (AnsiChar(sm.Memory[7]) = 'x') and
          (AnsiChar(sm.Memory[8]) = 'i') and (AnsiChar(sm.Memory[9]) = 'f')
        )
      then
        sExt := 'jpeg'
      else
      // BMP:
      if
        (AnsiChar(sm.Memory[0]) = 'B') and (AnsiChar(sm.Memory[1]) = 'M')
        // and (AnsiChar(sm.Memory[2]) in ['6', 'B', 'z', ':'])
      then
        sExt := 'bmp'
      else
      // ICO:
      if
        (sm.Memory[0] = 0) and (sm.Memory[1] = 0) and
        (sm.Memory[2] = 1) and (sm.Memory[3] = 0) and
        (sm.Memory[4] = 1) and (sm.Memory[5] = 0)
      then
        sExt := 'ico'
      else
      {
      // x-ICON:
      if
        (sm.Memory[0] = 32) and (sm.Memory[1] = 32) and
        (sm.Memory[2] = 01) and (sm.Memory[3] = 32) and
        (sm.Memory[4] = 01) and (sm.Memory[5] = 32)
      then
        sExt := 'ico'
      else
      }
      if sm.Size > 60 then
      begin
        // WMF:
        if
          (AnsiChar(sm.Memory[55]) = 'W') and (AnsiChar(sm.Memory[56]) = 'M') and
          (AnsiChar(sm.Memory[57]) = 'F')
        then
          sExt := 'wmf';
      end;
    end;

    if Length(sExt) = 0 then
      Abort; // unknown format

    Graphic := nil;
    try

    begin
      {$IFNDEF DELPHI_NET}
      if Pos('\'+sExt+'\', '\jpeg\jpg\jpe\jfif\') > 0 then
      begin
        Graphic := TJPEGImage.Create;
        Graphic.LoadFromStream(sm);
        Image.Picture.Graphic := Graphic;
        Image.Visible := True;
        exit;
      end
      else
      {$ENDIF}
      if Pos('\'+sExt+'\', '\bmp\bitmap\') > 0 then
      begin
        Graphic := TBitmap.Create;
        {$IFDEF DELPHI_NET}
        Graphic.LoadFromStream( TCLRStreamWrapper.Create(sm) );
        {$ELSE}
        Graphic.LoadFromStream(sm);
        {$ENDIF}
        Image.Picture.Graphic := Graphic;
        Image.Visible := True;
        exit;
      end
      else
      if Pos('\'+sExt+'\', '\ico\icon\') > 0 then
      begin
        Graphic := TIcon.Create;
        {$IFDEF DELPHI_NET}
        Graphic.LoadFromStream( TCLRStreamWrapper.Create(sm) );
        {$ELSE}
        Graphic.LoadFromStream(sm);
        {$ENDIF}
        Image.Picture.Graphic := Graphic;
        Image.Visible := True;
        exit;
      end
      else
      if Pos('\'+sExt+'\', '\wmf\emf\') > 0 then
      begin
        Graphic := TMetafile.Create;
        {$IFDEF DELPHI_NET}
        Graphic.LoadFromStream( TCLRStreamWrapper.Create(sm) );
        {$ELSE}
        Graphic.LoadFromStream(sm);
        {$ENDIF}
        Image.Picture.Graphic := Graphic;
        Image.Visible := True;
        exit;
      end;
    end;

    finally
      Graphic.Free;
    end;

    Abort;

  end;
begin
  btnTools_SaveBinary.Visible := False;
  btnShowBinary.Visible := False;
  inherited Init(mp, TagInfo, Node, {bShow = NoShow == False =>}False);

  if (Node=nil) or (not bShow) then
    exit;

  sExt := '';
  cbShowBinary.Visible := True;

  if cbShowBinary.Checked then
  begin
    stError.Visible := False;
    ScrollBox.Visible := False;
    HexEditor.Visible := True;
    if Length(fData)=0 then
      inherited;
    exit;
  end;

  if mp = nil then
  begin
    Image.Picture.Graphic := nil;
    inherited;
    exit;
  end;

  stError.Visible := False;
  HexEditor.Visible := False;
  ScrollBox.Visible := True;
  btnTools_SaveBinary.Visible := False;
  btnShowBinary.Visible := False;

  sm := TElMemoryStream.Create;
  try
    Screen.Cursor := crHourGlass;
    mp.GetDataSize(DataSize);
    SetLength(vBuff, DataSize);
    mp.GetData(vBuff, DataSize);
    sm.Memory := vBuff;
    // debug: sm.SaveToFile('a.gif')
    Image.Hide;
    try
    {$IFDEF _GraphicEx_}
      GraphicClass := FileFormatList.GraphicFromContent(sm);
      if GraphicClass <> nil then
      begin
        Graphic := GraphicClass.Create;
        try
          sm.Position := 0;
          Graphic.LoadFromStream(sm);
          Image.Picture.Graphic := Graphic;
          Image.Visible := True;
        finally
          Graphic.Free;
        end;
        exit;
      end;
      sm.Position := 0;
    {$ENDIF IFDEF _GraphicEx_}
      LoadDefImage;
    except
      on e:Exception do
      begin
        Image.Picture.Graphic := nil;
        if Length(sExt) > 0 then
          S := sExt
        else
          S := mp.ContentSubtype;

        stError.Caption := 'Error: Unsupported image format: "' +  S + '"';
        if not (e is EAbort) then
          stError.Caption := stError.Caption + ' :'#13#10#13#10 + e.Message;

        stError.Visible := True;

        cbShowBinary.Visible := False;
        cbShowBinary.Tag := 1;
        cbShowBinary.Checked := True;
        cbShowBinary.Tag := 0;
        btnTools_SaveBinary.Visible := True;
        btnShowBinary.Visible := True;
      end;
    end;

  finally
    sm.Free;
    Screen.Cursor := crDefault;
  end;

end;

procedure TfraImage.cbShowBinaryClick(Sender: TObject);
var
  ANode: TTreeNodeInfo;
begin
  if cbShowBinary.Tag = 1 then
    exit;
  stError.Visible := False;
  ScrollBox.Visible := not cbShowBinary.Checked;
  HexEditor.Visible := cbShowBinary.Checked;

  cbShowBinary.Tag := 1;
  try
    ANode := fNode;
    fNode := nil;
    InitSafe(fElMessagePart, fTagInfo, nil, False);
    InitSafe(fElMessagePart, fTagInfo, ANode, True);
  finally
    cbShowBinary.Tag := 0;
  end;
end;

procedure TfraImage.btnShowBinaryClick(Sender: TObject);
var
  ANode: TTreeNodeInfo;
begin
  // reload data:
  btnShowBinary.Visible := False;
  btnTools_SaveBinary.Visible := False;
  ANode := fNode;
  fNode := nil;
  InitSafe(fElMessagePart, fTagInfo, nil, False);
  InitSafe(fElMessagePart, fTagInfo, ANode, True);
end;

initialization
  TfraImage.RegisterClass(TfraImage);
end.