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 thenContView1DblClick(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 BeginMyContact := GetThisOutlookItem(StrToInt(ContView1.Selected.subitems[2]));With StartForm.MyId doIf Not GetData(MyContact.CustomerId) then beginInitData;If MyContact.CustomerId <> '' thenId := MyContact.CustomerIdElseId := MyContact.CompanyName;If DoesIdExist(Startform.MyId.Id) then beginWarning('Дескриптор данных', 'Не могу установить уникальный Id' + CRLF+ 'Отредактируйте CustomerId в Outlook и попытайтесь снова');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 beginInitData;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 beginMyContact := 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. |