Шпаргалка. Использование Microsoft Script Control в приложениях - #2

Итак, продолжим:
Если вы внимательно посмотрите на предыдущую реализацию метода Invoke, вы заметите две функции, а именно CheckArgCount и IsVdalidTypeBSTR
Первая функция проверяет количество параметров переданных в процедуру и функцию и определена в базовом классе как

// Проверяем кол-во параметров
function TBase.CheckArgCount(Count: Integer; Accepted: Integer; ExcepInfo : Pointer) : Boolean;
var
  I: Integer;
begin
  Result := FALSE;
  Result := Accepted = Count;
  if Assigned(ExcepInfo) and (not Result) then
  begin
    ZeroMemory(ExcepInfo, SizeOf(TExcepInfo));
    TExcepInfo(ExcepInfo^).wCode := 1001;
    TExcepInfo(ExcepInfo^).bstrSource      := SysAllocString(PWideChar('CheckArgCount'));
    TExcepInfo(ExcepInfo^).bstrDescription := SysAllocString(PWideChar('Неверное количество параметров!'));
  end;
end;

также данная функция заполняет информацию об ошибке в структуру ExcepInfo, которая в свою очередь возвращает Invoke.

Проверка типов параметров

И вторая функция IsVdalidTypeBSTR является надстройкой над функцией проверки значения Variant на определенный тип (подробнее об Variant-типе посмотреть можно здесь

// Проверяем на соответствие типов
function TBase.IsValidType(Argument: TVariantArg;
                         TypesId : Variant): Boolean;
var
  I : Integer;
  isOk : Boolean;
  Identificator : Integer;
begin
  isOk := False;
  if VarIsArray(TypesId) then
  begin
    try
       VarArrayLock(TypesId);
       for I := VarArrayLowBound(TypesId, 1) to VarArrayHighBound(TypesId, 1) do
       begin
          Identificator := StrToInt(
                               VarToStr(VarArrayGet(TypesId, [I]))
                                   );
          isOk := (Argument.vt = Identificator);
          if isOk then Break;
       end;
    finally
       VarArrayUnLock(TypesId);
    end;
  end;
  if VarIsNumeric(TypesId) then
  begin
     Identificator := StrToInt(VarToStr(TypesId));
     isOk := (Argument.vt = Identificator);
  end;

  Result := isOk;
end;

function TBase.IsVdalidTypeBSTR(Argument: TVariantArg): Boolean;
begin
 Result := IsValidType(Argument, VarArrayOf([VT_BSTR, VT_VARIANT or VT_BYREF]));
end;

Как видите IsValidTypeStr представляет собой вызов IsValidType с параметром VarArrayOf([VT_BSTR, VT_VARIANT or VT_BYREF]))
Понятно для чего нужна проверка, если в процедуру или функцию вы ожидаете число а вам идет тип строка то конечно логика работы программы будет нарушена вплоть до возникновения ошибок. Что бы это-го не случилось мы и проверяем тип параметра заранее.
Однако почему мы проверяем не на совпадение с VT_BSTR, что казалось бы логичным, раз мы ждем строку, почему мы еще проверяем на тип VT_VARIANT or VT_BYREF.
Ответ на этот вопрос довольно прост, вспомним наш VBS-код:

Sub Main()
MyCLASS.MessageInformation("Проверка работы")
End Sub

Если бы мы проверяли параметр только на VT_BSTR то код бы отработал бы как и положено, однако если бы наш скрипт выглядел так:

Sub Main()
Dim Str
Str = "Проверка работы"
MyCLASS.MessageInformation(Str)
End Sub

Т.е.мы передовали бы переменную в наш класс, то проверка бы на VT_BSTR не прошла бы и мы бы получили ошибку 'Неверное количество параметров!'. И это было бы правильно т.к. переменные в Script Control передаются с флагом типа - VT_VARIANT or VT_BYREF
Поэтому это нужно учитывать – это первый подводный камень. Второй подводный камень смотрим ниже, если ж опять запустить наш пример с вторым VBS-кодом в версиях Delphi ниже XE, то в место текста "Проверка работы" мы увидим абракадабру. Это связано с тем, что MS Script Control работает с Unicode-строкой. А реализация поддержки PWideChar в версиях разная. И если в Delphi XE/XE2 код выдаст читаемое сообщение, то в D2010 будут крякозябры.
Те, кто использует XE/XE2 следующий раздел может спокойно пропустить, те кто сидит на версиях ниже могут использовать следующий обходной прием, а именно преобразование типа переменной Variant к конкретному типу

Преобразование типов параметров

Для этого воспользуемся функцией VariantChangeType которая устанавливает определенный тип, итак наша реализация выглядеть будет так

case DispID of
       DISPID_MessageInformation :
        begin
          // Проверка на кол-во параметров
          if not CheckArgCount(P.cArgs, 1, ExcepInfo) then
          begin
             Result := DISP_E_EXCEPTION;
             Exit;
          end;
          // Аргументы в обратном порядке
          if IsVdalidTypeBSTR(P.rgvarg^[0])
          then
          begin
             {Меняем тип данных на строку, если вдруг пришла переменная}
             VariantChangeTypeToBSTR(P.rgvarg^[0]);
             VariantChangeTypeToBSTR(P.rgvarg^[1]);

             ShowMessage('Информация ' + #10#13 + TDispParams(P).rgvarg^[0].bstrval);                
          end
          else
          begin
              SetErrorCheckParamsType(ExcepInfo, fn_MESSAGEINFORMATION);
              Result := DISP_E_EXCEPTION;
          end;
        end;

 * *
procedure TBase.VariantChangeTypeToBSTR(var Argument: TVariantArg);
begin
 VariantChangeType(OleVariant(TDispParams(Argument)),
                   OleVariant(TDispParams(Argument)),
                   0,VT_BSTR);
end;

Такой хитрый обход в версии D2010 устраняет проблему с крякозябрами. Может это не совсем и хорошее решение – но рабочее. Фактически мы приводим тип переменной Variant к строке.

Продолжение следует.

Далее: Создание функции ; Работа с var-параметрами в функции или процедуре, возврат параметров из функции ; Обработка ошибок IScriptError