PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Module ActiveScript for VBScript and JScript with PB-Runtime Variables

https://www.purebasic.fr/english/viewtopic.php?t=71399

Page 3 of 4

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Thu Jan 02, 2020 7:08 pm
by mk-soft
Module ActiveScript Update v2.07
- Bugfix ActiveScriptSite cntRef
- Bugfix ActiveScriptSiteWindow -> QuerInterface
- Bugfix ActiveScriptSiteInteruptPull -> QuerInterface
- Cleanup Code

Module SmartTags Update v2.04
- Change ClearSmartTags(...) - Tag name optional for clear all SmartTags

:wink:

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Fri Jan 03, 2020 2:00 pm
by mk-soft
Update v2.08
- Bugfix ActiveScriptSite -> OnScriptError

The passed object 'ScriptError' must not be released within the object.

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Fri Jul 24, 2020 11:51 am
by mk-soft
Module ActiveScript Update v2.09
- Change Debug Levels
- Added DebugLevelRuntimeTrace (1)

Set the debug level to #DebugLevelRuntimeTrace to get only the output of VBS Runtime.Trace <Value>.

VariantHelper Update v2.04
- Remove Debug Output

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Fri Jul 24, 2020 1:02 pm
by mk-soft
Small example with Sub and Functions ... :wink:

Code: Select all

;-TOP

; Comment   : Modul ActiveScript Example 12
; Version   : v2.09

; Link to ActiveScript  : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399
; Link to SmartTags     : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399#p527089
; Link to VariantHelper : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399#p527090

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

XIncludeFile "Modul_ActiveScript.pb"
XIncludeFile "Modul_SmartTags.pb"
XIncludeFile "VariantHelper.pb"

UseModule ActiveScript
UseModule ActiveSmartTags

; -------------------------------------------------------------------------------------

Procedure.s GetDataSectionText(*Addr.Character)
  Protected result.s, temp.s
  While *Addr\c <> #ETX
    temp = PeekS(*Addr)
    *Addr + StringByteLength(temp) + SizeOf(Character)
    result + temp + #LF$
  Wend
  ProcedureReturn result
EndProcedure

; -------------------------------------------------------------------------------------

Global vbs.s, sValue1.s, sValue2.s

Runtime sValue1, sValue2

; -------------------------------------------------------------------------------------

vbs = GetDataSectionText(?vbs)

Debug "*** New ActiveScript ***"
*Control = NewActiveScript()
If *Control
  Debug "*** Add Object SmartTags ***"
  AddNamedObject(*Control, "SmartTags", NewSmartTags())
  Debug "*** Parse ScriptText Sub and Functions***"
  r1 = ParseScriptText(*Control, vbs)
  If r1 = #S_OK
    Debug "Code Ready 1."
  EndIf
  
  sValue1 = "Hello World!"
  r1 = ParseScriptText(*Control, ~"SetValue(Runtime.String(\"sValue1\"))")
  If r1 = #S_OK
    Debug "Code Ready 2."
  EndIf
  
  r1 = ParseScriptText(*Control, ~"Runtime.String(\"sValue2\") = GetValue()")
  If r1 = #S_OK
    Debug "Code Ready 3."
  EndIf
  Debug "Result = " + sValue2
  
  Debug "*** Free ActiveScript ***"
  FreeActiveScript(*Control)
  Debug "*** Finished ActiceScript ***"

  Debug "************************************************************"
EndIf
; -------------------------------------------------------------------------------------

DataSection
  vbs:
  Data.s ~"On Error Resume Next"
  Data.s ~""
  Data.s ~"Public TextValue"
  Data.s ~""
  Data.s ~"Sub SetValue(Value)"
  Data.s ~" TextValue = Value"
  Data.s ~" Runtime.Trace \"Sub SetValue \" & Value"
  Data.s ~"End Sub"
  Data.s ~""
  Data.s ~"Function GetValue()"
  Data.s ~" GetValue = Ucase(TextValue)"
  Data.s ~"End Function"
  Data.s ~""
  Data.s ~""
  Data.s ~""
  Data.s #ETX$
  Data.i 0
EndDataSection

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Mon Jul 27, 2020 4:06 pm
by mk-soft
Update VariantHelper v2.05
- Added: Simple PB Arrays from and to Variant (SmartTags)

Update VariantHelper v2.05.1
- Optimize

Example

Code: Select all

;-TOP

; Comment   : Modul ActiveScript Example 15
; Version   : v2.09

; Link to ActiveScript  : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399
; Link to SmartTags     : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399#p527089
; Link to VariantHelper : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399#p527090

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

