VB在DLL定义数组不可以赋值的吗

Question

Option ExplicitPrivate Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( _
     ByVal hwnd As Long, _
     ByVal lpText As String, _
     ByVal lpCaption As String, _
     ByVal wType As Long) As Long
Private Type Node        '结点类型
       p(8) As Long      '结点状态表
       Spac As Long      '空格位置
       last As Long      '父结点标识
       u(8) As Long      '结点数码位置表
       f As Long         '估价函数
       g As Long
       h As Long
End Type
Dim Nodes() As Node      '空队列
Dim EndNode As Node      '目标结点
Dim Temp As Node         '临时结点
Dim head As Long         '队列头指针
Dim tail As Long         '队列尾指针
Dim dir(3) As Long       '空格移动增量
Dim s As String          '字符串变量
Dim dis(81) As Long      '两个结点同一数码的相对距离表
Dim v(8) As Long         '目标结点数码位置表
Dim counts&, MoveStep&, num(8), tmp$
Dim Cchu As String
Dim CZi As String
Public Text2a(17) As Long
Dim Text1a As String
'保存结点状态，准备输出
Private Sub DispNode(Temp As Node)
Dim i&
counts = counts + 1
For i = 0 To 8
    If Temp.p(i) = 0 Then
        Cchu = Cchu & i & ","
    End If
    
    If i = 8 Then
    s = s + CStr(Temp.p(i))
    Else
    s = s + CStr(Temp.p(i)) & ","
    End If
    If (i + 1) Mod 3 = 0 Then s = s & vbCrLf
Nexts = s & vbCrLf
End Sub'确定搜索路径
Private Sub DispPath(ByVal k As Long)
k = Nodes(k).last
If k = -1 Then Exit Sub
DispPath k
DispNode Nodes(k)
End Sub'移动空格
Private Function SpacMove(T As Node, ByVal k As Long) As Boolean
Dim oldspac&
With T
    '如果移出边界返回False
    If k = 0 Then If .Spac < 3 Then Exit Function
    If k = 1 Then If .Spac Mod 3 = 0 Then Exit Function
    If k = 2 Then If .Spac Mod 3 = 2 Then Exit Function
    If k = 3 Then If .Spac > 5 Then Exit Function
   '记录原来的空格位置
   oldspac = .Spac
   '新空格位置
   .Spac = .Spac + dir(k)
   '移动空格（交换数码）
   .p(oldspac) = .p(.Spac)
  
   .p(.Spac) = 0
   '交换数码的位置
   .u(0) = .Spac
   .u(.p(oldspac)) = oldspac
   '返回True
   SpacMove = True
End With
End Function'判断两个结点是否相同
Private Function Equal(T1 As Node, T2 As Node) As Boolean
Dim i&
Equal = True
For i = 0 To 8
    If T1.p(i) <> T2.p(i) Then
        Equal = False
        Exit For
    End If
Next
End Function'查找重复结点序号
Private Function Rept(T As Node) As Long
Dim i&
For i = 0 To tail
    If Equal(T, Nodes(i)) Then Exit For
Next
Rept = i
End Function'计算估价函数f
Private Sub Calcuf(Temp As Node)
Dim i&
With Temp
    .h = 0
    For i = 1 To 8
        .h = .h + dis(.u(i) * 9 + v(i))
    Next
    .g = .g + 1
    .f = .g + .h
End With
End Sub'将结点按f大小插入队列（开启列表）
Private Sub Sortf()
Dim i&, j&
ReDim Preserve Nodes(tail + 1)
For i = head + 1 To tail
    If Temp.f < Nodes(i).f Then Exit For
Next
For j = tail To i Step -1
    Nodes(j + 1) = Nodes(j)
Next
Nodes(i) = Temp
End Sub'A*搜索法
Private Sub Astar()
Dim i&, k&
'队列头、尾指针指向队列头（初始结点）
head = 0
tail = 0
'计算初始结点的f
Calcuf Nodes(0)
'队列不空则循环
Do While head <= tail
    Text1a = head
    DoEvents
    '尝试向上、左、右、下移动空格
    For i = 0 To 3
    
        '取队列头结点
        Temp = Nodes(head)
        '如果是目标结点
        If Equal(Temp, EndNode) Then
            '确定搜索路径
            DispPath head
            '目标结点
            DispNode Nodes(head)
            '退出
            Exit Sub
        End If
         '若可以扩展则
        If SpacMove(Temp, i) Then
            '记录父结点标识
            Temp.last = head
            '计算f
            Calcuf Temp
            '计算重复结点号
            k = Rept(Temp)
            '若不重复则
            If k > tail Then
                '按f大小插入队列
                Sortf
                '移动队列尾指针
                tail = tail + 1
            '否则如果与待扩展结点重复
            ElseIf head <= k And k <= tail Then
                '则比较两结点的g，保留g小的结点
                If Nodes(k).g > Temp.g Then Nodes(k) = Temp
            End If
            
        End If
        
    Next
    
    '一个结点不能再扩展，放入关闭列表，并指向下一结点
    head = head + 1
