| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

BindToObject

Polevi ©   (2004-04-13 11:50:00) 

Возникла задача получить ссылки на открытые в системе книги Excel - то есть на их интерфейс IWorkbook
Решаю ее с помощью RunningObjectTable

На некоторых машинах HResultCode(BindToObject(...)) возвращает 8 - ERROR_NOT_ENOUGH_MEMORY. Причем не время от времени, а всегда. То есть есть машины на которых код просто отказывается работать.

program rot;
{$APPTYPE CONSOLE}

uses
 SysUtils,
 ActiveX,
 ComObj,
 Windows;

var
 rotbl:IRunningObjectTable;
 em:IEnumMoniker;
 m:IMoniker;
 bc:IBindCtx;
 celtFetched:longint;
 unk:IUnknown;
 rst:HResult;
const
 IID__Workbook: TGUID = '{000208DA-0000-0000-C000-000000000046}';
begin
 Writeln('Search '+GuidToString(IID__Workbook));
 CoInitialize(nil);
 OleCheck(CreateBindCtx(0, bc));
 OleCheck(GetRunningObjectTable(0,rotbl));
 OleCheck(rotbl.EnumRunning(em));
 OleCheck(em.Reset);
 OleCheck(em.Next(1,m,@celtFetched));
 while celtFetched=1 do
 try
   try
     rst:=m.BindToObject(bc,nil,IID__Workbook,unk);
     if Succeeded(rst) then
       Writeln('OK. Object binding.')
     else
       raise Exception.CreateFmt('BindToObject failed. Return code %d',[HResultCode(rst)]);
   except
     on E:Exception do writeln(E.Message);
   end;
 finally
   OleCheck(em.Next(1,m,@celtFetched));
 end;
 CoUninitialize;
 readln;
end.

если моникер не ссылается на интерфейс, передаваемый в BindToObject - он возвращает error 87 -  ERROR_INVALID_PARAMETER

иначе должен вернуть S_OK и ссылку на интерфейс в последнем параметре
в большинчстве случаев так и просиходит,  но на некоторых машинах возвращает 8 ошибку -   ERROR_NOT_ENOUGH_MEMORY

может есть у кого идеи ?

на всех тестируемых машинах 98 Win SE, Office 2000

---

Polevi   (2004-04-15 19:02:00) [1]

так я наверно и сделаю

---

VMcL   (2004-04-15 18:04:00) [2]

>>Polevi ©  (15.04.04 17:59) [15]

Ну тогда только Breakpoint, при останове - View CPU (Ctrl+Alt+C) и F7, F7, F7...
Или вообще SoftIce'ом :)

---

Polevi   (2004-04-15 17:59:00) [3]

у меня уже руки опускаются
представь себе ситуацию
стоят 2 машины, Win98 SE, Office 2000, IE6
установлено с одного диска
на одной машине работает, на другой - нет
да и других программ нет никаких - обычные офисные машины
разве что на одной Acrobat Reader 6 - на другой 5
мистика какаято..

---

VMcL   (2004-04-15 17:04:00) [4]

>>Polevi ©  (15.04.04 16:54) [13]

Win98SE? Может на нее или на Офис какой-нить патч натравить нужно?

---

Polevi   (2004-04-15 16:54:00) [5]

