Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Низкоуровневое программирование > Win Api
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 19.04.2015, 20:36   #11
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию Добавление агрумента для вызова

Код:
{Эта процедура будет добавлять передаваемые аргументы в список
 в виде массива, которые пойдут параметрами в метод или свойство интерфейса,
 что будет вызываться}
procedure TAlisaOLE.AddArgument(Varvalue: Variant);
begin
 //Количество аргументов можно повысить хоть до MAXINT. Это по желанию.
 //Если аргумент можно добавить
  if ArgsLen<Length(aParams) then begin
    //Он допишется в следующую допустимую ячейку списка
    aParams[ArgsLen]:=Varvalue;
    //И номер последнего указанного элемента списка увеличится на единицу
    //указывая на следующую свободную ячейку массива аргументов
    inc(ArgsLen);
  end;
end;
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.04.2015, 20:37   #12
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию Получение интерфейса по классу или GUID

Код:
//Эта функция получает указатель на запрашиваемый интерфейс по его имени класса
//И возвращает True или False если удалось или не удалось это сделать
function TAlisaOLE.GetObject(aName: String): Boolean;
begin
  Error:='';
  try        //Попробуем по имени класса получить указатель на интерфейс
    Disp:=CreateOleObject(aName);
    Result:=true;
  except
   on e:Exception do begin
     Disp:=nil;     //Если не удалось
     Result:=false; //Выведем гневное сообщение, и вернем False для проверок в программе
     Error:='Get OLE object error: '+e.Message;
   end;
  end;
end;
Код:
//Эта функция получает указатель на запрашиваемый интерфейс по его GUID
//И возвращает True или False если удалось или не удалось это сделать
function TAlisaOLE.GetObject(aGuid: TGUID): Boolean;
begin
  Error:='';
  try      //Попробуем по GUID получить указатель на интерфейс
    Disp:=CreateComObject(aGuid) as IDispatch;
    Result:=true;
  except
   on e:Exception do begin
     Disp:=nil;     //Если не удалось
     Result:=false; //Выведем гневное сообщение, и вернем False для проверок в программе
     Error:='Get OLE object error: '+e.Message;
   end;
  end;
end;


Код:
constructor TAlisaOLE.Create;
begin
  Disp:=nil;
  ArgsLen:=0;
  //При создании объекта до получения интерфейса проинициализируем
  //систему потоков для OLE сервера
  CoInitialize(nil);
end;
Код:
destructor TAlisaOLE.Destroy;
begin
  //Деактивируем инрефейс
  Disp:=nil;
  //И выключим инициализацию
  CoUninitialize;
end;
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.04.2015, 20:40   #13
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию И сама демонстрация вызова

Код:
program project1;
uses sysutils,comobj,activex,Windows,variants, LazUTF8;
begin
 //Создаем объект, который будет вызывать OLE сервер
 with TAlisaOLE.Create do begin
    //Активируем этот сервер по имени его класса
    if GetObject('Tester.CoTester') then begin
        //Установим свойство pint=528
        AddArgument(528); //Указываем что будет присвоен свойству аргумент, значение коего 528
        //И вызовем интерфейс, который это сделает
        if InvokeMethod('pint',true,true) then writeln('Property '+InvokedCommand+' set')
        //Если интерфейс отработал с ошибкой - выведем ее на экран
        else writeln(Error);

        //Теперь запросим значение свойства pint
        if InvokeMethod('pint',true,false) then writeln('Property '+InvokedCommand+' = ',ResultOle)
        //Если произошла ошибка - выведем ее на экран
        else writeln(Error);
    end else writeln(Error); //Если сервер не может быть активирован - выведем ошибку
   Destroy;
 end;

 //Теперь попробуем то же самое - задействует OLE Visual Basic Script.
 with TAlisaOLE.Create do begin
   //Опять укажем его имя класса
    if GetObject('MSScriptControl.ScriptControl') then begin
        //Зададим его свойству Language значение  VBScript
        Item['Language']:='VBScript';
        if ErrorCode=0 then writeln('Property '+InvokedCommand+' set')
        else writeln(Error);

        {Item был пришит для удобства (см. выше), с таким же успехом можно было написать так:

         AddArgument('VBScript');
         if InvokeMethod('Language',true,true) then writeln('Property '+InvokedCommand+' set')
          else writeln(Error);

         }

        //И попросим вычислить выражение 2+2, переданное в виде строки в параметр
        AddArgument('2+2');
        //Сделает это метод eval, которому строку скормим.
        //ResultOle вернет результат
        if InvokeMethod('eval',false,false) then writeln('2+2=',ResultOle)
        else writeln(Error);
    end else writeln(Error);
   Destroy;
 end;

 readln;