Loop
End Sub'初始化
Private Sub Init()
Dim i As Long, j As Long, k As Long
'初始结点
ReDim Nodes(0)
'读入初始状态数据，记录其下标
With Nodes(0)
    For i = 0 To 8
        .p(i) = Text2a(i)
        .u(.p(i)) = i
    Next
    .Spac = .u(0)
    .last = -1
    .f = 0
    .g = 0
    .h = 0
End With
'读入目标状态数据，记录其下标
With EndNode
    For i = 0 To 8
        .p(i) = Text2a(i + 9)
        v(.p(i)) = i
    Next
    .Spac = v(0)
    .last = -1
    .f = 0
    .g = 0
    .h = 0
End With
'空格移动增量数据
For i = 0 To 3
    dir(i) = i * 2 - 3
Next
'计算两个结点同一数码的相对距离
For i = 0 To 80
    j = i \ 9
    k = i Mod 9
    dis(i) = Abs(j \ 3 - k \ 3) + Abs(j Mod 3 - k Mod 3)
Next
s = ""
counts = 0
End SubPrivate Function DllMain(hInst As Long, Reason As Long, Reserved1 As Long)
    '返回1,表示DLL允许被装入
    '入口点设置为这个函数时,不知道为什么无法成功调用.....
    '调用的EXE虽然是报"找不到DLL"的错,但是实际上是这个DLL没有被成功载入.
    '貌似应该还在这里做点什么...
    '现在还是只能把入口点设置为原来的__vbaS
    '请高手指点一下........-_-b
    DllMain = True
End FunctionPublic Function BinGePinTu(ByVal Zhi As String) As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim ii As Long
Dim fen() As String'检查状态数码
Cchu = ""
CZi = ""
Zhi = StrConv(Zhi, vbUnicode)For i = 0 To 17
    Text2a(i) = i
    MessageBox 0&, Text2a(i), "错误提示", 0
NextMessageBox 0&, Text2a(i), "错误提示", 0For i = 0 To 8
     For j = 0 To 8
        If Text2a(j) = i Then Exit For
     Next
     If j = 9 Then Text1a = "初始状态错误": Exit Function
Next
For i = 0 To 8
     For j = 9 To 17
        If Text2a(j) = i Then Exit For
     Next
     If j = 18 Then Text1a = "目标状态错误": Exit Function
Next
'counts初始状态数码-->目标状态数码交换次数
For i = 0 To 8
    v(i) = Text2a(i)
     If v(i) = 0 Then j = i
Next
'先交换空格到目标位置
For i = 0 To 8
    If Val(Text2a(i + 9)) = 0 Then
        k = i
        If k = j Then
            counts = 0
        Else
            counts = Abs(j - k + 1) And 1
            v(j) = v(k)
            v(k) = 0
        End If
        Exit For
    End If
Next
'按目标状态逐个交换初始状态数码
For i = 0 To 8
    If v(i) <> Val(Text2a(i + 9)) Then
        For j = i + 1 To 8
            If v(j) = Val(Text2a(i + 9)) Then
                counts = counts + 1
                v(j) = v(i)
                v(i) = Val(Text2a(i + 9))
                Exit For
            End If
        Next
    End If
Next
'只有交换偶数次才能转换
If (counts And 1) Then Text1a = "状态不可转换": Exit Function
'数据初始化
Init
'A*搜索法
Astarfen = Split(Cchu, ",")For ii = LBound(fen) To UBound(fen) - 1
    If CZi = "" Then
        CZi = CLng(fen(ii))
    Else
        CZi = CZi & "," & CLng(fen(ii))
    End If
NextBinGePinTu = CZiEnd Function我在线等。。希望有人帮我一下。  错误那句是就是在调用过程 BinGePinTu
For i = 0 To 17
    Text2a(i) = i  '这个错误在这里不能赋值
    MessageBox 0&, Text2a(i), "错误提示", 0
Next

Answer 1

DLL不可以直接赋值，可以把参数传进去，内部再赋值

Answer 2

