oracle map连接字符串,vb+oracle+mapx实现的最短路径查询

Const INFINITE = 1E+38 \'无限大常数

Const maxNode = 292 \'最大顶点数

Const maxEdge = 440 \'最大边数

Dim fnode1(1 To maxEdge) As Integer \'记录以起点排序的起点集

Dim tnode1(1 To maxEdge) As Integer \'记录以起点排序的终点集

Dim lgth1(1 To maxEdge) As Double

\'记录与前两个数组对应的路径长度

Dim roadid1(1 To maxEdge) As Integer \'记录对应的roadid号

Dim fnode2(1 To maxEdge) As Integer \'记录以终点排序的起点集

Dim tnode2(1 To maxEdge) As Integer \'记录以终点排序的终点集

Dim lgth2(1 To maxEdge) As Double

\'记录以终点排序时的路径长度值

\'Dim roadid2(1 To maxEdge) As Integer

Dim F_TNode(2, maxNode) As Integer \'total FirstNodes connect to a

LastNode，二维

Dim T_FNode(2, maxNode) As Integer \'total LastNodes connect to a

FirstNode

Dim path() As Integer

Dim roadid() As Integer

Dim conn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim flagShrstPath As Boolean

Dim lInfo As New Mapxlib.LayerInfo

Private Sub cmdShrstPath_Click()

If flagShrstPath = False Then

flagShrstPath = True

cmdShrstPath.Caption = "路径分析(开)"

End If

If flagShrstPath = True Then

cmdShrstPath.Enabled = False

Debug.Print "The shortest length is: " + CStr(shortpath(1,

291))

\'在地图上显示最短路径

Dim lyrs As New Mapxlib.Layers

Dim lyrFindLayer As Mapxlib.Layer

\'Dim ftrs As MapXLib.Features

Dim ftr As Mapxlib.Feature

\'Dim dsets As MapXLib.DataSets

\'Dim dset As MapXLib.Dataset

\'Dim rvs As MapXLib.Rowvalues

\'Dim rv As MapXLib.Rowvalue

Dim slt As Mapxlib.Selection

Dim foundFeature As Mapxlib.FindFeature

Set lyrFindLayer = Map.Layers.Add(lInfo)

\'ftr=lyrFindLayer.f

Dim roadid As Integer

For Each roadid In path()

If ftr.FeatureKey = roadid Then

End If

End Sub

Private Sub Form_Load()

flagShrstPath = False

\'Dim lInfo As New MapXLib.LayerInfo

lInfo.Type = miLayerInfoTypeServer \'来自数据库服务器

\'定义连接字符串

Dim connectStr As String

connectStr = "SRVR=gis;UID=crmgis;PWD=mapinfo"

\'添加LayerInfo参数

lInfo.AddParameter "connectstring", connectStr

lInfo.AddParameter "name", "try"

lInfo.AddParameter "toolkit", "ORAINET"

lInfo.AddParameter "cache", "off"

lInfo.AddParameter "mbrsearch", "on"

lInfo.AddParameter "query", "select * from Road"

lInfo.AddParameter "AutoCreateDataset", 1

\'至此，完成数据库的连接了，开发者可以进行相应的数据调用了

Map.Layers.Add lInfo, 1

End Sub

Private Sub Initialize()

\'//连接数据库，读入有关数据

\'On Error GoTo procerror

conn.Open "dsn=crm;uid=crmgis;PWD=mapinfo;"

\'Topo关系数组的初始化/

Dim i As Integer

Dim j As Integer

\'//初始化fnode1,tnode1,lgth1Dim sqlStr1 As String

sqlStr1 = "select firstnode,lastnode,length, roadid from road order

by firstnode"

rs.Open sqlStr1, conn

rs.MoveFirst

For i = 1 To maxEdge

fnode1(i) = CInt(rs!FIRSTNODE)

tnode1(i) = CInt(rs!LASTNODE)

lgth1(i) = CDbl(rs!Length)

roadid1(i) = CInt(rs!roadid)

If rs.EOF = False Then

rs.MoveNext

End If

Next i

rs.Close

\'//初始化fnode2,tnode2,lgth2

Dim sqlStr2 As String

sqlStr2 = "select firstnode,lastnode,length,roadid from road order

by lastnode"

rs.Open sqlStr2, conn

rs.MoveFirst

For i = 1 To maxEdge

fnode2(i) = CInt(rs!FIRSTNODE)

tnode2(i) = CInt(rs!LASTNODE)

lgth2(i) = CDbl(rs!Length)

\'roadid2(i) = CInt(rs!roadid)

If rs.EOF = False Then

rs.MoveNext

End If

Next i

rs.Close

conn.Close

\'//找出某个起点与其相连的终点的个数

Dim m As Integer

Dim flag As Boolean \'设置一个旗标看某点号是否重复出现

For j = 1 To 2

For m = 1 To maxNode

T_FNode(j, m) = -1

F_TNode(j, m) = -1

Next m

Next j

For j = 1 To maxNode

flag = False

For m = 1 To maxEdge

If j = fnode1(m) And flag = False Then

T_FNode(1, j) = m

\'表示j点拥有终点，并且该点在fnode1()中的位置为m

T_FNode(2, j) = 1

flag = True

ElseIf j = fnode1(m) And flag = True Then

T_FNode(1, j) = m

T_FNode(2, j) = T_FNode(2, j) + 1

End If

Next m

Next j

\'///找出与某个终点相连的起点的个数

For j = 1 To maxNode

flag = False

For m = 1 To maxEdge

If j = tnode2(m) And flag = False Then

F_TNode(1, j) = m

F_TNode(2, j) = 1

flag = True

ElseIf j = tnode2(m) And flag = True Then

F_TNode(1, j) = m

F_TNode(2, j) = F_TNode(2, j) + 1

