'任意のファイルをテーブルの属性値に保存・読込
Private Sub StoreMemoryBlobStream()
Dim strFileName As String
Dim strPGDBName As String
Dim strTableName As String
Dim strField As String
Dim blnFileLoad As Boolean
strFileName = "D:\Workspace\BinaryFile.bin" '任意のバイナリファイル
strPGDBName = "D:\Workspace\New Personal Geodatabase.mdb" 'PGDB Workspace
strTableName = "Layers" 'Table
strField = "Layers" 'MemoryBlobStreamのフィールド名
Dim pTable As ITable
Set pTable = GetTable(strPGDBName, strTableName)
Dim pRow As IRow
Set pRow = pTable.Search(Nothing, False).NextRow
Dim pMemoryBlobStream As IMemoryBlobStream
Select Case blnFileLoad
Case True '属性値にファイルを読込
Set pMemoryBlobStream = New MemoryBlobStream
pMemoryBlobStream.LoadFromFile strFileName
pRow.Value(pRow.Fields.FindField(strField)) = pMemoryBlobStream
pRow.Store
Case False '属性値をファイルに保存
Set pMemoryBlobStream = pRow.Value(pRow.Fields.FindField(strField))
pMemoryBlobStream.SaveToFile strFileName
End Select
End Sub
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub LoadBlob()
'BLOB格納先テーブルの取得
Dim pTable As ITable
Set pTable = GetTable("D:\Workspace\New Personal Geodatabase.mdb", "Layers")
Dim pCursor As ICursor
Set pCursor = pTable.Search(Nothing, False)
Dim pRow As IRow
Set pRow = pCursor.NextRow
If (pRow Is Nothing) Then Exit Sub
'対象属性値をIMemoryBlobStreamで取得
Dim pMemoryStream As IMemoryBlobStream
Set pMemoryStream = pRow.Value(pRow.Fields.FindField("Layers"))
Dim pLayer As ILayer
Set pLayer = New FeatureLayer '該当のオブジェクトはあらかじめインスタンス化しておく
UseMemoryBlobStream pLayer, pMemoryStream, False
Dim pMxDocument As IMxDocument
Set pMxDocument = ThisDocument
pMxDocument.FocusMap.AddLayer pLayer
End Sub
Private Sub SaveBlob()
'マップ内の最上位レイヤのPersistStreamを取得します。
Dim pMxDocument As IMxDocument
Set pMxDocument = ThisDocument
Dim pMemoryStream As IMemoryBlobStream
Set pMemoryStream = New MemoryBlobStream 'あらかじめMemoryBlobStreamオブジェクトを生成しておく
UseMemoryBlobStream pMxDocument.FocusMap.Layer(0), pMemoryStream, True
'BLOB格納先テーブルの取得
Dim pTable As ITable
Set pTable = GetTable("D:\Workspace\New Personal Geodatabase.mdb", "Layers")
Dim pRow As IRow
Set pRow = pTable.CreateRow
pRow.Value(pRow.Fields.FindField("Layers")) = pMemoryStream 'MemoryBlobStreamを格納
pRow.Store
End Sub
'******************************************************************************
' 定義 :UseMemoryBlobStream
' 概要 :PersistStreamをMemoryBlobStreamに格納・読み込み
' 第1引数 :IPersistStream 該当のオブジェクトをインスタンス化しておく
' 第2引数 :IMemoryBlobStream 予めMemoryBlobStreamをインスタンス化しておく
' 第3引数 :Boolean 保存:True、読み込み:False
' 戻り値 :なし
'******************************************************************************
Private Function UseMemoryBlobStream(ByVal PersistStream As IPersistStream, ByVal Blob As IMemoryBlobStream, Save As Boolean)
'Streamを保存する場合
If Save = True Then
PersistStream.Save Blob, False 'MemoryBlobStreamオブジェクトにStreamを保存
Else
'Streamを読み込む場合
PersistStream.Load Blob 'MemoryBlobStreamオブジェクトからStreamを読み込み
End If
End Function
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'BLOB型フィールドのオブジェクトを取得
Public Sub LoadBlob()
'BLOB格納先テーブルの取得
Dim pTable As ITable
Set pTable = GetTable("D:\Workspace\New Personal Geodatabase.mdb", "Layers")
Dim pCursor As ICursor
Set pCursor = pTable.Search(Nothing, False)
Dim pRow As IRow
Set pRow = pCursor.NextRow
If (pRow Is Nothing) Then Exit Sub
'対象属性値をIMemoryBlobStreamで取得
Dim pMemoryStream As IMemoryBlobStream
Set pMemoryStream = pRow.Value(pRow.Fields.FindField("Layers"))
Dim pLayer As ILayer
Set pLayer = New FeatureLayer
'PersistStreamで取得
Dim pPersistStream As IPersistStream
Set pPersistStream = pLayer
pPersistStream.Load pMemoryStream
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
pMxDoc.FocusMap.AddLayer pLayer
End Sub
'BLOB型フィールドにオブジェクトを保存
Public Sub SaveBlob()
'マップ内の最上位レイヤのPersistStreamを取得します。
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
'オブジェクトをIPersistStreamにQI
Dim pPersistStream As IPersistStream
Set pPersistStream = pMxDoc.FocusMap.Layer(0)
'オブジェクトをメモリのBLOBストリームに保存
Dim pMemoryStream As IMemoryBlobStream
Set pMemoryStream = New MemoryBlobStream
pPersistStream.Save pMemoryStream, False
'BLOB格納先テーブルの取得
Dim pTable As ITable
Set pTable = GetTable("D:\Workspace\New Personal Geodatabase.mdb", "Layers")
Dim pRow As IRow
Set pRow = pTable.CreateRow
pRow.Value(pRow.Fields.FindField("Layers")) = pMemoryStream
pRow.Store
End Sub
'テーブル取得
Private Function GetTable(WorkspaceName As String, TableName As String) As ITable
Dim strWorkspace As String
Dim strTable As String
strWorkspace = "D:\Workspace\New Personal Geodatabase.mdb"
strTable = "Layers"
Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New AccessWorkspaceFactory
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(WorkspaceName, 0)
Set GetTable = pFeatureWorkspace.OpenTable(TableName)
End Function
記事
