Sample Application: OutlookTest3.dpr

Project source
Form source (Pascal)
Form source (DFM)

Design-time form image
Project source: OutlookTest3.dpr

program OutlookTest3;

uses
  Forms,
  fmOutlookTest3 in 'fmOutlookTest3.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
Back to top
Form source: fmOutlookTest3.pas

unit fmOutlookTest3;

{Demonstrates how to drag stuff from outlook into a list, and then manipulate
 (edit) it later (in the actual object store) using automation.

 Last modified:  09/29/99}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  uoole, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    UOTextTarget1: TUOTextTarget;
    ListView1: TListView;
    Button1: TButton;
    ckbOpenFOlder: TCheckBox;
    RadioGroup1: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
      const dropText: String; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure UOTextTarget1DragOver(Sender: TObject; effect: TDropEffect;
      X, Y: Integer);
    procedure RadioGroup1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
  private
    { Private declarations }
    ilSmall: TImageList;
    ilLarge: TImageList;
    FFolderName: string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ActiveX, uoUtil, ShlObj, ShellAPI, COMObj;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  aSHFi: TSHFileInfo;
begin
  // Set up the image lists - small and large separately.
  // They are owned by the form, and will be destroyed along with it.
  // Share the images so that we won't destroy the system
  // image lists.
  // Use a dummy wildcard filename for this call.
  ilSmall := TImageList.Create(Self);
  ilSmall.ShareImages := true;
  ilSmall.Handle := SHGetFileInfo('*.*', 0, aSHFi, sizeOf(aSHFi),
       SHGFI_ATTRIBUTES	  // Retrieves the file attribute flags.
    or SHGFI_DISPLAYNAME  // Retrieves the display name for the file.
    or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
    or SHGFI_SMALLICON	  // Causes the large icon to be retrieved
  );
  ListView1.SmallImages := ilSmall;

  ilLarge := TImageList.Create(Self);
  ilLarge.ShareImages := true;
  ilLarge.Handle := SHGetFileInfo('*.*', 0, aSHFi, sizeOf(aSHFi),
       SHGFI_ATTRIBUTES	  // Retrieves the file attribute flags.
    or SHGFI_DISPLAYNAME  // Retrieves the display name for the file.
    or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
    or SHGFI_LARGEICON	  // Causes the large icon to be retrieved
  );
  ListView1.LargeImages := ilLarge;

  with UOTextTarget1, CustomFormats do
  begin
    OverrideDropEffects[deMove] := deCopy;
    OverrideDropEffects[deLink] := deCopy;
    AddObject('Object Descriptor', TObject(TYMED_HGLOBAL));
  end;
end;

procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
  const dropText: String; X, Y: Integer);
var
  j: integer;
  s: string;
  aSL: TStringList;
  anIStorage: IStorage;
  aSHFi: TSHFileInfo;
  outlook: OleVariant;
  cf: OleVariant;
begin
  Screen.Cursor := crHourglass;

  try
    outlook := GetActiveOleObject('Outlook.Application');
    cf := outlook.activeexplorer.currentfolder;

    s := '';
    while (not (cf.Parent.class = 0)) do // All the way to the application object
    begin
      s := '|' + cf.name + s;
      cf := cf.parent;
    end;
    FFolderName := s;

    s := UOTextTarget1.DataObjectGetFormat('FileGroupDescriptor');
    aSL := uoFileListFromFileGroupDescriptor(s);
    try
      for j := 1 to aSL.Count do
      begin
        if (AnsiCompareText(ExtractFileExt(aSL[0]), '.msg') <> 0) then break;
        // Its content is on an IStream, at lindex j-1
        // Global overrides for lindex and tymed
        DataObjectLindex := j-1;
        DataObjectTymed := TYMED_ISTORAGE;
        s := UOTextTarget1.DataObjectGetFormat('FileContents');

        // Watch out for nothing at that index...
        if (s <> '') then
        begin
          // Get the IStorage
          DWORD(anIStorage) := uoDecodeDWORDFromString(s);

          // Are we saving Outlook as MSG files? (A saved .MSG file can be double-
          // clicked to start up Outlook editing that message).
          // This is just an exercise in putting the IStorage on a file.
          // How?  Make another storage that IS a file, and copy to there!
          // Because the default is direct (as opposed to transacted) mode,
          // the change gets saved immediately.
          s := uoGetTempFilename('uox');
          s := ChangeFileExt(s, '.msg');

          // Save to file so we can use SHGetFileInfo()
          // uoSaveIStorageToFile() introduced in V1.31
          uoSaveIStorageToFile(anIStorage, s);

          SHGetFileInfo(PChar(s), 0, aSHFi, sizeOf(aSHFi),
               SHGFI_ATTRIBUTES   // Retrieves the file attribute flags.
            or SHGFI_DISPLAYNAME  // Retrieves the display name for the file.
            or SHGFI_SYSICONINDEX // Retrieves the handle of the icon
            or SHGFI_TYPENAME     // Retrieves the type of item
            or SHGFI_SMALLICON    // Causes the small icon to be retrieved
          );
          // Delete the file again
          DeleteFile(s);

          // Add info to the list view
          with ListView1.Items.Add do
          begin
            Caption := ChangeFileExt(aSL[j-1], '');
            SubItems.Add( StrPas(aSHFi.szTypeName));
            SubItems.Add(FFolderName);
            ImageIndex := aSHFi.iIcon;
          end;
        end;
      end;
    finally
      aSL.Free;
    end;
  finally
    outlook := unassigned;
    cf := unassigned;
    Screen.Cursor := crDefault;
  end;
