Archive for June, 2008
Rich Text Cell in a DataGridView
Posted by Kelly's Chronicles in Uncategorized on June 30, 2008
I needed to have more dynamic content in a datagridview cell with a custom cell provided to us in VS 2005 and up
. Here is a class I came up with to accomplish this. Hope it helps somebody!
Sample Usage:
Sample usage:
Private Sub ConfigureGrid()
Me.gridQuestion.AutoGenerateColumns = False
Me.gridQuestion.Columns.Clear()
Dim column As New DataGridViewRichTextColumn()
column.ReadOnly = True
column.Width = Me.gridQuestion.ClientSize.Width
Me.gridQuestion.Columns.Add(column)
End Sub
—————————-
Imports System.Runtime.InteropServices
Imports System.Drawing.Printing
Imports VB6 = Microsoft.VisualBasic.Compatibility.VB6
Public Class DataGridViewRichTextCell
Inherits DataGridViewTextBoxCell
Private m_rtfTemplate As New RichTextBox
Protected Overrides Sub Paint(ByVal graphics As Graphics, _
ByVal clipBounds As Rectangle, ByVal cellBounds As Rectangle, _
ByVal rowIndex As Integer, ByVal cellState As DataGridViewElementStates, _
ByVal value As Object, ByVal formattedValue As Object, _
ByVal errorText As String, ByVal cellStyle As DataGridViewCellStyle, _
ByVal advancedBorderStyle As DataGridViewAdvancedBorderStyle, _
ByVal paintParts As DataGridViewPaintParts)
Dim brush As New SolidBrush(cellStyle.BackColor)
graphics.FillRectangle(brush, cellBounds)
brush.Dispose()
‘ Convert the text to Rtf, and then transfer to the Graphics object.
Me.PaintRtf(formattedValue, graphics, cellBounds, cellStyle.Font, cellStyle.BackColor)
‘ Paint the cell border after everything is done, or it will get
‘ overridden.
MyBase.PaintBorder(graphics, clipBounds, cellBounds, cellStyle, advancedBorderStyle)
End Sub
Private Function GetSelectionLink(ByVal charIndex As Integer) As Boolean
Const SCF_SELECTION As Int32 = &H1
Const CFE_LINK As Int32 = &H20
Dim cf As CHARFORMAT2_STRUCT = New CHARFORMAT2_STRUCT
cf.cbSize = CType(Marshal.SizeOf(cf), UInt32)
cf.szFaceName = New Char(32) {}
Dim wParam As IntPtr = New IntPtr(SCF_SELECTION)
Dim lParam As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(cf))
Marshal.StructureToPtr(cf, lParam, False)
Dim res As IntPtr = SendMessage(m_rtfTemplate.Handle, EM_GETCHARFORMAT, wParam, lParam)
cf = CType(Marshal.PtrToStructure(lParam, GetType(CHARFORMAT2_STRUCT)), CHARFORMAT2_STRUCT)
Marshal.FreeCoTaskMem(lParam)
Return (cf.dwEffects And CFE_LINK)
End Function
Public Overrides ReadOnly Property DefaultNewRowValue() As Object
Get
‘ Use the current date and time as the default value.
Return String.Empty
End Get
End Property
#Region "PaintRtf"
<StructLayout(LayoutKind.Sequential)> _
Private Structure CHARFORMAT2_STRUCT
Public cbSize As UInt32
Public dwMask As UInt32
Public dwEffects As UInt32
Public yHeight As Int32
Public yOffset As Int32
Public crTextColor As Int32
Public bCharSet As Byte
Public bPitchAndFamily As Byte
<MarshalAs(UnmanagedType.ByValArray, SizeConst:=32)> _
Public szFaceName As Char()
Public wWeight As UInt16
Public sSpacing As UInt16
Public crBackColor As Integer
Public lcid As Integer
Public dwReserved As Integer
Public sStyle As Int16
Public wKerning As Int16
Public bUnderlineType As Byte
Public bAnimation As Byte
Public bRevAuthor As Byte
Public bReserved1 As Byte
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure RECT
Public Left As Integer
Public Top As Integer
Public Right As Integer
Public Bottom As Integer
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure CHARRANGE
Public cpMin As Integer ‘ First character of range (0 for start of doc)
Public cpMax As Integer ‘ Last character of range (-1 for end of doc)
End Structure
<StructLayout(LayoutKind.Sequential)> _
Private Structure FORMATRANGE
Public hdc As IntPtr ‘ Actual DC to draw on
Public hdcTarget As IntPtr ‘ Target DC for determining text formatting
Public rc As RECT ‘ Region of the DC to draw to (in twips)
Public rcPage As RECT ‘ Region of the whole DC (page size) (in twips)
Public chrg As CHARRANGE ‘ Range of text to draw (see above declaration)
End Structure
Private Const WM_USER As Int32 = &H400
Private Const EM_FORMATRANGE As Int32 = WM_USER + 57
Private Const EM_GETCHARFORMAT As Int32 = (WM_USER + 58)
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
(ByVal hWnd As IntPtr, ByVal msg As Int32, ByVal wparam As IntPtr, _
ByVal lparam As IntPtr) As IntPtr
‘ Render the contents of the RichTextBox for printing
‘ Return the last character printed + 1 (printing start from this point for next page)
Private Sub PaintRtf(ByVal value As String, ByVal gr As Graphics, ByVal bounds As Rectangle, ByVal font As Font, ByVal backColor As Color)
If value Is Nothing Then
Exit Sub
End If
‘ Use an internal RichTextBox to format the text according to the
‘ business rules.
m_rtfTemplate.Font = font
m_rtfTemplate.WordWrap = False
m_rtfTemplate.Text = value
m_rtfTemplate.BackColor = backColor
m_rtfTemplate.DetectUrls = True
‘ Mark starting and ending character.
Dim cRange As CHARRANGE
cRange.cpMin = 0
cRange.cpMax = value.Length
‘ Calculate the area to render and print. The bounds need to
‘ be converted from pixels to twips (1/1440 of an inch).
Dim rectCell As New RECT
rectCell.Left = VB6.PixelsToTwipsX(bounds.Left) + 30
rectCell.Top = VB6.PixelsToTwipsY(bounds.Top) + 30
rectCell.Right = VB6.PixelsToTwipsX(bounds.Right)
rectCell.Bottom = VB6.PixelsToTwipsY(bounds.Bottom)
Dim rectPrint As RECT = rectCell
‘ Get the DC for the graphics object.
Dim hdc As IntPtr = gr.GetHdc()
‘ Initialize the FORMATRANGE structure for the EM_FORMATRANGE message.
Dim fmtRange As FORMATRANGE
fmtRange.chrg = cRange ‘ Indicate character from to character to
fmtRange.hdc = hdc ‘ Use the same DC for measuring and rendering
fmtRange.hdcTarget = hdc ‘ Point at printer hDC
fmtRange.rc = rectPrint ‘ Indicate the area on page to print
fmtRange.rcPage = rectCell ‘ Indicate whole size of page
Dim wParam As IntPtr = New IntPtr(1)
‘ Pass the FORMATRANGE structure to the lParam handle for the
‘ EM_FORMATRANGE message sent to the internal RichTextBox.
Dim lParam As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(fmtRange))
Marshal.StructureToPtr(fmtRange, lParam, False)
‘ Tell the RichTextBox to paint on the DC.
Dim res As IntPtr = SendMessage(m_rtfTemplate.Handle, EM_FORMATRANGE, wParam, lParam)
‘ Free the block of memory allocated.
Marshal.FreeCoTaskMem(lParam)
‘ Release the device context handle obtained by a previous call.
gr.ReleaseHdc(hdc)
End Sub
#End Region
End Class
Public Class DataGridViewRichTextColumn
Inherits DataGridViewColumn
Public Sub New()
MyBase.New(New DataGridViewRichTextCell)
End Sub
Public Overrides Property CellTemplate() As DataGridViewCell
Get
Return MyBase.CellTemplate
End Get
Set(ByVal value As DataGridViewCell)
‘ Ensure that the cell used for the template is a CalendarCell.
If Not (value Is Nothing) AndAlso _
Not value.GetType().IsAssignableFrom(GetType(DataGridViewRichTextCell)) _
Then
Throw New InvalidCastException("Must be a DataGridViewRichTextCell")
End If
MyBase.CellTemplate = value
End Set
End Property
End Class
Connection To Database Fails in Emulator but not in Visual Studio 2008
Posted by Kelly's Chronicles in Uncategorized on June 27, 2008
Well I have got a problem here. As I said yesterday I had begun to design applications in the compact .NET Framework 3.5 for a smart device. I have the Mobile 6 SDK installed. I created a data connection to a table called Employees in the GUI. When I preview the data in the GUI it works fine as shown below:
But when I go to debug the code and ask it just simply open and close the connection and here is what happens. It asks me what I want to deploy in and I request the Windows Mobile 6 Standard Landscape QVGA Emulator as I am using a Q Moto widescreen. Here is the error I have gotten. I have no idea what is causing this and have asked several friends to no avail. If anyone has any ideas I could be most grateful! The help when asked to assist in this situation is not at all helpful.
Technorati Tags: Windows Mobil 6,Visual Studio,Emulator,Q Moto,vb.net
Update:
After further investigation it appears I had to launch the Device Emulator Manager under Tools, highlight the emulator I was using and select "Connect" (make sure it is not cradled). Then while working do not close the emulator. And now it connects fine. Thanks to those who tried to help.
Windows Mobile 6 ,Windows Mobile 6 SDK, and Outlook
Posted by Kelly's Chronicles in Uncategorized on June 26, 2008
I am going to take a break today from my normal code workings to write about a topic that has got me a little steamed.
I just bought a Q Moto this past weekend. After a few days of just learning it I decided it was time to sync my email, contacts and calendar with my Outlook on my laptop. So far, I have been extremely happy with this product and even downloaded the Mobil 6 SDK to develop applications against it in Visual Studio 2008. First though my experience with Outlook on Windows Mobil 6.
I am assuming since it is an internet enabled device that there would be a way to make Outlook go out to my gmail account and get my mail. Then when I plug it in to the USB port at home, it would sync the emails in my phone with my Inbox.
I assumed incorrectly.
Oh it will let you create an email message on the mobile version of outlook, but you cant send it till you plugged in to your laptop again. You can create an additional email account that will download your messages but they won’t go into Outlook when you sync up to your laptop again. I could choose to leave the messages on the server but then when I go to the web interface on a normal machine everything is there.
This just plain stinks. I bought this thing to stay on top of my email and not have to worry about emails that are not in the right place. MS needs to find a way to have it go up on the server my laptop Outlook is configured with and get the emails just like it does on my laptop. And then sync it back to my laptop when I plug it in.
This is just silly.
Okay now on the SDK……….
As I am typing this of course it works fine. But yesterday it kept bombing Visual Studio 2008 (yes folks before you ask I had rebooted several times yesterday) and wanting to send error reports. But as of now it appears to be working ok. I am looking forward to writing for this device and see what I can do.
XML File as Data Source and Bind To DataSet in vb.net
Posted by Kelly's Chronicles in Uncategorized on June 25, 2008
What we would want to do is define a data layer class, keep an instance of the DataSet, and provide methods and properties to access the DataSet. I haven’t been able to use these concept at GE Healthcare yet but will be soon hopefully. Hope this helps somebody.
Sample usage would be:
Private m_dataLayer As New DataLayer(Application.StartupPath & "\Data.xml")
…
Me.DataGridView1.DataSource = m_dataLayer.Tables("Employee")
Imports System.Data
Public Class DataLayer
Private m_data As DataSet
Private m_fileName As String
Public Sub New(ByVal fileName As String)
m_data = new DataSet()
m_data.ReadXml(fileName)
m_fileName = fileName
End Sub
Public ReadOnly Property Table(ByVal tableName As String)
Get
Return m_data.Tables(tableName)
End Get
End Property
Public Sub Write()
m_data.WriteXml(m_fileName)
End Sub
End Class
Map Or Disconnect a Network Drive in vb.net
Posted by Kelly's Chronicles in Uncategorized on June 24, 2008
There are times when working with network drives it becomes necessary in an application to create or remove a network share. We don’t want an unhanded exception if the path is not mapped correctly or if it does not exist. (often users will screw this up after it has been correctly imaged on their machine). I actually ran into this at one point at GE Healthcare. Here is a very watered down sample of this (basically for security reasons). One caveat: The windows script host must be enabled for this to work.
' Add a COM reference to Windows Script Host Object Model.
Imports IWshRuntimeLibrary
Imports System.Runtime.InteropServices
Public Class NetworkDriveMapper
Public Shared Sub MapDrive(ByVal driveLetter As String, _
ByVal networkPath As String, ByVal isPersistent As Boolean)
' Create a new shell object.
Dim networkShell As New WshNetwork()
Try
' Disconnect the drive first, forcing a permanent change.
DisconnectDrive(driveLetter, True, True)
' Map the drive to the path.
networkShell.MapNetworkDrive(driveLetter, networkPath, Convert.ToBoolean(isPersistent))
Finally
If Not networkShell Is Nothing Then
Marshal.ReleaseComObject(networkShell)
networkShell = Nothing
End If
End Try
End Sub
Public Shared Sub DisconnectDrive(ByVal driveLetter As String, _
ByVal willForce As Boolean, ByVal isPersistent As Boolean)
' Create a new shell object.
Dim networkShell As New WshNetwork()
If IO.Directory.Exists(driveLetter) Then
Try
networkShell.RemoveNetworkDrive(driveLetter, Convert.ToBoolean(willForce), _
Convert.ToBoolean(isPersistent))
Finally
If Not networkShell Is Nothing Then
Marshal.ReleaseComObject(networkShell)
networkShell = Nothing
End If
End Try
End If
End Sub
End Class
Get Window Handles Associated With Process in vb.net
Posted by Kelly's Chronicles in Uncategorized on June 23, 2008
For an application, it became necessary to find all handles (hWND) associated with that process and not just the main window. Here is what I came up with. I won’t be able to use these concepts at work yet but will once we upgrade our framework version. Hope it helps someone.
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports System.Text
Public Class ApiWindow
Public MainWindowTitle As String = ""
Public ClassName As String = ""
Public hWnd As Int32
End Class
''' <summary>
''' Enumerate top-level and child windows
''' </summary>
''' <example>
''' Dim enumerator As New WindowsEnumerator()
''' For Each top As ApiWindow in enumerator.GetTopLevelWindows()
''' Console.WriteLine(top.MainWindowTitle)
''' For Each child As ApiWindow child in enumerator.GetChildWindows(top.hWnd)
''' Console.WriteLine(" " + child.MainWindowTitle)
''' Next child
''' Next top
''' </example>
Public Class WindowsEnumerator
Private Delegate Function EnumCallBackDelegate(ByVal hwnd As Integer, ByVal lParam As Integer) As Integer
' Top-level windows.
Private Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer
' Child windows.
Private Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Integer, ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer
' Get the window class.
Private Declare Function GetClassName _
Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Integer, ByVal lpClassName As StringBuilder, ByVal nMaxCount As Integer) As Integer
' Test if the window is visible--only get visible ones.
Private Declare Function IsWindowVisible Lib "user32" _
(ByVal hwnd As Integer) As Integer
' Test if the window's parent--only get the one's without parents.
Private Declare Function GetParent Lib "user32" _
(ByVal hwnd As Integer) As Integer
' Get window text length signature.
Private Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
' Get window text signature.
Private Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As StringBuilder) As Int32
Private _listChildren As New List(Of ApiWindow)
Private _listTopLevel As New List(Of ApiWindow)
Private _topLevelClass As String = ""
Private _childClass As String = ""
''' <summary>
''' Get all top-level window information
''' </summary>
''' <returns>List of window information objects</returns>
Public Overloads Function GetTopLevelWindows() As List(Of ApiWindow)
EnumWindows(AddressOf EnumWindowProc, &H0)
Return _listTopLevel
End Function
Public Overloads Function GetTopLevelWindows(ByVal className As String) As List(Of ApiWindow)
_topLevelClass = className
Return Me.GetTopLevelWindows()
End Function
''' <summary>
''' Get all child windows for the specific windows handle (hwnd).
''' </summary>
''' <returns>List of child windows for parent window</returns>
Public Overloads Function GetChildWindows(ByVal hwnd As Int32) As List(Of ApiWindow)
' Clear the window list.
_listChildren = New List(Of ApiWindow)
' Start the enumeration process.
EnumChildWindows(hwnd, AddressOf EnumChildWindowProc, &H0)
' Return the children list when the process is completed.
Return _listChildren
End Function
Public Overloads Function GetChildWindows(ByVal hwnd As Int32, ByVal childClass As String) As List(Of ApiWindow)
' Set the search
_childClass = childClass
Return Me.GetChildWindows(hwnd)
End Function
''' <summary>
''' Callback function that does the work of enumerating top-level windows.
''' </summary>
''' <param name="hwnd">Discovered Window handle</param>
''' <returns>1=keep going, 0=stop</returns>
Private Function EnumWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
' Eliminate windows that are not top-level.
If GetParent(hwnd) = 0 AndAlso CBool(IsWindowVisible(hwnd)) Then
' Get the window title / class name.
Dim window As ApiWindow = GetWindowIdentification(hwnd)
' Match the class name if searching for a specific window class.
If _topLevelClass.Length = 0 OrElse window.ClassName.ToLower() = _topLevelClass.ToLower() Then
_listTopLevel.Add(window)
End If
End If
' To continue enumeration, return True (1), and to stop enumeration
' return False (0).
' When 1 is returned, enumeration continues until there are no
' more windows left.
Return 1
End Function
''' <summary>
''' Callback function that does the work of enumerating child windows.
''' </summary>
''' <param name="hwnd">Discovered Window handle</param>
''' <returns>1=keep going, 0=stop</returns>
Private Function EnumChildWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
Dim window As ApiWindow = GetWindowIdentification(hwnd)
' Attempt to match the child class, if one was specified, otherwise
' enumerate all the child windows.
If _childClass.Length = 0 OrElse window.ClassName.ToLower() = _childClass.ToLower() Then
_listChildren.Add(window)
End If
Return 1
End Function
''' <summary>
''' Build the ApiWindow object to hold information about the Window object.
''' </summary>
Private Function GetWindowIdentification(ByVal hwnd As Integer) As ApiWindow
Const WM_GETTEXT As Int32 = &HD
Const WM_GETTEXTLENGTH As Int32 = &HE
Dim window As New ApiWindow()
Dim title As New StringBuilder()
' Get the size of the string required to hold the window title.
Dim size As Int32 = SendMessage(hwnd, WM_GETTEXTLENGTH, 0, 0)
' If the return is 0, there is no title.
If size > 0 Then
title = New StringBuilder(size + 1)
SendMessage(hwnd, WM_GETTEXT, title.Capacity, title)
End If
' Get the class name for the window.
Dim classBuilder As New StringBuilder(64)
GetClassName(hwnd, classBuilder, 64)
' Set the properties for the ApiWindow object.
window.ClassName = classBuilder.ToString()
window.MainWindowTitle = title.ToString()
window.hWnd = hwnd
Return window
End Function
End Class
Technorati Tags: vb.net,.NET Framework,csharp,Handles,Window,Process,System,Generic,Runtime,InteropServices,Text,ApiWindow,MainWindowTitle,WindowsEnumerator,GetTopLevelWindows,GetChildWindows,Delegate,EnumCallBackDelegate,EnumWindows,EnumChildWindows,GetClassName,Alias,IsWindowVisible,parent,GetParent,signature,SendMessage,SendMessageA,EnumWindowProc,enumeration,EnumChildWindowProc,Callback,WM_GETTEXT,WM_GETTEXTLENGTH,collection,hWND,enumerator
Windows Live Tags: vb.net,.NET Framework,csharp,Handles,Window,Process,System,Generic,Runtime,InteropServices,Text,ApiWindow,MainWindowTitle,WindowsEnumerator,GetTopLevelWindows,GetChildWindows,Delegate,EnumCallBackDelegate,EnumWindows,EnumChildWindows,GetClassName,Alias,IsWindowVisible,parent,GetParent,signature,SendMessage,SendMessageA,EnumWindowProc,enumeration,EnumChildWindowProc,Callback,WM_GETTEXT,WM_GETTEXTLENGTH,collection,hWND,enumerator
Fun with FTP in vb.net
Posted by Kelly's Chronicles in .NET on June 20, 2008
Since GE Healthcare has us working in 1.1 of the framework these days, I don’
t have the advantage of using the packaged FTP control. But I have gotten one written using 2.0 technology now that will be far superior to the class I have been using. We will at some point be upgrading our applications to the new version of the framework and hopefully soon cause I am excited to begin working with the new tools.
' Add a reference to Microsoft.mshtml to the project.
Imports System
Imports System.IO
Imports System.Net
Imports System.Text.RegularExpressions
Imports System.Web
Public Class FtpProcessor
Private Const BLOCK_SIZE As Integer = 4096
Public Shared Function ListDirectory(ByVal host As String, ByVal remoteDirectory As String) As List(Of FtpDirectoryEntry)
Return ListDirectory(host, remoteDirectory, "", "")
End Function
''' <summary>
''' Get a directory listing from the FTP server. Parse the HTML response
''' to build a list of FtpDirectoryEntry objects describing each entry.
''' </summary>
''' <returns>A list of FTP server directory entries.</returns>
Public Shared Function ListDirectory(ByVal host As String, ByVal remoteDirectory As String, ByVal userName As String, ByVal password As String) As List(Of FtpDirectoryEntry)
' Build the URL to point to the remote file to download
Dim uri As String = FormatHost(host) & remoteDirectory
' Build an FTP request to download the file
Dim request As FtpWebRequest = CType(FtpWebRequest.Create(uri), FtpWebRequest)
' Setup the request.
request.Method = WebRequestMethods.Ftp.ListDirectory
request.KeepAlive = False
InitializeRequest(request, uri, userName, password)
' Get the response from the FTP server
Using response As FtpWebResponse = CType(request.GetResponse(), FtpWebResponse)
' Get the file stream from the response.
Using stream As Stream = response.GetResponseStream()
Using reader As New StreamReader(stream)
Dim commandResult As String = reader.ReadToEnd()
Return ParseAnchors(commandResult)
End Using
End Using
End Using
Return Nothing
End Function
Public Shared Sub DownloadFile(ByVal host As String, ByVal remoteFile As String, ByVal localFile As String)
DownloadFile(host, remoteFile, localFile, "", "")
End Sub
''' <summary>
''' Download the remote file to the local file name.
''' </summary>
Public Shared Sub DownloadFile(ByVal host As String, ByVal remoteFile As String, ByVal localFile As String, ByVal userName As String, ByVal password As String)
' Build the URL to point to the remote file to download
Dim uri As String = FormatHost(host) & " " & remoteFile
' Build an FTP request to download the file
Dim request As FtpWebRequest = CType(FtpWebRequest.Create(uri), FtpWebRequest)
' Setup the request.
request.Method = WebRequestMethods.Ftp.DownloadFile
InitializeRequest(request, uri, userName, password)
' Get the response from the FTP server
Using response As FtpWebResponse = CType(request.GetResponse(), FtpWebResponse)
' Get the file stream from the response.
Using input As Stream = response.GetResponseStream()
' Save the file stream to a local file
Using output As New FileStream(localFile, FileMode.CreateNew)
' Read the input file stream from the response.
Using reader As New BinaryReader(input)
' Write the input file stream to the output file, one block at a time.
Using writer As New BinaryWriter(output)
While reader.PeekChar() <> -1
writer.Write(reader.ReadBytes(BLOCK_SIZE))
End While
End Using
End Using
End Using
End Using
End Using
End Sub
Public Shared Function UploadFile(ByVal host As String, ByVal remoteFile As String, ByVal localFile As String) As String
Return UploadFile(host, remoteFile, localFile, "", "")
End Function
''' <summary>
''' Upload the local file to the host as the remote file.
''' </summary>
''' <returns>Status description from the server response.</returns>
Public Shared Function UploadFile(ByVal host As String, ByVal remoteFile As String, ByVal localFile As String, _
ByVal userName As String, ByVal password As String) As String
Dim uri As String = FormatHost(host) & " " & remoteFile
Dim contentLength As Long = New FileInfo(localFile).Length
Dim request As FtpWebRequest = CType(WebRequest.Create(uri), FtpWebRequest)
InitializeRequest(request, uri, userName, password)
request.ContentLength = contentLength
request.Method = WebRequestMethods.Ftp.UploadFile
Using localStream As New FileStream(localFile, FileMode.Open, FileAccess.Read, FileShare.None)
Using reader As New BinaryReader(localStream)
Using uploadStream As Stream = request.GetRequestStream()
Using writer As New BinaryWriter(uploadStream)
For count As Long = 0 To contentLength Step BLOCK_SIZE
writer.Write(reader.ReadBytes(BLOCK_SIZE))
Next count
End Using
End Using
End Using
End Using
Using response As FtpWebResponse = CType(request.GetResponse(), FtpWebResponse)
Return response.StatusDescription
End Using
End Function
''' <summary>
''' Make sure that the host is in the format ftp://host/
''' </summary>
Private Shared Function FormatHost(ByVal host As String) As String
host = host.Trim().ToLower().TrimStart("//").TrimStart("\\").TrimEnd("\")
If Not host.StartsWith("ftp://") Then
host = "ftp://" & host
End If
If Not host.EndsWith("/") Then
host &= "/"
End If
Return host
End Function
''' <summary>
''' Set up the FtpWebRequest for SSL, UseBinary, credentials, and proxy.
''' </summary>
Private Shared Sub InitializeRequest(ByVal request As FtpWebRequest, ByVal uri As String, ByVal userName As String, ByVal password As String)
request.UseBinary = True
request.KeepAlive = False
request.EnableSsl = uri.StartsWith("https")
If userName.Trim().Length > 0 AndAlso password.Trim().Length > 0 Then
request.Credentials = New NetworkCredential(userName, password)
End If
If WebProxy.GetDefaultProxy().Address IsNot Nothing Then
Dim proxy As New WebProxy()
proxy.UseDefaultCredentials = True
proxy.Address = WebProxy.GetDefaultProxy().Address
request.Proxy = proxy
End If
End Sub
''' <summary>
''' Find all the directories and files in the HTML response from the server.
''' </summary>
Private Shared Function ParseAnchors(ByVal html As String) As List(Of FtpDirectoryEntry)
Dim document As New mshtml.HTMLDocumentClass()
TryCast(document, mshtml.IHTMLDocument2).write(html)
Dim list As New List(Of FtpDirectoryEntry)()
For Each element As mshtml.HTMLBRElement In document.getElementsByTagName("br")
Dim sibling As Object = element.nextSibling
Dim entry As FtpDirectoryEntry = Nothing
While sibling IsNot Nothing
If TypeOf sibling Is mshtml.IHTMLDOMTextNode Then
Dim textNode As mshtml.IHTMLDOMNode = CType(sibling, mshtml.IHTMLDOMNode)
entry = New FtpDirectoryEntry()
ParseDirectoryEntry(entry, textNode.nodeValue)
sibling = textNode.nextSibling
ElseIf TypeOf sibling Is mshtml.HTMLAnchorElement Then
Dim anchor As mshtml.HTMLAnchorElement = CType(sibling, mshtml.HTMLAnchorElement)
entry.Name = anchor.innerText
sibling = anchor.nextSibling
list.Add(entry)
End If
End While
Next element
Return list
End Function
''' <summary>
''' Parse the date/time and directory #text node text
''' </summary>
''' <example>
''' <![CDATA[02/08/05 12:00AM <DIR>]]>
''' </example>
Private Shared Sub ParseDirectoryEntry(ByVal entry As FtpDirectoryEntry, ByVal input As String)
Dim pattern As String = "(?<timestamp>\d{1,2}/\d{1,2}/\d{2,4}\s+\d{1,2}:\d{1,2}\s?(AM|PM))\s+(?<dir>\<DIR\>)?"
Dim match As Match = Regex.Match(input, pattern, RegexOptions.IgnoreCase)
If match.Success Then
Dim result As Date
If Date.TryParse(match.Groups("timestamp").Value, result) Then
entry.Timestamp = result
End If
If match.Groups("dir").Length > 0 Then
entry.IsDirectory = True
End If
End If
End Sub
End Class
Public Class FtpDirectoryEntry
Public IsDirectory As Boolean
Public Name As String
Public Timestamp As DateTime
End Class
Serialize a Class to XML that contains another class with vb.net
Posted by Kelly's Chronicles in Uncategorized on June 19, 2008
I had the 2 classes. I’m trying to serialize them into XML in an application I was dealing with at GE Healthcare. Here is the result I’m getting:
<Main>
<Field1 />
<Field2 />
</Main>
This is the result I would like to be getting:
<Main>
<Common>
<Market />
<AcctNum />
</Common>
<Field1 />
<Field2 />
</Main>
I didn’t understand what I was missing. Well it turns out I was trying to set two roots with both classes having the XmlRoot attribute. So here is what I came up with. Hope it helps someone.
<Serializable(), XmlRoot("Main")> _
Public Class clsMain
<XmlElement("Common")> _
Public Common As New clsCommon()
Private m_Field1 As String = String.Empty
<XmlAttribute("field1")> _
Public Property Field1() As String
Get
Return m_Field1
End Get
Set(ByVal value As String)
m_Field1 = value.ToString
End Set
End Property
Private m_Field2 As String = String.Empty
<XmlAttribute("field2")> _
Public Property Field2() As String
Get
Return m_Field2
End Get
Set(ByVal value As String)
m_Field2 = value.ToString
End Set
End Property
Public Function Serialize() As XmlDocument
Dim serializer As New XmlSerializer(Me.GetType())
Dim writer As New StringWriter()
Dim serializedObject As New XmlDocument()
serializer.Serialize(writer, Me)
serializedObject.LoadXml(writer.ToString())
Return serializedObject
End Function
Public Sub Serialize(ByVal fileName As String)
Dim ns As New XmlSerializerNamespaces()
ns.Add("", "")
Dim serializer As New XmlSerializer(Me.GetType())
Using stream As New FileStream(fileName, FileMode.Create)
serializer.Serialize(stream, Me, ns)
End Using
End Sub
End Class
<Serializable()> _
Public Class clsCommon
Private m_Market As String = String.Empty
<XmlAttribute("market")> _
Public Property Market() As String
Get
Return m_Market
End Get
Set(ByVal value As String)
m_Market = value.ToString
End Set
End Property
Private m_AcctNum As String = String.Empty
<XmlAttribute("acct")> _
Public Property AcctNum() As String
Get
Return m_AcctNum
End Get
Set(ByVal value As String)
m_AcctNum = value.ToString
End Set
End Property
End Class
It’s usage would be
Dim c As New clsMain()
c.Common.AcctNum = "1"
c.Common.Market = "Industry"
c.Field1 = "f1"
c.Field2 = "f2"
c.Serialize("c:\temp\main.xml")
Create Directory Structure From XML File with vb.net
Posted by Kelly's Chronicles in .NET on June 18, 2008
One of my assignments at GE Healthcare was to recreate a directory structure from a an already created XML file. This is what I came up with.
Make sure you put:
Imports System.IO
Imports System.Xml
At the top of your class.
Hope it helps someone.
Private Sub button4_Click(ByVal sender As Object, ByVal e As EventArgs)
Dim document As New XmlDocument()
document.Load("C:\test.xml")
CreateDirectories("c:\temp\test\", document.SelectNodes("root/folder"))
End Sub
Private Sub CreateDirectories(ByVal directory As String, ByVal nodes As XmlNodeList)
For Each node As XmlNode In nodes
Dim directoryName As String = node.Attributes("name").Value
Dim fullPath As String = directory + directoryName + "\"
Directory.CreateDirectory(fullPath)
If node.HasChildNodes Then
CreateDirectories(fullPath, node.ChildNodes)
End If
Next
End Sub
Fix Invalid Characters in XML File with vb.net
Posted by Kelly's Chronicles in .NET on June 17, 2008
In the workplace you probably use XML files quite a bit. Java based xml files can produce some tricky situations where there are invisible or invalid characters exist and you need to clean them up prior to using dataset.readxml. I racked my brain for a while but came up with this method to remove those characters. I figured out what the problem was when I opened the xml file in notepad and noticed the square windows uses to represent characters it does not know what to do with. Hope it helps someone.
Public Function CleanString(ByVal s As String) As String
Dim st As String = s
For i As Integer = 0 To 7
st = st.Replace(Chr(i), "")
Next
For i As Integer = 11 To 12
st = st.Replace(Chr(i), "")
Next
For i As Integer = 14 To 31
st = st.Replace(Chr(i), "")
Next
Return st
End Function
Technorati Tags: vb.net,.NET Framework,csharp,XML,Fix,Invalid,Characters,File,files,Java,notepad,Replace,situations
Windows Live Tags: vb.net,.NET Framework,csharp,XML,Fix,Invalid,Characters,File,files,Java,notepad,Replace,situations
Kelly's Chronicles 
Recent Comments