ole.htm

对于学习很有帮助

                   for i2 := 1 to MyFolders2.Count do begin
                       MyFolder2 := MyNameSpace.folders(i).Folders(i2);
                       If (MyFolder2.DefaultItemType = ItemType)
                           or (MyFolder2.Name = ThisName) then
                               Begin
                                    MyTreeData := TTreeData.create;
                                    MyTreeData.ItemId := MyFolder2.EntryId;
{this is what you need to directly point at the folder}
                                    MyNode :=
Treeview1.Items.addChildObject(RootNode, MyFolder2.Name, MyTreeData);
                                    MyFolders3 :=
MyNameSpace.folders(i).Folders(i2).Folders;
                                    If MyFolders3.Count > 0 then
                                       for i3 := 1 to MyFolders3.Count do
				   begin
                                           MyFolder3 := MyNameSpace.folders(i).Folders(i2).Folders(i3);
                                           If (MyFolder3.DefaultItemType = ItemType) then
                                               Begin
                                                    MyTreeData := TTreeData.create;
                                                    MyTreeData.ItemId := MyFolder3.EntryId;
                                                    MyNode2 :=
Treeview1.Items.addChildObject(MyNode, MyFolder3.Name, MyTreeData);
                                               end;
                                       end;
                               end;
                   end;
         end;
       If MyTree.TreeView1.Items.Count = 2 then
{there is only the root and my designated folder}
          MyFolder :=
MyNameSpace.GetFolderFromID(TTreeData(MyTree.TreeView1.Items[1].Data).ItemId
)
       Else
          begin
              MyTree.Treeview1.FullExpand;
              MyTree.ShowModal;
              If MyTree.ModalResult = mrOk then
                 Begin
                      If MyTree.Treeview1.Selected <> nil then
                         MyFolder :=
MyNameSpace.GetFolderFromID(TTreeData(MyTree.Treeview1.Selected.Data).ItemId
);
                 end
              else
                 Begin
                     MyOutlook := UnAssigned;
                     For i:= MyTree.Treeview1.Items.Count -1 downto 0 do
                         TTreeData(MyTree.Treeview1.Items[i].Data).free;
                     MyTree.release;
                     exit;
                 end;
          end;
       For i:= MyTree.Treeview1.Items.Count -1 downto 0 do
           TTreeData(MyTree.Treeview1.Items[i].Data).free;
       MyTree.release;
       Result := true;
end;

Function MakeOutlookContact(MyId : TMyId; MyContId : TMyContId) : boolean;
var      MyContact : Variant;
begin
       Result := false;
       If not GetOutlookUp(OlContactItem)
          then exit;
       MyContact := MyFolder.Items.Add(olContactItem);
       MyContact.Title := MyContId.Honorific;
       MyContact.FirstName := MyContId.FirstName;
       MyContact.MiddleName := MycontId.MiddleInit;
       MyContact.LastName :=  MycontId.LastName;
       MyContact.Suffix := MyContId.Suffix;
       MyContact.CompanyName := MyId.OrganizationName;
       MyContact.JobTitle := MyContId.Title;
       MyContact.OfficeLocation := MyContId.OfficeLocation;
       MyContact.CustomerId := MyId.ID;
       MyContact.Account := MyId.AccountId;
       MyContact.BusinessAddressStreet := MyId.Address1 + CRLF + MyId.Address2;
       MyContact.BusinessAddressCity := MyId.City;
       MyContact.BusinessAddressState := MyId.StProv;
       MyContact.BusinessAddressPostalCode := MyId.Postal;
       MyContact.BusinessAddressCountry := MyId.Country;
       If (MyContId.Fax = Nothing) or (MyContId.Fax = ASpace) then
          MyContact.BusinessFaxNumber := MyId.Fax
       Else
          MyContact.BusinessFaxNumber := MyContId.Fax;
       If (MyContId.WorkPhone = Nothing) or (MyContId.WorkPhone = ASpace)