end;

procedure touch(var x);
begin
  // Cute debugging trick.  Call touch on any variable and it won't be
  // optimized out.
end;

procedure TForm1.Button1Click(Sender: TObject);
// Handle a button click to open the selected item.
var
  Outlook: OleVariant;
  aNamespace: OleVariant;
  aFolder: OleVariant;
  j: integer;
  aSL: TStringList;
  aLi: TListItem;
  found: boolean;
  s1, s2: string;
  expl: OleVariant;
  c: integer;
begin
  aLi := ListView1.Selected;
  if not assigned(aLi) then exit;

  // Reconstruct the path to the item in Outlook
  aSL := uoTokenize(aLi.SubItems[1], ['|']);
  try
    Outlook := GetActiveOleObject('Outlook.Application');
    aNamespace := Outlook.GetNamespace('MAPI');
    aFolder := aNamespace.Folders(aSL[0]);
    for j := 2 to aSL.Count do
    begin
      aFolder := aFolder.Folders(aSL[j-1]);
    end;
  finally
    aSL.Free;
  end;

  // Now we have a folder.  If the checkbox is checked, open the folder too.
  // First, though, see if it's already open.
  found := false;
  c := Outlook.Explorers.Count;
  // touch(c);
  for j := 1 to c do
  begin
    try
      expl := Outlook.Explorers.Item[j];
      s1 := expl.Currentfolder.Name;
      s2 := aFolder.Name;
      if (AnsiCompareText(s1, s2) = 0) then
      begin
        found := true;
        // It's already open - just activate the open one
        if ckbOpenFolder.Checked then
          Outlook.Explorers.Item[j].Activate;
        break; // No need to search further - we found it
      end;
    except
      // Trap OLE errors
      on EOleSysError do;
      on EOleError do;
    end;
  end;
  // If it wasn't opened and we want it open, open it.
  if ((not found) and ckbOpenFolder.Checked) then
    aFolder.Display;

  // Open an inspector (editor) for the item.
  aFolder.Items(aLi.Caption).Display;

  // Finally, clear all of the variants
  Outlook := Unassigned;
  aNamespace := Unassigned;
  aFolder := Unassigned;
  expl := Unassigned;
end;

procedure TForm1.UOTextTarget1DragOver(Sender: TObject;
  effect: TDropEffect; X, Y: Integer);
begin
  // Only show drop cursor if we really want the stuff being dragged
  // This doesn't affect the functionality, but it's important to get
  // user feedback in the UI right.
  with UOTextTarget1 do
  begin
    DataObjectTymed := TYMED_ISTREAM;
    AcceptCustom := DataObjectHasFormat('RenPrivateSourceFolder');
    AcceptCustom := AcceptCustom
      and DataObjectHasFormat('FileGroupDescriptor')
      // don't accept drags of folders
      and not DataObjectHasFormat('UniformResourceLocator');
  end;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  // Select a new viewstyle for the listview
  ListView1.ViewStyle := TViewStyle(RadioGroup1.ItemIndex);
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
begin
  // Doubleclick is the same as clicking the button
  Button1Click(Button1);
end;

end.
Back to top
Form source: fmOutlookTest3.dfm

object Form1: TForm1
  Left = 192
  Top = 107
  BorderStyle = bsDialog
  Caption = 'Test of dragging items from Outlook'
  ClientHeight = 320
  ClientWidth = 570
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 8
    Width = 351
    Height = 13
    Caption = 
      'Drop items from MS Outlook on this list (e-mail, contacts, appoi' +
      'ntments, etc'
  end
  object ListView1: TListView
    Left = 8
    Top = 64
    Width = 554
    Height = 249
    Columns = <
      item
        Caption = 'Outlook Item'
        Width = 200
      end
      item
        Caption = 'Type'
        Width = 150
      end
      item
        Caption = 'Folder name'
        Width = 200
      end>
    ColumnClick = False
    ReadOnly = True
    TabOrder = 0
    ViewStyle = vsReport
    OnDblClick = ListView1DblClick
  end
  object Button1: TButton
    Left = 403
    Top = 11
    Width = 137
    Height = 25
    Caption = 'Open the item'
    TabOrder = 1
    OnClick = Button1Click
  end
  object ckbOpenFOlder: TCheckBox
    Left = 403
    Top = 39
    Width = 137
    Height = 17
    Caption = 'Open container folder'
    TabOrder = 2
  end
  object RadioGroup1: TRadioGroup
    Left = 8
    Top = 23
    Width = 337
    Height = 37
    Caption = 'List view style'
    Columns = 4
    ItemIndex = 3
    Items.Strings = (
      'Icons'
      'Small Icons'
      'List'
      'Report')
    TabOrder = 3
    OnClick = RadioGroup1Click
  end
  object UOTextTarget1: TUOTextTarget
    AcceptorControl = ListView1
    AcceptTextFormats = [dtfCustom]
    OnDragOver = UOTextTarget1DragOver
    OnDrop = UOTextTarget1Drop
    Left = 264
    Top = 144
  end
end
Back to top

Back to the examples page