Re: PB DLL mit Rückgabe String in Office 64-Bit verwenden
Verfasst: 14.04.2020 12:27
@mk-soft
Ich verstehe deinen Code-Ausschnitt nicht zu recht.
Ich verstehe deinen Code-Ausschnitt nicht zu recht.
Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
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
Code: Alles auswählen
ProcedureDLL.i HoleString()
Protected Zeichenkette.s
Static r1
Zeichenkette = "Test-Zeichenkette"
r1 = SysAllocString_(Zeichenkette)
ProecureReturn r1
EndProcedure Code: Alles auswählen
Private Declare PtrSafe HoleString Lib "Test.dll" () As StringCode: Alles auswählen
Dim Zeichenkette As String
Zeichenkette = HoleString()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
Code: Alles auswählen
Dim Result As Variant
Result = HoleString()Code: Alles auswählen
ProcedureDLL.l Test(*Value.integer)
Protected pbString.s = GetString(*Value)
...
EndProcedureCode: 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
EndProcedureCode: Alles auswählen
Dim sText As String
sText = Text1.Text
Result = Test(sText)Code: Alles auswählen
Result = PeekS(@*vbText\text, *vbText\len, Format)Code: Alles auswählen
sText = "" & Text1.TextCode: Alles auswählen
sText = ""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 ""
EndProcedureCode: 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