如何在VBA(Excel Visual Basic)中从DLL接收“char *d”？

Question

现在我正在尝试获取一个 char 字符串作为下面的 c 函数。

这是DLL的C函数，

char _stdcall *fmt_hex(long long num, int nbits, char *d)
{
    sprintf(d, "0x%0*llX", (nbits - 1) / 4 + 1, num);
    return (d);
}

以下是Excel VBA函数。

Option Explicit

Private Declare PtrSafe Function pll_dll Lib "F:\work\pll_dll\x64\Debug\pll_dll.dll" (ByVal num As LongLong, ByVal nbits As Integer, ByRef d As String)

Dim d As String

Sub useSquareInVBA()
    
    Cells(4, 4).Text = pll_dll(3, 4, d)

End Sub

但是当我运行此代码时，程序停止了。 你能告诉我我该怎么做才能解决这个问题吗？

更新2

当我运行这段代码时 “C”

#include <stdio.h>
#include <stdlib.h>
#include <math.h>

double _stdcall pll_dll(double* datain0, double* datain1, double* dataout0, double* dataout1,  char * str)
{
    dataout0[0] = datain0[0] + 10;
    dataout1[0] = datain1[0] + 10;
    
    str ="c";
    
    return 0;
}

“VBA”

Option Explicit

Private Declare PtrSafe Function pll_dll Lib "F:\work\pll_dll\x64\Debug\pll_dll.dll" _
(ByRef x_in As Double, ByRef y_in As Double, ByRef x_out As Double, ByRef y_out As Double, ByRef str As String) As Double

Dim Error As Integer

Dim d1 As Double
Dim d2 As Double
Dim d3 As Double
Dim d4 As Double
Dim sometext As String


Function pll_dll_excel(data1 As Double, data2 As Double, data3 As Double, data4 As Double, text As String) As Double

pll_dll_excel = pll_dll(data1, data2, data3, data4, text)
    
End Function

Sub useSquareInVBA()
    MsgBox pll_dll_excel(3, 4, d1, d2, sometext)
    Cells(5, 5).Value = d1
    Cells(6, 6).Value = d2
    Cells(7, 7).Value = sometext
End Sub

不，程序停止，但某些文本始终为空“”值。

你能帮我吗？

更新3

我已经检查过这里的文章。

如何从 DLL 返回未知大小的字符串到 Visual Basic

当我关注这篇文章时，我意识到这不是“C”。 我如何成为“C”？

Answer 1

我遇到了类似的问题，这篇文章是最相关的搜索结果。

我没有给出问题的直接解决方案（归功于GSerg提出了正确的方法），而是发布了我如何实现接收作为参考传递的字符数组的通用版本：

C 函数（共享库）：

int func(int a, double b, char *result) {
    ...
    result[0] = 'A';
    result[1] = 'B';
    result[2] = '\0';
    return EXIT_SUCCESS;
}

VBA：

Option Explicit

' Import DLL function
Private Declare PtrSafe Function func Lib "C:\path\to\c-shared-library.dll" _
    (ByVal a As Integer, ByVal b As Double, ByVal result As String) As Integer

' Functions for use by Excel - DLL functions cannot be directly used
Function getResult(ByVal a As Integer, ByVal b As Double) As String
    Dim status As Integer
    Dim result As String
    result = Space$(2)
    status = func(a, b, result)
    If status = 0 Then getResult = result Else Err.Raise 1000, "Error", "Failed to get result"
End Function

就我而言，结果始终是两个字符数组，但我认为上述方法可以进行相应修改。

Answer 2

经过大量试验和错误，这适用于常规 ascii 字符串。 如果您使用宽字符串，您可能需要使用 BSTR 或类似的其他东西。

Option Explicit

Declare PtrSafe Function lstrlenA Lib "kernel32" (ByVal lpString As LongPtr) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As String, ByVal Source As LongPtr, ByVal length As Long)

Private Declare PtrSafe Function api_get_message Lib "C:\tools\my-api\bin\mydll.dll" () As LongPtr


Function PtrToStringAnsi(ByVal lpString As LongPtr) As String
    Dim length As Long
    length = lstrlenA(lpString)  ' Get the length of the string

    If length > 0 Then
        PtrToStringAnsi = String(length, vbNullChar)  ' Allocate space
        CopyMemory PtrToStringAnsi, lpString, length  ' Copy the memory
    End If
End Function

Public Function API_GetMessage() As String
    Dim messagePtr As LongPtr
    Dim message As String
    messagePtr = api_get_message()
    
    If messagePtr <> 0 Then
        message = PtrToStringAnsi(messagePtr)
        message = Replace(message, "\n", vbNewLine)
        API_GetMessage = message
    Else
        API_GetMessage = "No message available."
    End If
End Function