⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 simplepointwksfactoryhelper.cls

📁 COM编程接口处理方法 多个方法调用COM库函数
💻 CLS
字号:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SimplePointWksFactoryHelper"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Implements IPlugInWorkspaceFactoryHelper

Private Property Get IPlugInWorkspaceFactoryHelper_CanSupportSQL() As Boolean
  IPlugInWorkspaceFactoryHelper_CanSupportSQL = False
End Property

Private Function IPlugInWorkspaceFactoryHelper_ContainsWorkspace(ByVal parentDirectory As String, ByVal FileNames As IFileNames) As Boolean

  IPlugInWorkspaceFactoryHelper_ContainsWorkspace = False
  
  If FileNames Is Nothing Then
    IPlugInWorkspaceFactoryHelper_ContainsWorkspace = IPlugInWorkspaceFactoryHelper_IsWorkspace(parentDirectory)
  Else
    Dim pFSO As Object
    Set pFSO = CreateObject("Scripting.FileSystemObject")
    If Not pFSO.FolderExists(parentDirectory) Then
      Exit Function
    End If
    
    Dim sFileName As String
    sFileName = FileNames.Next
    Do Until sFileName = ""
      If Not FileNames.IsDirectory Then
        If LCase(Right(sFileName, 4)) = g_sFileExtension Then
          IPlugInWorkspaceFactoryHelper_ContainsWorkspace = True
          Exit Function
        End If
      End If
      sFileName = FileNames.Next
    Loop
  End If
End Function

Private Property Get IPlugInWorkspaceFactoryHelper_DatasetDescription(ByVal DatasetType As esriDatasetType) As String
  If DatasetType = esriDTFeatureClass Then
    IPlugInWorkspaceFactoryHelper_DatasetDescription = "SimplePoint Feature Class"
  Else
    IPlugInWorkspaceFactoryHelper_DatasetDescription = ""
  End If
End Property

Private Property Get IPlugInWorkspaceFactoryHelper_DataSourceName() As String
  IPlugInWorkspaceFactoryHelper_DataSourceName = "SimplePoint"
End Property

Private Function IPlugInWorkspaceFactoryHelper_GetWorkspaceString(ByVal parentDirectory As String, ByVal FileNames As IFileNames) As String
  IPlugInWorkspaceFactoryHelper_GetWorkspaceString = ""
  
  If FileNames Is Nothing Then
    If IPlugInWorkspaceFactoryHelper_IsWorkspace(parentDirectory) Then
      IPlugInWorkspaceFactoryHelper_GetWorkspaceString = parentDirectory
    End If
  Else
    Dim pFSO As Object
    Set pFSO = CreateObject("Scripting.FileSystemObject")
    If Not pFSO.FolderExists(parentDirectory) Then
      Exit Function
    End If
    
    Dim bFound As Boolean
    bFound = False
    Dim sFileName As String
    FileNames.Reset
    sFileName = FileNames.Next
    Do Until sFileName = ""
      If Not FileNames.IsDirectory Then
        If LCase(Right(sFileName, 4)) = g_sFileExtension Then
          ' Remove the file from the list
          FileNames.Remove
          bFound = True
        End If
        ' We are not implementing metadata, so no need to check for .xml extensions
      End If
      sFileName = FileNames.Next
    Loop
  
    If bFound Then
      IPlugInWorkspaceFactoryHelper_GetWorkspaceString = parentDirectory
    End If
    ' Empty string returned if not found
  End If
End Function

Private Function IPlugInWorkspaceFactoryHelper_IsWorkspace(ByVal wksString As String) As Boolean
  IPlugInWorkspaceFactoryHelper_IsWorkspace = False
  
  Dim pFSO As Object
  Set pFSO = CreateObject("Scripting.FileSystemObject")
  If Not pFSO.FolderExists(wksString) Then
    Exit Function
  End If
  
  Dim pFolder As Object
  Set pFolder = pFSO.GetFolder(wksString)
  
  Dim pFileCollection As Object
  Dim pFile As Object
  Set pFileCollection = pFolder.Files
  For Each pFile In pFileCollection
    If LCase(Right(pFile.Name, 4)) = g_sFileExtension Then
      IPlugInWorkspaceFactoryHelper_IsWorkspace = True
      Exit Function
    End If
  Next
  
End Function

Private Function IPlugInWorkspaceFactoryHelper_OpenWorkspace(ByVal wksString As String) As IPlugInWorkspaceHelper
  
  ' Check that the workspace is valid.
  If Not IPlugInWorkspaceFactoryHelper_IsWorkspace(wksString) Then
    Set IPlugInWorkspaceFactoryHelper_OpenWorkspace = Nothing
    Err.Raise E_FAIL, , "Workspace string invalid: " & wksString
    Exit Function
  End If
  
  ' Create the workspace helper object
  Dim pSimplePointWorkspaceHelper As ISimplePointWorkspaceHelper
  Set pSimplePointWorkspaceHelper = New SimplePointWorkspaceHelper
  pSimplePointWorkspaceHelper.WorkspacePath = wksString
  
  Set IPlugInWorkspaceFactoryHelper_OpenWorkspace = pSimplePointWorkspaceHelper ' Inline QI to IPlugInWorkspaceHelper
End Function

Private Property Get IPlugInWorkspaceFactoryHelper_WorkspaceDescription(ByVal plural As Boolean) As String
    IPlugInWorkspaceFactoryHelper_WorkspaceDescription = "SimplePoint data"
End Property

Private Property Get IPlugInWorkspaceFactoryHelper_WorkspaceFactoryTypeID() As IUID
  ' GUID returned is for the proxy workspace factory that gets created
  ' It should always be the same GUID, i.e. a constant
  ' You can generate a GUID with Microsoft Visual Studio's Guidgen.exe or uuidgen.exe,
  ' or with the GuidTool in the ArcObjects Developer Kit
  Dim pUID As esriCore.IUID
  Set pUID = New UID
  pUID.Value = "{6322F361-E3F0-11d5-8A7A-00104BB6FCCB}"
  Set IPlugInWorkspaceFactoryHelper_WorkspaceFactoryTypeID = pUID
End Property

Private Property Get IPlugInWorkspaceFactoryHelper_WorkspaceType() As esriWorkspaceType
  IPlugInWorkspaceFactoryHelper_WorkspaceType = esriFileSystemWorkspace
End Property

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -