'任意のファイルをテーブルの属性値に保存・読込 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
BLOB 型にオブジェクトを読込・保存する方法
2016/9/1 (木)