then
          MyContact.BusinessTelephoneNumber := MyId.Phone
       Else
          MyContact.BusinessTelephoneNumber := MyContId.WorkPhone;
       MyContact.CompanyMainTelephoneNumber := MyId.Phone;
       MyContact.HomeFaxNumber := MyContId.HomeFax;
       MyContact.HomeTelephoneNumber := MyContId.HomePhone;
       MyContact.MobileTelephoneNumber := MyContId.MobilePhone;
       MyContact.OtherTelephoneNumber := MyContId.OtherPhone;
       MyContact.PagerNumber := MyContId.Pager;
       MyContact.Email1Address := MyContId.Email;
       MyContact.Email2Address := MyId.Email;
       Result := true;
       Try MyContact.Save;
       Except
           Result := false;
       end;
       MyOutlook := Unassigned;

end;

Function GetThisOutlookItem(AnIndex : Integer) : Variant;
Begin
  Result := myFolder.Items(AnIndex);
end;

Function GetOutlookFolderItemCount : Integer;
Var myItems : Variant;
Begin
    Try MyItems := MyFolder.Items;
      Except
         Begin
            Result := 0;
            exit;
         end;
      end;
    Result := MyItems.Count;
end;

Function FindMyOutlookItem(AFilter : String; var AItem : Variant) :
Boolean;
Begin
{this is another real PAIN - nil variant}
       Result := true;
       Try
          AItem := myFolder.Items.Find(AFilter);
       Except
          Begin
             aItem := MyFolder;
             Result := false;
          end;
       End;

End;

Function FindNextMyOutlookItem(var AItem : Variant) : Boolean;
Begin
       Result := true;
       Try
          AItem := myFolder.Items.FindNext;
       Except
          Begin
             AItem := myFolder;
             Result := false;
          end;
       End;
End;


Function CloseOutlook : Boolean;
begin
       Try MyOutlook := Unassigned;
       Except
       End;
       Result := true;

end;
</PRE><HR>

How to use this stuff! <br>
a unit to pick an Outlook contact <br>
With many thanks to B. stowers and the lovely extended list view<br>

<HR><PRE>unit UImpContact;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UMain, StdCtrls, Buttons, ComCtrls, ExtListView;

type
  TFindContact = class(TForm)
    ContView1: TExtListView;
    SearchBtn: TBitBtn;
    CancelBtn: TBitBtn;
    procedure SearchBtnClick(Sender: TObject);
    procedure CancelBtnClick(Sender: TObject);
    procedure ContView1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FindContact: TFindContact;

implementation
Uses USearch;

{$R *.DFM}

procedure TFindContact.SearchBtnClick(Sender: TObject);
begin
   If ContView1.Selected <> nil then
      ContView1DblClick(nil);
end;

procedure TFindContact.CancelBtnClick(Sender: TObject);
begin
    CloseOutlook;
    ModalResult := mrCancel;
end;

procedure TFindContact.ContView1DblClick(Sender: TObject);
var MyContact : variant;
begin
   If ContView1.Selected <> nil then Begin
         MyContact := GetThisOutlookItem(StrToInt(ContView1.Selected.subitems[2]));
         With StartForm.MyId do
            If Not GetData(MyContact.CustomerId) then begin
               InitData;
               If MyContact.CustomerId <> '' then
                  Id := MyContact.CustomerId
               Else
                  Id := MyContact.CompanyName;
               If DoesIdExist(Startform.MyId.Id) then begin
                  Warning('Data Handler', 'Can not establish unique Id' + CRLF
                          + 'Edit CustomerId in Outlook and then try again');
                  CloseOutlook;
                  ModalResult := mrCancel;
                  Exit;
                  end;
               OrganizationName := MyContact.CompanyName;
               IdType := 1;
               AccountId := MyContact.Account;
               Address1 := MyContact.BusinessAddressStreet;
               City := MyContact.BusinessAddressCity;
               StProv := MyContact.BusinessAddressState ;
               Postal := MyContact.BusinessAddressPostalCode;
               Country := MyContact.BusinessAddressCountry;
               Phone := MyContact.CompanyMainTelephoneNumber;
               Insert;
               end;
         With StartForm.MyContId do begin
               InitData;
               ContIdId := StartForm.MyId.Id;
               Honorific := MyContact.Title ;
               FirstName := MyContact.FirstName ;
               MiddleInit := MyContact.MiddleName ;
               LastName :=  MyContact.LastName ;
               Suffix := MyContact.Suffix ;
               Fax :=    MyContact.BusinessFaxNumber ;
               WorkPhone :=   MyContact.BusinessTelephoneNumber;
               HomeFax := MyContact.HomeFaxNumber ;
               HomePhone := MyContact.HomeTelephoneNumber ;
               MobilePhone := MyContact.MobileTelephoneNumber ;
               OtherPhone := MyContact.OtherTelephoneNumber ;
               Pager := MyContact.PagerNumber ;
               Email := MyContact.Email1Address ;
               Title := MyContact.JobTitle;
               OfficeLocation := MyContact.OfficeLocation ;
               Insert;
               End;
   end;
