[infopol]

Код:

function VariantObjectClassName(const V: OleVariant): string;
var
pd: PVarData;
ti: ITypeInfo;
disp: IDispatch;
 basicType  : Integer;
sDoc, sHelpFile: PBStr;
helpCtx: PLongInt;
 typeString : string;
 Presult:PBStr;
begin

pd := PVarData(@V);

 basicType := pd^.VType  and VarTypeMask;

  // ????????? ?????? ??? ???????????? ????
  case basicType of
    varEmpty     : typeString := 'varEmpty';
    varNull      : typeString := 'varNull';
    varSmallInt  : typeString := 'varSmallInt';
    varInteger   : typeString := 'varInteger';
    varSingle    : typeString := 'varSingle';
    varDouble    : typeString := 'varDouble';
    varCurrency  : typeString := 'varCurrency';
    varDate      : typeString := 'varDate';
    varOleStr    : typeString := 'varOleStr';
    varDispatch  : typeString := 'varDispatch';
    varError     : typeString := 'varError';
    varBoolean   : typeString := 'varBoolean';
    varVariant   : typeString := 'varVariant';
    varUnknown   : typeString := 'varUnknown';
    varByte      : typeString := 'varByte';
    varWord      : typeString := 'varWord';
    varLongWord  : typeString := 'varLongWord';
    varInt64     : typeString := 'varInt64';
    varStrArg    : typeString := 'varStrArg';
    varString    : typeString := 'varString';
    varAny       : typeString := 'varAny';
    varTypeMask  : typeString := 'varTypeMask';
    varObject    : typeString := 'varObject';
  end;

Result :={VarToStr(pd^.VType)+'|'+} typeString;// VarToStr(pd^.VType);
try
// Delphi-объект, упакованный как varObject
if (pd^.VType = varObject) and  (pd^.VPointer <> nil) then
begin
Result := TObject(pd^.VPointer).ClassName;
//Exit;
end;
except
    Result := 'IDispatch none typeinfo';

end;
disp:=IDispatch.Create;




// COM/Automation объект (IDispatch или IUnknown)
if (pd^.VType = varDispatch) or (pd^.VType = varUnknown) then
begin
// Попробуем получить IDispatch
try
                     // VarAsType(V,varVariant);
disp :=IDispatch( pd.VDispatch);//VarAsType(V,varVariant));
pd:= PVarData(@disp);
   //   disp.ClassType.ClassName;
   if pd^.VType = varObject then
       Result := TObject(pd^.VPointer).ClassName;
//ShowMessage('IDispatch'+#13+VarToStr(pd^.VType)+#13+Result);
except
disp := nil;
end;
end;

           try
if Assigned(disp) then
begin
 // Получаем typeinfo (локаль можно заменить на LOCALE_USER_DEFAULT)
 if Succeeded(disp.GetTypeInfo(0, {LOCALE_USER_DEFAULT{}GetUserDefaultLCID, ti)) and Assigned(ti) then
  begin
  result:='';
            // // Получаем typeinfo (локаль можно заменить на LOCALE_USER_DEFAULT)
    // MEMBERID_NIL (-1) — имя типа
   ti.GetDocumentation(-1, @Result, @sDoc, nil, nil);
Result:=(result) ;
  // ShowMessage('Succeeded'+#13+Result);

   //    ti.GetDocumentation(MEMBERID_NIL, PResult, sDoc, helpCtx, sHelpFile);
  end
  else
    Result := 'IDispatch без typeinfo';
        // }

       // disp.Free;
end;
           except
              Result := 'Error IDispatch typeinfo';
           end;


end;

пришлось перекодировать результат из UTF8 в Win