PureDispHelper UserLib - Update with Includefile for Unicode

SFSxOI · Post by **SFSxOI** » Thu Feb 14, 2008 10:28 am

If the one on pure area is not the correct one, I've got the .zip that was in the link from right before ts-soft's link quit working. If you want I can send it to you if its OK with ts-soft.

ts-soft · Post by **ts-soft** » Thu Feb 14, 2008 10:38 am

SFSxOI wrote:If the one on pure area is not the correct one, I've got the .zip that was in the link from right before ts-soft's link quit working. If you want I can send it to you if its OK with ts-soft.

Please send it to André, thanks

SFSxOI · Post by **SFSxOI** » Thu Feb 14, 2008 11:06 am

sent...glad to help out.

Post by **Andre** » Thu Feb 14, 2008 12:25 pm

Thanks, SFSxOI for sending the email!

But: the download link posted above contains already the right (and latest) archive. So I've now corrected the download link in the Showcase project too and all is working fine...

nicolaus · Post by **nicolaus** » Thu Feb 21, 2008 7:01 pm

@ts-soft
you have a example how i can create a excel file but how i can read a e exist excel file?

Where can i find informations for Methodes, Proberty´s and so, what the functions of the disphelper want as parameter?

thanks,
Nico

mk-soft · Post by **mk-soft** » Thu Feb 28, 2008 8:51 pm

@nicolaus

Download from http://www.devcomponents.com/ COM Assistant.
It´s good tool.

flashvnn · Post by **flashvnn** » Mon Jun 23, 2008 5:53 pm

Hi, i see a Flash Example with puredisphelper, but how i use fscommand with puredisphelper.
please help

ts-soft · Post by **ts-soft** » Mon Jun 23, 2008 6:09 pm

flashvnn wrote:Hi, i see a Flash Example with puredisphelper, but how i use fscommand with puredisphelper.
please help

Make a search for a vbs example and change it to puredisphelper (is easy)
I can't help, i have no documentation on this.

mback2k · Post by **mback2k** » Wed Aug 13, 2008 2:30 pm

Would it be possible to create such lib for WMI classes? I need to be able to use SetDNSServerSearchOrder Method of the Win32_NetworkAdapterConfiguration Class and would like to avoid VBScript in my PureBasic program. Thanks in advance

I am open for any advice in this issue.
http://msdn.microsoft.com/en-us/library ... S.85).aspx

I currently use this way, but I would like to directly access the WMI with PB.

Code: Select all

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_ProcedureDLLs(A)
  _AboutBox()
  AddObject(A,b,c)
  Reset()
  AddCode(source.p-bstr)
  Eval(A.p-bstr,*b.VARIANT)
  ExecuteStatement(A.p-bstr)
  Run(strCommand.p-bstr, intWindowStyle.l, bWaitOnReturn.l)
EndInterface

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

