Page 2 of 2
Posted: Mon Oct 16, 2006 1:29 pm
by bingo
for testing and learning in pb4 ...
Code: Select all
Procedure.l Ansi2Uni(ansi.s)
SHStrDup_(@ansi,@memziel)
ProcedureReturn memziel
EndProcedure
Procedure.s Uni2Ansi(*Unicode.l)
size.l = WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, #Null, #Null, #Null, #Null)
ansi.s=Space(size)
WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, @ansi, size, #Null, #Null)
ProcedureReturn ansi
EndProcedure
x.VARIANT
x\vt = #VT_BSTR
Interface IScriptProcedure Extends IDispatch
get_Name(a)
get_NumArgs(a)
get_HasReturnValue(a)
EndInterface
Interface IScriptProcedureCollection Extends IDispatch
get__NewEnum(a)
get_Item(a,b,c,d,e)
get_Count(a)
EndInterface
Interface IScriptModule Extends IDispatch
get_Name(a)
get_CodeObject(a)
get_Procedures(a)
AddCode(a)
Eval(a,b)
ExecuteStatement(a)
Run(a,b,c)
EndInterface
Interface IScriptModuleCollection Extends IDispatch
get__NewEnum(a)
get_Item(a,b,c,d,e)
get_Count(a)
Add(a,b,c)
EndInterface
Interface IScriptError Extends IDispatch
get_Number(a)
get_Source(a)
get_Description(a)
get_HelpFile(a)
get_HelpContext(a)
get_Text(a)
get_Line(a)
get_Column(a)
Clear()
EndInterface
Interface IScriptControl Extends IDispatch
get_Language(a)
put_Language(a)
get_State(a)
put_State(a)
put_SitehWnd(a)
get_SitehWnd(a)
get_Timeout(a)
put_Timeout(a)
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(a,b,c)
Reset()
AddCode(a)
Eval(a,b)
ExecuteStatement(a)
Run(a,b,c)
EndInterface
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ScriptControl,0,1,?IID_IScriptControl,@Object.IScriptControl) = 0
object\reset()
object\put_Language(Ansi2Uni("vbscript"))
object\AddCode(Ansi2Uni(PeekS(?sample_vbs)))
object\Eval(Ansi2Uni("sample"),@x)
Debug uni2ansi(x\bstrVal)
object\reset()
object\release()
Else
MessageRequester("error", "msscriptcontrol error [msscript.ocx] !", #MB_ICONHAND)
End
EndIf
CoUninitialize_()
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
;sample vbs
DataSection
sample_vbs:
Data.s "a=1:b=2:sample=cstr(a+b):msgbox(sample)"
Data.b 0
EndDataSection
Posted: Mon Oct 16, 2006 5:22 pm
by Shannara
Bingo: Ah, I need to check that out tonight.
(rest):
Someone on the forums said that using VTables can emulate classes that can be placed in AddObject. Problem is, the compiled userlib in the linked thread works (except for missing addobject), and since the "global" script variable is inside a procedure, it is not global outside of the userlib. So you cant access the addobject from there.
However, the source provided breaks everytime you run coInit.... Thus I am assuming it has the wrong ID code in it. And every tool I found on these forums (so far) doesnt provide the correct id, or whatnot.
Posted: Fri Jan 05, 2007 3:46 am
by X
I believe the code below may hold the answer.
Code: Select all
Interface IPBFriendly
SayHello()
SayGoodbye()
TellMyName(Name.s)
EndInterface
Structure VTPBFriendlyFunctions
SayHello.l
SayGoodbye.l
TellMyName.l
EndStructure
Structure PBFriendly
*VirtualTable.VTPBFriendlyFunctions
Name.s
EndStructure
Procedure SayHello(*Self.PBFriendly)
If *Self\Name > ""
MessageRequester("Friendly", "Hello " + *Self\Name + ".")
Else
MessageRequester("Friendly", "Hello. I'm afraid we haven't been introduced")
EndIf
EndProcedure
Procedure SayGoodbye(*Self.PBFriendly)
If *Self\Name > ""
MessageRequester("Friendly", "Goodbye " + *Self\Name + ".")
Else
MessageRequester("Friendly", "Goodbye. It's a shame we didn't get to know each other better")
EndIf
EndProcedure
Procedure TellMyName(*Self.PBFriendly, Name.s)
*Self\Name = Name
MessageRequester("Friendly", "Pleased to meet you, " + Name + ", I'm Purebasic.")
EndProcedure
Global VTPBFriendly.VTPBFriendlyFunctions
VTPBFriendly\SayHello = @SayHello()
VTPBFriendly\SayGoodbye = @SayGoodbye()
VTPBFriendly\TellMyName = @TellMyName()
Global NewList Instances.PBFriendly()
Procedure.l CreateFriendly()
; Create a new PBFriendly within the Instances list.
AddElement(Instances())
; Assign the Virtual table
Instances()\VirtualTable = VTPBFriendly
; Initialise the fields
Instances()\Name = ""
; Return a pointer (hence the @) to the new structure
ProcedureReturn @Instances()
EndProcedure
Procedure.l Ansi2Uni(ansi.s)
SHStrDup_(@ansi,@memziel)
ProcedureReturn memziel
EndProcedure
Procedure.s Uni2Ansi(*Unicode.l)
Size.l = WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, #Null, #Null, #Null, #Null)
ansi.s=Space(Size)
WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, @ansi, Size, #Null, #Null)
ProcedureReturn ansi
EndProcedure
x.VARIANT
x\vt = #VT_BSTR
Interface IScriptProcedure Extends IDispatch
get_Name(a)
get_NumArgs(a)
get_HasReturnValue(a)
EndInterface
Interface IScriptProcedureCollection Extends IDispatch
get__NewEnum(a)
get_Item(a,b,c,d,e)
get_Count(a)
EndInterface
Interface IScriptModule Extends IDispatch
get_Name(a)
get_CodeObject(a)
get_Procedures(a)
AddCode(a)
Eval(a,b)
ExecuteStatement(a)
Run(a,b,c)
EndInterface
Interface IScriptModuleCollection Extends IDispatch
get__NewEnum(a)
get_Item(a,b,c,d,e)
get_Count(a)
Add(a,b,c)
EndInterface
Interface IScriptError Extends IDispatch
get_Number(a)
get_Source(a)
get_Description(a)
get_HelpFile(a)
get_HelpContext(a)
get_Text(a)
get_Line(a)
get_Column(a)
Clear()
EndInterface
Interface IScriptControl Extends IDispatch
get_Language(a)
put_Language(a)
get_State(a)
put_State(a)
put_SitehWnd(a)
get_SitehWnd(a)
get_Timeout(a)
put_Timeout(a)
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(a,b,c)
Reset()
AddCode(a)
Eval(a,b)
ExecuteStatement(a)
Run(a,b,c)
EndInterface
Procedure myBox()
MessageRequester("This Works", "This Works!", #PB_MessageRequester_Ok)
EndProcedure
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ScriptControl,0,1,?IID_IScriptControl,@Object.IScriptControl) = 0
Object\Reset()
Object\put_Language(Ansi2Uni("vbscript"))
Simon.IPBFriendly = CreateFriendly()
;Simon\SayHello()
Object\AddObject(Ansi2Uni("myBox"), @Simon.IPBFriendly, 0)
Object\AddCode(Ansi2Uni(PeekS(?sample_vbs)))
Object\Eval(Ansi2Uni("sample"),@x)
Debug Uni2Ansi(x\bstrVal)
Object\Reset()
Object\release()
Else
MessageRequester("error", "msscriptcontrol error [msscript.ocx] !", #MB_ICONHAND)
End
EndIf
CoUninitialize_()
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
;sample vbs
DataSection
sample_vbs:
Data.s "a=1:b=2:sample=cstr(a+b):msgbox(sample)"
Data.b 0
EndDataSection
Posted: Fri Jan 05, 2007 9:10 am
by Rings
@X: i got an memory exception error at:
Object\AddObject(Ansi2Uni("myBox"), @Simon.IPBFriendly, 0)
any hints ?
using w2k with PB4.0x
Posted: Fri Jan 05, 2007 6:22 pm
by X
May try replace
with
Posted: Fri Jan 05, 2007 6:31 pm
by netmaestro
That helps, but now I get an IMA on line 37.
BTW, Bingo's code works fine here.
Posted: Fri Jan 05, 2007 6:44 pm
by X
I think the problem was AddObject member? Here I try to help on that. Problem with my code above, if "class" have more then 1 function, all are called when pass class to AddObject. I do not know how to fix.
Posted: Fri Jan 05, 2007 9:41 pm
by ricardo
X wrote:I believe the code below may hold the answer.
This looks great but i cant compile it (PB 4)
Im very interested on some way to make this work.