elmimeviewer_datacommon.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 1,114 行 · 第 1/3 页

                  sName := LowerCase(Trim(ExtractFileExtension(wsName)));
                  if sName <> '' then
                  begin
                    // text files:
                    if PosExSafe('\'+sName+'\', '\txt\text\')>0 then
                      Node.ImageIndex := 12
                    else
                    // image files
                    if PosExSafe('\'+sName+'\',
                      '\gif\jpg\jpeg\jpe\jfif\png\bmp\bitmap\wmf\emf\ico\phtm\phtml'+
                      '\rle\dib\vin\vst\vda\tga\icb\tiff\tif\fax\eps\pcx\pcc\scr\rpf\rla'+
                      '\sgi\rgba\rgb\bw\psd\pdd\ppm\pgm\pbm\cel\pic\pcd\cut\psp\') > 0
                    then
                      Node.ImageIndex := 14
                    else
                    if SameText(sName, 'doc') then
                      wsContentSubtype := 'msword'
                    else
                    if SameText(sName, 'ppt') then
                      wsContentSubtype := 'nd.ms-powerpoint'
                    else
                    if SameText(sName, 'rtf') then
                      Node.ImageIndex := 31
                    else
                    if SameText(sName, 'pdf') then
                      Node.ImageIndex := 30
                    else
                    if SameText(sName, 'xls') then
                      Node.ImageIndex := 33
                    else
                    // web files:
                    if PosExSafe('\'+sName+'\', '\htm\html\shtm\shtml\xml\xls\css\cgi\php\js\java\')>0 then
                      Node.ImageIndex := 13
                    else
                    // multimedia files:
                    if PosExSafe('\'+sName+'\', '\avi\mpg\mpeg\vob\divx\mp3\wav\m3u\pls\')>0 then
                      Node.ImageIndex := 35
                    else
                    // archives, cd images, packages
                    if PosExSafe('\'+sName+'\', '\zip\gzip\gz\bzip\bz\tar\arj\rar\ha\iso\rpm\deb\')>0 then
                      Node.ImageIndex := 35
                    else
                    // c, cpp files:
                    if PosExSafe('\'+sName+'\', '\h\hpp\')>0 then
                      Node.ImageIndex := 38
                    else
                    if PosExSafe('\'+sName+'\', '\c\cpp\')>0 then
                      Node.ImageIndex := 39
                    else
                    // pascal files:
                    if PosExSafe('\'+sName+'\', '\pas\dfm\xfm\inc\')>0 then
                      Node.ImageIndex := 36
                    {else
                    if PosExSafe(';'+sName+';', ';;')>0 then
                      Node.ImageIndex := 38
                    else
                    ;
                    {}
                  end;
                end;

                if wsContentSubtype='' then
                  exit
                else
                if WideSameText(wsContentSubtype, 'msword') then
                  Node.ImageIndex := 32;
                if WideSameText(wsContentSubtype, 'vnd.ms-powerpoint') then
                  Node.ImageIndex := 34;
                if WideSameText(wsContentSubtype, 'pkcs7-signature') then
                  Node.ImageIndex := 44;
                if WideSameText(wsContentSubtype, 'pkcs7-mime') then
                begin
                  Node.ImageIndex := 45;
                  //smime-type=signed-data
                  //smime-type=enveloped-data
                end
              end
              else
              if IsMessage then
                Node.ImageIndex := 9;
            end;
          end;
    //        tiPartList, tiPart, // multipart body
    //        tiPartHandler, tiPartBodyHandler // part and body handlers
      end;
    end;
  finally
    Node.SelectedIndex := Node.ImageIndex;
  end;

end;

procedure TElMimePlugFrame.InitSafe(mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo; bShow: Boolean);
begin
  if (fNode<>Node) or (fTagInfo = tiOptions) then
  try
    Init(mp, TagInfo, Node, bShow);
  except
    //on e:Exception do
    //  Application.HandleException(e);
  end;
end;

class function TElMimePlugFrame.IsSupportedThisMessapePart(
  mp: TElMessagePart; TagInfo: TTagInfo; Node: TTreeNodeInfo): Boolean;
begin
  Result := False;
end;

class procedure TElMimePlugFrame.RegisterClass(ClassInfo: TElMimePlugFrameClass);
begin
  if RegisteredPlugFramesList.IndexOf(TObject(ClassInfo)) < 0 then
    RegisteredPlugFramesList.Add(TObject(ClassInfo))
end;

class procedure TElMimePlugFrame.UnRegisterClass(ClassInfo: TElMimePlugFrameClass);
var
  i: Integer;
begin
  i := RegisteredPlugFramesList.IndexOf(TObject(ClassInfo));
  if i>=0 then
    RegisteredPlugFramesList.Delete(i);
end;

procedure TElMimePlugFrame.UpdateView;
begin
  if not fFixedFirstInsert then
    fFixedFirstInsert := True;
end;

procedure TElMimePlugFrame.WriteHTMLCode(sm: TElCustomMemoryStream);
begin
  {empty}
end;

{ TTreeNodeInfoOptions }

constructor TTreeNodeInfoOptions.Create(AOwner: TTreeNodes;
  ATagInfo: TTagInfo; ATagObject: TObject; bFullControl: Boolean);
begin
  inherited Create(AOwner, ATagInfo, ATagObject, bFullControl);
  fLocked := True;
end;

{ TTreeNodesA }

{$IFNDEF D_6_UP}
{$hints off}
type
  TCustomTreeViewH = class(TCustomTreeView);
  TTreeNodeH = class(TPersistent)
  private
    FOwner: TTreeNodes;
    FText: string;
    FData: Pointer;
    FItemId: HTreeItem;
  protected
    function IsFirstNode: Boolean;
  end;
  TTreeNodesH = class(TPersistent)
  private
    FOwner: TCustomTreeView;
    FUpdateCount: Integer;
  end;

function TTreeNodeH.IsFirstNode: Boolean;
begin
  Result := not TTreeNode(Self).Deleting
    and (TTreeNode(Self).Parent = nil)
    and (TTreeNode(Self).GetPrevSibling = nil)
  ;
end;

procedure TTreeNodesA.Repaint(Node: TTreeNode);
var
  R: TRect;
begin
  if TTreeNodesH(Self).FUpdateCount < 1 then
  begin
    while (Node <> nil) and not Node.IsVisible do
      Node := Node.Parent;
    if Node <> nil then
    begin
      R := Node.DisplayRect(False);
      InvalidateRect(Owner.Handle, @R, True);
    end;
  end;
end;

procedure TTreeNodesA.AddedNode(Value: TTreeNode);
begin
  if Value <> nil then
  begin
    Value.HasChildren := True;
    Repaint(Value);
  end;
end;

resourcestring
  sInsertError = 'Unable to insert an item';

function TTreeNodesA._AddNode(Node, Relative: TTreeNode; const S: string;
  Ptr: Pointer; Method: TNodeAttachMode): TTreeNode;
const
  cAddMode: array [TNodeAttachMode] of TAddMode =
    (taAdd, taAddFirst, taAdd, taAddFirst, taInsert);
var
  Item, ItemId: HTreeItem;
  Parent: TTreeNode;
  AddMode: TAddMode;
begin
  if Node = nil then
    Result := TCustomTreeViewH(Owner).CreateNode
  else
    Result := Node;
  try
    Item := nil;
    ItemId := nil;
    Parent := nil;
    AddMode := cAddMode[Method];
    if Relative <> nil then
      case Method of
        naAdd, naAddFirst:
          begin
            Parent := Relative.Parent;
            if Parent <> nil then
              Item := Parent.ItemId;
          end;
        naAddChild, naAddChildFirst:
          begin
            Parent := Relative;
            Item := Parent.ItemId;
          end;
        naInsert:
          begin
            Parent := Relative.Parent;
            if Parent <> nil then
              Item := Parent.ItemId;
            Relative := Relative.GetPrevSibling;
            if Relative <> nil then
              ItemId := Relative.ItemId
            else
              AddMode := taAddFirst;
          end;
      end;
    Result.Data := Ptr;
    Result.Text := S;
    Item := AddItem(Item, ItemId, CreateItem(Result), AddMode);
    if Item = nil then
      raise EOutOfResources.Create(sInsertError);
    TTreeNodeH(Result).FItemId := Item;
    if (TTreeNodesH(Self).FUpdateCount = 0) and TTreeNodeH(Result).IsFirstNode then
      SendMessage(Handle, WM_SETREDRAW, 1, 0);
    AddedNode(Parent);
    //if not Reading then
    //  TCustomTreeViewH(Owner).Added(Result);
  except
    Result.Free;
    raise;
  end;
end;
{$hints on}
{$ENDIF IFNDEF D_6_UP}

function TTreeNodesFix.AddNode(Node, Relative: TTreeNode; const S: string;
  Ptr: {$IFDEF DELPHI_NET}TObject{$ELSE}Pointer{$ENDIF}; Method: TNodeAttachMode): TTreeNode;
var
  SaveIndex: Integer;
  //Nodes: TTreeNodes;
begin
  if Node= nil then
  begin
    Result := nil;
    exit;
  end;
  SaveIndex := Node.StateIndex;
  Node.StateIndex := -1;
  {$IFDEF D_6_UP}
  Result := inherited AddNode(Node, Relative, S, Ptr, Method);
  {$ELSE}
  Result := _AddNode(Node, Relative, S, Ptr, Method);
  {$ENDIF IFNDEF D_6_UP}
  if SaveIndex>=0 then
    Node.StateIndex := SaveIndex;
end;

{ TElMimePlugFrameOptions }

constructor TElMimePlugFrameOptions.Create(AOwner: TComponent; RootNode: TTreeNode; Nodes: TTreeNodesA);
begin
  inherited Create(AOwner);
  fRootNode := RootNode;
  fNodes := Nodes;
end;

class procedure TElMimePlugFrameOptions.RegisterClass(ClassInfo: TElMimePlugFrameOptionsClass);
begin
  if RegPlugOptFraClasses.IndexOf(TObject(ClassInfo)) < 0 then
    RegPlugOptFraClasses.Add(TObject(ClassInfo))
end;

class procedure TElMimePlugFrameOptions.UnRegisterClass(ClassInfo: TElMimePlugFrameOptionsClass);
var
  i: Integer;
  obj: TObject;
begin
  RegPlugOptFraClasses.Remove(TObject(ClassInfo));
  i := 0;
  while i < RegPlugOptFra.Count do
  begin
    if TObject(RegPlugOptFra[i]).ClassType = ClassInfo then
    begin
      obj := TObject(RegPlugOptFra[i]);
      RegPlugOptFra.Delete(i);
      obj.Free;
      continue;
    end;
    inc(i);
  end;
end;

procedure TdmElMime.InitExtensions(Node: TTreeNode);
var
  i: Integer;
  ci: TElMimePlugFrameOptionsClass;
  op: TElMimePlugFrameOptions;
begin
  for i:=0 to RegPlugOptFraClasses.Count-1 do
  begin
    ci := TElMimePlugFrameOptionsClass(RegPlugOptFraClasses[i]);
    if ci = nil then
      continue;
    op := ci.Create(nil, Node, TTreeNodesA(Node.Owner));
    RegPlugOptFra.Add(op);
  end;
end;

procedure TdmElMime.DataModuleDestroy(Sender: TObject);
var
  i: Integer;
  op: TElMimePlugFrameOptions;
begin
  i := 0;
  while i < RegPlugOptFra.Count do
  begin
    op := TElMimePlugFrameOptions(RegPlugOptFra[i]);
    RegPlugOptFra[i] := nil;
    if op <>nil then
    try
      op.BeforeRemoveParent;
      op.Parent := nil;
      op.Free;
    except
    end;
    inc(i);
  end;
end;

initialization
  RegisteredPlugFramesList := TList.Create;
  PlugFramesList := TList.Create;
  RegPlugOptFraClasses := TList.Create;
  RegPlugOptFra := TList.Create;
finalization
  RegisteredPlugFramesList.Free;
  PlugFramesList.Free;
  RegPlugOptFraClasses.Free;
  RegPlugOptFra.Free;
end.