Visual Basic.Net: Virtual Memory
How To Use Virtual Memory In Visual Basic.Net
Sometimes don't you want to use ram as you go, instead of loading giant files into ram? Here is an example of how to utilize Virtual Memory in Visual Basic.
Code:
The following Visual Basic code uses the MemoryMappedFile.CreateFromFile(FileName) method, although MemoryMappedFile has other methods available, they are not available in this article. This example generates fake DNA sequences to demonstrate how to use Virtual Memory. This example is designed to work if you simply create a new Visual Basic.Net project, and replace all of Form1's code with the following code and click run:
Option Strict On
Imports System
Imports System.Text
Imports System.IO.MemoryMappedFiles
Public Class Form1
'This will hold the references for the files stored in Virtual Memory
Private Lines As New List(Of MemoryMappedFile)
'This is used to generate random characters for the file
Private Random As New Random(1)
'This is used for flashing the seeking... 's flashing .'s
Private LastSeekingString As String = Space(3)
'this is the path to the folder where Virtual Ram files will be stored
Private Path As String = My.Computer.FileSystem.SpecialDirectories.Desktop & "\DatFiles\"
'A richtextbox will be used for displaying data
Friend WithEvents RichTextBox1 As New DBRichTextBox With {.Parent = Me, .Width = 565, .BackColor = Color.FromArgb(33, 33, 33), .ForeColor = Color.White}
'These scrollbars scroll the data offsets/line numbers
Friend WithEvents VScrollBar1 As New VScrollBar With {.Parent = Me}
Friend WithEvents HScrollBar1 As New HScrollBar With {.Parent = Me}
'This aligns the blocks of data, regardless of the line numbers using the .PadRight feature later
Dim LineLabelPadWidth As Integer = 10
'Calculate how many lines are visible in the richtextbox
Private ReadOnly Property MaxVisibleLines As Integer
Get
'Get the height of the current font
Dim TextHieght As Integer = RichTextBox1.Font.Height
'calculate how many lines the richtextbox can hold
Return (RichTextBox1.ClientRectangle.Height \ TextHieght) - 2
End Get
End Property
Private ReadOnly Property VisibleCharactersInLine As Integer
Get
Dim CharacterWidth As Integer
'Calculate the width of a character(for monospaced font consolas, the width is half of the height)
CharacterWidth = RichTextBox1.Font.Height \ 2
'Calculate how many data characters are in a line
Dim Characters As Integer = (RichTextBox1.ClientRectangle.Width \ CharacterWidth) - LineLabelPadWidth - 1
'return the result
Return Characters
End Get
End Property
#Region "Events"
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
'Dispose each memorymappedfile before exiting the program
For Each mmf As MemoryMappedFile In Lines
mmf.Dispose()
Next
If My.Computer.FileSystem.DirectoryExists(Path) Then
'Delete the files if they exist
My.Computer.FileSystem.DeleteDirectory(Path, FileIO.DeleteDirectoryOption.DeleteAllContents)
End If
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Text = "System.IO.MemoryMappedFiles.MemoryMappedFile Example"
Try
'Add the scroll event handler for the scrollbars
AddHandler VScrollBar1.Scroll, AddressOf ScrollBar_Scroll
AddHandler HScrollBar1.Scroll, AddressOf ScrollBar_Scroll
If My.Computer.FileSystem.DirectoryExists(Path) Then My.Computer.FileSystem.DeleteDirectory(Path, FileIO.DeleteDirectoryOption.DeleteAllContents)
'Create the directory to store the virtual memory files in
My.Computer.FileSystem.CreateDirectory(Path)
'Disable the richtextboxes scrollbars(because we are using our own)
RichTextBox1.ScrollBars = RichTextBoxScrollBars.None
'make richtextbox1 readonly
RichTextBox1.ReadOnly = True
'Make the form double buffered
Me.DoubleBuffered = True
'Position all controls
DoLayout()
'randomize the timer
Randomize()
'Create a stringbuilder reference
Dim SB As StringBuilder
For Line As Integer = 0 To 99 ' Generate 100 200000 Character dummy DNA data lines.
'Assign a new instance of stringbuilder to the reference
SB = New StringBuilder
'Generate Each Line's Data(Each line will, have its own file for VRAM
For LineCharacters As Integer = 0 To 199999 ' Make each line 200000 chars long
'Append a random character to the stringbuilder
SB.Append(GetRandomGeneChar)
Next
'Generate a filename for the current line
Dim FileName As String = Path & "DataFile" & Line.ToString & ".Dat"
'Use a file stream to write to the file
Using FS As New IO.FileStream(FileName, IO.FileMode.CreateNew)
'convert the string into an array of byte
Dim Array As Byte() = Encoding.ASCII.GetBytes(SB.ToString)
'write the array to the stream
FS.Write(Array, 0, Array.Count)
'close the file stream
FS.Close()
'Clear the array
Array = {}
GC.Collect()
End Using
'create a new memorymapped file, this locks the file for exclusive use with your program
Dim MemoryMappedFile As MemoryMappedFile = MemoryMappedFile.CreateFromFile(FileName)
'Add a reference to the loaded memorymapped file to the list of memorymappedfiles(one entire file per line)
Lines.Add(MemoryMappedFile)
Next
'Set Richtextbox1 to have a monospaced font
RichTextBox1.Font = New Font("consolas", 16)
'Since each line will be 200k Characters long, we need to set the horizontal scrollbar's maxvalue
HScrollBar1.Maximum = 200000 - VisibleCharactersInLine + 8
'reset the scrollpoint of hscrollbar
HScrollBar1.Minimum = 0
'calculate Vscrollbar's max value
VScrollBar1.Maximum = Lines.Count - MaxVisibleLines + 8
'reset the scrollpoint
VScrollBar1.Minimum = 0
' Highlight the concatenated output of the locationstring function and the displaytext function(highlight the chromosones characters)
HighlightChromies(locationString() & DisplayText())
Catch ex As Exception
MsgBox(ex.StackTrace)
End Try
GC.Collect()
End Sub
Private Sub Form1_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
'reposition the controls on the form
DoLayout()
'reset the maximum values of the scrollbars because the size of the richtextbox changed
Try
VScrollBar1.Maximum = Lines.Count - MaxVisibleLines + 8
'Each file is exactly 200000 characters long, and the scrollbar will not quite scroll to its max value(bug?), so we adjust with 8 characters
HScrollBar1.Maximum = 200000 - VisibleCharactersInLine + 8
'1.) Calculate the location string
'2.) Calculate the display text
'3.) Concatonate the result of the two
'4.) Highlight the concatonated result of the two
HighlightChromies(locationString() & DisplayText())
Catch : End Try
End Sub
Private Sub ScrollBar_Scroll(sender As Object, e As ScrollEventArgs)
'Choose the type of scroll event that was raised
Select Case e.Type
Case ScrollEventType.EndScroll
'If the user finished scrolling:
'1.) Calculate the location string
'2.) Calculate the display text
'3.) Concatonate the result of the two
'4.) Highlight the concatonated result of the two
HighlightChromies(locationString() & DisplayText())
Case ScrollEventType.ThumbTrack
'The user is probably scrolling too fast
'to maintain good performance, so instead we just
'display information about
'the current selection
RichTextBox1.Text = SeekingString() & locationString()
Case Else
'The user is probably holding the buttons
'down on the scrollbar, so we don't want to
'use the processor intensive highlight sub until they have finished scrolling
RichTextBox1.Text = SeekingString() & locationString() & DisplayText()
End Select
End Sub
#End Region
#Region "Functions"
Private Function DisplayText() As String
'Create a new stringbuilder
Dim SB As New StringBuilder
'Scroll through the visible range of lines(using the scrollbar to determine the user selection
For I As Integer = VScrollBar1.Value To VScrollBar1.Value + MaxVisibleLines
'Call the GetData function to create a line of data
'Append that line of data to the stringbuilder
SB.Append(GetData(I, HScrollBar1.Value, VisibleCharactersInLine))
Next
'retirm the final result, removing the last carriage return that was appended
Return SB.ToString.Substring(0, SB.Length - 1)
End Function
Private Function GetData(LineNumber As Integer, Offset As Integer, Length As Integer) As String
Try
'Create a reference to the current line's memorymappedfile
Dim CurrentMemoryMappedFile As MemoryMappedFile = Lines(LineNumber)
'create an array to hold that line's bytes
Dim Bytes(199999) As Byte
'Create a MemoryMappedViewAccessor to load data from that file
Using V As MemoryMappedViewAccessor = CurrentMemoryMappedFile.CreateViewAccessor
'Read the data into the Bytes Array
V.ReadArray(Of Byte)(0, Bytes, 0, 200000)
End Using
'Converting the bytes into a string, build a data line for display
Return ("Line" & LineNumber.ToString & ":").PadRight(LineLabelPadWidth, " "c) & Encoding.ASCII.GetString(Bytes.ToList.GetRange(Offset, Length).ToArray) & vbCrLf
Catch ex As Exception
'return a line that has the error message.
Return ("Line" & LineNumber.ToString & ":").PadRight(LineLabelPadWidth, " "c) & ex.Message & vbCrLf
End Try
End Function
Public Function SeekingString() As String
'This is purly asthetic
'Add the appearence of animated dot dot dotting... working...
Select Case LastSeekingString
Case Space(3)
LastSeekingString = "." & Space(2)
Case "." & Space(2)
LastSeekingString = ".." & Space(1)
Case ".." & Space(1)
LastSeekingString = "..."
Case "..."
LastSeekingString = Space(3)
Case Else
LastSeekingString = Space(3)
End Select
Return "Seeking" & LastSeekingString
End Function
Private Function GetRandomGeneChar() As Char 'Function Borrowed from Reed Kimble:)
'Randomly select one of "ACTG"
Dim chars As String = "ATCG"
Return chars(Random.Next(0, 4))
End Function
Private Function locationString() As String
'Generate the first line displayed in the richtextbox,
'that identifies exactly what information is being displayed.
Return "Map coordinates[X=" & HScrollBar1.Value.ToString & ", Y=" & VScrollBar1.Value.ToString & "]" & vbCrLf
End Function
#End Region
#Region "Subs"
Private Sub DoLayout()
'Calculate the controls locations and sizes
RichTextBox1.Location = New Point(0, 0)
VScrollBar1.Left = Me.ClientRectangle.Width - VScrollBar1.Width
VScrollBar1.Height = Me.ClientRectangle.Height - HScrollBar1.Height
HScrollBar1.Left = 0
HScrollBar1.Width = Me.ClientRectangle.Width - VScrollBar1.Width
HScrollBar1.Top = Me.ClientRectangle.Height - HScrollBar1.Height
RichTextBox1.Width = Me.ClientRectangle.Width - VScrollBar1.Width
RichTextBox1.Height = Me.ClientRectangle.Height - HScrollBar1.Height
End Sub
Private Sub HighlightChromies(Text As String)
'Generating RTF is faster than setting the selection color properties :)
'Create RTF Header
Dim Header As String = "{\rtf1\ansi\deff0{\fonttbl{\f0\fnil\fcharset0 " & RichTextBox1.Font.FontFamily.Name & ";}}" & vbCrLf & _
"{\colortbl ;\red0\green128\blue0;\red0\green0\blue255;\red255\green165\blue0;\red255\green0\blue0;}" & vbCrLf & _
"\viewkind4\uc1\pard\lang1033\f0\fs" & CInt((RichTextBox1.Font.Size * 2)).ToString & " "
'Build RTF Code to highlight all occurrences of each of the following
Text = Text.Replace("G", "\highlight3 G\highlight0") 'g
Text = Text.Replace("A", "\highlight1 A\highlight0") 'a
Text = Text.Replace("C", "\highlight4 C\highlight0") 'c
Text = Text.Replace("T", "\highlight2 T\highlight0") 't
'replace all carriage returns with the RTF code that indicates a carriage return
Text = Text.Replace(vbCrLf, "\par" & vbCr)
'Assemble all the parts of the RTF code, set the RTF property of the richtextbox
RichTextBox1.Rtf = Header & Text & " \par " & vbCrLf & "}"
End Sub
#End Region
Public Class DBRichTextBox
Inherits RichTextBox
Sub New()
'The whole purpose of this
'inherited richtextbox
'is for the doublebuffering. thats it.
Me.DoubleBuffered = True
End Sub
End Class
End Class