PureDispHelper Userlib - Update Include für Unicode Support

[Falko]

Das wäre nicht schlecht, denn das was mk-soft mir zuvor mit dem AD-USB
gezeigt hatte, hat soweit prima funktioniert.
Nur leider ist das mit sehr viel Aufwand verbunden, wenn man dagegen
eure interessante Lib sieht

Gruß ..Falko

[mk-soft]

Habe folgende Identifier Type ausprobiert.

%v für Variant geht
%S für Unicode geht.

FF

[ts-soft]

Habe folgende Identifier Type ausprobiert.

%v für Variant geht
%S für Unicode geht.

FF

Dann hab ich ja was dazu gelernt
Es werden also alle Identifier der Original-Lib funktionieren, wobei, da die Lib
nur im ANSI-Modus läuft, bringts ja nicht viel.

[mk-soft]

Ich bin in C nicht ganz fit.

Aber es gibt, glaube ich, nur ein Code mit allen Identifier Typen und es ist eine nur ein frage wie der Code comilliert wird. In Ansi oder in Unicode.

Vielleicht reicht es beide LIBs zu nehmen und intern eine Umschaltung
zwischen den beiden LIBs vorzunehmen.

FF

[ts-soft]

Ich krieg die C-Lib nicht fehlerfrei kompiliert. Die statische Lib von FB funkt.
zwar ein bissel, aber lauter IMA, kommt keine Freude auf, die setzt Unicode
voraus, nur die spezielle ANSI-Version läuft bisher mit PB.

Dafür bräuchten wir also einen C-Experten, edel hat bereits abgesagt,
ansonsten wüßte ich nicht, wer das Umsetzen sollte.

[mk-soft]

Ich bekomme den Scoure mit Pelles C ohne fehler compiliert.

Ob die LIB einwandfrei läuft weiss ich noch nicht.

dhCreateObject(LPCOLESTR szProgId, LPCWSTR szMachine, IDispatch ** ppDisp)

ist noch Wide String (Unicode)

Vielleicht noch alle erforderlicherlichen Funktionen mit xyzW und xyzA erweitern.

FF

[ts-soft]

Ich bekomme den Scoure mit Pelles C ohne fehler compiliert.

Ob die LIB einwandfrei läuft weiss ich noch nicht.

dhCreateObject(LPCOLESTR szProgId, LPCWSTR szMachine, IDispatch ** ppDisp)

ist noch Wide String (Unicode)

Vielleicht noch alle erforderlicherlichen Funktionen mit xyzW und xyzA erweitern.

FF

LPOLESTR ist ein Bstr-Unicode, kein Problem. Kannste mir mal bitte
eine fehlerfrei kompilierte statische Lib zu kommen lassen? Ich hab nur
die von FreeBASIC, die abhängkeiten zur libgcc hat und probleme
bereitet.

Wenn Du die zu nutzenden Funktionen noch mit PB_ versorgen könntest,
könnte man direkt eine Userlib draus basteln.

Aber erstmal nur eine unveränderte statisch Lib, mal sehen ob die
weniger Probleme bereitet.

Für Olestring einfach Unicode-String mit SysAllocStr_ bearbeiten.

//Nachtrag:
Wie kann ich diese Abhängigkeiten lösen:

---------------------------
PureBasic - Linker error
---------------------------
POLINK: error: Unresolved external symbol '___ftoll'.

POLINK: error: Unresolved external symbol '___assert'.

POLINK: error: Unresolved external symbol '__fltused'.

POLINK: fatal error: 3 unresolved external(s).

Dann wäre ich einen Schritt weiter

[ts-soft]

Update: Version 1.2

Include/Import Datei hinzugefügt, für Unicode-Support.
Source und Project-Dateien für Dev-C++ hinzugefügt.

2 einfache Beispiele angepaßt, laufen wahlweise Uni/Ansi.

Habe nur die Basisfunktionen importiert, wer es erweitern möchte,
bitteschön, wer das dann noch zur Verfügung stellt, noch besser

[mk-soft]

@ts-soft

habe die gleichen Schwierigkeiten mit den Abhängigkeit von
- ole32.lib
- oleaut32.lib
- uuid.lib

nach Import blieben bei mir noch zwei Abhängigkeiten über.

Assert und tfoll.

Vielleicht bekommen wir noch eine LIB hin wo die Abhängigkeiten aufgelöst sind.

FF

[mk-soft]

UPDATE Variant Helper

Der DispHelper funktioniert soweit sehr Gut.

Es gibt aber Probleme Werte zu übergeben die nicht von Type LONG sind.
Der PB-Compiler für eine Formatumwandlung durch.
Es gibt leider keinen Type VOID oder ANY bei PB

Man kann aber die Parameter als Type Variant "%v" übergeben.