XIncludeFile "Modul_ActiveScript.pb"
XIncludeFile "Modul_SmartTags.pb"
XIncludeFile "VariantHelper.pb"

UseModule ActiveScript
UseModule ActiveSmartTags

; -------------------------------------------------------------------------------------

Procedure.s GetDataSectionText(*Addr.Character)
  Protected result.s, temp.s
  While *Addr\c <> #ETX
    temp = PeekS(*Addr)
    *Addr + StringByteLength(temp) + SizeOf(Character)
    result + temp + #LF$
  Wend
  ProcedureReturn result
EndProcedure

; -------------------------------------------------------------------------------------

Global script.s

Dim TextList.s(3)
TextList(0) = "****"
TextList(1) = "Hello World"
TextList(2) = "I like Purebasic"
TextList(3) = "****"

Dim Values.d(2)
Values(0) = 100.0
Values(1) = 200.0
Values(2) = 50.5

Dim Result.i(0)

*Control = NewActiveScript()
If *Control
  ; AddOn SmartTags hinzufügen
  AddNamedObject(*Control, "SmartTags", NewSmartTags())
  
  Debug "*** Parse ScriptText ***"
  
  script = GetDataSectionText(?vbs)
  
  StringArrayToVariant(TextList(), SmartTags("TextList"))
  DoubleArrayToVariant(Values(), SmartTags("Values"))
  
  r1 = ParseScriptText(*Control, script)
  If r1 = #S_OK
    Debug "Code Ready."
  EndIf
  
  Debug "* List *"
  If IsVariantVarArray(SmartTags("List"))
    If VariantToStringArray(SmartTags("List"), TextList())
      For i = 0 To ArraySize(TextList())
        Debug TextList(i)
      Next
    EndIf
  EndIf
  
  Debug "* Result *"
  If IsVariantVarArray(SmartTags("Result"))
    If VariantToIntegerArray(SmartTags("Result"), Result())
      For i = 0 To ArraySize(Result())
        Debug Result(i)
      Next
    EndIf
  EndIf
  
  
  Debug "*** Free ActiveScript ***"
  FreeActiveScript(*Control)
  
  Debug "************************************************************"
EndIf

; -------------------------------------------------------------------------------------

DataSection
  vbs:
  Data.s ~"'On Error Resume Next"
  Data.s ~""
  Data.s ~"Dim r1, textlist, text, sum, values, value"
  Data.s ~""
  Data.s ~"textlist = SmartTags(\"TextList\")"
  Data.s ~"values = SmartTags(\"Values\")"
  Data.s ~""
  Data.s ~"If IsArray(textlist) Then"
  Data.s ~"  For Each text in textlist"
  Data.s ~"    r1 = r1 + text + vbNewLine"
  Data.s ~"  Next"
  Data.s ~"Else"
  Data.s ~"  msgbox \"No Array\""
  Data.s ~"End If"
  Data.s ~"If IsArray(values) Then"
  Data.s ~"  For Each value in values"
  Data.s ~"    sum = sum + value"
  Data.s ~"  Next"
  Data.s ~"Else"
  Data.s ~"  msgbox \"No Array\""
  Data.s ~"End If"
  Data.s ~"msgbox r1 & vbNewline & sum"
  Data.s ~""
  Data.s ~"Dim i, list(10), result(10)"
  Data.s ~""
  Data.s ~"For i = 0 to 10"
  Data.s ~" list(i) = \"Counter \" & i"
  Data.s ~" result(i) = 100 + i"
  Data.s ~"Next"
  Data.s ~""
  Data.s ~"' Update SmartTags"
  Data.s ~"SmartTags(\"List\") = list"
  Data.s ~"SmartTags(\"Result\") = result"
  Data.s ~""
  Data.s #ETX$
  Data.i 0
EndDataSection

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Tue Jul 28, 2020 2:59 pm
by Kwai chang caine
Thanks for all this great job :shock: 8)
Two last examples works fine here, thanks for sharing 8)

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Tue Sep 22, 2020 2:03 pm
by Derren
Hi mk-soft,

is there any way I can use the 32bit version of the scripting host?

I'm trying the following VBS code, that I found online, to access a Microsoft Access accdb file.

Code: Select all

Set conn = CreateObject("ADODB.Connection")
' Connect to the database
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\Users\User\Desktop\Database1.accdb"
conn.Open strConnect
MsgBox conn
StrSQL = "Select * from Tabelle1"
Set rs = conn.Execute(StrSQL)
Do While Not rs.EOF
    MsgBox "Spalte1:" & rs.Fields("Spalte1") & " Spalte2:"& rs.Fields("Spalte2")
    rs.MoveNext
