:Start of VDSActiveX vdsactivex.dsc
DragonSphere Software Demos

If you are viewing this script in your browser you can save it as a VDS 5.x source file (*.dsc) to run it.
#
# DragonSphere Software's Home Page
#  
# All Source Files for this demo
#
# This demo is just me having a little fun with various ActiveX controls.
#
Title VDS ActiveX
If @Greater(@Name(@SYSINFO(DSVER)),4)

External GadgetX.dll,@SYSINFO(DSVER)

  # Commands for use with GadgetX.dll
  #DEFINE COMMAND,GADGETX,DEFINE,SETVAR,OLE
  # Functions for use with GadgetX.dll  
  #DEFINE FUNCTION,GADGETX,GETVAR,OLE,SIZEOF
Else
  Warn This demo was designed to work with VDS 5.x@CR()http://www.dialogscript.com
  Stop
End


Define Variable,Object,ScriptElem
Define Variable,Object,wdApp
Define Variable,Object,wdDoc
Define Variable,Object,agent
Define Variable,Object,character
Define Variable,Object,RegEx
Define Variable,Object,ieApp
Define Variable,Object,SHDocVw
Define Variable,Object,MyVariant
Define GUID,DWebBrowserEvents2,{34A715A0-6587-11D0-924A-0020AFC7AC4D}

Define Constant,OLE_TRUE,-1
Define Constant,OLE_FALSE,0
Ole Init
#Ole Exceptions,SHOW
SetVar ieApp,@Ole(Create,Shell.Explorer.2,Null)
%%winclass = "#VDSActiveX"
DIALOG CREATE,VDS ActiveX,-1,0,500,350,CLASS VDSActiveX
REM *** Modified by Dialog Designer on 3/4/2005 - 23:34 ***

  DIALOG ADD,TEXT,TEXT1,1,1,,,
  DIALOG ADD,BUTTON,BUTTON1,1,420,64,24,Design On

  %%HTML_PAGE = @chr(60)BODY@chr(62)Please enter your password: @chr(60)INPUT TYPE=password ID='PasswordBox' Name='PasswordBox' size='20'@chr(62)@chr(60)P@chr(62)@chr(60)INPUT ID='OKButton' NAME='OKButton' TYPE='BUTTON' VALUE='OK' onclick='OKClicked.value=1'@chr(62)@chr(60)P@chr(62)@chr(60)input type='hidden' id='OKClicked' name='OKClicked' value='0' size='10'@chr(62)@chr(60)/BODY@chr(62)
  rem InternetExplorer.Application
  
  DIALOG ADD,BUTTON,BUTTON2,3,319,64,24,Design Off  
  Ole Attach,ieApp,%%winclass,40,40,@dlgpos(,W),@diff(@dlgpos(,H),19)
  DIALOG ADD,STATUS,STATUS1
DIALOG SHOW

rem HOTKEY ADD,TABKEY,TAB
rem Gadget MyObj,NULL

Ole Call,ieApp,"Navigate(^B)","about:blank"

rem Ole Set,ieApp,"Toolbar = ^b",OLE_TRUE
rem Ole Set,ieApp,"MenuBar = ^b",OLE_TRUE
rem Ole Set,ieApp,"Application.StatusBar = ^b",OLE_TRUE
rem Ole Set,ieApp,"Width = ^d",@dlgpos(,W)
rem Ole Set,ieApp,"Height = ^d",@dlgpos(,H)
rem Ole Set,ieApp,"Left = ^d",40
rem Ole Set,ieApp,"Top = ^d",40
rem Ole Set,ieApp,"Visible = ^b",OLE_TRUE
Ole Call,ieApp,"document.write(^B)",%%HTML_PAGE
rem Info %%Test@CR()


%%Body = @Ole(Get,ieApp,^B,"document.body.outerHTML")
Info Here is the body text we just wrote to the browser@CR()@CR()%%Body@CR()
Ole Call,ieApp,"document.close"


Define EventMap,DWebBrowserEvents2,StatusTextChange,102
Define EventMap,DWebBrowserEvents2,ProgressChange,108
Define EventMap,DWebBrowserEvents2,CommandStateChange,105
Define EventMap,DWebBrowserEvents2,OnQuit,253
%%cookie = @Ole(ConnectEvents,ieApp,DWebBrowserEvents2)
%%OKClicked = 0
%%DontQT = 0
:evloop
# %E =
wait event
%E = @event()
If %E
  goto %E
End
GOTO evloop
:BUTTON1BUTTON
  Ole SetProperty,ieApp,"document.designMode = ^B",On
GOTO evloop
:BUTTON2BUTTON
  Ole SetProperty,ieApp,"document.designMode = ^B",Off
GOTO evloop
:DWebBrowserEvents2ProgressChange
  Dialog Set,TEXT1,We are progressing@Cr()@Trim(@Ole(EventParamsList,DWebBrowserEvents2ProgressChange))
