FreeBasic写DLL给VB6调用(直接用API创建和修改VB字符串方法)
写DLL给VB用，不是什么难题，但我们要做到字符变量，从FreeBasic到VB6，从VB6到FreeBasic，在VB6端无痛使用，那就要费点功夫了。
VB6代码：直接写 String
Private Declare Function GetStr Lib "FBtoVB.dll" Alias "GETSTR@0" () As String '返回字符串
FreeBasic和VB6的字符变量的内存格式是不同的，因此我们要在FreeBasic的地方搞个转换函数。
FB代码：
'=====================关键函数================
'--------------------------------------------------------------------------
Function BStrToString(nBStr As BStr) As String '将VB里的字符串转换为FB里使用的字符串
Dim L As Long =Peek(Long,Cast(UInteger,nBStr) -4)
Dim ss As String = String(L,0)
memcpy StrPtr(ss),nBStr,L
Function = ss
End Function
'--------------------------------------------------------------------------
Function StringToBStr(nStr As String) As BStr '将FB里的字符串转换为VB里使用的字符串
Function = SysAllocString( Cast(WString Ptr, StrPtr(nStr) ) ) '伪造 VB 字符串
End Function
'--------------------------------------------------------------------------
Function BStrToStringW(nBStr As BStr) As String '将VB里的字符串转换为FB里使用的字符串,用于字符数组
'注意，假如字符串里包含 chr(0) 将会在此被截断
Dim ss As String
If nBStr <> 0 Then
ss = *CPtr(WString Ptr, nBStr)
End If
Function = ss
End Function
'--------------------------------------------------------------------------
Sub SetBstr(ByRef nBStr As BStr,nStr As String ) ' 修改VB字符串,用于字符数组
'必须是 ByRef ，不然修改不了nBStr，默认是 ByVal
If nBStr=0 Then
'无字符
nBStr=SysAllocString(nStr) '新增字符串
Else
'有字符
SysReAllocString(@nBStr,nStr) '修改字符串
End If
End Sub下面是FB里的导出函数代码，测试例题用：
'--------------------------------------------------------------------------
Function JiaFa(ByVal a As Long ,ByVal b As Long ) As Long Export '参数全是数字例题
'ByVal 由于VB和FB默认表达不同，避免发生不一至的情况，前面的必须加个，和VB那边一样。
Return a+b
End Function
'--------------------------------------------------------------------------
Sub Dizi(ByRef a As Long ) Export'以地址传来参数
a=666
End Sub
'--------------------------------------------------------------------------
Sub LongShuZhu(ByVal a As Long Ptr,ByVal b As Long) Export '处理VB的数组
'FB 和 VB 之间，处理数组的方式不同，因此无法直接传数组
'只能以指针的方式处理
For i As Long =0 To b-1
a[i]=Rnd *10000
Next
End Sub
'--------------------------------------------------------------------------
Function GetStr() As BStr Export '返回字符例题
'直接将字符返回到VB里，由于VB与FB的字符内存不同，必须用转换
Dim a As String
a="返dd回dd字dd符dd例dd题dd"
Return StringToBStr(a)
End Function
'--------------------------------------------------------------------------
Function LenDuoStr(ByVal a As BStr ,ByVal b As BStr ,ByVal c As BStr ,ByVal d As BStr ) As Long Export '处理VB发来的字符例题
'由于VB与FB的字符内存不同，必须用转换
AfxMsg BStrToString(a)
Return Len(BStrToString(b) & BStrToString(c) & BStrToString(d))
End Function
'--------------------------------------------------------------------------
Sub StrShuZhu(ByVal a As BStr Ptr ,ByVal b As Long) Export '处理VB的数组
'FB 和 VB 之间，处理数组的方式不同，因此无法直接传数组
'只能以指针的方式处理
Dim bb As String
For i As Long =0 To b-1
bb=BStrToStringW(a[i])
If Len(bb) Then AfxMsg bb,"读取字符"
SetBstr a[i],Str(Rnd *999 )
Next
End Sub再来看VB6这边的DLL声明例题：
'==============处理数字变量===================
Private Declare Function JiaFa Lib "FBtoVB.dll" Alias "JIAFA@8" (ByVal a As Long, ByVal b As Long) As Long '数字例题
'Alias 里的全部是大写，不管FB里如何，一律大写
'@8 标准符号，是为了兼容C语言默认带的， 表示有2个参数，无参数是 @0 ,1个参数为 4 ，几个就 几个*4
Private Declare Sub Dizi Lib "FBtoVB.dll" Alias "DIZI@4" (ByRef a As Long) '传地址数字
'以地址方式传数字参数给FB，FB那里可以修改参数值了
Private Declare Sub LongShuZhu Lib "FBtoVB.dll" Alias "LONGSHUZHU@8" (ByVal 数组地址 As Long, ByVal 数组长度 As Long) '数组例题
'FB 和 VB 之间，处理数组的方式不同，因此无法直接传数组，数组长度是为了FB那边知道长度，不然超边界了软件会崩溃的。
'其它数字和Long 一样处理，对应FB那边类型名是
'VB类型：Byte Integer Single Double
'FB类型：UByte Short Single Double
'==============处理字符串变量===================
Private Declare Function GetStr Lib "FBtoVB.dll" Alias "GETSTR@0" () As String '返回字符串
'从FB里传来的字符，VB这边直接使用，无障碍。
Private Declare Function LenDuoStr Lib "FBtoVB.dll" Alias "LENDUOSTR@16" (ByVal a As String, ByVal b As String, ByVal c As String, ByVal d As String) As Long '传字符串给FB
'传VB的字符到FB那边使用。注意，FB那边中文算2个，英文算1个。
Private Declare Sub StrShuZhu Lib "FBtoVB.dll" Alias "STRSHUZHU@8" (ByVal 数组地址 As Long, ByVal 数组长度 As Long) '数组例题
'FB 和 VB 之间，处理数组的方式不同，因此无法直接传数组，数组长度是为了FB那边知道长度，不然超边界了软件会崩溃的。
'还增加了数组的操作方法，下面是VB6调用DLL例题
Private Sub Form_Load()
ChDrive App.Path '必须先设置软件文件夹，否则，万一不在EXE文件夹开启软件，会发生找不到DLL文件的错误
ChDir App.Path
End Sub
Private Sub Command4_Click()
Dim a As Long
a = 100
Dizi a
Debug.Print a
End Sub
Private Sub Command5_Click()
Dim a(10) As Long, i As Long
LongShuZhu VarPtr(a(0)), UBound(a) + 1
For i = 0 To 10
Debug.Print a(i),
Next
Debug.Print
End Sub
Private Sub Command6_Click()
Dim a(10) As String, i As Long
a(0) = "dd"
a(2) = ""
StrShuZhu VarPtr(a(0)), UBound(a) + 1
For i = 0 To 10
Debug.Print a(i),
Next
Debug.Print
End Sub
Private Sub Command1_Click()
Label1 = JiaFa(10, 20)
End Sub
Private Sub Command2_Click()
Dim b As String
b = GetStr
Label1 = b
Debug.Print b, Len(b)
End Sub
Private Sub Command3_Click()
Dim a As String
a = "w我o"
Label1 = LenDuoStr(a, "p单位c", "", "ddd")
End Sub