Loop
Here's the PB-Code using your include:

Code: Select all

IncludeFile "ActiveScript.pbi"

vbs.s = "" + 
~"Set conn = CreateObject(\"ADODB.Connection\")"+#CRLF$+
~"' Connect to the database"+#CRLF$+
~"strConnect = \"Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\\Users\\User\\Desktop\\Database1.accdb\""+#CRLF$+
~"conn.Open strConnect"+#CRLF$+
~"MsgBox conn"+#CRLF$+

~"StrSQL = \"Select * from Tabelle1\""+#CRLF$+
~"Set rs = conn.Execute(StrSQL)"+#CRLF$+
~"Do While Not rs.EOF"+#CRLF$+
~"    MsgBox \"Spalte1:\" & rs.Fields(\"Spalte1\") & \" Spalte2:\"& rs.Fields(\"Spalte2\")"+#CRLF$+
~"    rs.MoveNext"+#CRLF$+
~"Loop"


*Control = ActiveScript::NewActiveScript()
If *Control
  ActiveScript::ParseScriptText(*Control, vbs)
  ActiveScript::FreeActiveScript(*Control)
EndIf

Okay, so this VBS-code does not actually work on my machine (says the Provider can not be found) and here is why: https://social.technet.microsoft.com/Fo ... forum=ITCG

The comments there said to use a 32bit scripting host
From a 32 bit prompt:

cscript yourfile.vbs

From a 64 bit prompt:

c:\windows\SysWow64\cscript yourfile.vbs
And NOW, it does indeed work, using the line with the SysWow64 directory.

Is there any way I can do this with your Active Script?

I tried messing about with this part here, exchanging the x86 for the x64 data. But then it did nothing at all.

Code: Select all

    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      IID_IActiveScriptParse:  ; {BB1A2AE2-A4F9-11CF-8F20-00805F2CD064} 32 bit
      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
   
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      IID_IActiveScriptSiteDebug: ; {51973C11-CB0C-11D0-B5C9-00A0244A0E7A} 32 bit
      Data.l $51973C11
      Data.w $CB0C, $11D0
      Data.b $B5, $C9, $00, $A0, $24, $4A, $0E, $7A
    CompilerEndIf
   
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
      IID_IActiveScriptSiteDebug: ; {D6B96B0A-7463-402C-92AC-89984226942F} 64 bit
      Data.l $D6B96B0A
      Data.w $7463, $402C
      Data.b $92, $AC, $89, $98, $42, $26, $94, $2F
    CompilerEndIf
Any help would be greatly appreciated. I'm trying for days to get data from an Access-file and nothing seems to work.
Thanks :)

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Tue Sep 22, 2020 2:52 pm
by mk-soft
Here there is the same problem as with DLL's. X64 program uses X64 DLL's and X64 COM objects. Similar to X86 programs X86 DLL's and X86 COM objects.
So the problem is that your X64 program also uses the X64 COM objects for ADODB and therefore also the database drivers for X64.