有点点明白!!!!我先去试一下.谢谢楼上的朋友 我是第一次弄这个DLL

Answer 3

八数码难题啊
你的DLL的代码是VB的么？是的话把代码贴出来我帮你看看。

Answer 4

从你的代码看到，BinGePinTu这个函数这是定义了，并没有看到哪调用了。你的代码太长了，只贴关键代码就行了。

Answer 5

Option ExplicitPrivate Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" ( _
     ByVal hwnd As Long, _
     ByVal lpText As String, _
     ByVal lpCaption As String, _
     ByVal wType As Long) As Long
Private Type Node        '结点类型
       p(8) As Long      '结点状态表
       Spac As Long      '空格位置
       last As Long      '父结点标识
       u(8) As Long      '结点数码位置表
       f As Long         '估价函数
       g As Long
       h As Long
End Type
Dim Nodes() As Node      '空队列
Dim EndNode As Node      '目标结点
Dim Temp As Node         '临时结点
Dim head As Long         '队列头指针
Dim tail As Long         '队列尾指针
Dim dir() As Long       '空格移动增量
Dim s As String          '字符串变量
Dim dis() As Long      '两个结点同一数码的相对距离表
Dim v() As Long         '目标结点数码位置表
Dim counts&, MoveStep&, tmp$
Dim Cchu As String
Dim CZi As String
Public Text2a() As Long
Dim Text1a As String
'保存结点状态，准备输出
Private Sub DispNode(Temp As Node)
Dim i&
counts = counts + 1
For i = 0 To 8
    If Temp.p(i) = 0 Then
        Cchu = Cchu & i & ","
    End If
    
    If i = 8 Then
    s = s + CStr(Temp.p(i))
    Else
    s = s + CStr(Temp.p(i)) & ","
    End If
    If (i + 1) Mod 3 = 0 Then s = s & vbCrLf
Nexts = s & vbCrLf
End Sub'确定搜索路径
Private Sub DispPath(ByVal k As Long)
k = Nodes(k).last
If k = -1 Then Exit Sub
DispPath k
DispNode Nodes(k)
End Sub'移动空格
Private Function SpacMove(T As Node, ByVal k As Long) As Boolean
Dim oldspac&With T
    '如果移出边界返回False
    If k = 0 Then If .Spac < 3 Then Exit Function
    If k = 1 Then If .Spac Mod 3 = 0 Then Exit Function
    If k = 2 Then If .Spac Mod 3 = 2 Then Exit Function
    If k = 3 Then If .Spac > 5 Then Exit Function
   '记录原来的空格位置
   oldspac = .Spac
   '新空格位置
   .Spac = .Spac + dir(k)
   '移动空格（交换数码）
   .p(oldspac) = .p(.Spac)
  
   .p(.Spac) = 0
   '交换数码的位置
   .u(0) = .Spac
   .u(.p(oldspac)) = oldspac
   '返回True
   SpacMove = True
End With
End Function'判断两个结点是否相同
Private Function Equal(T1 As Node, T2 As Node) As Boolean
Dim i&
Equal = True
For i = 0 To 8
    If T1.p(i) <> T2.p(i) Then
        Equal = False
        Exit For
    End If
Next
End Function'查找重复结点序号
Private Function Rept(T As Node) As Long
Dim i&
For i = 0 To tail
    If Equal(T, Nodes(i)) Then Exit For
Next
Rept = i
End Function'计算估价函数f
Private Sub Calcuf(Temp As Node)
Dim i&With Temp
    .h = 0
    For i = 1 To 8
        .h = .h + dis(.u(i) * 9 + v(i))
    Next
    .g = .g + 1
    .f = .g + .h
End With
End Sub'将结点按f大小插入队列（开启列表）
Private Sub Sortf()
Dim i&, j&
ReDim Preserve Nodes(tail + 1)
For i = head + 1 To tail
    If Temp.f < Nodes(i).f Then Exit For
Next
For j = tail To i Step -1
    Nodes(j + 1) = Nodes(j)
