PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

ScriptControl v1.10 (Neu AddObject für eigene ClassObjects)

https://www.purebasic.fr/german/viewtopic.php?t=22863

Seite 1 von 1

ScriptControl v1.10 (Neu AddObject für eigene ClassObjects)

Verfasst: 17.07.2010 21:14
von mk-soft
Hi,
Mit der Hilfe von Josh "COM Object Tutorial" kann man jetzt eigene PB-Proceduren in den VB-Script einbinden.

Zum Beispiel Variablen in einer Map zur Laufzeit mit den Script zu lesen oder schreiben.
Dazu wird ein ClassObject erzeugt und diese dann mit AddObject(...) eingebunden.

Update v1.12
- Neu: SCtr_GetError() - Ergenis als String
- Beispiel überarbeitet

Smarttags.pb

Code: Alles auswählen

;-TOP
;- Smarttags example by Michael kastner

CompilerIf #PB_Compiler_Unicode <> 1
  CompilerError "Option Unicode einstellen"
CompilerEndIf

;- Includes *****************************************************************************

IncludeFile "..\source\ScriptControl.pbi"

;- Strukturen ***************************************************************************

  Structure udtObject
    *VTable
    cntRef.l
    *oOwn.IUnknown
    *oPar.IUnknown
    *oApp.IUnknown
  EndStructure

  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
  
  Structure udtArgs
    ID.VARIANT[0]
  EndStructure
  
;- Helper Variant String ****************************************************************