goto evloop
:DWebBrowserEvents2CommandStateChange
  %%OldSep = @fsep()
  Option FieldSep,@chr(44)
  PARSE "%%Command;%%Enable",@Ole(EventParamsList,DWebBrowserEvents2CommandStateChange)
  Dialog Set,TEXT1,Did you click IE?@Cr()@Trim("CommandStateChange("%%Command","%%Enable")")
  Option FieldSep,%%OldSep
  %%OKClicked = @Ole(Get,ieApp,^d,"document.all.OKClicked.value")
  If @Not(@Zero(%%OKClicked))
    rem Ole Exceptions,OFF
    %%Password = @Ole(Get,ieApp,^B,"document.all.PasswordBox.value")
    If %%Password
      Info Your password is %%Password
      Ole Set,ieApp,"document.all.PasswordBox.value(^B)",""
    End
    %%OKClicked = 0
    Ole Set,ieApp,"document.all.OKClicked.value(^B)",0
  End
GOTO EVLOOP
:GADGETOBJ
  %%MSG = @GetVar(GetMsg)
  Info %%MSG@CR()
GOTO EVLOOP
:DWebBrowserEvents2StatusTextChange
:SETSTATUS
  rem %%mystatustext = @Substr(%E,@succ(%%Pipe),@pred(@Pos(")",%E)))

  %%mystatustext = @Trim(@Ole(EventParamsList,DWebBrowserEvents2StatusTextChange))
  Dialog Set,STATUS1,%%mystatustext
  Dialog Set,TEXT1,%%mystatustext
  rem Ole Return,0
goto evloop

:WM_KEYFIRST
  Info This is a test WM_KEYFIRST
goto evloop
:WM_KEYLAST
  Info This is a test WM_KEYLAST
goto evloop
:WM_SYSCOMMAND
  Info this is a test WM_SYSCOMMAND
:CLOSE  
:DWebBrowserEvents2OnQuit
  %%Params = @Ole(EventParamsList,DWebBrowserEvents2OnQuit)
  Dialog Set,TEXT1,Leaving So soon@CR()"OnQuit("%%Params")"
  Ole Remove,ieApp,VDS ActiveX
  Ole DisConnectEvents,ieApp,DWebBrowserEvents2,%%cookie
  Ole Call,ieApp,"Quit"
  Ole Free,Object,ieApp
rem Dim RegEx As New VBScript.RegExp 
# Use the VBScript Regular Expression control to validate a email address
SetVar RegEx,@Ole(Create,VBScript.RegExp,NULL)
Ole Set,RegEx,pattern = ^B,"^\w+(\.\w+)*@\w+\.\w+(\.\w+)*$"
Rem Lets break down the above pattern for the fictious email address of Dragon.Sphere@vdsworld.uk.com
Rem The first character ^ tells VBScript to start looking for a pattern.
Rem The next part (\w+) tells VBScript to match any word or character
Rem The next part |(\.\w+)* if VBScript finds a email address like Dragon.Sphere or Dragon.Sphere.Net that is valid too.
Rem The next part @ tells VBScript to look for the @ character in the email address
Rem The next part \w+ determines if you put a word or character after the @ sign.
Rem Then we have our first \. which looks for the period character in the email address
Rem Then basicly repeat the pattern over again with \w+(\.\w+)*
Rem Finally end the pattern with the $
# Ignore the case of the email address
Ole Set,RegEx,IgnoreCase = ^b,OLE_TRUE
# Set global to true
Ole Set,RegEx,Global = ^b,OLE_TRUE
%%Email = @Input(Please give me an email address to validate)
If @OK()
  
  If @Equal(@Ole(Call,RegEx,^b,"Test(^B)",%%Email),@GetVar(OLE_TRUE))
    # If the email address is real show the user name portion of the email address
    Info Cool Email address@CR()@SubStr(%%Email,1,@Pred(@Pos("@",%%Email)))
  Else
    # if we got some bogus address warn the user
    %%Email =
    Warn Not a real email address
  End
End
# Ok we are done with this object
Ole Free,Object,RegEx

# Automate MS Word
SetVar wdApp,@Ole(Create,Word.Application,NULL)
# Show MS Word to the user
Ole Set,wdApp,Visible = ^b,OLE_TRUE
rem Ole Call,wdApp,Documents.Add
# Add a document
SetVar wdDoc,@Ole(Get,wdApp,^o,"Documents.Add")
# Type some text
Ole Call,wdApp,"Selection.TypeText(^B)",My Gadget Sample@CR()
# Info Hello MSWord control @GetVar(wdApp)@CR()
# Do some fancy Text effects
Ole Call,wdDoc,"Shapes.AddTextEffect(^d,^B,^B,^d,^d,^d,^e,^e)",15,"GadgetX Rocks!","Arial Black",36,0,0,90.0,224.95
Wait 10
# Info Hello MSWord control @GetVar(wdDoc)@CR()
Ole Call,wdDoc,"Close(^d)",0
# Make MS Word think the active document is already saved
#Ole Set,wdApp,ActiveDocument.Saved = ^b,OLE_TRUE
# Hide MS Word
Ole Set,wdApp,Visible = ^b,OLE_FALSE
# Quit MS Word (e.g... Some Anti-Virus software's will stop this method and prompt the user)
Ole Call,wdApp,Quit