Procedure.s GetNameServer(ip$)
  Protected VBS$, ScriptControl.IScriptControl, var.VARIANT, result.s
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ScriptControl, 0, 1, ?IID_IScriptControl, @ScriptControl) = #S_OK
    ScriptControl\Reset()
    ScriptControl\put_Language("VBScript")
    VBS$ + "strComputer = " + Chr(34) + "." + Chr(34) + #CRLF$
    VBS$ + "Set objWMIService = GetObject(" + Chr(34) + "winmgmts:" + Chr(34) + " _" + #CRLF$
    VBS$ + "    & " + Chr(34) + "{impersonationLevel=impersonate}!\\" + Chr(34) + " & strComputer & " + Chr(34) + "\root\cimv2" + Chr(34) + ")" + #CRLF$
    VBS$ + "Set IPConfigSet = objWMIService.ExecQuery _" + #CRLF$
    VBS$ + "    (" + Chr(34) + "SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=TRUE" + Chr(34) + ")" + #CRLF$
    VBS$ + "For Each IPConfig in IPConfigSet" + #CRLF$
    VBS$ + "    If IPConfig.IPAddress(0)=" + Chr(34) + ip$ + Chr(34) + " Then " + #CRLF$
    VBS$ + "        For i=LBound(IPConfig.DNSServerSearchOrder) to UBound(IPConfig.DNSServerSearchOrder)" + #CRLF$
    VBS$ + "            If i>0 Then" + #CRLF$
    VBS$ + "                name = name & " + Chr(34) + "," + Chr(34) + #CRLF$
    VBS$ + "            End If" + #CRLF$
    VBS$ + "            name = name & IPConfig.DNSServerSearchOrder(i)" + #CRLF$
    VBS$ + "        Next" + #CRLF$
    VBS$ + "    End If" + #CRLF$
    VBS$ + "Next" + #CRLF$
    ScriptControl\AddCode(VBS$)
    If ScriptControl\Eval("name", @var) = #S_OK
      Select var\vt
        Case #VT_BOOL
          If var\boolVal = #VARIANT_TRUE
            result = "1"
          Else
            result = ""
          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 = StrQ(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
  EndIf
EndProcedure

Procedure.l SetNameServer(ip$, ServerList$)
  Protected VBS$, ScriptControl.IScriptControl, var.VARIANT, result.l
  CoInitialize_(0)
  If CoCreateInstance_(?CLSID_ScriptControl, 0, 1, ?IID_IScriptControl, @ScriptControl) = #S_OK
    ScriptControl\Reset()
    ScriptControl\put_Language("VBScript")
    VBS$ + "arrDNSServers = Array(" + Chr(34) + ReplaceString(ServerList$, ",", Chr(34) + "," + Chr(34)) + Chr(34) + ")" + #CRLF$
    VBS$ + "strComputer = " + Chr(34) + "." + Chr(34) + #CRLF$
    VBS$ + "Set objWMIService = GetObject(" + Chr(34) + "winmgmts:" + Chr(34) + " _" + #CRLF$
    VBS$ + "    & " + Chr(34) + "{impersonationLevel=impersonate}!\\" + Chr(34) + " & strComputer & " + Chr(34) + "\root\cimv2" + Chr(34) + ")" + #CRLF$
    VBS$ + "Set IPConfigSet = objWMIService.ExecQuery _" + #CRLF$
    VBS$ + "    (" + Chr(34) + "SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=TRUE" + Chr(34) + ")" + #CRLF$
    VBS$ + "For Each IPConfig in IPConfigSet" + #CRLF$
    VBS$ + "    If IPConfig.IPAddress(0)=" + Chr(34) + ip$ + Chr(34) + " Then " + #CRLF$
    VBS$ + "        code = IPConfig.SetDNSServerSearchOrder(arrDNSServers)" + #CRLF$
    VBS$ + "    End If" + #CRLF$
    VBS$ + "Next" + #CRLF$
    ScriptControl\AddCode(VBS$)
    If ScriptControl\Eval("code", @var) = #S_OK
      Select var\vt
        Case #VT_BOOL
          If var\boolVal = #VARIANT_TRUE
            result = #True
          Else
            result = #False
          EndIf
        Case #VT_BSTR
          result = Val(PeekS(var\bstrVal, #PB_Any, #PB_Unicode))
        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
          result = var\dblVal
        Default
          result = 0
      EndSelect
      VariantClear_(var)
    Else
      result = 0
    EndIf
    If Not result
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

SFSxOI · Post by **SFSxOI** » Sat Aug 16, 2008 6:37 pm

I second mback2k's suggestion for the disphelper having wmi, that would be great.

ts-soft · Post by **ts-soft** » Sat Aug 16, 2008 6:42 pm

http://disphelper.sourceforge.net/ wrote:Included with DispHelper are over 20 samples that demonstrate using COM objects including ADO, CDO, Outlook, Eudora, Excel, Word, Internet Explorer, MSHTML, PocketSoap, Word Perfect, MS Agent, SAPI, MSXML, WIA, dexplorer and WMI.

mback2k · Post by **mback2k** » Sat Aug 16, 2008 7:33 pm

Thanks for the information. Could you convert the wmi.c as an example, please?

SFSxOI · Post by **SFSxOI** » Tue Aug 19, 2008 2:49 pm

the lib doesn't seem to work with this after conversion:

Code: Select all

Set objWMIService = GetObject("winmgmts:\\" & _
    strComputer & "\root\cimv2")

I probably did something wrong tho. I dont get where to put the "'s for the '& _strComputer & ' part.

SFSxOI · Post by **SFSxOI** » Wed Aug 27, 2008 9:08 pm

OK, i'm having a terrible time with getting the lib to work for vbs, i'm adapting one of your examples for use.

First, this is the original .vbs from the MSDN:

Code: Select all

strComputer = "."
Set objWMIService = GetObject( _ 
    "winmgmts:\\" & strComputer & "\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery _
    ("Select IPAddress from Win32_NetworkAdapterConfiguration ")
 
For Each IPConfig in IPConfigSet
    If Not IsNull(IPConfig.IPAddress) Then 
        For i=LBound(IPConfig.IPAddress) _
            To UBound(IPConfig.IPAddress)
                WScript.Echo IPConfig.IPAddress(i)
        Next
    End If
Next

And next this is the code as i have it right now:

Code: Select all

Procedure.s AdapterConfig() ; Returns AdapterConfig

   Protected Script$ 
      
      strComputer.s = Chr(34) + "." + Chr(34) + #CRLF$
    	Script$ = "Set objWMIService = GetObject(" + Chr(34) + "winmgmts:" + Chr(34) + " _" + #CRLF$
    	Script$ + "    & " + Chr(34) + "{impersonationLevel=impersonate}!\\" + Chr(34) + " & strComputer & " + Chr(34) + "\root\cimv2" + Chr(34) + ")" + #CRLF$
    	Script$ + "Set IPConfigSet = objWMIService.ExecQuery _" + #CRLF$
    	Script$ + "    (" + Chr(34) + "Select IPAddress from Win32_NetworkAdapterConfiguration" + Chr(34) + ")" + #CRLF$
    	Script$ + "For Each IPConfig in IPConfigSet" + #CRLF$
    	Script$ + "    If Not IsNull(IPConfig.IPAddress) Then " + #CRLF$
    	Script$ + "        For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)" + #CRLF$
    	Script$ + "            name = name & IPConfig.description(i) & vbTab & IPConfig.IPAddress(i) & vbCrlf" + #CRLF$
    	Script$ + "        Next" + #CRLF$
    	Script$ + "    End If" + #CRLF$
    	Script$ + "Next" + #CRLF$
     
   ProcedureReturn Script$ 
EndProcedure


dhToggleExceptions(#True)

Define.l Result, obj = dhCreateObject("MSScriptControl.ScriptControl")
Define.s Script

If obj

  dhPutValue(obj, "Language = %T", @"VBScript")
  dhGetValue("%T", @Result, obj, "Language")

  If Result

    Debug "Language: " + PeekS(Result)
    dhFreeString(Result) : Result = 0

  EndIf

  ;dhPutValue(obj, "TimeOut = %d", 20000)
  dhGetValue("%d", @Result, obj, "TimeOut")

  Debug "TimeOut: " + Str(Result) + " ms"
  Script = AdapterConfig()
  dhCallMethod(obj, "AddCode(%T)", @Script)
  dhGetValue("%T", @Result, obj, "Eval(%T)", @"myTitle")

  If Result

    Debug "Adapter:" + PeekS(Result)
    dhFreeString(Result) : Result = 0

  EndIf

  dhReleaseObject(obj) : obj = 0

EndIf

I'm using your vbs.pb as a sort of guide, but i'm not sure if i even have it correct. Doesn't work, what am i doing wrong (probably everything) ?

ts-soft · Post by **ts-soft** » Wed Aug 27, 2008 9:22 pm

Code: Select all

       Script$ + "            name = name & IPConfig.description(i) & vbTab & IPConfig.IPAddress(i) & vbCrlf" + #CRLF$

Code: Select all

dhGetValue("%T", @Result, obj, "Eval(%T)", @"myTitle")

No time to test, but you use name for the result in script and myTitle to get the result.

// edit

Code: Select all

Procedure.s AdapterConfig() ; Returns AdapterConfig

   Protected Script$
     
       Script$ = "Set objWMIService = GetObject(" + Chr(34) + "winmgmts:" + Chr(34) + " _" + #CRLF$
       Script$ + "    & " + Chr(34) + "{impersonationLevel=impersonate}!\\.\root\cimv2" + Chr(34) + ")" + #CRLF$
       Script$ + "Set IPConfigSet = objWMIService.ExecQuery _" + #CRLF$
       Script$ + "    (" + Chr(34) + "Select IPAddress from Win32_NetworkAdapterConfiguration" + Chr(34) + ")" + #CRLF$
       Script$ + "For Each IPConfig in IPConfigSet" + #CRLF$
       Script$ + "    If Not IsNull(IPConfig.IPAddress) Then " + #CRLF$
       Script$ + "        For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)" + #CRLF$
       Script$ + "            name = name & IPConfig.description(i) & vbTab & IPConfig.IPAddress(i) & vbCrlf" + #CRLF$
       Script$ + "        Next" + #CRLF$
       Script$ + "    End If" + #CRLF$
       Script$ + "Next" + #CRLF$
     
   ProcedureReturn Script$
EndProcedure

SetClipboardText(AdapterConfig())

Save the clipboard to bla.vbs and you will see a error in line 8
"IPConfig.description(i)"
Remove the error from your script and make the changes of eval!
I'm not a vb-scripter and the methode "AddCode" is not supported in
Vista, so i can't test it

greetings
Thomas