Шустрый
Профиль
Группа: Участник
Сообщений: 68
Регистрация: 7.4.2006
Репутация: нет
Всего: нет
|
Привет всем скачал этот ЮНИТ TrDispCall при подключение выдает [Error] Need imported data reference ($G) to access 'GUID_NULL' from unit 'TrDispCall' Работаю с package бпл ками Как решит эту проблему? Заранее благодарен | Код |
{**********************************************************}
{ }
{ This code took from ComObj.pas }
{ Copyright (c) 1997-2001 Borland Software Corporation }
{ }
{ Fix added by Gene Feudorov, mailto:[email protected] }
{ Stock Company "Trust-M", Ekatirinburg, 2004 }
{ }
{**********************************************************}
unit TrDispCall;
interface
{ Gene Feudorov added }
{ function DispCallLocaleID(Value: Integer): Integer; }
{ Changes LocaleID called from DispCall }
{ Value - sets new LocaleID to use in DispCall }
{ Returns: Old Value of LocaleID }
function DispCallLocaleID(Value: Integer): Integer;
implementation
uses Variants, Windows, ActiveX, SysUtils;
resourcestring
SOleError = 'OLE error %.8x'; { const from ComConst.pas }
threadvar // <-- для потоконезависимости
LocaleID: integer; // Gene Feudorov added
function DispCallLocaleID(Value: Integer): Integer;
begin
Result := LocaleID;
LocaleID := Value;
end;
const
{ Maximum number of dispatch arguments }
MaxDispArgs = 64; {!!!}
{ Special variant type codes }
varStrArg = $0048;
{ Parameter type masks }
atVarMask = $3F;
atTypeMask = $7F;
atByRef = $80;
function TrimPunctuation(const S: string): string;
var
P: PChar;
begin
Result := S;
P := AnsiLastChar(Result);
while (Length(Result) > 0) and (P^ in [#0..#32, '.']) do
begin
SetLength(Result, P - PChar(Result));
P := AnsiLastChar(Result);
end;
end;
type
EOleError = class(Exception);
EOleSysError = class(EOleError)
private
FErrorCode: HRESULT;
public
constructor Create(const Message: string; ErrorCode: HRESULT;
HelpContext: Integer);
property ErrorCode: HRESULT read FErrorCode write FErrorCode;
end;
EOleException = class(EOleSysError)
private
FSource: string;
FHelpFile: string;
public
constructor Create(const Message: string; ErrorCode: HRESULT;
const Source, HelpFile: string; HelpContext: Integer);
property HelpFile: string read FHelpFile write FHelpFile;
property Source: string read FSource write FSource;
end;
procedure DispCallError(Status: Integer; var ExcepInfo: TExcepInfo;
ErrorAddr: Pointer; FinalizeExcepInfo: Boolean);
var
E: Exception;
begin
if Status = Integer(DISP_E_EXCEPTION) then
begin
with ExcepInfo do
E := EOleException.Create(bstrDescription, scode, bstrSource,
bstrHelpFile, dwHelpContext);
if FinalizeExcepInfo then
Finalize(ExcepInfo);
end else
E := EOleSysError.Create('', Status, 0);
if ErrorAddr <> nil then
raise E at ErrorAddr
else
raise E;
end;
procedure ClearExcepInfo(var ExcepInfo: TExcepInfo);
begin
FillChar(ExcepInfo, SizeOf(ExcepInfo), 0);
end;
procedure DispCall(const Dispatch: IDispatch; CallDesc: PCallDesc;
DispID: Integer; NamedArgDispIDs, Params, Result: Pointer); stdcall;
type
TExcepInfoRec = record // mock type to avoid auto init and cleanup code
wCode: Word;
wReserved: Word;
bstrSource: PWideChar;
bstrDescription: PWideChar;
bstrHelpFile: PWideChar;
dwHelpContext: Longint;
pvReserved: Pointer;
pfnDeferredFillIn: Pointer;
scode: HResult;
end;
var
DispParams: TDispParams;
ExcepInfo: TExcepInfoRec;
{ Gene Feudorov added }
lcid: Integer;
begin
{ Gene Feudorov added }
{ Write LocaleID to local varable }
lcid := LocaleID;
asm
PUSH EBX
PUSH ESI
PUSH EDI
MOV EBX,CallDesc
XOR EDX,EDX
MOV EDI,ESP
MOVZX ECX,[EBX].TCallDesc.ArgCount
MOV DispParams.cArgs,ECX
TEST ECX,ECX
JE @@10
ADD EBX,OFFSET TCallDesc.ArgTypes
MOV ESI,Params
@@1: MOVZX EAX,[EBX].Byte
TEST AL,atByRef
JNE @@3
CMP AL,varVariant
JE @@2
CMP AL,varDouble
JB @@4
CMP AL,varDate
JA @@4
PUSH [ESI].Integer[4]
PUSH [ESI].Integer[0]
PUSH EDX
PUSH EAX
ADD ESI,8
JMP @@5
@@2: PUSH [ESI].Integer[12]
PUSH [ESI].Integer[8]
PUSH [ESI].Integer[4]
PUSH [ESI].Integer[0]
ADD ESI,16
JMP @@5
@@3: AND AL,atTypeMask
OR EAX,varByRef
@@4: PUSH EDX
PUSH [ESI].Integer[0]
PUSH EDX
PUSH EAX
ADD ESI,4
@@5: INC EBX
DEC ECX
JNE @@1
MOV EBX,CallDesc
@@10: MOV DispParams.rgvarg,ESP
MOVZX EAX,[EBX].TCallDesc.NamedArgCount
MOV DispParams.cNamedArgs,EAX
TEST EAX,EAX
JE @@12
MOV ESI,NamedArgDispIDs
@@11: PUSH [ESI].Integer[EAX*4-4]
DEC EAX
JNE @@11
@@12: MOVZX ECX,[EBX].TCallDesc.CallType
CMP ECX,DISPATCH_PROPERTYPUT
JNE @@20
PUSH DISPID_PROPERTYPUT
INC DispParams.cNamedArgs
CMP [EBX].TCallDesc.ArgTypes.Byte[0],varDispatch
JE @@13
CMP [EBX].TCallDesc.ArgTypes.Byte[0],varUnknown
JNE @@20
@@13: MOV ECX,DISPATCH_PROPERTYPUTREF
@@20: MOV DispParams.rgdispidNamedArgs,ESP
PUSH EDX { ArgErr }
LEA EAX,ExcepInfo
PUSH EAX { ExcepInfo }
PUSH ECX
PUSH EDX
CALL ClearExcepInfo
POP EDX
POP ECX
PUSH Result { VarResult }
LEA EAX,DispParams
PUSH EAX { Params }
PUSH ECX { Flags }
// PUSH EDX { LocaleID }
PUSH lcid { Fix by Gene Feudorov }
PUSH OffSet GUID_NULL { IID }
PUSH DispID { DispID }
MOV EAX,Dispatch
PUSH EAX
MOV EAX,[EAX]
CALL [EAX].Pointer[24]
TEST EAX,EAX
JE @@30
LEA EDX,ExcepInfo
MOV CL, 1
PUSH ECX
MOV ECX,[EBP+4]
JMP DispCallError
@@30: MOV ESP,EDI
POP EDI
POP ESI
POP EBX
end;
end;
procedure DispCallByID(Result: Pointer; const Dispatch: IDispatch;
DispDesc: PDispDesc; Params: Pointer); cdecl;
asm
PUSH EBX
MOV EBX,DispDesc
XOR EAX,EAX
PUSH EAX
PUSH EAX
PUSH EAX
PUSH EAX
MOV EAX,ESP
PUSH EAX
LEA EAX,Params
PUSH EAX
PUSH EAX
PUSH [EBX].TDispDesc.DispID
LEA EAX,[EBX].TDispDesc.CallDesc
PUSH EAX
PUSH Dispatch
CALL DispCall
MOVZX EAX,[EBX].TDispDesc.ResType
MOV EBX,Result
JMP @ResultTable.Pointer[EAX*4]
@ResultTable:
DD @ResEmpty
DD @ResNull
DD @ResSmallint
DD @ResInteger
DD @ResSingle
DD @ResDouble
DD @ResCurrency
DD @ResDate
DD @ResString
DD @ResDispatch
DD @ResError
DD @ResBoolean
DD @ResVariant
DD @ResUnknown
DD @ResDecimal
DD @ResError
DD @ResByte
@ResSingle:
FLD [ESP+8].Single
JMP @ResDone
@ResDouble:
@ResDate:
FLD [ESP+8].Double
JMP @ResDone
@ResCurrency:
FILD [ESP+8].Currency
JMP @ResDone
@ResString:
MOV EAX,[EBX]
TEST EAX,EAX
JE @@1
PUSH EAX
CALL SysFreeString
@@1: MOV EAX,[ESP+8]
MOV [EBX],EAX
JMP @ResDone
@ResDispatch:
@ResUnknown:
MOV EAX,[EBX]
TEST EAX,EAX
JE @@2
PUSH EAX
MOV EAX,[EAX]
CALL [EAX].Pointer[8]
@@2: MOV EAX,[ESP+8]
MOV [EBX],EAX
JMP @ResDone
@ResVariant:
MOV EAX,EBX
CALL System.@VarClear
MOV EAX,[ESP]
MOV [EBX],EAX
MOV EAX,[ESP+4]
MOV [EBX+4],EAX
MOV EAX,[ESP+8]
MOV [EBX+8],EAX
MOV EAX,[ESP+12]
MOV [EBX+12],EAX
JMP @ResDone
@ResSmallint:
@ResInteger:
@ResBoolean:
@ResByte:
MOV EAX,[ESP+8]
@ResDecimal:
@ResEmpty:
@ResNull:
@ResError:
@ResDone:
ADD ESP,16
POP EBX
end;
{ EOleSysError }
constructor EOleSysError.Create(const Message: string; ErrorCode: HRESULT;
HelpContext: Integer);
var
S: string;
begin
S := Message;
if S = '' then
begin
S := SysErrorMessage(ErrorCode);
if S = '' then FmtStr(S, SOleError, [ErrorCode]);
end;
inherited CreateHelp(S, HelpContext);
FErrorCode := ErrorCode;
end;
{ EOleException }
constructor EOleException.Create(const Message: string; ErrorCode: HRESULT;
const Source, HelpFile: string; HelpContext: Integer);
begin
inherited Create(TrimPunctuation(Message), ErrorCode, HelpContext);
FSource := Source;
FHelpFile := HelpFile;
end;
initialization
begin
LocaleID := 0; // or LOCALE_USER_DEFAULT ?
DispCallByIDProc := @DispCallByID; // set new disp handler
end;
finalization
begin
DispCallByIDProc := nil;
end;
end.
|
|
[Error] Need imported data reference ($G) to acces 
Загрузка ...
