PB DLL mit Rückgabe String in Office 64-Bit verwenden

[TC_O]

@mk-soft
Ich verstehe deinen Code-Ausschnitt nicht zu recht.

[mk-soft]

Bei VBA ist Type String ein "BSTR"

Mit der der API SysAllocString_(String) wird ein BSTR erstellt.

Link: https://renenyffenegger.ch/notes/develo ... ring/index

Sollte somit gehen

P.S.

Code: Alles auswählen

; Stringübergabe von PureBasic nach VBA
ProcedureDLL.i SetString(*StringByVal)
  Static r1
  Protected text.s
  
  text = PeekS(*StringByVal)
  SysFreeString_(*StringByVal)
  text = ReverseString(text)
  
; Wird wohl nicht gebraucht
;   If r1
;     SysFreeString_(r1)
;   EndIf
  
  r1 = SysAllocString_(text)
  ProcedureReturn r1
EndProcedure

MS: https://docs.microsoft.com/de-de/office ... s-in-excel

[TC_O]

Ok.. wir kommen der Sache schon näher.
Die Rückgabe eines Strings aus PB nach 64-Bit VBA funktioniert noch nicht so ganz korrekt.

Beispiel:

Code: Alles auswählen

ProcedureDLL.i HoleString()
  Protected Zeichenkette.s 
  Static r1

  Zeichenkette = "Test-Zeichenkette"
  r1 = SysAllocString_(Zeichenkette)
  ProecureReturn r1
EndProcedure  

Deklaration in 64-Bit Access / VBA:

Code: Alles auswählen

Private Declare PtrSafe HoleString Lib "Test.dll" () As String

Aufruf in VBA:

Code: Alles auswählen

Dim Zeichenkette As String
Zeichenkette = HoleString()

Das Ergebnis sieht jetzt so aus: T e s t -
Also jeweils ein 0-Ascii Zeichen zwischen den Buchstaben

[mk-soft]

Alles komisch. Habe lange nichts mehr damit gemacht, aber früher (x86) ging es.

Andere Lösung über Variant (nach MSDN)

Code: Alles auswählen

; Stringübergabe von PureBasic nach VBA
ProcedureDLL.i HoleString(*varg.variant)
  Protected text.s
  
  text = "Hello World!"
  VariantClear_(*varg)
  *varg\vt = #VT_BSTR
  *varg\bstrVal = SysAllocString_(text)
  ProcedureReturn Len(text)
  
EndProcedure

Code: Alles auswählen

Private Declare PtrSafe HoleString Lib "Test.dll" (ByRef Result As Variant) As Integer

Dim Result As Variant

Kann ich aber leider nicht testen

[TC_O]

Danke für deine Hilfe, aber das funktioniert auch nicht.
Es wird zwar die korrekte Länge zurückgegeben, aber der Übergabeparameter bleibt leer (Leerstring).

[TC_O]

Stop!! Kommando zurück!
Es funktioniert doch; hatte aus Versehen "Dim Result As String" statt " ... As Variant" in VBA stehen.

Gibt es auch die Möglichkeit, dass die Zeichenkette als Funktionswert zurückgegeben wird?
Also bspw. so:

Code: Alles auswählen

Dim Result As Variant
Result = HoleString()

[mk-soft]

Nein, so nicht. (nach MSDN)

Variant hat aber den Vorteil das alles mögliche in beiden Richtungen übertragen werden kann. Sogar ganze Arrays.

Ein einfachen VariantHelper habe ich hier versteckt...
Link: ActiveScript

[TC_O]

Hallo mk-soft,

vielen herzlichen Dank!
Du hast mir sehr geholfen.

[TC_O]

Hallo mk-soft,

hast du evtl. noch eine Idee / Lösung für mich?
Diesmal handelt es sich um die String-Übergabe von VB6/VBA nach PureBasic.

Code: Alles auswählen

ProcedureDLL.l Test(*Value.integer)
  Protected pbString.s = GetString(*Value)
  ...
EndProcedure

Code: Alles auswählen

; Stringübergabe von VB6/VBA nach PureBasic
Procedure.s GetString(*Var.integer, Format=#PB_Ascii)
  Protected *vbText.vbString, Result.s
  *vbText = *Var\i - 4
  Result = PeekS(@*vbText\text, *vbText\len, Format)
  ProcedureReturn Result  
EndProcedure

Wenn ich hier einen Leer-String übergebe, der aus einer VB.TextBox stammt ...

Code: Alles auswählen

Dim sText As String
sText = Text1.Text
Result = Test(sText)

... stürzt mir PB ab - und zwar genau an der Stelle:

Code: Alles auswählen

Result = PeekS(@*vbText\text, *vbText\len, Format)

ABER NUR: wenn der Leerstring DIREKT aus einer TextBox von VB stammt.
Wenn ich schreibe:

Code: Alles auswählen

sText = "" & Text1.Text

oder auch

Code: Alles auswählen

sText = ""

funktioniert es, obwohl "sText" in diesem Fall auch ein Leerstring ist.

Ein OnError hilft hier leider auch nichts:

Code: Alles auswählen

Procedure.s GetString(*Var.integer, Format=#PB_Ascii)
  Protected *vbText.vbString, Result.s
  
  OnErrorGoto(?ErrHandler)
  *vbText = *Var\i - 4
  Result = PeekS(@*vbText\text, *vbText\len, Format)
  ProcedureReturn Result  
  
ErrHandler:  
    ProcedureReturn ""
EndProcedure

[mk-soft]

Variant ist dein Freund.

Update Beispiel mit Double Value

Code: Alles auswählen

ProcedureDLL.l TestString(*Value.Variant)
  Protected r1
  Protected pbString.s, dblVal.d
  If *Value = 0
    Debug "Invalid Pointer"
    ProcedureReturn 0
  EndIf
  
  Select *Value\vt
    Case #VT_EMPTY
      pbString = ""
      Debug "Value is Empty"
      ;TODO
      r1 = 0
    Case #VT_BSTR
      pbString = PeekS(*Value\bstrVal, -1, #PB_Unicode)
      ;TODO
      r1 = Len(pbString)
    Case #VT_R8
      dblVal = *Value\dblVal
      ;TODO
      r1 = dblVal
    Default
      Debug "Value is not valid. VarType = " + *Value\vt 
      ;TODO
      r1 = 0
  EndSelect
  
  ProcedureReturn r1
  
EndProcedure

Private Declare PtrSafe TestString Lib "Test.dll" (ByRef Value As Variant) As Integer