Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2004.05.30;
Скачать: [xml.tar.bz2];

Вниз

мертвый код?   Найти похожие ветки 

 
clickmaker ©   (2004-05-06 18:01) [0]

Для своих нужд слегка переделывал процедуру DispatchInvoke из ComObj.pas и тока что обратил внимание, что там несколько совершенно лишних кусков (выделил жирным):

procedure DispatchInvoke(const Dispatch: IDispatch; CallDesc: PCallDesc;
 DispIDs: PDispIDList; Params: Pointer; Result: PVariant);
type
 PVarArg = ^TVarArg;
 TVarArg = array[0..3] of DWORD;
 TStringDesc = record
   BStr: PWideChar;
   PStr: PString;
 end;
var
 I, J, K, ArgType, ArgCount, StrCount, DispID, InvKind, Status: Integer;
 VarFlag: Byte;
 ParamPtr: ^Integer;
 ArgPtr, VarPtr: PVarArg;
 DispParams: TDispParams;
 ExcepInfo: TExcepInfo;
 Strings: array[0..MaxDispArgs - 1] of TStringDesc;
 Args: array[0..MaxDispArgs - 1] of TVarArg;
begin
 StrCount := 0;
 try
   ArgCount := CallDesc^.ArgCount;
   if ArgCount > MaxDispArgs then raise EOleException.CreateRes(@STooManyParams);
   if ArgCount <> 0 then
   begin
     ParamPtr := Params;
     ArgPtr := @Args[ArgCount];
     I := 0;
     repeat
       Dec(Integer(ArgPtr), SizeOf(TVarData));
       ArgType := CallDesc^.ArgTypes[I] and atTypeMask;
       VarFlag := CallDesc^.ArgTypes[I] and atByRef;
       if ArgType = varError then
       begin
         ArgPtr^[0] := varError;
         ArgPtr^[2] := DWORD(DISP_E_PARAMNOTFOUND);
       end
       else
       begin
         if ArgType = varStrArg then
         begin
           with Strings[StrCount] do
             if VarFlag <> 0 then
             begin
               BStr := StringToOleStr(PString(ParamPtr^)^);
               PStr := PString(ParamPtr^);
               ArgPtr^[0] := varOleStr or varByRef;
               ArgPtr^[2] := Integer(@BStr);
             end
             else
             begin
               BStr := StringToOleStr(PString(ParamPtr)^);
               PStr := nil;
               ArgPtr^[0] := varOleStr;
               ArgPtr^[2] := Integer(BStr);
             end;
           Inc(StrCount);
         end

         else if VarFlag <> 0 then
         begin
           if (ArgType = varVariant) and
              (PVarData(ParamPtr^)^.VType = varString) then
             VarCast(PVariant(ParamPtr^)^, PVariant(ParamPtr^)^, varOleStr);

           ArgPtr^[0] := ArgType or varByRef;
           ArgPtr^[2] := ParamPtr^;
         end

         else if ArgType = varVariant then
         begin
           if PVarData(ParamPtr)^.VType = varString then
           begin
             with Strings[StrCount] do
             begin
               BStr := StringToOleStr(string(PVarData(ParamPtr)^.VString));
               PStr := nil;
               ArgPtr^[0] := varOleStr;
               ArgPtr^[2] := Integer(BStr);
             end;
             Inc(StrCount);
           end
           else
           begin
             VarPtr := PVarArg(ParamPtr);
             ArgPtr^[0] := VarPtr^[0];
             ArgPtr^[1] := VarPtr^[1];
             ArgPtr^[2] := VarPtr^[2];
             ArgPtr^[3] := VarPtr^[3];
             Inc(Integer(ParamPtr), 12);
           end;
         end

         else
         begin
           ArgPtr^[0] := ArgType;
           ArgPtr^[2] := ParamPtr^;
           if (ArgType >= varDouble) and (ArgType <= varDate) then
           begin
             Inc(Integer(ParamPtr), 4);
             ArgPtr^[3] := ParamPtr^;
           end;
         end;
         Inc(Integer(ParamPtr), 4);
       end;
       Inc(I);
     until I = ArgCount;
   end;
   DispParams.rgvarg := @Args;
   DispParams.rgdispidNamedArgs := @DispIDs[1];
   DispParams.cArgs := ArgCount;
   DispParams.cNamedArgs := CallDesc^.NamedArgCount;
   DispID := DispIDs[0];
   InvKind := CallDesc^.CallType;
   if InvKind = DISPATCH_PROPERTYPUT then
   begin
     if Args[0][0] and varTypeMask = varDispatch then
       InvKind := DISPATCH_PROPERTYPUTREF;
     DispIDs[0] := DISPID_PROPERTYPUT;
     Dec(Integer(DispParams.rgdispidNamedArgs), SizeOf(Integer));
     Inc(DispParams.cNamedArgs);
   end else
     if (InvKind = DISPATCH_METHOD) and (ArgCount = 0) and (Result <> nil) then
       InvKind := DISPATCH_METHOD or DISPATCH_PROPERTYGET;
   Status := Dispatch.Invoke(DispID, GUID_NULL, 0, InvKind, DispParams,
     Result, @ExcepInfo, nil);
   if Status <> 0 then DispatchInvokeError(Status, ExcepInfo);
   J := StrCount;
   while J <> 0 do
   begin
     Dec(J);
     with Strings[J] do
       if PStr <> nil then OleStrToStrVar(BStr, PStr^);
   end;

 finally
   K := StrCount;
   while K <> 0 do
   begin
     Dec(K);
     SysFreeString(Strings[K].BStr);
   end;
 end;
end;

Или здесь какой-то хитрый смысл?


 
CinCinNut ©   (2004-05-07 19:30) [1]

у них наверное платят за кол-во строк :)


 
pasha_golub ©   (2004-05-07 20:31) [2]

CinCinNut ©   (07.05.04 19:30) [1]
LOL, однако чует мой анус, где-то тут подвох! :-)


 
Alex Konshin ©   (2004-05-07 21:04) [3]

А в чем подвох?
Все строковые аргументы где нужно переводятся в BStr.
Все вроде верно.


 
Alex Konshin ©   (2004-05-07 21:08) [4]

Ааа, они в другую сторону переводят...
А! Так это они для var аргументов снимают результат. Так что все равно все разумно, но пока не вижу, почему они эти результаты никуда не отдают.


 
Alex Konshin ©   (2004-05-07 21:12) [5]

А-а-а! Так там же PString, так что результат в последнем цикле-то и возвращается.
Вот все и разрешилось. По крайней мере алгоритмически все верно.



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2004.05.30;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.031 c
3-1084272590
Nazer
2004-05-11 14:49
2004.05.30
Какие индексы создать ??


3-1083509571
Крутыш
2004-05-02 18:52
2004.05.30
Какой лучше использовать протокол


14-1084455006
Razor
2004-05-13 17:30
2004.05.30
Программирование для мобильников


11-1073934915
Maxim Pushkar
2004-01-12 22:15
2004.05.30
Не работает Font.Color для RichEdit?


1-1084619254
DimonNew
2004-05-15 15:07
2004.05.30
передача свойст объектов в качестве параметров процедуры





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский