PureDispHelper UserLib - Update with Includefile for Unicode

[freak]

Well, i would actually use it for all the functions (byte, bool, float etc), as it handles
even #VT_BYREF etc, which your code currently cannot handle.

[ts-soft]

@freak

I hope mk-soft will change this in next time, thanks for support

Update
DispHelper_Include.pb

added OCX_CreateGadget with Unicode-Support (PB-Source)
I hope it works like the lib.

[ts-soft]

Updated the VariantHelper_Include.pb

Code: Select all

;-TOP
; Kommentar     : Variant Helper
; Author        : mk-soft
; Second Author : ts-soft
; Datei         : VariantHelper_Include.pb
; Version       : 2.05
; Erstellt      : 30.04.2007
; Geändert      : 01.05.2007
;
; Compilermode  :
;
; ***************************************************************************************

Define.l vhLastError

; ***************************************************************************************

;- Structure SAFEARRAY
Structure SAFEARRAYBOUND
  cElements.l
  lLbound.l
EndStructure

Structure pData
  StructureUnion
    bVal.b[0]; AS BYTE            ' VT_UI1
    iVal.w[0]; AS INTEGER         ' VT_I2
    lVal.l[0]; AS LONG            ' VT_I4
    llVal.q[0]; AS QUAD           ' VT_I8
    fltVal.f[0]; AS SINGLE        ' VT_R4
    dblVal.d[0]; AS DOUBLE        ' VT_R8
    boolVal.w[0]; AS INTEGER      ' VT_BOOL
    scode.l[0]; AS LONG           ' VT_ERROR
    cyVal.l[0]; AS LONG           ' VT_CY
    date.d[0]; AS DOUBLE          ' VT_DATE
    bstrVal.l[0]; AS LONG         ' VT_BSTR
    punkVal.l[0]; AS DWORD        ' VT_UNKNOWN
    pdispVal.l[0]; AS DWORD       ' VT_DISPATCH
    parray.l[0]; AS DWORD         ' VT_ARRAY|*
    Value.Variant[0];
  EndStructureUnion
EndStructure
 
Structure SAFEARRAY
  cDims.w
  fFeatures.w
  cbElements.l
  cLocks.l
  *pvData.pData
  rgsabound.SAFEARRAYBOUND[0]
EndStructure

; ***************************************************************************************


;- Errorhandling

; ***************************************************************************************

Procedure.l vhGetLastError()

  Shared vhLastError
 
  ProcedureReturn vhLastError
 
EndProcedure

; ***************************************************************************************

Procedure.s vhGetLastMessage()

  Shared vhLastError
 
  Protected *Buffer, len, result.s
 
  len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,vhLastError,0,@*Buffer,0,0)
  If len
    result = PeekS(*Buffer, len - 2)
    LocalFree_(*Buffer)
    ProcedureReturn result
  Else
    ProcedureReturn "Errorcode: " + Hex(vhLastError)
  EndIf
 
EndProcedure

; ***************************************************************************************


;- Safearray Functions

; ***************************************************************************************

Procedure.l GetVariantSafeArrayCount(*Var.Variant) ; Result Count of Elements
  Protected result.l, *array.safearray
  If *Var
    If (*Var\vt & #VT_ARRAY) = #VT_ARRAY
      *array = *Var\parray
      result = *array\rgsabound\cElements
    Else
      result = 0
    EndIf
  Else
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

; ***************************************************************************************

Procedure.l GetVariantSafeArrayVarType(*Var.Variant) ; Result Vartype of Array
  Protected result.l, *array.safearray
  If *Var
    result = *Var\vt & $1FFF
  Else
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

; ***************************************************************************************

Procedure.l GetVariantSafeArray(*Var.Variant) ; Result a Pointer to Array
  Protected result.l, *array.safearray
  If *Var
    If (*Var\vt & #VT_ARRAY) = #VT_ARRAY
      *array = *Var\parray
      result = *array\pvdata
    Else
      result = 0
    EndIf
  Else
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

; ***************************************************************************************


;- Type Conversion

; ***************************************************************************************

; UNICODE / ASCII Helper for SysAllocString
Procedure helpSysAllocString(*Value)
  ProcedureReturn SysAllocString_(*Value)
EndProcedure
Prototype.l ProtoSysAllocString(Value.p-unicode)

;-T_BSTR
Global T_BSTR.ProtoSysAllocString = @helpSysAllocString()

; ***************************************************************************************

Procedure.d T_DATE(pbDate) ; Result Date from PB-Date
 
  Protected date.d
 
  date = pbDate / 86400.0 + 25569.0
  ProcedureReturn date
 
EndProcedure

; ***************************************************************************************

Procedure T_BOOL(Assert) ; Result Variant Type Boolean

  If Assert
    ProcedureReturn #VARIANT_TRUE
  Else
    ProcedureReturn #VARIANT_FALSE
  EndIf
  
EndProcedure

; ***************************************************************************************

;- Conversion Variant to PB Values

Procedure.s VT_STR(*Var.Variant)

  Shared vhLastError.l

  Protected hr.l, result.s, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_BSTR)
    If hr = #S_OK
      result = PeekS(VarDest\bstrVal, #PB_Any, #PB_Unicode)
      VariantClear_(VarDest)
      ProcedureReturn result
   
    Else
      vhLastError = hr
      ProcedureReturn ""
    EndIf
   
  EndIf
EndProcedure
 
; ***************************************************************************************
 
Procedure.l VT_BOOL(*Var.Variant)

  Shared vhLastError.l

  Protected hr.l, result.l, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_BOOL)
    If hr = #S_OK
      result = VarDest\boolVal
      VariantClear_(VarDest)
      If result
        ProcedureReturn #True
      Else
        ProcedureReturn #False
      EndIf
      
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************

Procedure.b VT_BYTE(*Var.Variant)

  Shared vhLastError.l

  Protected hr.l, result.b, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_I1)
    If hr = #S_OK
      result = VarDest\bVal
      VariantClear_(VarDest)
      ProcedureReturn result
   
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************

Procedure.w VT_WORD(*Var.Variant)

  Shared vhLastError.l

  Protected hr.l, result.w, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_I2)
    If hr = #S_OK
      result = VarDest\iVal
      VariantClear_(VarDest)
      ProcedureReturn result
   
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************

Procedure.l VT_LONG(*Var.Variant)

  Shared vhLastError.l

  Protected hr.l, result.l, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_I4)
    If hr = #S_OK
      result = VarDest\lVal
      VariantClear_(VarDest)
      ProcedureReturn result
   
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************

Procedure.q VT_QUAD(*Var.Variant)
 
  Shared vhLastError.l

  Protected hr.l, result.q, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_I8)
    If hr = #S_OK
      result = VarDest\llVal
      VariantClear_(VarDest)
      ProcedureReturn result
   
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************

Procedure.f VT_FLOAT(*Var.Variant)

  Shared vhLastError.l

  Protected hr.l, result.f, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_R4)
    If hr = #S_OK
      result = VarDest\fltVal
      VariantClear_(VarDest)
      ProcedureReturn result
   
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************

Procedure.d VT_DOUBLE(*Var.Variant)

  Shared vhLastError.l

  Protected hr.l, result.d, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_R8)
    If hr = #S_OK
      result = VarDest\dblVal
      VariantClear_(VarDest)
      ProcedureReturn result
   
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************

Procedure.l VT_DATE(*Var.Variant) ; Result PB-Date from Variant Date

  Shared vhLastError.l
 
  Protected pbDate
 
  Protected hr.l, result.d, VarDest.Variant
 
  If *Var
    hr = VariantChangeType_(VarDest, *Var, 0, #VT_DATE)
    If hr = #S_OK
      pbDate = (VarDest\dblVal  - 25569.0) * 86400.0
      VariantClear_(VarDest)
      ProcedureReturn pbDate
    Else
      vhLastError = hr
      ProcedureReturn 0
    EndIf
   
  EndIf

EndProcedure
 
; ***************************************************************************************


;- Converions PB Values to Variant

; ***************************************************************************************

Macro V_EMPTY(Arg)
  VariantClear_(Arg)
EndMacro

; ***************************************************************************************

Macro V_NULL(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_NULL
  Arg\llVal
EndMacro

; ***************************************************************************************

Macro V_DISP(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_DISPATCH
  Arg\pdispVal
EndMacro

; ***************************************************************************************

Macro V_UNKNOWN(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UNKNOWN
  Arg\punkVal
EndMacro

; ***************************************************************************************

Macro V_STR(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BSTR
  Arg\bstrVal
EndMacro

; ***************************************************************************************

Macro V_BOOL(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BOOL
  Arg\boolVal
EndMacro

; ***************************************************************************************

Macro V_BYTE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I1
  Arg\bVal
EndMacro

; ***************************************************************************************

Macro V_UBYTE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UI1
  Arg\bVal
EndMacro

; ***************************************************************************************

Macro V_WORD(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I2
  Arg\iVal
EndMacro

; ***************************************************************************************

Macro V_UWORD(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UI2
  Arg\iVal
EndMacro

; ***************************************************************************************

Macro V_LONG(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I4
  Arg\lVal
EndMacro

; ***************************************************************************************

Macro V_ULONG(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_UI4
  Arg\lVal
EndMacro

; ***************************************************************************************

Macro V_QUAD(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_I8
  Arg\llVal
EndMacro

; ***************************************************************************************

Macro V_FLOAT(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_R4
  Arg\fltVal
EndMacro

; ***************************************************************************************

Macro V_DOUBLE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_R8
  Arg\dblVal
EndMacro

; ***************************************************************************************

Macro V_DATE(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_DATE
  Arg\dblVal
EndMacro

; ***************************************************************************************

Macro V_NULL_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_NULL
  Arg\pllVal
EndMacro

; ***************************************************************************************

Macro V_DISP_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_DISPATCH
  Arg\ppdispVal
EndMacro

; ***************************************************************************************

Macro V_UNKNOWN_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_UNKNOWN
  Arg\ppunkVal
EndMacro

; ***************************************************************************************

Macro V_STR_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_BSTR
  Arg\pbstrVal
EndMacro

; ***************************************************************************************

Macro V_BOOL_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_BOOL
  Arg\pboolVal
EndMacro

; ***************************************************************************************

Macro V_BYTE_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_I1
  Arg\pbVal
EndMacro

; ***************************************************************************************

Macro V_UBYTE_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_UI1
  Arg\pbVal
EndMacro

; ***************************************************************************************

Macro V_WORD_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_I2
  Arg\piVal
EndMacro

; ***************************************************************************************

Macro V_UWORD_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_UI2
  Arg\piVal
EndMacro

; ***************************************************************************************

Macro V_LONG_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_I4
  Arg\plVal
EndMacro

; ***************************************************************************************

Macro V_ULONG_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_UI4
  Arg\plVal
EndMacro

; ***************************************************************************************

Macro V_QUAD_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_I8
  Arg\pllVal
EndMacro

; ***************************************************************************************

Macro V_FLOAT_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_R4puredisphelper
  Arg\pfltVal
EndMacro

; ***************************************************************************************

Macro V_DOUBLE_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_R8
  Arg\pdblVal
EndMacro

; ***************************************************************************************

Macro V_DATE_BYREF(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_BYREF | #VT_DATE
  Arg\pdblVal
EndMacro

; ***************************************************************************************

[Dare]

Anyone know of good sites (with safe stuff) that list useful and usable ocx etc files?

I want to try my hand at something (anything) from scratch, but best if it is useful just in case against all odds I get it right.

[ts-soft]

@Dare
You can look here:
http://www.vbaccelerator.com/home/VB/Co ... /index.asp

[Dare]

Thanks ts-soft.

Some other useful info and bits on that site as well.

[ts-soft]

Updated Disphelper_Include.pb

some errors fixed

added FOREACH macros


//edit
some mistakes in foreach-macros changed (13:26)

[mk-soft]

Updated VariantHelper_Include.pb with Variant ByRef

Download: http://home.arcor.de/m_kastner/MyCodes/ ... Include.pb
Testfile: http://home.arcor.de/m_kastner/MyCodes/ ... tHelper.pb

All new version to be direct by ts-soft.

[ts-soft]

thanks michael, i have uploaded your new version.

[KIKI]

HI Ts-Soft
I make what you say to me and i have always the same problem

Type Mismatch "LoadcomponentFromurl.argument.index:3

The problem seems to come from the third argument of the function
@"private:factory/swriter", @"_blank",1 ,openpar
Openpar is an array :
openpar(0)=#True
openpar(1)="secret"
openpar(2)=#True

These function works well in vb.

[ts-soft]

A array in com is a VARIANT-Type! Not the same as an array in PB

[KIKI]

A array in com is a VARIANT-Type! Not the same as an array in PB

ok BUT HOW CAN I DO TO HAVE THESE INSTRUCT WORKING it seems that the problem come from the third parameter :
dhGetValue("%o",@oDoc, oDesk,".loadComponentFromURL(%T,%T,%d,%T)",@"private:factory/swriter", @"_blank",0 ,openpar() )
of loadcomponenturl. the 0
Maybe if you can't help me i will renonce to igrate my programm becase i am unable to solve this problem.

[ts-soft]

Change the code to none use of array

[KIKI]

Change the code to none use of array

It's impossible because Office org need an array with this parameters but the problem do't comes from the array it's come from the third parameter the 0 which seems not passing

[ts-soft]

You can only pass strings and longs, or you use an variant. PB can't pass an
array to this lib in this form!!!.
Office org need an array is nonsense. Put all Values, one by one, and call Method.