From: "Jill Marquiss"
This answers those really interesting questions of{--------------------Straight from the type library--------------- WORDDEC.INC}
Const
// OlAttachmentType
olByValue = 1;
olByReference = 4;
olEmbeddedItem = 5;
olOLE = 6;
// OlDefaultFolders
olFolderDeletedItems = 3;
olFolderOutbox = 4;
olFolderSentMail = 5;
olFolderInbox = 6;
olFolderCalendar = 9;
olFolderContacts = 10;
olFolderJournal = 11;
olFolderNotes = 12;
olFolderTasks = 13;
// OlFolderDisplayMode
olFolderDisplayNormal = 0;
olFolderDisplayFolderOnly = 1;
olFolderDisplayNoNavigation = 2;
// OlInspectorClose
olSave = 0;
olDiscard = 1;
olPromptForSave = 2;
// OlImportance
olImportanceLow = 0;
olImportanceNormal = 1;
olImportanceHigh = 2;
// OlItems
olMailItem = 0;
olAppointmentItem = 1;
olContactItem = 2;
olTaskItem = 3;
olJournalItem = 4;
olNoteItem = 5;
olPostItem = 6;
// OlSensitivity
olNormal = 0;
olPersonal = 1;
olPrivate = 2;
olConfidential = 3;
// OlJournalRecipientType;
olAssociatedContact = 1;
// OlMailRecipientType;
olOriginator = 0;
olTo = 1;
olCC = 2;
olBCC = 3 ;
Const
wdGoToBookmark = -1;
wdGoToSection = 0;
wdGoToPage = 1;
wdGoToTable = 2;
wdGoToLine = 3;
wdGoToFootnote = 4;
wdGoToEndnote = 5;
wdGoToComment = 6;
wdGoToField = 7;
wdGoToGraphic = 8;
wdGoToObject = 9;
wdGoToEquation = 10;
wdGoToHeading = 11;
wdGoToPercent = 12;
wdGoToSpellingError = 13;
wdGoToGrammaticalError = 14;
wdGoToProofreadingError = 15;
wdGoToFirst = 1;
wdGoToLast = -1;
wdGoToNext = 2; //this is interesting
wdGoToRelative = 2; //how can these two be the same
wdGoToPrevious = 3;
wdGoToAbsolute = 1;
Function GetWordUp(StartType : string):Boolean;
Function InsertPicture(AFileName : String) : Boolean;
Function InsertContactInfo(MyId : TMyId; MyContId : TMyContId): Boolean;
Function GetOutlookUp(ItemType : Integer): Boolean;
Function MakeOutLookContact(MyId : TMyId; MyContId : TMyContId) : Boolean;
Function ImportOutlookContact : Boolean;
Function GetOutlookFolderItemCount : Integer;
Function GetThisOutlookItem(AnIndex : Integer) : Variant;
Function FindMyOutlookItem(AFilter : String; var AItem : Variant) :Boolean;
Function FindNextMyOutlookItem(var AItem : Variant) : Boolean;
Function CloseOutlook : Boolean;
Type TTreeData = class(TObject)
Public
ItemId : String;
end;
{$I worddec.inc} {literal crap translated from type libraries}
Var
myRegistry : TRegistry;
GotWord : Boolean;
WhereIsWord : String;
WordDoneMessage : Integer;
Basically : variant;
Wordy: Variant;
MyDocument : Variant;
MyOutlook : Variant;
MyNameSpace : Variant;
MyFolder : Variant;
MyAppointment : Variant;
Function GetWordUp(StartType : string):Boolean;
// to start word the "right" way for me
// if you start word, you own word and I wanted it to remain after I closed
var i : integer;
AHwnd : Hwnd;
AnAnswer : Integer;
temp : string;
MyDocumentsCol : Variant;
TemplatesDir : Variant;
OpenDialog1 : TopenDialog;
begin
result := false;
myRegistry := Tregistry.Create;
myRegistry.RootKey := HKEY_LOCAL_MACHINE;
// no word 8, no function
If myRegistry.KeyExists('SOFTWARE\Microsoft\Office\8.0\Word')
then
GotWord := true
Else
GotWord := false;
If GotWord then
//where the heck is it?
If myRegistry.OpenKey('SOFTWARE\Microsoft\Office\8.0', false) then
begin
WhereisWord := myRegistry.ReadString('BinDirPath');
MyRegistry.CloseKey;
end
else
GotWord := false;
If GotWord then
//where are those pesky templates?
Begin
MyRegistry.RootKey := HKEY_CURRENT_USER;
If
myRegistry.OpenKey('SOFTWARE\Microsoft\Office\8.0\Common\FileNew\SharedTemplates', false) then
Begin
TemplatesDir := myRegistry.ReadString(Nothing);
MyRegistry.CloseKey;
end
Else
Begin
Warning('Ole setup','The workgroup templates have not been setup');
GotWord := false;
end;
End;
myRegistry.free;
If not gotword then
Begin
Warning('Ole Handler', 'Word is not installed');
exit;
end;
//this is the class name for the last two versions of word's main window
temp := 'OpusApp';
AHwnd := FindWindow(pchar(temp),nil);
If (AHwnd = 0) then
//it isn't running and I don't wanna start it by automation
Begin
Temp := WhereisWord + '\winword.exe /n';
AnAnswer := WinExec(pchar(temp), 1);
If (AnAnswer < 32) then
Begin
Warning('Ole Handler', 'Unable to find WinWord.exe');
Exit;
End;
End;
Application.ProcessMessages;
{If you use Word.Application, you get your own instance}
{If you use Word.Document, you get the running instance}
{this makes a trash document (for me, anyway) and I chuck it out later}
try {and make a new document}
Basically := CreateOleObject('Word.Document.8');
except
Warning('Ole Handler', 'Could not start Microsoft Word.');
Result := False;
Exit;
end;
Try {get the app variant from that new document}
Wordy := Basically.Application;
Except
Begin
Warning('Ole Handler', 'Could not access Microsoft Word.');
Wordy := UnAssigned;
Basically := UnAssigned;
Exit;
end;
end;
Application.ProcessMessages;
Wordy.visible := false;
MyDocumentsCol := Wordy.Documents;
{If its just my throw away document or I wanted a brand new one}
If (MyDocumentsCol.Count = 1) or
(StartType = 'New') then
Begin
OpenDialog1 := TOpenDialog.Create(Application);
OpenDialog1.filter := 'WordTemplates|*.dot|Word Documents|*.doc';
OpenDialog1.DefaultExt := '*.dot';
OpenDialog1.Title := 'Select your template';
OpenDialog1.InitialDir := TemplatesDir;
If OpenDialog1.execute then
Begin
Wordy.ScreenUpdating:= false;
MyDocumentsCol := wordy.Documents;
MyDocumentsCol.Add(OpenDialog1.Filename, False);
OpenDialog1.free;
end
Else
begin
OpenDialog1.Free;
Wordy.visible := true;
Wordy := Unassigned;
Basically := Unassigned;
Exit;
end;
end
Else
{get rid of my throwaway}
MyDocument.close(wdDoNotSaveChanges);
{now I either have a new document based on a template the user selected
or I have their current document}
MyDocument := Wordy.ActiveDocument;
Result := true;
Application.ProcessMessages;
end;
Function InsertPicture(AFileName : String) : Boolean;
var
MyShapes : Variant;
MyRange : variant;
begin
Result := True;
If GetWordUp('Current')then
Try
Begin
MyRange := MyDocument.Goto(wdgotoline, wdgotolast);
MyRange.EndOf(wdParagraph, wdMove);
MyRange.InsertBreak(wdPageBreak);
MyShapes := MyDocument.InlineShapes;
MyShapes.AddPicture(afilename, false, true, MyRange);
end;
Finally
begin
Wordy.ScreenUpdating:= true;
Wordy.visible := true;
Wordy := Unassigned;
Basically := UnAssigned;
Application.ProcessMessages;
end;
end
else
Result := False;
end;
Function InsertContactInfo(MyId : TMyId; MyContId : TMyContId) : Boolean;
var
MyCustomProps : Variant;
begin
{ personally, I store stuff in document properties and then give out a
toolbar macro to allow the user to "set" the properties in their template or current
document.
this has three advantages that I know of (and no defects that I'm aware of)
1. The user can place the location of the info in the document either
before or after this function runs
2. A custom property can be placed any number of times inside the same
document
3. A user can map the properties in their Outlook or search on them using
that abismal file open in Word}
Result := true;
If GetWordUp('New')then
Try
Begin
MyCustomProps := MyDocument.CustomDocumentProperties;
MyCustomProps.add(cpId, false, msoPropertyTypeString, MyId.Id);
MyCustomProps.add(cpOrganizationName, false,
msoPropertyTypeString, MyId.OrganizationName);
MyCustomProps.add(cpAddress1, false,
msoPropertyTypeString,MyId.Address1);
MyCustomProps.add(cpAddress2, false, msoPropertyTypeString,
MyId.Address2);
MyCustomProps.add(cpCity, false, msoPropertyTypeString,
MyId.City);
MyCustomProps.add(cpStProv, false, msoPropertyTypeString,
MyId.StProv);
MyCustomProps.add(cpCountry, false,
msoPropertyTypeString,MyId.City);
MyCustomProps.add(cpPostal, false, msoPropertyTypeString,
MyId.Country);
MyCustomProps.add(cpAccountId, false, msoPropertyTypeString,
MyId.AccountId);
MyCustomProps.add(cpFullName, false, msoPropertyTypeString,
MyContId.FullName);
MyCustomProps.add(cpSalutation, false, msoPropertyTypeString,
MyContId.Salutation);
MyCustomProps.add(cpTitle, false,
msoPropertyTypeString,MyContId.Title);
If (MyContId.workPhone = Nothing) or (MycontId.WorkPhone =
ASpace) then
MyCustomProps.add(cpPhone, false, msoPropertyTypeString,
MyId.Phone )
else
MyCustomProps.add(cpPhone, false, msoPropertyTypeString,
MyContId.WorkPhone );
If (MyContId.Fax = Nothing) or (MycontId.Fax = ASpace) then
MyCustomProps.add(cpFax, false, msoPropertyTypeString,
MyId.Fax)
else
MyCustomProps.add(cpFax, false,
msoPropertyTypeString,MyContId.Fax);
If (MyContId.EMail = Nothing) or (MycontId.Email = ASpace) then
MyCustomProps.add(cpEmail, false, msoPropertyTypeString,
MyId.Email)
else
MyCustomProps.add(cpEmail, false, msoPropertyTypeString,
MyContId.Email);
MyCustomProps.add(cpFirstName, false,
msoPropertyTypeString,MyContId.FirstName);
MyCustomProps.add( cpLastName, false, msoPropertyTypeString,
MyContId.LastName);
MyDocument.Fields.Update;
end;
Finally
begin
Wordy.ScreenUpdating:= true;
Wordy.visible := true;
Wordy := Unassigned;
Basically := UnAssigned;
Application.ProcessMessages;
end;
end
Else
Result := false;
end;
Function GetOutlookUp(ItemType : Integer): Boolean;
Const
AppointmentItem = 'Calendar';
TaskItem = 'Tasks';
ContactItem = 'Contacts';
JournalItem = 'Journal';
NoteItem = 'Notes';
var
MyFolders : Variant;
MyFolders2 : variant;
MyFolders3 : variant;
MyFolder2 : Variant;
MyFolder3 : variant;
MyUser : Variant;
MyFolderItems : Variant;
MyFolderItems2 : Variant;
MyFolderItems3 : Variant;
MyContact : Variant;
i, i2, i3 : Integer;
MyTree : TCreateCont;
MyTreeData : TTreeData;
RootNode, MyNode, MyNode2 : ttreeNode;
ThisName : String;
Begin
{this is really ugly........
There is some really wierd thing going on in the object model for outlook
so excuse this folder.folder.folder stuff cause the "right way" doesn't work
for folders and this does}
{user picks folder from treeview}
Result := False;
Case ItemType of
olAppointmentItem : ThisName := AppointmentItem;
olContactItem : ThisName := ContactItem;
olTaskItem : ThisName := TaskItem;
olJournalItem : ThisName := JournalItem;
olNoteItem : ThisName := NoteItem;
Else
ThisName := 'Unknown';
End;
try
MyOutlook := CreateOleObject('Outlook.Application');
except
warning('Ole Interface','Could not start Outlook.');
Exit;
end;
{this is the root folder}
MyNameSpace := MyOutlook.GetNamespace('MAPI');
MyFolderItems := MyNameSpace.Folders;
MyTree := TCreateCont.create(Application);
{Really unfortunate, but a user can create something other than the default
folder for the kind of thing you're interested in - so this goes down a coupla
levels in the folder chain}
MyTree.Caption := 'Select ' + ThisName + ' Folder';
With MyTree do
If MyFolderItems.Count > 0 then
For i := 1 to MyFolderItems.Count do begin
MyFolder := MyNameSpace.Folders(i);
MyTreeData := TTreeData.create;
MyTreeData.ItemId := MyFolder.EntryId;
RootNode := TreeView1.Items.AddObject(nil, MyFolder.Name, MyTreeData);
MyFolders2 := MyNameSpace.folders(i).Folders;
If MyFolders2.Count > 0 then
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;
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.
From: johan@lindgren.pp.se
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.This creates the oleobject upon creation and then whenever you press a button it calls a procedure in the oleserver.
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.
From: Darek Maluchnik <embrio@plearn.edu.pl>
Assuming that you have Word2(6)/Delphi1 or 32bit Word/Delphi2.Try:
Declare Function StringFromDelphi Lib "c:\sample\test.dll" As String Sub MAIN mystring$ = StringFromDelphi Insert mystring$ End Sub
library Test; (* test.dpr in c:\sample *)
uses Testform in 'TESTFORM.PAS';
exports
StringFromDelphi;
begin
end.
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.
There is a text in PCMagazine Vol12.No22 on accessing DLL functions from Word. You can get it (DLLACCES) from PCMag web site.
This page has been created with