There are two possibilities.
1.
Compile the program with X86 (What you don't want to do)

2.
Install the database drivers for X64.

Download AccessDatabaseEngine Link: https://www.microsoft.com/en-us/downloa ... x?id=54920

I hope this helps you :!:

Re: Module ActiveScript for VB-Script with PB-Runtime Variab

Posted: Tue Sep 22, 2020 3:13 pm
by Derren
Thanks. Found the solution of installing drivers on another thread and also in many threads in other forums, but that's no an option on the machines I want to run this software, unfortunately.

Re: Module ActiveScript for VB-Script with PB-Runtime Variables

Posted: Fri Nov 19, 2021 9:23 am
by infratec
Hi Michael,

I run into an IMA at FreeStructureVariant() when I use your VariantHelper.pbi version v2.05.1

Code: Select all

  Protected FieldList.i, *VariantArray.variant, *SA.SAFEARRAY

  ...
 
  While Not oMicrotech\GetIntegerProperty("Eof()")
      
      *VariantArray = oMicrotech\GetVariantProperty("ReadFieldListValues(" + Str(FieldList) + ")")
      *SA = *VariantArray\bstrVal
      
      AdrNr$ = GetVariantString(*SA\pvData\Value[0])
      
      If Not FindMapElement(*Ini\AddressMap(), AdrNr$)
        AddMapElement(*Ini\AddressMap(), AdrNr$)
        *Ini\AddressMap()\Name$ = AdrNr$ + " " + GetVariantString(*SA\pvData\Value[1])
        ;Debug *Ini\AddressMap()\Name$
      EndIf
      
      FreeStructureVariant(*VariantArray)
      
      oMicrotech\Invoke("Next()")
    Wend
If I comment FreeStructureVariant(*VariantArray) the program works without problems.

If I debug into FreeStructureVariant() and if I go with the cursor over *Value I can see the structure.
The IMA happens at FreeStructure(*Value).

Any idea?

Btw. I use COMatePlus to do the Microtech stuff.

Re: Module ActiveScript for VB-Script with PB-Runtime Variables

Posted: Fri Nov 19, 2021 12:39 pm
by mk-soft
The function "FreeStructureVariant" is only available for the function "FreeStructureVariant" when using #PB_Any

So a "VariantClear_(*Value)" is sufficient. Even if the Variant is a pointer to a SafeArray

MSDN: https://docs.microsoft.com/en-us/window ... riantclear

Re: Module ActiveScript for VB-Script with PB-Runtime Variables

Posted: Fri Nov 19, 2021 12:43 pm
by infratec
Thanks for the clarification.

Re: Module ActiveScript for VB-Script with PB-Runtime Variables

Posted: Sat Apr 13, 2024 11:32 pm
by mk-soft
Update v2.10
- Bugfix release objects

Found another bug and optimised the release of the objects :wink:

Re: Module ActiveScript for VBScript and JScript with PB-Runtime Variables

Posted: Sun Apr 14, 2024 12:27 pm
by mk-soft
AddOn SmartTags Update v2.06
- Added SmartTags as object method
- Set and get SmartTags explizite as text

* Modul SmartTags

The SmartTags can now be used as object methods.
As you often forget to release the object again (Set Obj = Nothing), these are automatically released at the end.
In addition, SmartTags can now be explicitly read or written as text (type conversion).

Example 18

Code: Select all

;-TOP

; Comment   : Modul ActiveScript Example 18
; Version   : v2.05.1

; Link to ActiveScript  : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399
; Link to SmartTags     : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399#p527089
; Link to VariantHelper : https://www.purebasic.fr/english/viewtopic.php?f=12&t=71399#p527090

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

XIncludeFile "Modul_ActiveScript.pb"
XIncludeFile "Modul_SmartTags.pb"
XIncludeFile "VariantHelper.pb"

UseModule ActiveScript
UseModule ActiveSmartTags

; -------------------------------------------------------------------------------------

; EnableExplicit

Global vbs.s, time.s , value.d

vbs = ~"dim var1, var2, var3, datum" + #LF$
vbs + ~"Set var1 = SmartTags('datum')" + #LF$
vbs + ~"Set var2 = SmartTags('value')" + #LF$
vbs + ~"Set var3 = SmartTags('time')" + #LF$
vbs + ~"var1.value = var1.value + 1.0" + #LF$
vbs + ~"datum = var1.text" + #LF$
vbs + ~"msgbox datum & vbNewLine & var2.value" + #LF$
vbs + ~"Set var1 = Nothing" + #LF$
vbs + ~"Set var2 = Nothing" + #LF$
vbs + ~"var3.text = time()" + #LF$
;vbs + ~"smarttags.text(\"time\") = time()" + #LF$
;vbs + ~"Set var3 = Nothing" + #LF$

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

SetVariantDate(SmartTags("datum"), Date())
SetVariantDouble(SmartTags("value"), 100.0)

Debug "************************************************************"
*Control = NewActiveScript()
If *Control
  AddNamedObject(*Control, "SmartTags", NewSmartTags())
  Debug "************************************************************"
  Debug vbs
  Debug "************************************************************"
  ParseScriptText(*Control, vbs)
  FreeActiveScript(*Control)
  Debug "************************************************************"
  Debug "Date = " + GetVariantString(SmartTags("datum"))
  ;time = GetVariantString(SmartTags("time"))
  If SmartTags("time")\vt = #VT_BSTR
    time = PeekS(SmartTags("time")\bstrVal)
  EndIf
  Debug "Time = " + time
  Debug "Value = " + GetVariantDouble(SmartTags("value"))
EndIf

Re: Module ActiveScript for VBScript and JScript with PB-Runtime Variables

Posted: Tue Apr 16, 2024 7:46 pm
by mk-soft
Update v2.11
- New and FreeActiveScript revised to release all resources.

ActiveScript.Close() is now used with FreeActiveScript. This automatically releases the objects created in the VBScript.
This should eliminate memory leaks.
All times are UTC+01:00
Page 3 of 4

Powered by phpBB® Forum Software © phpBB Limited