# I found a simple work around for the Anti-Virus issue above.
# This will not remove the Anti-Virus warning but it should cause the winword.exe
# process to close completely.

Define Variable,Object,wdApp2
SetVar wdApp2,@Ole(GetObject,Word.Application,NULL)
Ole Call,wdApp2,Quit

# Free our objects
Ole Free,Object,wdDoc
Ole Free,Object,wdApp
Ole Free,Object,wdApp2

SetVar ScriptElem,@Ole(Create,MSScriptControl.ScriptControl,NULL)
# Define a simple script for VBScript
%%Script = "MsgBox("@chr(34)"This is a VBScript test1."@chr(34)" & vbcrlf & "@chr(34)"It worked1!"@chr(34)",64 Or 3)"
# 
Ole Set,ScriptElem,Language = ^B,VBScript
Ole Set,ScriptElem,AllowUI = ^b,OLE_TRUE
Ole Set,ScriptElem,UseSafeSubset = ^b,OLE_FALSE
Ole Call,ScriptElem,Eval(^B),%%Script
Info Hello MSScript control @GetVar(ScriptElem)@CR()
Rem Load a VBScript function into a VDS list
List create,9
List Add,9,"function retfnc(s)"
List Add,9,"  retfnc=s"
List Add,9,"end function"
Rem Add the VBScript from VDS into the MS Scripting Host control
Ole Call,ScriptElem,"AddCode(^B)",@Text(9)
Rem Use the function a couple of ways
Ole Call,ScriptElem,"ExecuteStatement(^B)","msgbox retfnc("@chr(34)"true"@chr(34)")"
%Q = @Ole(Call,ScriptElem,^B,"Eval(^B)","retfnc("@chr(34)"true"@chr(34)")")
Info "Q = "%Q
List clear,9
List close,9

# Done playing with the Script Element
Ole Free,Object,ScriptElem


if %%Email
  # Read the users email address
  %%szPhrase = "Hello "\Ctx=@chr(34)E-mail@chr(34)\%%Email", how are you today? I am the Microsoft Agent."
Else
  # Well the user didn't share their email address with us.
  %%szPhrase = "Hello, how are you today? I am the Microsoft Agent."
End
# Load the Microsoft Agent control
#
SetVar agent,@Ole(Create,Agent.Control.2,NULL)
#
Ole Set,agent,Connected = ^b,OLE_TRUE
# Load the Merlin character
Ole Call,agent,"Characters.Load(^B)",Merlin

Ole Set,agent,"AudioOutput.Enabled = ^b",OLE_TRUE
# Get the Merlin character
SetVar character,@Ole(Get,agent,^o,"Characters(^B)",Merlin)
rem Ole Call,character,"Get(^B,^B)",State,"Showing, Gesturing, Hiding, Hearing, Idling, Listening, Moving, Speaking",OLE_TRUE
# Show the character
Ole Call,character,Show
Ole Call,character,Activate(^B),true
# Set the character state to moving
Ole Call,character,"Get(^B,^B,^B)",State,Moving,true
# move the character next to our window at it's default speed of 1000
Ole Call,character,"MoveTo(^d,^d)",@Diff(@dlgpos(,L),150),@Diff(@dlgpos(,T),50)
rem Ole Call,character,"Get(^B,^B,^b)",Animation,"Greet, GreetReturn",OLE_TRUE
# Play that character's greeting animation
Ole Call,character,"Play(^B)",Greet
rem Ole Call,character,"Get(^B,^B,^b)",WaveFile,"character.lwv",OLE_TRUE
Ole Call,character,"Get(^B,^B,^B)",State,Speaking,true
# Read our first phrase
Ole Call,character,"Speak(^B)",%%szPhrase
# Plug GadgetX
Ole Call,character,"Speak(^B)",Get \Map=@chr(34)Gadget X@chr(34)=@chr(34)GadgetX@chr(34)\ today! \Map=@chr(34)from Dragon Sphere Software@chr(34)=@chr(34)http://www.dragonsphere.net@chr(34)\
rem Ole Call,character,"Play(^B)",GreetReturn
# Info Get character @GetVar(character)
# Set the character state to moving
Ole Call,character,"Get(^B,^B,^B)",State,Moving,true
# move the character to the lower right of the desktop our window cutting animation speed in half
Ole Call,character,"MoveTo(^d,^d,^d)",@Diff(@SysInfo(SCREENWIDTH),150),@Diff(@SysInfo(SCREENHEIGHT),150),500
# wait a little while
wait 15
# Call the hide method
Ole Call,character,"Hide(^B)",false
wait 5
# Unload the character
Ole Call,agent,"Characters.UnLoad(^B)",Merlin
# Free everything
Ole Free,Object,character
Ole Free,Object,agent
Ole Exceptions,HIDE
Ole UnInit
Exit
:End of VDSActiveX