CloseOutlook;
ModalResult := mrOk;

end;

procedure TFindContact.FormCreate(Sender: TObject);
var      MyContact : Variant;
         MyCount : Integer;
         i : Integer;
         AnItem : TListItem;
begin
   If not GetOutlookUp(OlContactItem)
      then exit;
   MyCount := GetOutlookFolderItemCount ;
   For i := 1 to MyCount do begin
        MyContact := GetThisOutlookItem(i);
        AnItem := ContView1.Items.Add;
        AnItem.Caption := MyContact.CompanyName;
        AnItem.SubItems.add(MyContact.FirstName);
        AnItem.Subitems.Add(MyContact.LastName);
        AnItem.SubItems.Add(inttostr(i));
   End;

end;

procedure TFindContact.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    Action := cafree;
end;

end.

</PRE><HR>


<P><H1><A NAME="ole1">OLE Tester</P></A></H1>
<P><I>From: [e-mail]</I></P>


This is a VERY simple test that I made myself to get started with OLE. I was asked to add OLE support to a program I made and this 
is what I did to have a program to test that my own OLE server worked. <P>

This creates the oleobject upon creation and then whenever you press a button it calls a procedure in the oleserver. <P>

<HR><PRE>unit oletestu;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
     ttsesed : variant;
  end;

var
  Form1: TForm1;

implementation
uses oleauto;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ttsesed := createoleobject('ttdewed.ttsesole');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ttsesed.openeditfile;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ttsesed.appshow;
end;

end.
</PRE><HR>  

<P><H1><A NAME="ole2">Getting data from Delphi app into Word document</P></A></H1>
<P><I>From: Darek Maluchnik &lt;[e-mail]&gt;</I></P>


Assuming that you have Word2(6)/Delphi1 or 32bit Word/Delphi2. <p>
Try:

<LI>  Make macro in Word:

<HR><PRE>Declare Function StringFromDelphi  Lib "c:\sample\test.dll" As String

Sub MAIN
mystring$ = StringFromDelphi
Insert mystring$
End Sub
</PRE><HR>

<LI> Create simple TEST.DLL in Delphi - just form with a button.
   Save it (eg.in c:\sample - see Word macro) as test.dpr
   and testform.pas. Now add to your project EXPORTED function
   'StringFromDelphi' and 'close' on button click.
   You can paste the stuff from below:

<HR><PRE>library Test;  (* test.dpr in c:\sample *)
uses Testform in 'TESTFORM.PAS';
exports
    StringFromDelphi;
begin
end.
</PRE><HR>

<HR><PRE>unit Testform; (* testform.pas in c:\sample *)
interface
uses
WinTypes, WinProcs, Forms, Classes, Controls, StdCtrls, SysUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;
var
  Form1: TForm1;

function StringFromDelphi : PChar; export;
                     {$ifdef WIN32} stdcall; {$endif}

implementation
{$R *.DFM}

function StringFromDelphi: Pchar;
var StringForWord : array[0..255] of char;
begin
    Application.CreateForm(TForm1, Form1);
    Form1.ShowModal;
    Result:=StrPCopy(StringForWord, Form1.Button1.caption);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    close;
end;

end.
</PRE><HR>

<LI> Compile test.dll. Run macro from Word, Delphi form should
   appear - click the button to get some data from Delphi.<p>

There is a text in PCMagazine Vol12.No22 on accessing DLL functions
from Word. You can get it (DLLACCES) from PCMag web site. <P>


<HR SIZE="6" COLOR="LIME">
<FONT SIZE="2">
<a href="mailto:[e-mail]">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</BODY>
</HTML>