PureBasic Forums - English

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

PureDispHelper UserLib - Update with Includefile for Unicode

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

Page 16 of 18

Posted: Thu Feb 14, 2008 10:28 am
by SFSxOI
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.

Posted: Thu Feb 14, 2008 10:38 am
by ts-soft
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

Posted: Thu Feb 14, 2008 11:06 am
by SFSxOI
sent...glad to help out.

Posted: Thu Feb 14, 2008 12:25 pm
by Andre
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... :D

Posted: Thu Feb 21, 2008 7:01 pm
by nicolaus
@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

Posted: Thu Feb 28, 2008 8:51 pm
by mk-soft
@nicolaus

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

Posted: Mon Jun 23, 2008 5:53 pm
by flashvnn
Hi, i see a Flash Example with puredisphelper, but how i use fscommand with puredisphelper.
please help

Posted: Mon Jun 23, 2008 6:09 pm
by ts-soft
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.

Posted: Wed Aug 13, 2008 2:30 pm
by mback2k
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

Posted: Sat Aug 16, 2008 6:37 pm
by SFSxOI
I second mback2k's suggestion for the disphelper having wmi, that would be great.

Posted: Sat Aug 16, 2008 6:42 pm
by ts-soft
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.

Posted: Sat Aug 16, 2008 7:33 pm
by mback2k
Thanks for the information. Could you convert the wmi.c as an example, please? :)

Posted: Tue Aug 19, 2008 2:49 pm
by SFSxOI
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.

Posted: Wed Aug 27, 2008 9:08 pm
by SFSxOI
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) ?

Posted: Wed Aug 27, 2008 9:22 pm
by ts-soft

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
All times are UTC+01:00
Page 16 of 18

Powered by phpBB® Forum Software © phpBB Limited