Hvordan innarbeide enkle skripting evner til Delphi. Det kan være nyttig å kalle en metode, beskrevet som streng, på et grensesnitt, definert av en streng som inneholder noe sånt som "MyLib.MyObject1'.This enhet utsetter noen funksjon som du kan ringe for å få tilgang til IDispatch grensesnitt mer easily.-------------------------------{////////////////////////////////////////////////////////////////Name Enhetsleder DispatchLibPurpose av enhet: Utsetter funksjon å manipulere COM-objekter som implementerer IDispatch grensesnitt. Du kan kalle metoder eller eiendommer direkte, eller du kan føre opp alle funksjonene til en TStringList objekt. Et eksempel: prosedyre fa (sl: TStringList); Var en: variant; s: string; begynne a: = CreateOLEObject ("microsoft.msxml"); DocumentIDispatch (a, sl); ExecuteOnDispatchMultiParam (en "LoadXML", ["b"]); s: = ExecuteOnDispatchMultiParam (a, "xml", []); MessageDlg (s, mtInformation, [mbOk], 0); slutt; Koden er basert på en enhet som jeg fant på internett, men den inneholdt noen alvorlige feil, og det gjorde ikke støtte mer enn én parameter.Anything uvanlig: Coded etter: VJDate: 17.07.2001Revision historie: ////////////////////////////////////////////////////////////////} enhet DispatchLib; interfaceuses ActiveX, sysutils, klasser, skriver exMethodNotSupported = klasse (Unntak); exIDispatchCallError = klasse (Unntak), funksjon ExecuteOnDispatchMultiParam (TargetObj: IDispatch; metode: string; ParamValues: array of konst): OleVariant; prosedyre DocumentIDispatch (ID: IDispatch; Var SL: TStringList); prosedyre DocumentIDispatch2 (ID: IDispatch; Var SLNames: TStringList), funksjon ElementDescriptionToString (a: TElemDesc): string; implementationfunction ElementDescriptionToString (a: TElemDesc): string; begynne tilfelle a.tdesc.vt av VT_I4: Resultat: = 'int'; VT_R8: Resultat: = 'double'; VT_BSTR: Resultat: = 'streng'; annet Resultat: = ''; end, end, prosedyre DocumentIDispatch (ID: IDispatch; Var SL: TStringList); Var res: hresult; Telle, loop, loop2, loop3: integer; TI: ITypeinfo; PTA: PTypeAttr; PFD: PFuncDesc; varDesc: pVarDesc; numFunctions: integer; numParams: integer; funcDispID: integer; navn: TBStrList; numReturned: integer; functionstr: widestring; hide: boolean, begynner hevde (SL < > null, "SL kan ikke være null '); SL.Clear; res: = ID.GetTypeInfoCount (Count); hvis lyktes (res), og start for loop: = 0 til Count - en gjør begynne res: = ID.GetTypeInfo (loop, 0, TI); hvis lyktes (res), og start res: = TI.GetTypeAttr (PTA); hvis lyktes (res), og start hvis PTA ^ .typekind = TKIND_DISPATCH deretter begynne numFunctions: = PTA ^ .cFuncs; for loop2: = 0 til numFunctions - 1 gjør begynne res: = TI.GetFuncDesc (loop2, PFD); hvis lyktes (res), og start funcDispID: = PFD ^ .memid; numParams: = PFD ^ .cParams; res: = TI.GetNames (funcDispID,names, numParams + 1, numReturned); hvis lyktes (res), og start functionstr: = ''; hvis numReturned > 0 da functionstr: = functionstr + navn [0]; hvis numReturned > En da begynne functionstr: = functionStr + '('; for loop3: = 1 til numReturned - en ikke begynne hvis loop3 > en så functionstr: = functionstr + ','; functionstr: = functionstr + navn [loop3] + ': '+ ElementDescriptionToString (PFD ^ .lprgelemdescParam ^ [loop3 - 1]); ende; //functionstr: = functionstr + navn [numReturned - 1] +') '; functionstr: = functionstr + ')'; slutt; hide: = False; //Skjuler ikke ekspedere funksjoner hvis (PFD ^ .wFuncFlags og FUNCFLAG_FRESTRICTED) = FUNCFLAG_FRESTRICTED deretter skjule: = true; //Skjuler funksjoner som ikke er beregnet for skripting: utgangspunktet overflødige funksjoner hvis (PFD ^ .wFuncFlags og FUNCFLAG_FHIDDEN) = FUNCFLAG_FHIDDEN deretter skjule: = true; hvis ikke skjule så SL.add (functionstr); slutt; TI.ReleaseFuncDesc (PFD); slutt; slutt; slutt; TI.ReleaseTypeAttr (PTA); slutt; slutt; slutt; ende annet heve Exception.Create ('GetTypeInfoCount Feilet'); ende; prosedyre DocumentIDispatch2 (ID: IDispatch; Var SLNames: TStringList); Var res: hresult; Telle, loop, loop2, loop3: integer; TI: ITypeinfo; PTA: PTypeAttr; PFD: PFuncDesc; varDesc: pVarDesc; numFunctions: integer; numParams: integer; funcDispID: integer; navn: TBStrList; numReturned: integer; functionstr: widestring; skjule: boolean, begynner SLNames.Clear; res: = ID.GetTypeInfoCount (Count); hvis lyktes (res), og start for loop: = 0 til Count - en gjør begynne res: = ID.GetTypeInfo (loop, 0, TI); hvis lyktes (res), og start res: = TI.GetTypeAttr (PTA); hvis lyktes (res), og start hvis PTA ^ .typekind = TKIND_DISPATCH deretter begynne numFunctions: = PTA ^ .cFuncs; for loop2: = 0 til numFunctions - 1 gjør begynne res: = TI.GetFuncDesc (loop2, PFD); hvis ikke lyktes (res) deretter Fortsett; funcDispID: = PFD ^ .memid; numParams: = PFD ^ .cParams; res: = TI.GetNames (funcDispID,names, numParams + 1, numReturned); hvis ikke lyktes (res), og start TI.ReleaseFuncDesc (PFD); Fortsette; slutt; //Skjuler ikke ekspedere funksjoner hvis (PFD ^ .wFuncFlags og FUNCFLAG_FRESTRICTED) = FUNCFLAG_FRESTRICTED deretter Fortsett; //Skjuler funksjoner som ikke er beregnet for skripting: utgangspunktet overflødige funksjoner hvis (PFD ^ .wFuncFlags og FUNCFLAG_FHIDDEN) = FUNCFLAG_FHIDDEN deretter fortsette; functionstr: = ''; hvis numReturned > 0 da begynne functionstr: = functionstr + navn [0]; slutt; functionstr: = functionstr + '('; hvis numReturned > en begynner da for loop3: = 1 til numReturned - en ikke begynne hvis loop3 > en så functionstr: = functionstr + ','; functionstr: = functionstr + ElementDescriptionToString (PFD ^ .lprgelemdescParam ^ [loop3 - 1]); end, end, SLNames.Add (functionstr + ')'); TI.ReleaseFuncDesc (PFD); slutt; slutt; TI.ReleaseTypeAttr (PTA); slutt; slutt; slutt; ende annet heve Exception.Create ('GetTypeInfoCount Feilet'); end {////////////////////////////////////////////////////////////////Navn: ExecuteOnDispatchMultiParamPurpose: Å kjøre vilkårlig metode på gitt COM object.Author: VJDate: 07.07.2001History : ////////////////////////////////////////////////////////////////} funksjon ExecuteOnDispatchMultiParam (TargetObj: IDispatch, metode: string; ParamValues: array of konst): OleVariant; Var bredt: widestring; disps: TDispIDList; panswer: ^ olevariant; svare: olevariant; dispParams: TDispParams; aexception: TExcepInfo; pVarArg: PVariantArgList; res: hresult; ParamCount, jeg: integer; begynne Resultat: = false; //Forberede funksjonskall ParamCount: = Høy (ParamValues) + 1; wide: = metode; pVarArg: = null; hvis ParamCount > 0 da GetMem (pVarArg, ParamCount * sizeof (TVariantArg)); prøv //få dispid av forespurte metoden hvis ikke lyktes (TargetObj.GetIDsOfNames (GUID_NULL,wide, 1, 0,disps)) deretter heve exMethodNotSupported.Create ('Dette objektet støtter ikke denne metoden'); pAnswer: =answer; //Forberede parametere for i: = 0 til ParamCount - en ikke begynne case ParamValues ​​[ParamCount - en - i] .VType av vtInteger: begynne pVarArg ^ [i] .vt: = VT_I4; pVarArg ^ [i] .lVal: = ParamValues ​​[ParamCount - en - i] .VInteger; slutt; vtExtended: begynne pVarArg ^ [i] .vt: = VT_R8; pVarArg ^ [i] .dblVal: = ParamValues ​​[ParamCount - en - i] .VExtended ^; slutt; vtString, vtAnsiString, vtChar: begynne pVarArg ^ [i] .vt: = VT_BSTR; pVarArg ^ [i] .bstrVal: = PWideChar (WideString (PChar (ParamValues ​​[ParamCount - en - i] .VString))); slutt; annet heve Exception.CreateFmt ('Unsuported type for parameter med indeks% d', [i]); slutt; slutt; //Forberede ekspedere parametere dispparams.rgvarg: = pVarArg; dispparams.rgdispidNamedArgs: = null; dispparams.cArgs: = ParamCount; dispparams.cNamedArgs: = 0; //Gjøre IDispatch samtale res: = TargetObj.Invoke (disps [0], GUID_NULL, 0, DISPATCH_METHOD eller DISPATCH_PROPERTYGET, dispParams, pAnswer,aexception, null); //Sjekke resultatet dersom res < > 0 deretter heve exIDispatchCallError.CreateFmt ('Metode samtale unsuccessfull% s (% s).. ", [String (aexception.bstrDescription), streng (aexception.bstrSource)]); //Returnere resultatet Resultat: = svaret; slutt hvis ParamCount > 0 da FreeMem (pVarArg, ParamCount * sizeof (TVariantArg)); end, end;. slutten Anmeldelser