Next
Nodes(i) = Temp
End Sub'A*搜索法
Private Sub Astar()
Dim i&, k&'队列头、尾指针指向队列头（初始结点）
head = 0
tail = 0
'计算初始结点的f
Calcuf Nodes(0)
'队列不空则循环
Do While head <= tail
    Text1a = head
    DoEvents
    '尝试向上、左、右、下移动空格
    For i = 0 To 3
    
        '取队列头结点
        Temp = Nodes(head)
        '如果是目标结点
        If Equal(Temp, EndNode) Then
            '确定搜索路径
            DispPath head
            '目标结点
            DispNode Nodes(head)
            '退出
            Exit Sub
        End If
         '若可以扩展则
        If SpacMove(Temp, i) Then
            '记录父结点标识
            Temp.last = head
            '计算f
            Calcuf Temp
            '计算重复结点号
            k = Rept(Temp)
            '若不重复则
            If k > tail Then
                '按f大小插入队列
                Sortf
                '移动队列尾指针
                tail = tail + 1
            '否则如果与待扩展结点重复
            ElseIf head <= k And k <= tail Then
                '则比较两结点的g，保留g小的结点
                If Nodes(k).g > Temp.g Then Nodes(k) = Temp
            End If
            
        End If
        
    Next
    
    '一个结点不能再扩展，放入关闭列表，并指向下一结点
    head = head + 1
Loop
End Sub'初始化
Private Sub Init()
Dim i As Long, j As Long, k As Long
'初始结点
ReDim Nodes(0)
'读入初始状态数据，记录其下标
With Nodes(0)
    For i = 0 To 8
        .p(i) = Text2a(i)
        .u(.p(i)) = i
    Next
    .Spac = .u(0)
    .last = -1
    .f = 0
    .g = 0
    .h = 0
End With
'读入目标状态数据，记录其下标
With EndNode
    For i = 0 To 8
        .p(i) = Text2a(i + 9)
        v(.p(i)) = i
    Next
    .Spac = v(0)
    .last = -1
    .f = 0
    .g = 0
    .h = 0
End With
'空格移动增量数据
For i = 0 To 3
    dir(i) = i * 2 - 3
Next
'计算两个结点同一数码的相对距离
For i = 0 To 80
    j = i \ 9
    k = i Mod 9
    dis(i) = Abs(j \ 3 - k \ 3) + Abs(j Mod 3 - k Mod 3)
Next
s = ""
counts = 0
End SubPrivate Function DllMain(hInst As Long, Reason As Long, Reserved1 As Long)
    '返回1,表示DLL允许被装入
    '入口点设置为这个函数时,不知道为什么无法成功调用.....
    '调用的EXE虽然是报"找不到DLL"的错,但是实际上是这个DLL没有被成功载入.
    '貌似应该还在这里做点什么...
    '现在还是只能把入口点设置为原来的__vbaS
    '请高手指点一下........-_-b
    DllMain = True
End FunctionPublic Function BinGePinTu(ByVal Zhi As String) As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim ii As Long
Dim fen() As String
Dim fen1() As StringReDim Text2a(17)
ReDim v(8)
ReDim dis(81)
ReDim dir(3)
'检查状态数码
Cchu = ""
CZi = ""
Zhi = StrConv(Zhi, vbUnicode)
fen1 = Split(Zhi, ",")For j = 0 To 17
Text2a(j) = fen1(j)NextFor i = 0 To 8
     For j = 0 To 8
        If Text2a(j) = i Then Exit For
     Next
     If j = 9 Then Text1a = "初始状态错误": Exit Function
NextFor i = 0 To 8
     For j = 9 To 17
        If Text2a(j) = i Then Exit For
     Next
     If j = 18 Then Text1a = "目标状态错误": Exit Function
Next'counts初始状态数码-->目标状态数码交换次数
For i = 0 To 8
    v(i) = Text2a(i)
     If v(i) = 0 Then j = i
Next'先交换空格到目标位置
For i = 0 To 8
    If Val(Text2a(i + 9)) = 0 Then
        k = i
        If k = j Then
            counts = 0
        Else
            counts = Abs(j - k + 1) And 1
            v(j) = v(k)
            v(k) = 0
        End If
        Exit For
    End If
Next'按目标状态逐个交换初始状态数码
For i = 0 To 8
    If v(i) <> Val(Text2a(i + 9)) Then
        For j = i + 1 To 8
            If v(j) = Val(Text2a(i + 9)) Then
                counts = counts + 1
                v(j) = v(i)
                v(i) = Val(Text2a(i + 9))
                Exit For
            End If
        Next
    End If
Next'只有交换偶数次才能转换
If (counts And 1) Then Text1a = "状态不可转换": Exit Function
'数据初始化
Init
'A*搜索法
Astarfen = Split(Cchu, ",")
For ii = LBound(fen) To UBound(fen) - 1
    If CZi = "" Then
        CZi = CLng(fen(ii))
    Else
        CZi = CZi & "," & CLng(fen(ii))
    End If
Next
BinGePinTu = CZi
MessageBox 0&, BinGePinTu, "错误提示", 0
End Function
现在修改完毕.把静态数组改成动态的