changeds.bas

ArcEngine:批量将mxd中的图层(sde源)的source从一台服务器改变到另外一台

Attribute VB_Name = "ChangeDS"
Sub ChangeDataSourceOld()
'''将mxd中的图层(sde源)的source从一台服务器改变到另外一台
    Dim pDoc As IMxDocument
    Dim pMap As IMap
    Dim pFLayer As IFeatureLayer
    Dim i As Long, j As Long
    Dim pLayer As ILayer
    Dim pLayerColn As Collection
    Dim pCompositeLayer As ICompositeLayer
    Dim pSubLayer As ILayer
    
    ''''输入sde的登陆信息
    Dim pPropset As IPropertySet
    Dim pWorkspaceFact As IWorkspaceFactory
    Dim pFeatWorkspace As IFeatureWorkspace

    Set pLayerColn = New Collection
    
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
    For i = 0 To pMap.LayerCount - 1
        Set pLayer = pMap.Layer(i)
        If (TypeOf pLayer Is IFeatureLayer) Then
            pLayerColn.Add pLayer
        ElseIf (TypeOf pLayer Is ICompositeLayer) Then
            Set pCompositeLayer = pLayer
            For j = 0 To pCompositeLayer.Count - 1
                Set pSubLayer = pCompositeLayer.Layer(j)
                If (TypeOf pSubLayer Is IFeatureLayer) Then

                    pLayerColn.Add pSubLayer
                End If
            Next j
        End If
    Next i
    
    Dim pWS As IWorkspace
    Dim pDS As IDataset
    Dim strFC_Name As String
    Dim pNewFC As IFeatureClass
    Dim strDataDetails As String
    For i = 1 To pLayerColn.Count
        Set pFLayer = pLayerColn.Item(i)
        
        Dim pPubLayer As IPublishLayer
        Set pPubLayer = pFLayer
        strDataDetails = pPubLayer.DataDetails("")
        
        Debug.Print strDataDetails
        
        Dim strFCName As String
        Dim strServer As String
        Dim strInstance As String
        Dim strDatabase As String
        Dim strUser As String
        Dim strPassword As String
        Dim strVersion As String
        Dim pos1 As Long, pos2 As Long
        
        Dim strProp As String
        
        strDataDetails = UCase(strDataDetails)
        
        strProp = UCase("Feature Class:")
        pos1 = InStr(strDataDetails, strProp)
        pos2 = InStr(pos1, strDataDetails, Chr(10))
        If (pos1 > 1) Then strFCName = Trim(Mid(strDataDetails, pos1 + Len(strProp), pos2 - pos1 - Len(strProp) - 1))
        
        
        
        strProp = "SERVER:"
        pos1 = InStr(strDataDetails, strProp)
        pos2 = InStr(pos1, strDataDetails, Chr(10))
        If (pos1 > 1) Then strServer = Trim(Mid(strDataDetails, pos1 + Len(strProp), pos2 - pos1 - Len(strProp) - 1))
        
        strDataDetails = Replace(strDataDetails, strServer, "devserver")

        strProp = "INSTANCE:"
        pos1 = InStr(strDataDetails, strProp)
        pos2 = InStr(pos1, strDataDetails, Chr(10))
        If (pos1 > 1) Then strInstance = Trim(Mid(strDataDetails, pos1 + Len(strProp), pos2 - pos1 - Len(strProp) - 1))
        
        strProp = "DATABASE:"
        pos1 = InStr(strDataDetails, strProp)
        If pos > 1 Then pos2 = InStr(pos1, strDataDetails, Chr(10))
        If (pos1 > 1) Then strDatabase = Trim(Mid(strDataDetails, pos1 + Len(strProp), pos2 - pos1 - Len(strProp) - 1))
        
        strProp = "USER:"
        pos1 = InStr(strDataDetails, strProp)
        pos2 = InStr(pos1, strDataDetails, Chr(10))
        If (pos1 > 1) Then strUser = Trim(Mid(strDataDetails, pos1 + Len(strProp), pos2 - pos1 - Len(strProp) - 1))
        
        strProp = "PASSWORD:"
        pos1 = InStr(strDataDetails, strProp)
        If pos1 > 0 Then pos2 = InStr(pos1, strDataDetails, Chr(10))
        If (pos1 > 1) Then strPassword = Trim(Mid(strDataDetails, pos1 + Len(strProp), pos2 - pos1 - Len(strProp) - 1))
        

        
        strProp = "VERSION:"
        pos1 = InStr(strDataDetails, strProp)
        pos2 = InStr(pos1, strDataDetails, Chr(10))
        If (pos1 > 1) Then strVersion = Trim(Mid(strDataDetails, pos1 + Len(strProp), pos2 - pos1 - Len(strProp) - 1))
        
        
    ''''修改服务器名称
        strServer = "GISDATASZJ"
        strPassword = UCase(strUser)

        Set pPropset = New PropertySet
            With pPropset
                .SetProperty "server", strServer
                .SetProperty "instance", strInstance
                .SetProperty "database", strDatabase
                .SetProperty "user", strUser
                .SetProperty "password", strPassword
                .SetProperty "version", strVersion
            End With
            
            
        Set pWorkspaceFact = New SdeWorkspaceFactory
        Set pFeatWorkspace = pWorkspaceFact.Open(pPropset, 0)

        Set pNewFC = pFeatWorkspace.OpenFeatureClass(strFCName)
        Set pFLayer.FeatureClass = pNewFC

    Next i

End Sub