end.
В данном случае эвалюатор у нас продемонстрирован в виде передачи выражения 2+2 в бейсик винды. Так же можно написать что-то типа:
Код:
var s:string;
...
write('Введите выражение'); readln(s);
AddArgument(s);
... И вызов InvokeMethod с 'eval' как в примере
Вот как-то так... Привет Делфийцам
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.04.2015, 20:48   #14
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

А! Ну да. Зачем собственно я с этим заморачивался.
Набивал функционал в свой интерпретатор своего ЯВУ.
Теперь я могу написать программу типа:
Код:
(writeln (o := ole name='MSScriptControl.ScriptControl') (call o.error))
(writeln (call o.set Language='VBScript') ' Language=' o.language (call o.error))
(writeln (call o.set UseSafeSubset=0) ' UseSafeSubset=' o.UseSafeSubset (call o.error))
(writeln (call o.set AllowUI=1) ' AllowUI=' o.AllowUI (call o.error))
(writeln (call o.set TimeOut=-1) ' TimeOut=' o.TimeOut (call o.error))
(writeln (call o.invoke name='reset') ' ' (call o.error))
(writeln (call o.invoke name='AddCode' 
 '
    Function hello()
      hello = "hi"
    End Function      
') ' ' (call o.error))
(writeln (call o.invoke name='run' 'hello()') ' ' (call o.error))
(writeln (call o.invoke name='eval' '2+2') ' ' (call o.error))
Это пример взаимодействия с бейсиком

Который и будет работать с OLE обьектами в Винде, что увеличит КПД моих программ достаточно серьезно. Ну и думаю другим будет иногда полезно посмотреть как работают интерфейсы. Вдруг кто-то тоже пишет свой язык программирования
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.04.2015, 21:31   #15
waleri
Старожил
 
Регистрация: 13.07.2012
Сообщений: 6,493
По умолчанию

Теперь осталось сделать интеграцию в обратную сторону...
waleri вне форума Ответить с цитированием
Старый 19.04.2015, 21:38   #16
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Что имеется ввиду?
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 19.04.2015, 22:25   #17
Vapaamies
Ваш К. О.
Участник клуба
 
Аватар для Vapaamies
 
Регистрация: 26.12.2012
Сообщений: 1,755
По умолчанию

Ешкин кот! Теперь мне этот код ночью сниться будет.
Vapaamies вне форума Ответить с цитированием
Старый 19.04.2015, 22:30   #18
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
Теперь мне этот код ночью сниться будет.
М.м.м... А ты зайди на Говнокод.ру
Клин клином )
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 20.04.2015, 08:56   #19
waleri
Старожил
 
Регистрация: 13.07.2012
Сообщений: 6,493
По умолчанию

Цитата:
Сообщение от Stilet Посмотреть сообщение
Что имеется ввиду?
Имеется ввиду код, написаный скажем на VBS вызывал код, написанный на вашем ЯВУ.
waleri вне форума Ответить с цитированием
Старый 20.04.2015, 09:42   #20
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Цитата:
Имеется ввиду код, написаный скажем на VBS вызывал код, написанный на вашем ЯВУ.
А-а-а. Это в планах. Но пока в отдаленных.

Так что насчет критики? А то ведь я сие решение буду применять активно, у меня есть несколько необходимостей достаточно серьезных где это понадобилось уже сейчас. А вдруг я тут начудил.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
GetIDsOfNames. DISP_E_UNKNOWNNAME. Правильное использование. Stilet Win Api 9 12.04.2015 09:40
COM/OLE Automation, больше не в XE версиях Delphi? Человек_Борща Общие вопросы Delphi 0 28.02.2014 11:34
процедура invoke chpok1 Помощь студентам 1 07.06.2013 17:16
Проблема с Invoke в Windows Forms wmzvov Помощь студентам 1 16.09.2011 20:42
Как узнать тип (класс) OLE Automation объекта? Stilet Win Api 2 02.07.2010 09:07