Hier die Hilfsfunktionen um mit Variant einfach arbeiten zu können
und ein Beispiel mit Excel.

Code: VariantHelper2.pb

Code: Alles auswählen

;-TOP
; Kommentar     : Variant Helper
; Author        : mk-soft
; Second Author : 
; Datei         : VariantHelper_Include.pb
; Version       : 2.03
; Erstellt      : 30.04.2007
; Geändert      :
; 
; 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

; ***************************************************************************************
; 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)
  
  Protected date.d
  
  date = pbDate / 86400.0 + 25569.0
  ProcedureReturn date
  
EndProcedure

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

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

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

Procedure.s VT_STR(*Var.Variant)

  Shared vhLastError.l

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

  Shared vhLastError.l
  
  Protected result.l

  If *Var
    Select *Var\vt
      Case #VT_BOOL
        result = *Var\boolVal
      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
         *Var\dblVal
      Default
        vhLastError = $80020008
        result = 0
    EndSelect
    If result
      ProcedureReturn #True
    Else
      ProcedureReturn #False
    EndIf
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.b VT_BYTE(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.w VT_WORD(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.l VT_LONG(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn Val(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.q VT_QUAD(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn ValQ(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.f VT_FLOAT(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn ValF(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.d VT_DOUBLE(*Var.Variant)

  Shared vhLastError.l
  
  If *Var
    Select *Var\vt
      Case #VT_BOOL
        ProcedureReturn *Var\boolVal
      Case #VT_I1, #VT_UI1
        ProcedureReturn *Var\bVal
      Case #VT_I2, #VT_UI2
        ProcedureReturn *Var\iVal
      Case #VT_I4, #VT_UI4
        ProcedureReturn *Var\lVal
      Case #VT_I8, #VT_UI8
        ProcedureReturn *Var\llVal
      Case #VT_R4
        ProcedureReturn *Var\fltVal
      Case #VT_R8
        ProcedureReturn *Var\dblVal
      Case #VT_BSTR
        ProcedureReturn ValD(PeekS(*Var\bstrVal, #PB_Any, #PB_Unicode))
          
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.l VT_DATE(*Var.Variant) ; PB-Datum

  Shared vhLastError.l
  
  Protected pbDate
  
  If *Var
    Select *Var\vt
      Case #VT_DATE
        pbDate = (*Var\dblVal  - 25569.0) * 86400.0
        ProcedureReturn pbDate
      Default
        vhLastError = $80020008
        ProcedureReturn 0
      
    EndSelect
  EndIf
EndProcedure
  
; ***************************************************************************************

Procedure.l GetVariantSafeArrayCount(*Var.Variant)
  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)
  Protected result.l, *array.safearray
  If *Var
    result = *Var\vt & $1FFF
  Else
    result = 0
  EndIf
  ProcedureReturn result
EndProcedure

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

Procedure.l GetVariantSafeArray(*Var.Variant)
  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

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

Macro V_EMPTY(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_EMPTY
  arg\llVal = 0
EndMacro

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

Macro V_NULL(Arg)
  VariantClear_(Arg)
  Arg\vt = #VT_NULL
  arg\bstrVal
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

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

Code: Excel.pb

Code: Alles auswählen

; example by Kiffi

EnableExplicit

IncludeFile "Varianthelper2.pb"

Define.l ExcelApp, Workbook

dhToggleExceptions(#True)

ExcelApp = dhCreateObject("Excel.Application")

Define.variant wert1, wert2, wert3, result, text

V_DOUBLE(wert1) = 3.33333333333333
V_DOUBLE(wert2) = 4.44444444444444
V_DOUBLE(wert3) = 5.55555555555555
V_STR(text) = T_BSTR("Hallo Welt")

If ExcelApp
  
  dhPutValue(ExcelApp, ".Visible = %b", #True)
  
  dhGetValue("%o", @Workbook, ExcelApp, ".Workbooks.Add")
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 1, @"Feel")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 2, 1, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 3, 1, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 4, 1, @"Power")
  
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 2, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 3, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 4, @"Power")

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 2, wert1)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 3, wert2)
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 2, 4, wert3)

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %v", 3, 2, text)

  dhGetValue("%v", @result, ExcelApp, "Cells(%d, %d).Value", 2, 2)

  MessageRequester("PureDispHelper-ExcelDemo", "Result Cells(2,2): " + VT_STR(result))

  MessageRequester("PureDispHelper-ExcelDemo", "Click OK to close Excel")
  
  dhCallMethod(ExcelApp, ".Quit")
  
  dhReleaseObject(Workbook) : Workbook = 0
  dhReleaseObject(ExcelApp) : ExcelApp = 0
  
Else
  
  MessageRequester("PureDispHelper-ExcelDemo", "Couldn't create Excel-Object")
  
EndIf

FF