Procedure.s VT_STR(*Var.Variant)

  Protected hr.l, result.s, VarDest.Variant
 
  vhLastError = 0
  
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_BSTR)
    If hr = #S_OK
      result = PeekS(VarDest\bstrVal, #PB_Any, #PB_Unicode)
      VariantClear_(VarDest)
      ProcedureReturn result
    Else
      ProcedureReturn ""
    EndIf
   
  EndIf
EndProcedure

;- Helper Check Variant Type ************************************************************

Procedure CheckVT(*var.VARIANT, Type)
  
  Protected *va.VARIANT
  
  If *var\vt & #VT_VARIANT = #VT_VARIANT
    *va = *var\pvarVal
  Else
    *va = *var
  EndIf
  If *va\vt & #VT_TYPEMASK <> Type
    ProcedureReturn #DISP_E_BADVARTYPE
  Else
    ProcedureReturn #S_OK
  EndIf
  
EndProcedure

;- Helper New Object ********************************************************************

Procedure NewObject(*VT_Application)
  
  Define *oNew.udtObject
  
  ;Eine neues Applikationsobjekt erstellen
  *oNew         = AllocateMemory (SizeOf(udtObject))
  *oNew\VTable  = *VT_Application
  *oNew\oOwn    = *oNew
  *oNew\oPar    = *oNew
  *oNew\oApp    = *oNew
  *oNew\oOwn\AddRef()
  ProcedureReturn *oNew
  
EndProcedure

; ***************************************************************************************

;- Konstanten ***************************************************************************

; DispId´s

  #Smarttags  = 101
  
;- Deklarationen ************************************************************************

  Declare Object_GetSmarttags(*This, *varname.string, *value.VARIANT)
  Declare Object_PutSmarttags(*This, *varname.string, *value.VARIANT)
  
;- Globale Variablen, Listen
  
  Global NewMap Tags.VARIANT()
  
;- CLASS OBJECT *************************************************************************

  ; Begin Standard Interfaces

  Procedure.l Object_QueryInterface(*This.udtObject, *iid.IID, *Object.Integer)
    
    ;Standardzuweisungen auf eigenes Objekt
    If CompareMemory(*iid, ?IID_IUnknown, 16) Or CompareMemory(*iid, ?IID_IDispatch, 16)
      *Object\i = *This : *This\oOwn\AddRef()
      ProcedureReturn #S_OK
    EndIf

    ProcedureReturn #E_NOINTERFACE

  EndProcedure
  
  Procedure.l Object_AddRef(*This.udtObject)

    *This\cntRef + 1
    ProcedureReturn *This\cntRef

  EndProcedure
  
  Procedure.l Object_Release(*This.udtObject)

    ;Wenn Referenzzähler nicht auf 0 kommt
    If *This\cntRef > 1
      *This\cntRef - 1
      ProcedureReturn *This\cntRef
    EndIf

    ;Eigenes Objekt auflösen
    FreeMemory(*This)
    ProcedureReturn 0

  EndProcedure
  
  Procedure.l Object_GetTypeInfoCount(*This.udtObject, *CntTypeInfo.Long)
    
    *CntTypeInfo\l = 0
    ProcedureReturn #S_OK

  EndProcedure
  
  Procedure.l Object_GetTypeInfo(*This.udtObject, TypeInfo.l, LocalId.l, *ppTypeInfo.Integer)
    
    ProcedureReturn #S_OK

  EndProcedure
  
  Procedure.l Object_GetIDsOfNames(*This.udtObject, *iid.IID, *Name.String, cntNames.l, lcid.l, *DispId.Long)
    
    Protected Name.s
    
    Name = LCase(*Name\s)
    ; Hier die Funktionsnamen auf DispId auflösen
    Select name
      Case "smarttags"  
        *DispId\l = #Smarttags
        
      Default
        ProcedureReturn #DISP_E_MEMBERNOTFOUND
        
    EndSelect
    
    ProcedureReturn #S_OK
    
  EndProcedure
  
  Procedure.l Object_Invoke(*This.udtObject, DispId.l, *iid.IID, lcid.l, Flags.w, *DispParams.DISPPARAMS, *vResult.VARIANT, *ExcepInfo.EXCEPINFO, *ArgErr.Integer)
    
    Protected *vArg.udtArgs, r1
    
    *vArg = *DispParams\rgvarg
    
    Select DispId
      ; Hier werden die Funktionen aufgerufen
      ; Mit den Flags kann man den Type PropertyGet oder PropertyPut unterscheiden  
       Case #Smarttags
        ; Funktion für Get aufrufen
        If Flags & #DISPATCH_PROPERTYGET = #DISPATCH_PROPERTYGET
          ; Hier werden die Anzahl der Parameter überprüft
          If *Dispparams\cArgs <> 1
            ProcedureReturn #DISP_E_BADPARAMCOUNT
          EndIf
          ; Hier werden die Typen der Parameter überprüft
          If CheckVT(*vArg\ID[0], #VT_BSTR)
            ProcedureReturn #DISP_E_BADVARTYPE
          EndIf
          Object_GetSmarttags(*This, *vArg\ID[0], *vResult)
          ProcedureReturn #S_OK
          
        ; Funktion für Put aufrufen
        ElseIf Flags & #DISPATCH_PROPERTYPUT = #DISPATCH_PROPERTYPUT
          ; Hier werden die Anzahl der Parameter überprüft
          If *Dispparams\cArgs <> 2
            ProcedureReturn #DISP_E_BADPARAMCOUNT
          EndIf
          ; Hier werden die Typen der Parameter überprüft
          If CheckVT(*vArg\ID[1], #VT_BSTR)
            ProcedureReturn #DISP_E_BADVARTYPE
          EndIf
          Object_PutSmarttags(*This, *vArg\ID[1], *vArg\ID[0])
          ProcedureReturn #S_OK
          
        ; Funktion wurde ohne Get oder Put aufgerufen
        Else
          ProcedureReturn #DISP_E_BADPARAMCOUNT
          
        EndIf
        
      Default
        ProcedureReturn #DISP_E_MEMBERNOTFOUND
          
    EndSelect

  EndProcedure
  
  ; End Standard Interfaces
  
  ; Begin Eigene Interfaces
  
  Procedure Object_GetSmarttags(*this, *varname.VARIANT, *value.VARIANT)
    
    Protected *p, name.s
    
    name = VT_STR(*varname)
    
    If FindMapElement(Tags(), name)
      *p = @Tags()
      VariantCopy_(*value, *p)
    Else
      VariantClear_(*value)
    EndIf
    
  EndProcedure
  
  Procedure Object_PutSmarttags(*this, *varname.VARIANT, *value.VARIANT)
    
    Protected *p, name.s
    
    name = VT_STR(*varname)
    If AddMapElement(Tags(), name)
      *p = @Tags()
      VariantCopy_(*p, *value)
    EndIf
    
  EndProcedure
  
  ; End Eigene Interfaces
  
;- DATA SECTION *************************************************************************

  DataSection

    ; Standard IID
    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_IDispatch: ; {00020400-0000-0000-C000-000000000046}
    Data.l $00020400
    Data.w $0000,$0000
    Data.b $C0,$00,$00,$00,$00,$00,$00,$46
    
    ; Eigene VT
    VT_Smarttags:
    Data.i @Object_QueryInterface()
    Data.i @Object_AddRef()
    Data.i @Object_Release()
    Data.i @Object_GetTypeInfoCount()
    Data.i @Object_GetTypeInfo()
    Data.i @Object_GetIDsOfNames()
    Data.i @Object_Invoke()
    Data.i @Object_GetSmarttags()
    Data.i @Object_PutSmarttags()
    
    
  EndDataSection
  
; ***************************************************************************************

;- Main Test Program

InitScriptControl()

Tags("Zahl")\vt = #VT_R8
Tags()\dblVal = 100.95

Define vbs.s
; VB-Script
vbs = "Dim name, value" + #CRLF$
vbs + "name = 'VB-Zahl'" + #CRLF$
vbs + "My.Smarttags(name) = 20" + #CRLF$
vbs + "My.Smarttags('Text') = 'Hallo Welt'" + #CRLF$
vbs + "value = My.Smarttags('Zahl')" + #CRLF$
vbs + "MsgBox 'Value = ' & value"

vbs = ReplaceString(vbs, "'", #DOUBLEQUOTE$)

SCtr_SetLanguage("VBScript")
SCtr_SetTimeOut(20000)
SCtr_AddObject("My", NewObject(?VT_Smarttags))
r1 = SCtr_AddCode(vbs)
If r1 <> #S_OK
  Debug SCtr_GetError()
EndIf

result.d = SCtr_EvalDouble("value")
Debug "value = " + StrD(result)

ForEach tags()
  Debug "Map(" + MapKey(Tags()) + "): " + VT_STR(Tags())
Next

DeleteScriptControl()

End
ScriptControl.pbi v1.12

Code: Alles auswählen

;-TOP
;**
;* Kommentar    : ScriptControl _
;* Author 1     : ts-soft _
;* Author 2     : mk-soft _
; Author 3      : 
;* Datei        : ScriptControl.pb _
;* Version      : 1.12 _
;* Erstellt     : 10.07.2006 _
;* Geändert     : 17.07.2010 _

;** i IScriptControl
;* Interface für ScriptControl
Interface IScriptControl Extends IDispatch
  get_Language(a)
  put_Language(strLanguage.p-bstr)
  get_State(a)
  put_State(a)
  put_SitehWnd(a)
  get_SitehWnd(a)
  get_Timeout(timeout)
  put_Timeout(timeout)
  get_AllowUI(a)
  put_AllowUI(a)
  get_UseSafeSubset(a)
  put_UseSafeSubset(a)
  get_Modules(a)
  get_Error(a)
  get_CodeObject(a)
  get_Procedures(a)
  _AboutBox()
  AddObject(name.p-bstr,*object,addmembers)
  Reset()
  AddCode(source.p-bstr)
  Eval(a.p-bstr,*b.VARIANT)
  ExecuteStatement(a.p-bstr)
  Run(strCommand.p-bstr, intWindowStyle.l, bWaitOnReturn.l)
EndInterface

Interface IScriptError ; Provides access to scripting error information
  QueryInterface(riid.l,ppvObj.l)
  AddRef()
  Release()
  GetTypeInfoCount(pctinfo.l)
  GetTypeInfo(itinfo.l,lcid.l,pptinfo.l)
  GetIDsOfNames(riid.l,rgszNames.l,cNames.l,lcid.l,rgdispid.l)
  Invoke(dispidMember.l,riid.l,lcid.l,wFlags.l,pdispparams.l,pvarResult.l,pexcepinfo.l,puArgErr.l)
  get_Number(dispidMember.l)
  get_Source(dispidMember.l)
  get_Description(dispidMember.l)
  get_HelpFile(dispidMember.l)
  get_HelpContext(dispidMember.l)
  get_Text(dispidMember.l)
  get_Line(dispidMember.l)
  get_Column(dispidMember.l)
  Clear()
EndInterface

; ***************************************************************************************

;** InitScriptControl 

Procedure InitScriptControl()
  ;** g ScriptControl
  ;* Interfacevariable
  Global ScriptControl.IScriptControl
  
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ScriptControl, 0, 1, ?IID_IScriptControl, @ScriptControl) = #S_OK
    ScriptControl\Reset()
    ScriptControl\put_Language("VBScript")
  EndIf
  DataSection
  CLSID_ScriptControl:
  Data.l $0E59F1D5
  Data.w $1FBE,$11D0
  Data.b $8F,$F2,$00,$A0,$D1,$00,$38,$BC

  IID_IScriptControl:
  Data.l $0E59F1D3
  Data.w $1FBE,$11D0
  Data.b $8F,$F2,$00,$A0,$D1,$00,$38,$BC
  EndDataSection
EndProcedure


;** Delete ScriptControl 

Procedure DeleteScriptControl()
  ScriptControl\Release()
  CoUninitialize_()
EndProcedure

; ***************************************************************************************

;** SCtr_About
;* erzeugt eine AboutBox vom ScriptControl
Procedure SCtr_About()
  ScriptControl\_AboutBox()
EndProcedure

;** SCtr_AddObject
;* Object hinzufügen
Procedure SCtr_AddObject(name.s, *object)
  ProcedureReturn ScriptControl\AddObject(name, *object, 0)
EndProcedure

;** SCtr_AddCode
;* Code hinzufügen
Procedure SCtr_AddCode(Script.s)
  ProcedureReturn ScriptControl\AddCode(Script)
EndProcedure

;**SCtr_EvalVarType
;* Einen VariablenType lesen, ist LONG Variant Type
Procedure.l SCtr_EvalVarType(StringVar.s)
  Protected var.VARIANT
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    ProcedureReturn var\vt
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;** SCtr_EvalVariant
;* Einen Variablenwert lesen, ist Variant
Procedure.l SCtr_EvalVariant(StringVar.s, *Value.Variant)
  Protected var.VARIANT, result.l
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    VariantClear_(*Value)
    If VariantCopy_(*Value, var) = #S_OK
      result = #True
    Else
      result = #False
    EndIf
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

;** SCtr_EvalDate
;* Einen Variablenwert lesen, ist Unix Datum (Long)
Procedure.l SCtr_EvalDate(StringVar.s)
  Protected var.VARIANT, result.l
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    Select var\vt
      Case #VT_DATE
        result = (var\dblVal) * 86400 - 2209161600
      Default
        result = 0
    EndSelect
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;** SCtr_EvalDouble
;* Einen Variablenwert lesen, ist DOUBLE
Procedure.d SCtr_EvalDouble(StringVar.s)
  Protected var.VARIANT, result.d
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    Select var\vt
      Case #VT_BOOL
        result =  var\boolVal
      Case #VT_I1, #VT_UI1
        result = var\bVal
      Case #VT_I2, #VT_UI2
        result = var\iVal
      Case #VT_I4, #VT_UI4
        result = var\lVal
      Case #VT_I8, #VT_UI8
        result = var\llVal
      Case #VT_R4
        result = var\fltVal
      Case #VT_R8, #VT_DATE
        result = var\dblVal
      Case #VT_BSTR
        result = ValD(PeekS(var\bstrVal, #PB_Any, #PB_Unicode))
      Default
        result = 0.0
    EndSelect
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn 0.0
  EndIf
EndProcedure

;** SCtr_EvalFloat
;* Einen Variablenwert lesen, ist FLOAT
Procedure.f SCtr_EvalFloat(StringVar.s)
  Protected var.VARIANT, result.f
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    Select var\vt
      Case #VT_BOOL
        result =  var\boolVal
      Case #VT_I1, #VT_UI1
        result = var\bVal
      Case #VT_I2, #VT_UI2
        result = var\iVal
      Case #VT_I4, #VT_UI4
        result = var\lVal
      Case #VT_I8, #VT_UI8
        result = var\llVal
      Case #VT_R4
        result = var\fltVal
      Case #VT_R8, #VT_DATE
        result = var\dblVal
      Case #VT_BSTR
        result = ValF(PeekS(var\bstrVal, #PB_Any, #PB_Unicode))
      Default
        result = 0.0
    EndSelect
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn 0.0
  EndIf
EndProcedure

;** SCtr_EvalQuad
;* Einen Variablenwert lesen, ist Quad
Procedure.q SCtr_EvalQuad(StringVar.s)
  Protected var.VARIANT, result.q
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    Select var\vt
      Case #VT_BOOL
        result =  var\boolVal
      Case #VT_I1, #VT_UI1
        result = var\bVal
      Case #VT_I2, #VT_UI2
        result = var\iVal
      Case #VT_I4, #VT_UI4
        result = var\lVal
      Case #VT_I8, #VT_UI8
        result = var\llVal
      Case #VT_R4
        result = var\fltVal
      Case #VT_R8, #VT_DATE
        result = var\dblVal
      Case #VT_BSTR
        result = Val(PeekS(var\bstrVal, #PB_Any, #PB_Unicode))
      Default
        result = 0.0
    EndSelect
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;** SCtr_EvalLong
;* Einen Variablenwert lesen, ist LONG
Procedure.l SCtr_EvalLong(StringVar.s)
  Protected var.VARIANT, result.l
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    Select var\vt
      Case #VT_BOOL
        result =  var\boolVal
      Case #VT_I1, #VT_UI1
        result = var\bVal
      Case #VT_I2, #VT_UI2
        result = var\iVal
      Case #VT_I4, #VT_UI4
        result = var\lVal
      Case #VT_I8, #VT_UI8
        result = var\llVal
      Case #VT_R4
        result = var\fltVal
      Case #VT_R8, #VT_DATE
        result = var\dblVal
      Case #VT_BSTR
        result = Val(PeekS(var\bstrVal, #PB_Any, #PB_Unicode))
      Default
        result = 0.0
    EndSelect
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;** SCtr_EvalWord
;* Einen Variablenwert lesen, ist WORD
Procedure.w SCtr_EvalWord(StringVar.s)
  Protected var.VARIANT, result.w
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    Select var\vt
      Case #VT_BOOL
        result =  var\boolVal
      Case #VT_I1, #VT_UI1
        result = var\bVal
      Case #VT_I2, #VT_UI2
        result = var\iVal
      Case #VT_I4, #VT_UI4
        result = var\lVal
      Case #VT_I8, #VT_UI8
        result = var\llVal
      Case #VT_R4
        result = var\fltVal
      Case #VT_R8, #VT_DATE
        result = var\dblVal
      Case #VT_BSTR
        result = Val(PeekS(var\bstrVal, #PB_Any, #PB_Unicode))
      Default
        result = 0.0
    EndSelect
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;** SCtr_EvalByte
;* Einen Variablenwert lesen, ist BYTE
Procedure.b SCtr_EvalByte(StringVar.s)
  Protected var.VARIANT, result.b
  If ScriptControl\Eval(StringVar, @var) = #S_OK
    Select var\vt
      Case #VT_BOOL
        result =  var\boolVal
      Case #VT_I1, #VT_UI1
        result = var\bVal
      Case #VT_I2, #VT_UI2
        result = var\iVal
      Case #VT_I4, #VT_UI4
        result = var\lVal
      Case #VT_I8, #VT_UI8
        result = var\llVal
      Case #VT_R4
        result = var\fltVal
      Case #VT_R8, #VT_DATE
        result = var\dblVal
      Case #VT_BSTR
        result = Val(PeekS(var\bstrVal, #PB_Any, #PB_Unicode))
      Default
        result = 0.0
    EndSelect
    VariantClear_(var)
    ProcedureReturn result
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

;** SCtr_EvalStr
;* Einen Variablenwert lesen, ist String
Procedure.s SCtr_EvalStr(StringVar.s)
  Protected var.VARIANT, result.s
  If ScriptControl\Eval(StringVar, @var) = #S_OK
   Select var\vt
      Case #VT_BOOL
        If var\boolVal = #VARIANT_TRUE
          result = "TRUE"
        Else
          result = "FALSE"
        EndIf
      Case #VT_BSTR
        result = PeekS(var\bstrVal, #PB_Any, #PB_Unicode)
      Case #VT_I1, #VT_UI1
        result = Str(var\bVal)
      Case #VT_I2, #VT_UI2
        result = Str(var\iVal)
      Case #VT_I4, #VT_UI4
        result = Str(var\lVal)
      Case #VT_I8, #VT_UI8
        result = Str(var\llVal)
      Case #VT_R4
        result = StrF(var\fltVal)
      Case #VT_R8
        result = StrD(var\dblVal)
      Default
        result = ""
    EndSelect
    VariantClear_(var)
  Else
    result = ""
  EndIf
  ProcedureReturn result
EndProcedure

;** SCtr_Reset
;* Setzt das Control zurück
Procedure SCtr_Reset()
  ProcedureReturn ScriptControl\Reset()
EndProcedure

;** SCtr_Run
;* Funktion im Code aufrufen, der mit AddCode hinzugefügt wurde!
Procedure SCtr_Run(Script.s)
  ProcedureReturn ScriptControl\ExecuteStatement(Script)
EndProcedure

;** SCtr_SetLanguage
;* Die Sprache einstellen (zB "VBScript" oder "JScript", default ist "VBSCript"
Procedure SCtr_SetLanguage(Language.s)
  ProcedureReturn ScriptControl\put_Language(Language)
EndProcedure

;** SCtr_SetTimeOut
;* Timeoutwert setzen
Procedure SCtr_SetTimeOut(ms.l)
  ProcedureReturn ScriptControl\put_Timeout(ms)
EndProcedure

;** SCtr_GetTimeOut
;* Ermitteln welchen Wert TimeOut hat (Default 10000)
Procedure SCtr_GetTimeOut()
  Protected timeout.l
  ScriptControl\get_Timeout(@timeout)
  ProcedureReturn timeout
EndProcedure

;** SCtr_GetError
;* Ermitteln den Fehler (Line + Description)
Procedure.s SCtr_GetError()
  Protected ScriptError.IScriptError
  Protected Line, Description, DescriptionText.s, Result.s
  If ScriptControl\get_Error(@ScriptError) = #S_OK
    ScriptError\get_Line(@Line)
    If ScriptError\get_Description(@Description) = #S_OK
      If Description
        DescriptionText = PeekS(Description)
      Else
        DescriptionText = "No Error"
      EndIf
    EndIf
    ScriptError\Clear()
    ScriptError\Release()
  Else
    Result = "Fehler: SCtr_GetError"
  EndIf
  Result = "Line " + Str(Line) + ": " + DescriptionText
  ProcedureReturn Result
EndProcedure
Läuft leider zur Zeit nur unter Windows X86

FF :wink:

Re: ScriptControl v1.10 (Neu AddObject für eigene ClassObjec

Verfasst: 18.07.2010 10:58
von Josh
ein problem sehe ich bei echten 64bit anwendungen, da es nur eine 32bit version des script controls gibt. spätestens wenn man dann das in eine dll einbauen will, ist schluss mit lustig. das scriptcontrol ist ja auch ein sogenannter dumb host und kann verdammt viel nicht, was die ganze scriptgeschichte eigentlich bietet.

ein ansatz für einenen eigenen scripthost ist hier zu finden (projekt ruht momentan). mit dieser activescript geschichte lassen sich ein paar verdammt nette sachen machen. so wird z.b. quasi als nebenprodukt ein formatierungsstring geliefert, der in scintilla direkt für das highlightning verwendet werden kann.

Re: ScriptControl v1.10 (Neu AddObject für eigene ClassObjec

Verfasst: 18.07.2010 12:57
von mk-soft
So Tod ist vb-script gar nicht. Wird noch viel in der Industrie verwendet.
Habe mir Dein ActiveScript mal angeschaut und geht auch unter X64. Es ist aber viel komplizierter
eigenen Code einzubinden. Bis jetzt habe ich nicht raus gefunden wie man über AddNamedItem
diese realisieren kann.

VG :wink:

Re: ScriptControl v1.10 (Neu AddObject für eigene ClassObjec

Verfasst: 18.07.2010 14:00
von Josh
hab jetzt schon seit ein paar monaten nichts an dem projekt gemacht und steht momentan als baustelle. müsste mich erst wieder mal 1-2 tage reinarbeiten. AddNamedItem sollte mit den beiden flags

#SCRIPTITEM_ISVISIBLE = 2
#SCRIPTITEM_CODEONLY = 512

funktionieren

Re: ScriptControl v1.10 (Neu AddObject für eigene ClassObjec

Verfasst: 18.07.2010 15:52
von mk-soft
Habe mal ScriptControl mit SCtr_GetError() erweitert und das Beispiel Smarttags mit Paramterüberwachung ausgestattet.
Liefert somit auch Fehlermeldungen zurück.

FF :wink:
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de