End If

Next m

Next j

\'procerror:

\'MsgBox "数据库连接错误！"

End Sub

Public Function shortpath(startno As Integer, endno As Integer) As

Double \'以开始点，结束点为参数。

Dim result() As Double

Dim result1 As Integer \'定义结果点

Dim s1 As Double

Dim Stpath As Double

Dim min As Double

Dim ll As Integer \'记录开始点

Dim ii As Integer

Dim i As Integer

Dim j As Integer

Dim aa As Integer

Dim p As Integer

Dim q As Integer

Dim k As Integer

Dim visited() As Boolean \'标记已经检查过的点

Dim inResult() As Boolean \'标记已经作结果点用过的点

Dim resultLength() As Double \'从起点算起的最短路程

Dim no() As Integer

Dim nopoint As Integer

ReDim visited(1 To maxNode) As Boolean

ReDim inResult(1 To maxNode) As Boolean

ReDim resultLength(1 To maxNode) As Double

ReDim result(1 To 2, 1 To maxNode) As Double

\'定义结果，其中result(1,maxNode)为结果点，result(2,maxNode)为结果长度。

Call Initialize

For k = 1 To maxNode \' maxNode为网中最大的节点数。

visited(k) = False \'标记已经查过的点。

inResult(k) = False \'标记已经作结果点用过的点

resultLength(k) = 1E+38 \'假设从起点到任一点的距离都为无穷大

Next k

ll = startno \'设置开始点。

visited(ll) = True \'标记开始点为真。即已经作结果点用过。

j = 0

For aa = 1 To maxNode

\'先从与开始点相连的终点寻找

For i = 1 To T_FNode(2, ll) \'以与ll点相连的终点的个数循环

result1 = tnode1(T_FNode(1, ll) - i + 1)

\'找出与LL点相连的终点的点号

s1 = lgth1(T_FNode(1, ll) - i + 1) + result(2, ll)

\'找出长度并求和

If visited(result1) = True Then GoTo 200

\'如果已经被查过进行下一个

If inResult(result1) = True Then

\'如果已经作为结果点判断哪一个长

If resultLength(result1) >= s1 Then

\'如果这一点到起点的长度比现在的路线长，替代

resultLength(result1) = s1

result(1, result1) = ll

\'设置到这点的最短路径的前一点为LL点(精华部分)

result(2, result1) = s1 \'设置到这点的最短路径长度

GoTo 200

Else

GoTo 200

End If

End If

\'如果上面的条件都不符合则进行下面的语句

inResult(result1) = True

resultLength(result1) = s1

result(1, result1) = ll

result(2, result1) = s1

\'每找到一个点加一，为了下面的判断

j = j + 1

ReDim Preserve no(1 To j) As Integer

\'重新定义数组并使其值为当前的点号

no(j) = result1

200 Next i

\'再从与开始点相连的起点寻找，与上面一样不再标注

For p = 1 To F_TNode(2, ll)

result1 = fnode2(F_TNode(1, ll) - p + 1)

s1 = lgth2(F_TNode(1, ll) - p + 1) + result(2, ll)

If visited(result1) = True Then GoTo 300

If inResult(result1) = True Then

If resultLength(result1) >= s1 Then

resultLength(result1) = s1

result(1, result1) = ll

result(2, result1) = s1

GoTo 300

Else

GoTo 300

End If

End If

inResult(result1) = True

resultLength(result1) = s1

result(1, result1) = ll

result(2, result1) = s1

j = j + 1

ReDim Preserve no(1 To j) As Integer

no(j) = result1

300 Next p

\'设置最小为无穷大，最短路径点为空

min = 1E+38

minpoint = Null

\'(优化部分)

\'找出已经查过点中长度最短的点

For q = aa To j

If min > resultLength(no(q)) Then

ii = q

min = resultLength(no(q))

minpoint = no(q)

End If

Next q

\'如果没有结果，即起点与终点没有通路退出程序

If min = 1E+38 Then Exit Function

\'(重点优化)将两点互换，减少循环。

no(ii) = no(aa)

no(aa) = minpoint \'将路径最短的点放到no()中靠前一个位置

\'ReDim Preserve path(1 To aa) As Integer

\'path(aa) = minpoint

\'标记已经作为结果点判断过

visited(minpoint) = True

\'inResult(minpoint) = True

ll = minpoint \'下次从找到的路径最短的点出发

\'判断结果点是否等于终点，如果等于则已经找到最短路径

If minpoint = endno Then Exit For

Next aa

Dim z As Integer

Dim tempPoint As Integer

z = 2

tempPoint = result(1, endno)

ReDim Preserve path(1 To z) As Integer

\'path()前两个元素保存终点和终点的前一点，path()数组是从起点到终点路径点的反向顺序

path(1) = endno

path(2) = result(1, endno)

Do While tempPoint <> startno

tempPoint = result(1, tempPoint)

\'找出从起点到当前点的最短路径的前一点

z = z + 1

ReDim Preserve path(1 To z) As Integer

path(z) = tempPoint

Loop

ReDim roadid(z - 1) As Integer \'保存结果路径的roadid

Dim h As Integer

For h = z To 2 Step -1

For i = 1 To maxEdge

If path(h) = fnode1(i) And path(h - 1) = tnode1(i) Then

roadid(h - 1) = roadid1(i)

Exit For

ElseIf path(h) = tnode1(i) And path(h - 1) = fnode1(i) Then

roadid(h - 1) = roadid1(i)

Exit For

End If

Next i

Next h

For k = z - 1 To 1 Step -1

Debug.Print "RoadID: " + CStr(roadid(k))

\'输出路径，注意path()是反向的，即是从终点到起点的。

Next k

shortpath = result(2, endno) \'返回最短路径长度

End Function