jetzt wurschtle ich schon seit Stunden herum und kann keinen Fehler in meinem Code entdecken. Bin jetzt schon fast soweit, dass ich einen Fehler in PB vermute, insbesondere, da kein Fehler auftritt, wenn ich das Programm mit 32 bit kompiliere. Ich habe das ganze mal aus meinem Projekt herausgelöst, kürzer geht leider nicht mehr.
Es geht um die Zeile 192 in untenstehenden Code. Ich habe eine Variable vom Typ EXCEPINFO definiert. Wenn ich nun eine Referenz an ScriptError\GetExceptionInfo übergebe, stürzt mein Programm ab. EXCEPINFO hat eine Größe von 64 Byte.
Der Workaround mit selbst allociertem Speicher funktioniert übrigens. Zum testen bitte die Zeile 192 auskommentieren und die Zeile 193 verwenden. Zum testen bitte Unicode verwenden.
Bevor Missverständnisse aufkommen. Es geht mir nicht um den Fehler, der durch mein Script verursacht wird, den habe ich durch den Befehl MsgBoxxxx absichtlich herbeigeführt.
Code: Alles auswählen
EnableExplicit
;-===== INTERFACES ============================================================
Interface IActiveScript Extends IUnknown
SetScriptSite(a)
GetScriptSite(a, b)
SetScriptState(a)
GetScriptState(a)
Close()
AddNamedItem(a, b)
AddTypeLib(a, b , c , d)
GetScriptDispatch(a, b)
GetCurrentScriptThreadID(a)
GetScriptThreadID(a, b)
GetScriptThreadState(a, b)
InterruptScriptThread(a, b, c)
Clone(a)
EndInterface
Interface IActiveScriptParse Extends IUnknown
InitNew()
AddScriptlet(a, b, c, e, f, g, h, i, j, k, l)
ParseScriptText(a, b, c, e, f, g, h, i, j)
EndInterface
Interface IActiveScriptSite Extends IUnknown
GetLCID(a)
GetItemInfo(a, b, c, d)
GetDocVersionString(a)
OnScriptTerminate(a, b)
OnStateChange(a)
OnScriptError(a)
OnEnterScript()
OnLeaveScript()
GetWindow(a)
EnableModeless(a)
EndInterface
Interface IActiveScriptError Extends IUnknown
GetExceptionInfo(a)
GetSourcePosition(a, b, c)
GetSourceLineText(a)
EndInterface
;;=============================================================================
;-===== DATA SECTION ==========================================================
DataSection
IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IActiveScript: ; {BB1A2AE1-A4F9-11CF-8F20-00805F2CD064}
Data.l $BB1A2AE1
Data.w $A4F9,$11CF
Data.b $8F,$20,$00,$80,$5F,$2C,$D0,$64
IID_IActiveScriptSite: ; {DB01A1E3-A42B-11CF-8F20-00805F2CD064}
Data.l $DB01A1E3
Data.w $A42B,$11CF
Data.b $8F,$20,$00,$80,$5F,$2C,$D0,$64
IID_IActiveScriptSiteWindow: ; {D10F6761-83E9-11CF-8F20-00805F2CD064}
Data.l $D10F6761
Data.w $83E9,$11CF
Data.b $8F,$20,$00,$80,$5F,$2C,$D0,$64
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
IID_IActiveScriptParse: ; {BB1A2AE2-A4F9-11CF-8F20-00805F2CD064} 32bit
Data.l $BB1A2AE2
Data.w $A4F9,$11CF
Data.b $8F,$20,$00,$80,$5F,$2C,$D0,$64
CompilerEndIf
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
IID_IActiveScriptParse: ; {C7EF7658-E1EE-480E-97EA-D52CB4D76D17} 64 bit
Data.l $C7EF7658
Data.w $E1EE,$480E
Data.b $97,$EA,$D5,$2C,$B4,$D7,$6D,$17
CompilerEndIf
EndDataSection
;;=============================================================================
;-===== STRUKTUREN ============================================================
Structure EXCEPINFO
wCode.w
wReserved.w
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 : padding1.b[4] : CompilerEndIf
bstrSource.s
bstrDescription.s
bstrHelpFile.s
dwHelpContext.l
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 : padding2.b[4] : CompilerEndIf
*pvReserved
*pfnDeferredFillIn
sCode.l
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64 : padding3.b[4] : CompilerEndIf
EndStructure
;;=============================================================================
;-===== ACTIVESCRIPTSITE ================================================
Structure ASS
*VTABLE
cntRef.l
EndStructure
Procedure.l ASS_QueryInterface (*this.ASS, *iid.IID, *Object.INTEGER)
If CompareMemory(*iid, ?IID_IActiveScriptSite, 16) Or CompareMemory(*iid, ?IID_IUnknown, 16)
*Object = *this
ProcedureReturn #S_OK
EndIf
If CompareMemory(*iid, ?IID_IActiveScriptSiteWindow, 16)
*Object = *this
ProcedureReturn #S_OK
EndIf
ProcedureReturn #E_OUTOFMEMORY
EndProcedure
Procedure.l ASS_AddRef (*this.ASS)
*this\cntRef + 1
ProcedureReturn *this\cntRef
EndProcedure
Procedure.l ASS_Release (*this.ASS)
*this\cntRef - 1
If *this\cntRef < 1
FreeMemory(*this)
ProcedureReturn 0
EndIf
ProcedureReturn *this\cntRef
EndProcedure
Procedure.i ASS_GetLCID (*this.ASS, *LCID)
Define sLCID.s{5}
Static lLCID.l
;Language Id auslesen
GetLocaleInfo_(#LOCALE_USER_DEFAULT, #LOCALE_ILANGUAGE, @sLCID, 5)
lLCID = Val(sLCID)
PokeL(*LCID, lLCID)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASS_GetItemInfo (*this.ASS, a, b, c, d)
;Da gehört wahrscheinlich noch einiges rein
EndProcedure
Procedure.i ASS_GetDocVersionString(*this.ASS, a)
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i ASS_OnScriptTerminate (*this.ASS, a, b)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASS_OnStateChange (*this.ASS, a)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASS_OnScriptError (*this.ASS, *ScriptError.IActiveScriptError)
Define ErrSourceContext.i
Define ErrLine.i
Define ErrColumn.i
Define ErrExcepInfo.EXCEPINFO
Define *Workaround.EXCEPINFO
*Workaround = AllocateMemory (SizeOf (EXCEPINFO))
;Fehler aus Errorobjekt lesen
*ScriptError\GetSourcePosition(@ErrSourceContext, @ErrLine, @ErrColumn)
*ScriptError\GetExceptionInfo (@ErrExcepInfo)
; *ScriptError\GetExceptionInfo (*Workaround)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASS_OnEnterScript (*this.ASS)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASS_OnLeaveScript (*this.ASS)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASSWindow_GetWindow (*this.ASS, a)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASSWindow_EnableModless(*this.ASS, a)
ProcedureReturn #S_OK
EndProcedure
Procedure.i ASS_New()
Define *this.ASS
*this = AllocateMemory(SizeOf(ASS))
*this\VTABLE = ?VT_ASS
ProcedureReturn *this
EndProcedure
DataSection
VT_ASS:
Data.i @ASS_QueryInterface()
Data.i @ASS_AddRef()
Data.i @ASS_Release()
Data.i @ASS_GetLCID()
Data.i @ASS_GetItemInfo()
Data.i @ASS_GetDocVersionString()
Data.i @ASS_OnScriptTerminate()
Data.i @ASS_OnStateChange()
Data.i @ASS_OnScriptError()
Data.i @ASS_OnEnterScript()
Data.i @ASS_OnLeaveScript()
Data.i @ASSWindow_GetWindow()
Data.i @ASSWindow_EnableModless()
EndDataSection
;;=============================================================================
;-===== HAUPTPROGRAMM =========================================================
Define ClsId.GUID
Define *ActiveScript.IActiveScript
Define *ActiveScriptParse.IActiveScriptParse
Define *Site.IActiveScriptSite
Define ExcInfo.EXCEPINFO
Define sCode.s
Define hr.i
;Testcode
sCode = " MsgBoxxxx (" + Chr(34) + "Hallo PureBasic" + Chr(34) + ")"
;COM initialisieren
CoInitialize_(0)
;Klassenid suchen
hr = CLSIDFromProgID_(@"VBSCRIPT", @ClsId)
If hr : MessageRequester(Str(hr), "KlassenId konnte nicht ermittelt werden") : EndIf
;Instanz der Scriptengine erstellen
hr = CoCreateInstance_(@ClsId, 0, 1, ?IID_IActiveScript, @*ActiveScript)
If hr : MessageRequester(Str(hr), "Fehler beim Erstellen der Instanz") : EndIf
;Parseinterface der Scriptengine suchen
hr = *ActiveScript\QueryInterface(?IID_IActiveScriptParse, @*ActiveScriptParse)
If hr : MessageRequester(Str(hr), "Fehler beim Verbinden zum Scriptparser") : EndIf
;Parseinterface initialisieren
hr = *ActiveScriptParse\InitNew()
If hr : MessageRequester(Str(hr), "Fehler beim initialisieren") : EndIf
;Object für Scriptsite erstellen
*Site = ASS_New()
*Site\AddRef()
;Scriptsite zuweisen
hr = *ActiveScript\SetScriptSite(*Site)
If hr : MessageRequester(Str(hr), "Fehler bei SetScriptSite") : EndIf
;Script Engine Verbinden
hr = *ActiveScript\SetScriptState (2)
If hr : MessageRequester(Str(hr), "Fehler beim Setzen des Scriptstatus 'Connected'") : EndIf
;Scriptcode ausführen
hr = *ActiveScriptParse\ParseScriptText(@sCode, 0, 0, 0, 0, 0, 0, 0, @ExcInfo)
;;=============================================================================