前几天刚刚发了一篇 pb调用.net组件的实践
但是遇到了汉字乱吗的问题。经过测试，在pb9中调用不会出现乱码。但是由于原来的项目是用pb7写的。全部转移到pb9上的工作量是很大的。所以不能离开pb7的环境。最后采用了汉字转换成byte数据的方式解决了这个问题。
类代码：
Imports
System.Math
<
ComClass(CodeQuery.ClassId, CodeQuery.InterfaceId, CodeQuery.EventsId)
>
_
Public
Class CodeQuery
Class CodeQuery
COM GUID#Region "COM GUID"
' 这些 GUID 提供此类的 COM 标识
' 及其 COM 接口。若更改它们，则现有的
' 客户端将不再能访问此类。
Public Const ClassId As String = "225d6048-672b-42c0-a623-6688596592b0"
Public Const InterfaceId As String = "4812e4bd-0aa8-4716-a306-6d774d7cdc72"
Public Const EventsId As String = "a47bfff0-24ae-45ee-809a-2664efcd1777"
#End Region
' 可创建的 COM 类必须具有一个不带参数的 Public Sub New()
' 否则， 将不会在
' COM 注册表中注册此类，且无法通过
' CreateObject 创建此类。
Public Sub New()Sub New()
MyBase.New()
End Sub
Public Function getCodeList()Function getCodeList() As SortedList
Dim sl As SortedList
Dim crc As New CrcDbConnection.CrcDbConnection
crc.ConnDatabase()
sl = crc.GetCodeSortList
Return sl
End Function
''' <summary>
''' 返回字符串
''' </summary>
''' <returns>返回拼接成字符串的编码信息</returns>
''' <remarks>key;value|key;value|……</remarks>
Public Function getCodeString()Function getCodeString() As String
Dim sl As SortedList
sl = getCodeList()
Dim strCode As New System.Text.StringBuilder
If Not sl Is Nothing Then
Dim sItem As System.Collections.DictionaryEntry
For Each sItem In sl
strCode.Append(sItem.Key)
strCode.Append(";")
strCode.Append(sItem.Value)
strCode.Append("|")
Next
End If
Return IIf(strCode.Length > 0, strCode.Remove(strCode.Length - 1, 1).ToString, "")
End Function
''' <summary>
'''返回数组
''' </summary>
''' <returns>返回生成的数组</returns>
''' <remarks>二维数组储存key/value对</remarks>
Public Function getCodeArray()Function getCodeArray() As String(,)
Dim arrCode(,) As String
Dim i As Long = 0
Dim sl As SortedList
sl = getCodeList()
ReDim arrCode(sl.Count, 2)
If Not sl Is Nothing Then
Dim sItem As System.Collections.DictionaryEntry
For Each sItem In sl
arrCode(i, 0) = sItem.Key
arrCode(i, 1) = sItem.Value
i += 1
Next
End If
Return arrCode
End Function
''' <summary>
''' 返回编码
''' </summary>
''' <returns>返回选择编码</returns>
''' <remarks></remarks>
Public Function getCode()Function getCode() As String
Dim arrCode As String = ""
Dim i As Long = 0
Dim sl As SortedList
sl = getCodeList()
If Not sl Is Nothing Then
arrCode = sl.GetByIndex(sl.IndexOfKey("代码"))
End If
Return arrCode
End Function
''' <summary>
''' 返回asc
''' </summary>
''' <returns>返回asc编码串</returns>
''' <remarks></remarks>
Public Function getCodeStringASC()Function getCodeStringASC() As String
Dim sl As SortedList
sl = getCodeList()
Dim by As Byte()
Dim i As Long
Dim strCode As New System.Text.StringBuilder
If Not sl Is Nothing Then
Dim sItem As System.Collections.DictionaryEntry
For Each sItem In sl
by = System.Text.Encoding.Default.GetBytes(sItem.Key)
For i = 0 To by.GetUpperBound(0)
strCode.Append(by(i).ToString())
strCode.Append(":")
Next
strCode.Remove(strCode.Length - 1, 1)
strCode.Append(";")
by = System.Text.Encoding.Default.GetBytes(sItem.Value)
For i = 0 To by.GetUpperBound(0)
strCode.Append(by(i).ToString())
strCode.Append(":")
Next
strCode.Remove(strCode.Length - 1, 1)
strCode.Append("|")
Next
strCode.Remove(strCode.Length - 1, 1)
End If
Return strCode.ToString
End Function
''' <summary>
'''返回asc数组
''' </summary>
''' <returns>返回生成的asc数组</returns>
''' <remarks>二维数组储存key/value对</remarks>
Public Function getCodeArrayAsc()Function getCodeArrayAsc() As String(,)
Dim arrCode(,) As String
Dim i As Long = 0
Dim sl As SortedList
sl = getCodeList()
Dim by As Byte()
Dim j As Long
Dim strCode As New System.Text.StringBuilder
ReDim arrCode(sl.Count, 2)
If Not sl Is Nothing Then
Dim sItem As System.Collections.DictionaryEntry
For Each sItem In sl
by = System.Text.Encoding.Default.GetBytes(sItem.Key)
For j = 0 To by.GetUpperBound(0)
strCode.Append(by(j).ToString())
strCode.Append(":")
Next
If strCode.Length > 0 Then strCode.Remove(strCode.Length - 1, 1)
arrCode(i, 0) = strCode.ToString
strCode.Remove(0, strCode.Length)
by = System.Text.Encoding.Default.GetBytes(sItem.Value)
For j = 0 To by.GetUpperBound(0)
strCode.Append(by(j).ToString())
strCode.Append(":")
Next
If strCode.Length > 0 Then strCode.Remove(strCode.Length - 1, 1)
arrCode(i, 1) = strCode.ToString
strCode.Remove(0, strCode.Length)
i += 1
Next
End If
Return arrCode
End Function
End Class
请注意其中的
Public Function getCodeStringASC() As String 返回字符串
和
Public Function getCodeArrayAsc() As String(,) 返回数组
在 pb7 中的代码：
split 函数 public function long split (string str1, string sep, ref string arrR[])
long lPos
=
1
long
lFind
string
arrNull[]
if
isnull
(str1)
or
isnull
(sep)
then
setnull(lPos)
return lPos
end
if
arrR[] =
arrNull[]
lPos =
1
lFind =
pos(upper(str1), upper(sep))
do
while
lFind
>
0
arrR[lPos] =
left
(str1,lFind
-
1
)
str1 =
right
(str1,
len
(str1)
-
lFind
-
len
(sep)
+
1
)
lFind =
pos(upper(str1), upper(sep))
lPos =
lPos
+
1
loop
arrR[lPos] =
str1
return lPos
getcode1 函数 public function getcode1(ref string arrKey[], ref string arrValue[]) returns (none)
字符串方式
int intValue
oleobject objOle
objOle = create OLEObject
intValue = objOle.connecttonewobject(
"
codeforcom.CodeQuery
"
)
if intValue
=
0
then
string v
int i,j,k
v = objOle.getcodestringAsc()
string oItem[]
string oKey[]
string oAsc[]
string key
split (v,
"
|
"
,ref oItem)
for i
=
1
to
upperbound(oItem)
split (oItem[i],
"
;
"
,ref oKey)
for j
=
1
to
upperbound(oKey)
split (oKey[j],
"
:
"
,ref oAsc)
key = ""
for k
=
1
to
upperbound(oAsc)
key = key
+
char(
long
(oAsc[k]))
next
if j
=
1
then
arrKey[i] = key
else
arrValue[i] = key
end
if
next
next
end
if
getcode2 函数 public function getcode2(ref string arrKey[], ref string arrValue[]) returns (none)
数组方式
int intValue
oleobject objOle
objOle = create OLEObject
intValue = objOle.connecttonewobject( "
codeforcom.CodeQuery
"
)
if intValue =
0
then
int i,j,k
string arrReturn[ 50
,
2
]
string oAsc[]
string v,key
arrReturn = objOle.getCodeArrayAsc()
for i =
1
to
upperbound(arrReturn,
1
)
for j =
1
to
upperbound(arrReturn,
2
)
split (arrReturn[i,j], "
:
"
,ref oAsc)
key = ""
for k =
1
to
upperbound(oAsc)
key = key +
char(
long
(oAsc[k]))
next
if j =
1
then
arrKey[i] = key
else
arrValue[i] = key
end if
next
next
mle_1.text = v
end if
调用代码（字符串方式）：
string oKey[]
string oValue[]
long i
string r
getcode1(ref oKey,ref oValue)
for i = 1
to
upperbound(oKey)
r = r +
"
~r~n
"
+
oKey[i]
+
"
--
"
+
oValue[i]
next
mle_1.text = r
调用代码（数组方式）：
string oKey[]
string oValue[]
long i
string r
getcode2(ref oKey,ref oValue)
for i = 1
to
upperbound(oKey)
r = r + "
~r~n
"
+
oKey[i]
+
"
===
"
+
oValue[i]
next
mle_2.text = r
我们会发现数组方式比较特别，他会把数组中的数据，按顺序在写在返回的数组的第一行，第一行写满了，才在第二行写，一次类推，由于pb7不支持动态二维数据，所以返回的数据行列上并不对应。所以需要在基础类中添加标界符才行。有些麻烦。
另外，我也在vb.net中调用了这个封装类，测试的代码如下：
Public Class Form1 Class Form1
Private Sub Button1_Click()Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim u As New CodeForCom.CodeQuery
Dim t(,) As String
t = u.getCodeArrayAsc
Dim i As Long
Dim j As Long
Dim w As String = ""
Dim ll() As Byte
Dim uu() As String
Dim q As String
Dim k As Long
For i = 0 To t.GetUpperBound(0)
For j = 0 To t.GetUpperBound(1)
q = t(i, j)
If Not q Is Nothing Then
uu = q.Split(":")
ReDim ll(uu.GetUpperBound(0))
If uu.GetUpperBound(0) > 0 Then
For k = 0 To uu.GetUpperBound(0)
ll(k) = Convert.ToByte(uu(k))
Next
t(i, j) = System.Text.Encoding.Default.GetString(ll)
End If
End If
Next
Next
w = ""
For i = 0 To t.GetUpperBound(0)
For j = 0 To t.GetUpperBound(1)
w = w & t(i, j) & vbCrLf
Next
Next
MsgBox(w)
End Sub
End Class