>VMcL ©   (15.04.04 14:53) [12]
дык проблема то в том что на моем компе тоже все работает
а вот на некоторых - нет
ненавижу такие штуки :(

---

VMcL   (2004-04-15 14:53:00) [6]

Вот такой вариант на моем компе работает (WinXP Pro SP1):

program Polevi;
{$APPTYPE CONSOLE}

uses
 SysUtils,
 ActiveX,
 ComObj,
 Windows,
 Excel2000;

function AnsiToOem(const Src: String): String;
begin
 SetLength(Result, Length(Src));
 if Src <> '' then
   CharToOemA(PChar(Src), PChar(Result));
end;

var
 rotbl: IRunningObjectTable;
 em: IEnumMoniker;
 m: IMoniker;
 bc: IBindCtx;
 celtFetched: longint;
 unk: IUnknown;
 wb: Excel2000._Workbook;
begin
 Writeln('Search ' + GuidToString(IID__Workbook));
 Writeln;

 CoInitialize(nil);
 OleCheck(CreateBindCtx(0, bc));
 OleCheck(GetRunningObjectTable(0,rotbl));
 OleCheck(rotbl.EnumRunning(em));
 OleCheck(em.Reset);
 OleCheck(em.Next(1, m, @celtFetched));
 while celtFetched = 1 do
   try
     try
       OleCheck(rotbl.GetObject(m, unk));
       OleCheck(unk.QueryInterface(IID__Workbook, wb));

       writeln('OK: ' + AnsiToOem(String(wb.Name)));
     except
       on E: Exception do
         writeln('Error: ', AnsiToOem(E.Message));
     end;
   finally
     OleCheck(em.Next(1, m, @celtFetched));
   end;
 CoUninitialize;
 Writeln;
 Write('Press ENTER...');
 readln;
end.

Выдает error на Application'ы Excel'я; с Workbook'ами же всё ОК.

---

VMcL   (2004-04-15 14:33:00) [7]

>>VMcL ©  (15.04.04 14:25) [10]

Ой, забыл с ручника сняться. Сначала Application получаем, а потом и Workbook. Так что можно и по-твоему писать.

---

VMcL   (2004-04-15 14:25:00) [8]

>>Polevi ©  (15.04.04 13:48) [9]

Так по идее надо не IID__Workbook получать, а IID__Application
(IID__Application: TGUID = '{000208D5-0000-0000-C000-000000000046}';)

У меня на IID__Workbook писало "Интерфейс не поддерживается".

Написал вот так и заработало:

program Polevi;
{$APPTYPE CONSOLE}

uses
 SysUtils,
 ActiveX,
 ComObj,
 Windows,
 Excel2000;

var
 rotbl: IRunningObjectTable;
 em: IEnumMoniker;
 m: IMoniker;
 bc: IBindCtx;
 celtFetched: longint;
 unk, wb: IUnknown;
//const
//  IID__Workbook: TGUID = '{000208DA-0000-0000-C000-000000000046}';
//  IID__Application: TGUID = '{000208D5-0000-0000-C000-000000000046}';
begin
 Writeln('Search ' + GuidToString(IID__Workbook));
 CoInitialize(nil);
 OleCheck(CreateBindCtx(0, bc));
 OleCheck(GetRunningObjectTable(0,rotbl));
 OleCheck(rotbl.EnumRunning(em));
 OleCheck(em.Reset);
 OleCheck(em.Next(1, m, @celtFetched));
 while celtFetched = 1 do
   try
     try
       OleCheck(rotbl.GetObject(m, unk));
       //OleCheck(unk.QueryInterface(IID__Workbook, wb));
       OleCheck(unk.QueryInterface(IID__Application, wb));

       Writeln('OK. Object binding.');
     except
       on E: Exception do
         MessageBox(0, PChar(E.Message), 'Error', MB_OK or MB_TASKMODAL);
     end;
   finally
     OleCheck(em.Next(1, m, @celtFetched));
   end;
 CoUninitialize;
 readln;
end.

---

Polevi   (2004-04-15 13:48:00) [9]

>VMcL ©   (15.04.04 13:35) [8]
IUnknown, вот последняя версия на С

#include "stdafx.h"

int main(int argc, char* argv[])
{
     IBindCtx *bc;
IRunningObjectTable *rotbl;
IEnumMoniker *em;
IMoniker *m;
unsigned long celtFetched;
IUnknown *unk, *wb;

CoInitialize(NULL);

   IID   IID_Workbook;
   char*   szCLSID = "{000208DA-0000-0000-C000-000000000046}";
   WCHAR   szWideProgID[128];
   long lLen = MultiByteToWideChar( CP_ACP,
                    0,
                    szCLSID,
                    strlen( szCLSID ),
                    szWideProgID,
                    sizeof( szWideProgID ) );
   szWideProgID[ lLen ] = '\0';
   CLSIDFromString(szWideProgID,&IID_Workbook);

     CreateBindCtx(0,&bc);
GetRunningObjectTable(0,&rotbl);
rotbl->EnumRunning(&em);
em->Reset();
em->Next(1,&m,&celtFetched);
while(1==celtFetched)
{
 rotbl->GetObject(m,&unk);
 unk->QueryInterface(IID_Workbook,(void **)&wb);
 if(wb!=NULL)
  printf("Ok.\n");
 em->Next(1,&m,&celtFetched);
}
Sleep(2000);
return 0;
}

---

VMcL   (2004-04-15 13:35:00) [10]

>>Polevi ©  (15.04.04 10:22) [6]

wb у тебя OleVariant?

---

Polevi   (2004-04-15 13:05:00) [11]

Переписал все на VC, результат аналогичный..
Мдя..

---

Polevi   (2004-04-15 10:22:00) [12]

Заменил BindToObject на IRunningObjectTable::GetObject

...
 OleCheck(rotbl.GetObject(m,unk));
 OleCheck(unk.QueryInterface(IID__Workbook,wb));
...

IUnknown я получаю без ошибок
А вот вызов QueryInterface на "проблемных" машинах возвращает "неверный тип переменной"

???

---

VMcL   (2004-04-14 11:47:00) [13]

>>Nikolay M. ©  (14.04.04 11:41) [4]

Ну я ж сразу написал, что "ляпну глупость" [1] :)
Я таким не занимался, а только как вариант предложил.

---

Nikolay M.   (2004-04-14 11:41:00) [14]

> VMcL ©   (14.04.04 10:29) [3]

А если запустить новый Instance екселя? Не пойдеть :(

Есть мнение, что нужно биндиться непосредственно через ROT (IRunningObjectTable::GetObject).

---

VMcL   (2004-04-14 10:29:00) [15]

Ну если ты настаиваешь :)

Кинул на форму (D6):
* Button1: TButton
* Memo1: TMemo
* ExcelApplication1: TExcelApplication {из Excel2000.pas}

Установил свойство ExcelApplication1.ConnectKind в ckRunningInstance.

procedure TForm1.Button1Click(Sender: TObject);
var
 I: Integer;
 W: _Workbook;
 S: String;
begin
 Memo1.Clear;

 ExcelApplication1.Connect;
 try
   for I := 1 to ExcelApplication1.Workbooks.Count do
   begin
     W := ExcelApplication1.Workbooks[I];
     S := W.Name;
     Memo1.Lines.Add(S);
   end;
 finally
   ExcelApplication1.Disconnect;
 end;
end;

---

Polevi   (2004-04-13 15:32:00) [16]

сам то пробовал ?

---

VMcL   (2004-04-13 14:46:00) [17]

>>Polevi ©  (13.04.04 11:50)

Возможно я сейчас ляпну глупость, но почему просто не создать Excel.Application и не перебрать в цикле WorkBooks'ы?

---

Наверх