PageRenderTime 63ms CodeModel.GetById 13ms app.highlight 46ms RepoModel.GetById 1ms app.codeStats 0ms

/Source Code/SongDatabase/Export and Import/PrimaryFacility.vb

#
Visual Basic | 364 lines | 314 code | 26 blank | 24 comment | 0 complexity | 5a053277055b001bab7b2fbeca4d92ac MD5 | raw file
  1Imports System.IO
  2Imports System.IO.Path
  3Imports System.IO.Compression
  4Imports PluginSupport
  5Imports PowerSong.SongDatabase.Items
  6
  7Namespace ExportImport
  8
  9    ''' <summary>
 10    ''' Represents the import and export functionality of PowerSong databases.
 11    ''' </summary>
 12    Public Class PrimaryFacility
 13
 14        Private FDatabase As Database = Nothing
 15
 16        ''' <summary>
 17        ''' Initializes a new instance of the <see cref="PrimaryFacility" /> class.
 18        ''' </summary>
 19        ''' <param name="sourceDatabase">The source database to use for the export/import.</param>
 20        Public Sub New(ByVal sourceDatabase As Database)
 21            FDatabase = sourceDatabase
 22        End Sub
 23
 24        ''' <summary>
 25        ''' Exports the entire song database into a single file.
 26        ''' </summary>
 27        ''' <param name="fileName">The name of the target archive file.</param>
 28        Public Sub Export(ByVal fileName As String, _
 29                          ByVal exportSongs As Boolean, _
 30                          ByVal includeCategories As Boolean, _
 31                          ByVal exportPlugins As Boolean, _
 32                          ByVal exportStyles As Boolean)
 33
 34            Dim DS As Data = FDatabase.Data
 35
 36            ' Create the output stream
 37            Dim File As New BinaryWriter(New MemoryStream)
 38
 39            ' Write all files in this folder to the file
 40            If exportSongs Then
 41                For Each SourceFilename As String In Directory.GetFiles(FDatabase.Location, "*.song")
 42                    WriteFileToStream(File, SourceFilename, GetFileName(SourceFilename))
 43                Next
 44            End If
 45
 46            ' TODO: Allow importing of categories as well
 47            If includeCategories Then
 48
 49                ' Create a dataset for exporting
 50                Dim CategoriesDataset As New Data
 51                For Each Row As Data.CategoriesRow In DS.Categories
 52                    CategoriesDataset.Categories.ImportRow(Row)
 53                Next
 54                For Each Row As Data.SongsRow In DS.Songs
 55                    CategoriesDataset.Songs.ImportRow(Row)
 56                Next
 57                For Each Row As Data.SongCategoriesRow In DS.SongCategories
 58                    CategoriesDataset.SongCategories.ImportRow(Row)
 59                Next
 60
 61                ' Write the dataset to the archive
 62                Dim Writer As New StringWriter
 63                CategoriesDataset.WriteXml(Writer)
 64                Writer.Close()
 65                WriteTextToStream(File, Writer.ToString, "SongCategories.xml")
 66
 67            End If
 68
 69            If exportPlugins Then
 70                For Each SourceFilename As String In Directory.GetFiles(FDatabase.Location, "*.plugin")
 71                    WriteFileToStream(File, SourceFilename, GetFileName(SourceFilename))
 72                Next
 73            End If
 74
 75            If exportStyles Then
 76
 77                ' Create a dataset for exporting
 78                Dim StylesDataset As New Data
 79                For Each Row As Data.StylesRow In DS.Styles
 80                    StylesDataset.Styles.ImportRow(Row)
 81                Next
 82                For Each Row As Data.ProjectletsRow In DS.Projectlets
 83                    StylesDataset.Projectlets.ImportRow(Row)
 84                Next
 85
 86                ' Write the dataset to the archive
 87                Dim Writer As New StringWriter
 88                StylesDataset.WriteXml(Writer)
 89                Writer.Close()
 90                WriteTextToStream(File, Writer.ToString, "Styles.xml")
 91
 92            End If
 93
 94            ' Get the data as a sequence of bytes
 95            Dim Data(File.BaseStream.Length) As Byte
 96            File.BaseStream.Position = 0
 97            File.BaseStream.Read(Data, 0, File.BaseStream.Length)
 98
 99            ' Write to a compressed stream
100            Dim CompressedFile As New GZipStream(New FileStream(fileName, FileMode.Create), CompressionMode.Compress)
101            CompressedFile.Write(Data, 0, File.BaseStream.Length)
102
103            File.Close()
104            CompressedFile.Close()
105
106        End Sub
107
108        Public Function Import(ByVal fileStream As Stream, _
109                               ByVal pluginContext As PluginContextBase, _
110                               ByVal overwriteItems As Boolean) As List(Of String)
111
112            ' Start a transaction
113            Dim DS As Data = FDatabase.Data
114            Dim Messages As New List(Of String)
115            FDatabase.StartTransaction()
116            Try
117
118                ' Decompress all of the data in the given file into a memory stream
119                Dim ZipStream As New GZipStream(fileStream, CompressionMode.Decompress)
120                Dim MemoryStream As New MemoryStream
121                Dim Buffer(4096) As Byte
122                Dim BytesRead As Integer = ZipStream.Read(Buffer, 0, 4096)
123                While BytesRead > 0
124                    MemoryStream.Write(Buffer, 0, BytesRead)
125                    BytesRead = ZipStream.Read(Buffer, 0, 4096)
126                End While
127
128                ' Start reading from the beginning of the memory stream
129                MemoryStream.Position = 0
130                Dim File As New BinaryReader(MemoryStream)
131
132                ' Read each file in the stream
133                While File.BaseStream.Position < File.BaseStream.Length
134                    Dim NextFileName As String = File.ReadString
135                    Dim FileLength As Integer = File.ReadInt32
136                    Dim FileContents As Byte() = File.ReadBytes(FileLength)
137                    Dim OutputFileName As String = FDatabase.Location + "\" + NextFileName
138
139                    ' Work with the current file in the stream
140                    Select Case GetExtension(NextFileName).ToUpper
141
142                        Case ".SONG"
143                            ImportSong(DS, FileContents, OutputFileName, overwriteItems, Messages)
144
145                        Case ".PLUGIN"
146                            ImportPlugin(FileContents, pluginContext, OutputFileName, overwriteItems, Messages)
147
148                        Case ".XML"
149
150                            Select Case NextFileName.ToUpper
151
152                                Case "STYLES.XML"
153                                    ImportStyles(DS, FileContents, overwriteItems, Messages)
154
155                                Case "SONGCATEGORIES.XML"
156                                    Messages.Add("Song Categories have been included in the selected file but they cannot yet be imported. It is likely that a future version of PowerSong will allow Song Categories to be imported from the specified file.")
157
158                                Case Else
159                                    Messages.Add("Skipped over unknown file: '" + NextFileName + "'.")
160
161                            End Select
162
163                        Case Else
164                            Messages.Add("Skipped over unknown file: '" + NextFileName + "'.")
165
166                    End Select
167
168                End While
169
170            Finally
171                FDatabase.EndTransaction()
172            End Try
173
174            ' Perform some checks on the database - this assigns a category to uncategorised songs
175            FDatabase.Save()
176            DatabaseUpgrade.CheckSongCategories(FDatabase)
177
178            ' Recreate the index
179            FDatabase.RecreateIndex()
180
181            Return Messages
182
183        End Function
184
185        Private Sub ImportSong(ByVal dataSet As Data, _
186                               ByVal fileContents As Byte(), _
187                               ByVal destinationFileName As String, _
188                               ByVal overwriteExisting As Boolean, _
189                               ByVal messages As List(Of String))
190
191            ' Determine whether or not to import/overwrite the song
192            Dim ImportThisSong As Boolean = True
193            If IO.File.Exists(destinationFileName) Then
194                If Not overwriteExisting Then
195                    messages.Add("The song '" + destinationFileName + "' already exists.")
196                    ImportThisSong = False
197                End If
198            End If
199
200            If ImportThisSong = True Then
201
202                Try
203
204                    ' Write the song
205                    Dim OutputFile As New BinaryWriter(New FileStream(destinationFileName, FileMode.Create))
206                    OutputFile.Write(fileContents)
207                    OutputFile.Close()
208
209                    ' Add to the database if necessary
210                    Dim Song As SongItem = SongItem.Load(destinationFileName)
211                    Dim ExistingSong As Data.SongsRow = dataSet.Songs.FindBySongID(Song.SongID)
212                    If ExistingSong IsNot Nothing Then dataSet.Songs.RemoveSongsRow(ExistingSong)
213                    Dim SongRow As Data.SongsRow = dataSet.Songs.AddSongsRow(Song.SongID, Song.Title, Nothing)
214
215                    ' Display information about the song
216                    messages.Add("Added song: '" + Song.Title + "'.")
217
218                Catch ex As Exception
219                    messages.Add("Song import error: " + ex.Message)
220                End Try
221
222            End If
223
224        End Sub
225
226        Private Sub ImportPlugin(ByVal fileContents As Byte(), _
227                                 ByVal pluginContext As PluginSupport.PluginContextBase, _
228                                 ByVal destinationFileName As String, _
229                                 ByVal overwriteExisting As Boolean, _
230                                 ByVal messages As List(Of String))
231
232            If IO.File.Exists(destinationFileName) Then
233                messages.Add("The plugin '" + destinationFileName + "' already exists.")
234            Else
235
236                Try
237
238                    ' Add the plugin to the active database, instantiate it and call its Install method
239                    AddExistingPlugin(destinationFileName, fileContents)
240                    messages.Add("Added plugin '" + GetFileName(destinationFileName) + "'.")
241                    Dim Plugin As IPlugin = FDatabase.InstantiatePlugin(GetFileName(destinationFileName), pluginContext)
242                    Plugin.Install()
243                    messages.Add("Installed plugin '" + GetFileName(destinationFileName) + "'.")
244
245                Catch ex As Exception
246                    messages.Add("Plugin import error: " + ex.Message)
247                End Try
248
249            End If
250
251        End Sub
252
253        Private Sub ImportStyles(ByVal dataSet As Data, _
254                                 ByVal fileContents As Byte(), _
255                                 ByVal overwriteExisting As Boolean, _
256                                 ByVal messages As List(Of String))
257
258            Try
259
260                ' Get the styles
261                Dim StyleData As New Data
262                Dim Reader As New Xml.XmlTextReader(New MemoryStream(fileContents))
263                StyleData.ReadXml(Reader)
264                Reader.Close()
265
266                ' Import the styles
267                For Each Row As Data.StylesRow In StyleData.Styles
268
269                    Try
270                        Dim ExistingStyle As Data.StylesRow() = dataSet.Styles.Select("Name='" + Row.Name + "'")
271                        If ExistingStyle.Length = 0 Then
272
273                            ' Add the new style
274                            dataSet.Styles.ImportRow(Row)
275                            For Each SubRow As Data.ProjectletsRow In StyleData.Projectlets.Select("StyleID='" + Row.StyleID.ToString + "'")
276                                dataSet.Projectlets.ImportRow(SubRow)
277                            Next
278                            messages.Add("Added style '" + Row.Name + "'.")
279
280                        ElseIf overwriteExisting Then
281
282                            ' Overwrite existing style
283                            dataSet.Styles.RemoveStylesRow(ExistingStyle(0))
284                            dataSet.Styles.ImportRow(Row)
285                            For Each SubRow As Data.ProjectletsRow In StyleData.Projectlets.Select("StyleID='" + Row.StyleID.ToString + "'")
286                                dataSet.Projectlets.ImportRow(SubRow)
287                            Next
288                            messages.Add("Replaced style '" + Row.Name + "'.")
289
290                        Else
291                            messages.Add("The style '" + Row.Name + "' already exists, therefore it has been ignored.")
292                        End If
293
294                    Catch ex As Exception
295                        messages.Add("Cannot import style '" + Row.Name + "' because it is incompatible.")
296                    End Try
297
298                Next
299
300            Catch ex As Exception
301                messages.Add("The styles file contained in the archive is invalid.")
302            End Try
303
304        End Sub
305
306        Public Function Import(ByVal fileName As String, _
307                               ByVal pluginContext As PluginContextBase, _
308                               ByVal overwriteExistingSongs As Boolean) As List(Of String)
309
310            Dim Stream As New FileStream(fileName, FileMode.Open)
311            Dim Result As New List(Of String)
312
313            Try
314                Result = Import(Stream, pluginContext, overwriteExistingSongs)
315            Finally
316                Stream.Close()
317            End Try
318
319            Return Result
320
321        End Function
322
323        Private Sub WriteFileToStream(ByVal stream As BinaryWriter, _
324                                      ByVal fileName As String, _
325                                      ByVal fileNameInStream As String)
326
327            stream.Write(fileNameInStream)
328            Dim File As New BinaryReader(New FileStream(fileName, FileMode.Open))
329            Dim FileLength As Integer = File.BaseStream.Length
330            Dim Contents As Byte() = File.ReadBytes(FileLength)
331            stream.Write(FileLength)
332            stream.Write(Contents)
333            File.Close()
334
335        End Sub
336
337        Private Sub WriteTextToStream(ByVal stream As BinaryWriter, _
338                                      ByVal text As String, _
339                                      ByVal fileNameInStream As String)
340
341            stream.Write(fileNameInStream)
342            Dim Data As Byte() = System.Text.Encoding.Default.GetBytes(text)
343            stream.Write(Data.Length)
344            stream.Write(Data)
345
346        End Sub
347
348        Private Sub AddExistingPlugin(ByVal destinationFileName As String, ByVal fileContents As Byte())
349
350            ' Check extension
351            If GetExtension(destinationFileName).ToUpper <> ".PLUGIN" Then
352                Throw New ApplicationException("Plugin must have an extension of .PLUGIN.")
353            End If
354
355            If File.Exists(destinationFileName) Then Throw New ApplicationException("A plugin with the same file name already exists in the database.")
356            Dim OutputFile As New FileStream(destinationFileName, FileMode.Create)
357            OutputFile.Write(fileContents, 0, fileContents.Length)
358            OutputFile.Close()
359
360        End Sub
361
362    End Class
363
364End Namespace