PureDispHelper UserLib - Update with Includefile for Unicode

[mk-soft]

@KIKI

I have a same probleme

MakePropertyValue returned not a Dispatch (Object)

dhCreateObject("com.sun.star.ServiceManager") not aviable. Result empty.

[akj]

Thank you, srod

I have now managed to successfully convert the two Excel COM lines to PureBasic. The first line encoded as:

Code: Select all

Define.l ExcelApp, Workbook
ExcelApp = dhCreateObject("Excel.Application")
dhGetValue("%o", @Workbook, ExcelApp, ".Workbooks.Open(%s)", @"MySpreadsheet.xls")

[KIKI]

@KIKI

I have a same probleme

MakePropertyValue returned not a Dispatch (Object)

dhCreateObject("com.sun.star.ServiceManager") not aviable. Result empty.

I have the OpenOffice.org French version 2.2 and this is working perfectly.
Maybe the problem comes from your version of Open Office
If i can help you . Can you give the example i transfer to you ?

[ts-soft]

I have create a small PDF-Description of NeroCOM. Only Constants, Methods
and Events. You can download it here: http://ts-soft.eu/dl/NeroCOM.pdf
You should also load the NeroSDK on http://www.nero.com/nero7/eng/SDK_API.html for more information

Here a very simple example:

Code: Select all

; Nero example
; Debug all CD/DVD Devices
; by DataMiner and ts-soft

EnableExplicit

Define DISPHELPER_NO_OCX_CreateGadget

XIncludeFile "DispHelper_Include.pb"

dhInitializeImp()

Structure DriveInfo
  DeviceName.s
  HostAdapterName.s
  DriveLetter.s
EndStructure

dhToggleExceptions(#True)

Define obj.l, objNeroDrives.l, objNeroDriveItem.l, szResult.l, Result.l, i.l

NewList DI.DriveInfo()

obj = dhCreateObject("Nero.Nero")

If obj

  dhGetValue("%o", @objNeroDrives, obj, "GetDrives(%d)", 0)
 
  If objNeroDrives
    dhGetValue("%d", @Result, objNeroDrives, "Count()")

    If Result 
      For i = 0 To Result - 1
        dhGetValue("%o", @objNeroDriveItem, objNeroDrives, "Item(%d)", i)
        If objNeroDriveItem
          AddElement(DI())
          dhGetValue("%T", @szResult, objNeroDriveItem, "DeviceName")
          If szResult
            DI()\DeviceName = PeekS(szResult)
            dhFreeString(szResult)
          EndIf
          dhGetValue("%T", @szResult, objNeroDriveItem, "HostAdapterName")
          If szResult
            DI()\HostAdapterName = PeekS(szResult)
            dhFreeString(szResult)
          EndIf
          dhGetValue("%T", @szResult, objNeroDriveItem, "DriveLetter")
          If szResult
            DI()\DriveLetter = PeekS(szResult)
            dhFreeString(szResult)
          EndIf
          dhReleaseObject(objNeroDriveItem)
        EndIf
      Next
    EndIf
    dhReleaseObject(objNeroDrives)
  EndIf
  dhReleaseObject(obj)
EndIf

dhUninitialize()

ForEach DI()
  With DI()
    Debug \DriveLetter + ":    " + \HostAdapterName + "        " + \DeviceName
  EndWith
Next

[ts-soft]

OpenOffice Example by KIKI, with some corrections by me

Code: Select all

; based on excel example by kiffi and mk-soft
; example for openoffice by KIKI
; small corrections by ts-soft

EnableExplicit

Define DISPHELPER_NO_OCX_CreateGadget

XIncludeFile "DispHelper_Include.pb"
XIncludeFile "VariantHelper_Include.pb"

Define.l oSM, oDesk, oDoc, oTable, oCell

Procedure ChangeCellText(Table, Cell.s, Value.s)
  Protected oCell.l
  dhGetValue("%o", @oCell, Table, ".GetCellRangeByName(%T", @Cell)
  dhPutValue(oCell, ".String = %T", @Value)
  dhReleaseObject(oCell)
EndProcedure

Procedure PutCellValue(Table, Cell.s, *Value.VARIANT)
  Protected oCell.l
  dhGetValue("%o", @oCell, Table, ".GetCellRangeByName(%T", @Cell)
  dhPutValue(oCell, ".value = %v", *Value)
  dhReleaseObject(oCell)
EndProcedure

Define.safearray *openpar
Define.variant openarray
 
*openpar = saCreateSafeArray(#VT_DISPATCH, 0, 0)
V_ARRAY_DISP(openarray) = *openpar

dhInitializeImp()
dhToggleExceptions(#True)

Define.variant wert1, wert2, result, text
Define.d wert3 = 5.55555555555555

V_DOUBLE(wert1) = 3.33333333333333
V_DOUBLE(wert2) = 4.44444444444444
V_STR(text) = T_BSTR("Hello World")


oSM = dhCreateObject("com.sun.star.ServiceManager")
If oSM
  dhGetValue("%o",@oDesk,oSM, ".CreateInstance(%T)", @"com.sun.star.frame.Desktop")
  dhGetValue("%o",@oDoc, oDesk,".LoadComponentFromURL(%T,%T,%d,%v)",@"private:factory/scalc", @"_blank", 0, openarray)
  dhGetValue("%o",@oTable, odoc ,".Sheets.GetByIndex(%d)",  0)

  ChangeCellText(oTable, "A1", "Feel")
  ChangeCellText(oTable, "B1", "the")
  ChangeCellText(oTable, "C1", "pure")
  ChangeCellText(oTable, "D1", "Power")
  ChangeCellText(oTable, "A2", "The")
  ChangeCellText(oTable, "A3", "Pure")
  ChangeCellText(oTable, "A4", "Power")
  
  ; with VARIANT
  PutCellValue(oTable, "B2", wert1)
  PutCellValue(oTable, "B3", wert2)

  ; with PB-Double
  dhGetValue("%o", @oCell, oTable, ".GetCellRangeByName(%T", @"B4")
  dhPutValue(oCell, ".value = %e", @wert3)
  dhReleaseObject(oCell)
  
  dhGetValue("%o", @oCell, oTable, ".GetCellRangeByName(%T", @"C2")
  dhPutValue(oCell, ".String = %v", text)
  dhReleaseObject(oCell)

  dhGetValue("%o", @oCell, oTable, ".GetCellRangeByName(%T", @"B2")
  dhGetValue("%v", @result, oCell, ".Value")
  dhReleaseObject(oCell)

  MessageRequester("PureDispHelper-OpenCalcDemo", "Result Cells(2,2): " + VT_STR(result))
  MessageRequester("PureDispHelper-OpenCalcDemo", "Click OK to close Open Office")

  dhCallMethod(odoc,".close(%b)",#True)
  dhReleaseObject(oTable)
  dhReleaseObject(oDoc)
  dhReleaseObject(oSM)
EndIf
dhUninitialize()
End

[KIKI]

I Have aproblem compiling Calc office program or Writer office program
Error during the compilation
Here is the message

Code: Select all

polink_error unresolval external symbol __imp__CLSIDFromString 
                                                           __imp__CLSIDFromProgId
                                                           __imp__COGETClassObject.
                                                           __imp__COGETOBJECT
                                                           __imp__COInitialize
                                                           __imp__COUInitialize
6 error(s) unresolved external

If i create a messageRequester instruction the error compiling disappeared in the program

[ts-soft]

@KIKI
Please update the lib

Update Version 1.4

Helpfile enhanced
PureOCXHelper userlib updated (OCX_CreateGadget)
some other small bugfixes.

Download, see first posting

[ts-soft]

Sorry, new Version 1.5

added Userlibs with Unicode-Support as SubSystem.

All parametertypes as in the puredisphelper_include.pb supported

The userlibs is a bit big, there is a problem with tailbite, but this have no
effect on your executable.

[singo]

First, congratulations with the library, it is great work.

Few small problems with V1.5 examples downloaded today

With sendkeys.pb I get error "The system cannot find the file specified" for the

Code: Select all

dhCallMethod(oWScript, "Run(%s)", @"calc")

I tested with small vbscript and works Ok.

Code: Select all

Set ws=CreateObject("WScript.Shell")
ws.run("calc")

Also sendkeys only sends the first character in the string, that is

Code: Select all

dhCallMethod(oWScript, "SendKeys(%s)", @"1{+}")

only sends the first character "1".

This also happens with the sapi.pb example as the voice only speaks the first character of the string.

The other error I am getting in quite a few of the examples is
POLINK: error: Unresolved external symbol '_SYS_ToUnicode'

Can you help ?

I am running PB4.02 latest on XPSP2.

Thanks

[ts-soft]

Please check the compiler-options. Some demos have Unicode enabled,
without the right SubSystem.

[singo]

That fixed the problem, all demos working properly.

thanks ts-soft !

[akj]

How can I overcome the error "Object required" raised by dhGetObject() in this code?

Code: Select all

; IE_Titlebar  AKJ  16-May-07
; Get the titlebar text for an existing Internet Explorer window

#Program$ = "IE_Titlebar"
EnableExplicit

IncludePath #PB_Compiler_Home+"Examples\DispHelper_Include"
XIncludeFile "DispHelper_Include.pb"

dhInitializeImp()
dhToggleExceptions(#True)

Define.l ieApp, state, oDoc, title

; Get a running instance of IE
dhGetObject(#NULL$,"InternetExplorer.Application", @ieApp)
If ieApp=0
  MessageRequester(#Program$+" Error", "IE process Not running")
  dhUninitialize()
  End
EndIf

; Wait in case IE is not ready
Repeat
  dhGetValue("%d", @state, ieApp, ".ReadyState") ; ieApp.ReadyState
Until state=4

; Get IE title text
dhGetValue("%o", @oDoc, ieApp, ".Document") ; Set oDoc = ieApp.Document
dhGetValue("%T", @title, oDoc, ".title") ; title = oDoc.title
If title
  MessageRequester(#Program$+" Information", Trim(PeekS(title)))
EndIf
dhFreeString(title)

; Windup
dhReleaseObject(ieApp)
dhUninitialize()
End

[ts-soft]

Added AnimatedGif.ocx (freeware)
http://www.freevbcode.com/ShowCode.asp?id=4045

and example by Kiffi

[GeoTrail]

Cool, should be useful in a project I'm planning

[Amundo]

@akj

How can I overcome the error "Object required" raised by dhGetObject() in this code?

Looking at the documentation, and your code, I think the "#NULL$" should be the second parameter?

EDIT: And I'm not sure "InternetExplorer.Application" is a valid class name, lemme look it up...

Sorry, that is correct according to the sample C code. I now get "Invalid Class String"? The investigation continues...

EDIT (AGAIN):
Okay, downloaded and installed v1.5 and hacked the included "ie_navigate.pb", so the following uses the lib files, not the include file:

Code: Select all

EnableExplicit

Define.l ieApp, state, oDoc, title
#Program$ = "IE_Titlebar"

dhToggleExceptions(#True)

ieApp = dhCreateObject("InternetExplorer.Application")

If ieApp
  dhPutValue (ieApp, "Visible = %b", #True)
  dhCallMethod(ieApp, "Navigate(%T)", @"www.purebasic.com")
  
  Repeat
    dhGetValue("%d", @state, ieApp, ".ReadyState") ; ieApp.ReadyState
  Until state=4
  
  dhGetValue("%o", @oDoc, ieApp, ".Document") ; Set oDoc = ieApp.Document
  dhGetValue("%T", @title, oDoc, ".title") ; title = oDoc.title
  
  If title
    MessageRequester(#Program$+" Information", Trim(PeekS(title)))
  EndIf
  dhFreeString(title)
  
  dhReleaseObject(ieApp) : ieApp = 0
  
EndIf

I know it's not exactly what you were after (I'm guessing you'd need to check whether IE was running initially), but I hope it helps.