outlookdatalink.pas

来自「Gantt source file example to use in delp」· PAS 代码 · 共 197 行

{-----------------------------------------------------------------------------
 Unit Name: OutLookDataLink
 Author:    Dancemammal
 Purpose:   Link Gantt Chart to OutLook
 History:
-----------------------------------------------------------------------------}


unit OutLookDataLink;

interface

uses
   Windows, Classes, ComCtrls, SysUtils, Dialogs,
   ComObj, Graphics, Controls, Forms, Variants;


const
   olFolderTasks = 13;


type
   TOutlookDataLink = class(TObject)
   private
      MyOlApp: Variant;
      MyNameSpace: Variant;
      Active: Boolean;
      MyOLEObject: string;
      MyOLENameSpace: string;
   protected
   public
      constructor Create;
      destructor Destroy; override;
      function OutlookApplication: Variant;
      function OutlookNameSpace: Variant;
      function OutlookActiveExplorer: Variant;
      procedure ConnectOutlook(Connect: Boolean);
      function CurrentUser: string;
      function Tasks: Variant;
      function CreateTask: Variant;
      function Task(Index: Variant): Variant;
      function TaskCount: Word;
      procedure DeleteTask(MyTask: Variant);
      function FindTask(FindWhat: string): Variant;
      function TopFolders(Index: Variant): Variant;
   published
      property Connected: Boolean read Active write ConnectOutlook;
      property OLEObject: string read MyOLEObject write MyOLEObject;
      property OLENameSpace: string read MyOLENameSpace write MyOLENameSpace;
   end;


implementation




procedure TOutlookDataLink.ConnectOutlook(Connect: Boolean);
begin
   if Connect then
   begin
      try
         MyOlApp := CreateOleObject(OLEObject);
         MyNameSpace := MyOlApp.GetNamespace(OLENameSpace);
      except
         raise Exception.Create('Outlook registration failed');
      end;
   end else
   begin
      MyOlApp := NULL;
      MyNameSpace := NULL;
   end;
   Active := Connect;
end;

function TOutlookDataLink.CurrentUser: string;
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   try
      Result := MyNameSpace.CurrentUser.Name;
   except
      raise Exception.Create('Cannot import Item');
   end;
end;


function TOutlookDataLink.Tasks: Variant;
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   Result := myNameSpace.GetDefaultFolder(olFolderTasks);
end;


function TOutlookDataLink.Task(Index: Variant): Variant;
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   try
      Result := myNameSpace.GetDefaultFolder(olFolderTasks).Items[Index];
   except
      raise Exception.Create('Cannot Export Item');
   end;
end;


function TOutlookDataLink.TaskCount: Word;
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   try
      Result := myNameSpace.GetDefaultFolder(olFolderTasks).Items.Count;
   except
      Result := 0;
   end;
end;


function TOutlookDataLink.CreateTask: Variant;
var
   MyTask: Variant;
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   try
      MyTask := myNameSpace.GetDefaultFolder(olFolderTasks).Items.Add;
      Result := MyTask;
   except
      raise Exception.Create('Cannot create Task');
   end;
end;


procedure TOutlookDataLink.DeleteTask(MyTask: Variant);
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   try
      MyTask.Delete;
   except
      raise Exception.Create('Cannot delete Task');
   end;
end;

function TOutlookDataLink.FindTask(FindWhat: string): Variant;
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   try
      Result := myNameSpace.GetDefaultFolder(olFolderTasks).Items.Find(FindWhat);
   except
      raise Exception.Create('Error finding Task');
   end;
end;


function TOutlookDataLink.OutlookApplication: Variant;
begin
   Result := MyOlApp;
end;

function TOutlookDataLink.OutlookNameSpace: Variant;
begin
   Result := MyNameSpace;
end;

function TOutlookDataLink.OutlookActiveExplorer: Variant;
begin
   Result := MyOlApp.ActiveExplorer;
end;


function TOutlookDataLink.TopFolders(Index: Variant): Variant;
begin
   if not Active then
      raise Exception.Create('No connection to outlook');
   Result := myNameSpace.Folders.Item(Index);
end;

constructor TOutlookDataLink.Create;
begin
   inherited Create;
   if Active then ConnectOutlook(True);
   if OLEObject = '' then OLEObject := 'Outlook.Application';
   if OLENameSpace = '' then OLENameSpace := 'MAPI';
end;

destructor TOutlookDataLink.Destroy;
begin
   ConnectOutlook(False);
   inherited Destroy;
end;


end.