CodeKeep VB.NET Feed

Google Map Geocoder Class

Wed, 28 Oct 2009 18:04:03 GMT

Description: googleMap Geocoder Class retrieves from Google API latitude and longitude coordinates from supplied address MUST SUPPLY GOOGLE MAP API KEY FOR EACH NEW DOMAIN http://code.google.com/apis/maps/signup.html

Link: http://www.codekeep.net/snippets/bf54a251-5f07-41d6-a11b-2f119b5386af.aspx

Imports Microsoft.VisualBasic
Imports System.Net
Imports System.IO

Public Class geocode
    Private Shared xLat As Double  'Returned Latitude
    Private Shared xLng As Double  'Returned Longitude
    Private Shared xStatusDesc As String 'Lookup Description from xStatus
    Private Shared xStatus As Integer 'Returned Status Code
    Private xAccuracy As Integer    'Degree of accuracy return from google parsing address
    Private xAccuracyDesc As String 'Lookup Description from xAccuracy
    Private xMinAccuracy As Acc = Acc.Intersection 'Minimum Accuracy desired

    Private xStreetAddress As String
    Private xCity As String
    Private xState As String
    Private xPostalCode As String
    Private xCountry As String

    Public Enum Acc 'Accuracy Settings
        Unknown = 0
        Country = 1
        Region = 2
        Sub_Region = 3
        Town = 4
        PostalCode = 5
        Street = 6
        Intersection = 7
        Address = 8
        Premise = 9
    End Enum

    Public Property MinAccuracy() As Acc
        Get
            Return xMinAccuracy
        End Get
        Set(ByVal value As Acc)
            xMinAccuracy = value
        End Set
    End Property

    Public Property setStreetAddress() As String
        Get
            Return xStreetAddress
        End Get
        Set(ByVal value As String)
            xStreetAddress = value
        End Set
    End Property

    Public Property setCity() As String
        Get
            Return xCity
        End Get
        Set(ByVal value As String)
            xCity = value
        End Set
    End Property

    Public Property setState() As String
        Get
            Return xState
        End Get
        Set(ByVal value As String)
            xState = value
        End Set
    End Property

    Public Property setPostalCode() As String
        Get
            Return xPostalCode
        End Get
        Set(ByVal value As String)
            xPostalCode = value
        End Set
    End Property

    Public Property setCountry() As String
        Get
            Return xCountry
        End Get
        Set(ByVal value As String)
            xCountry = value
        End Set
    End Property


    Public ReadOnly Property AccuracyDesc() As String
        Get
            Select Case xAccuracy
                Case 0
                    xAccuracyDesc = "Unknown accuracy."
                Case 1
                    xAccuracyDesc = "Country level accuracy."
                Case 2
                    xAccuracyDesc = "Region (state, province, prefecture, etc.) level accuracy."
                Case 3
                    xAccuracyDesc = "Sub-region (county, municipality, etc.) level accuracy."
                Case 4
                    xAccuracyDesc = "Town (city, village) level accuracy."
                Case 5
                    xAccuracyDesc = "Post code (zip code) level accuracy."
                Case 6
                    xAccuracyDesc = "Street level accuracy."
                Case 7
                    xAccuracyDesc = "Intersection level accuracy."
                Case 8
                    xAccuracyDesc = "Address level accuracy."
                Case 9
                    xAccuracyDesc = "Premise (building name, property name, shopping center, etc.) level accuracy."
                Case Else
                    xAccuracyDesc = "Unknown accuracy."
            End Select
            Return xAccuracyDesc
        End Get
    End Property
    Public ReadOnly Property Accuracy() As Integer
        Get
            Return xAccuracy
        End Get

    End Property

    Public ReadOnly Property StatusDesc() As String
        Get
            Select Case xStatus
                Case 200
                    xStatusDesc = "G_GEO_SUCCESS"
                Case 500
                    xStatusDesc = "G_GEO_SERVER_ERROR"
                Case 601
                    xStatusDesc = "G_GEO_MISSING_QUERY"
                Case 602
                    xStatusDesc = "G_GEO_UNKNOWN_ADDRESS"
                Case 603
                    xStatusDesc = "G_GEO_UNAVAILABLE_ADDRESS"
                Case 610
                    xStatusDesc = "G_GEO_BAD_KEY"
                Case 620
                    xStatusDesc = "G_GEO_TOO_MANY_QUERIES"
                Case Else
                    xStatusDesc = "UNKNOWN ERROR"
            End Select
            Return xStatusDesc
        End Get
    End Property
    Public ReadOnly Property geo_status() As Integer
        Get
            Return xStatus
        End Get
    End Property
    Public ReadOnly Property lat() As Double
        Get
            Return xLat
        End Get
    End Property
    Public ReadOnly Property lng() As Double
        Get
            Return xLng
        End Get
    End Property
    Public Sub New()
        MinAccuracy = Acc.Intersection 'set as default minumum accuracy
    End Sub
    Public Sub New(ByVal setAccuracy As Acc)
        MinAccuracy = setAccuracy
    End Sub

    Public Sub getAddress()
        getAddress(xStreetAddress & ", " & xCity & ", " & xState & " " & xPostalCode & " " & xCountry)
    End Sub

    Public Sub getAddress(ByVal streetAddress As String, ByVal city As String, ByVal state As String, ByVal postalCode As String, Optional ByVal country As String = "")
        getAddress(streetAddress & ", " & city & ", " & state & " " & postalCode & " " & country)
    End Sub

    Public Sub getAddress(ByVal fulladdress As String)
        Dim url As String = "http://maps.google.com/maps/geo?q=" & HttpContext.Current.Server.UrlEncode(fulladdress) & _
       "&output=csv&key=" & ConfigurationManager.AppSettings("GoogleMapKey")
        Dim latlong As String


        With WebRequest.Create(New Uri(url)).GetResponse()
            With New StreamReader(.GetResponseStream())
                latlong = .ReadToEnd()
            End With
        End With

        Dim thedata(3) As String
        thedata = latlong.Split(",")
        If thedata(0) = "200" And thedata(1) >= xMinAccuracy Then
            xLat = thedata(2)
            xLng = thedata(3)
        End If
        xStatus = thedata(0)
        xAccuracy = thedata(1)

    End Sub
End Class

Marquee Control in VB.NET / C# for Windows application

Wed, 28 Oct 2009 05:58:14 GMT

Description: Marquee Control is used to display scrolling text. Marquee Control / Marquee Label/ Marquee Text in VB.NET / C# for Windows application

Link: http://www.codekeep.net/snippets/d55af57f-2983-4fe4-b9da-39b7268157c6.aspx

Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.ComponentModel

<ToolboxBitmap(GetType(TextBox))> _
<Description("This control is used to display scrolling text.")> _
Public Class ScrollingMarquee
    Inherits System.Windows.Forms.UserControl

    Friend WithEvents tmrMain As System.Windows.Forms.Timer

    Private startPosition As Integer = 0
    Private m_MarqueeText As String = String.Empty
    Private m_LeftToRight As Direction = Direction.Left
    Private m_ScrollSpeed As Integer = 5
    Private m_ShadowColor As Color = Color.Black
    Private hDC As IntPtr

    Private Structure tSize
        Dim X As Long
        Dim Y As Long
    End Structure

    Public Enum Direction
        Left
        Right
    End Enum

    Public Sub New()
        MyBase.New()
        InitializeComponent()
        AddHandler MyBase.Paint, AddressOf OnPaint
    End Sub

    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.components = New System.ComponentModel.Container
        Me.tmrMain = New System.Windows.Forms.Timer(Me.components)
        Me.tmrMain.Enabled = True
        Me.Name = "ScrollingMarquee"
        Me.Size = New System.Drawing.Size(120, 13)
        Me.BackColor = Color.White
        Me.ForeColor = Color.Red
        Me.Dock = DockStyle.Top
    End Sub

    <Category("Marquee")> _
    <Description("Gets/Sets the text that scrolls accross the marquee.")> _
    Public Property MarqueeText() As String
        Get
            MarqueeText = m_MarqueeText
        End Get
        Set(ByVal Value As String)
            m_MarqueeText = Value
            Invalidate()
        End Set
    End Property

    <Category("Marquee")> _
    <Description("Gets/Sets the direction of the control")> _
    Public Property ScrollLeftToRight() As Direction
        Get
            Return Me.m_LeftToRight
        End Get
        Set(ByVal Value As Direction)
            m_LeftToRight = Value
            Invalidate()
        End Set
    End Property

    <Category("Marquee")> _
    <Description("Gets/Sets the scroll speed of the control. Values can be from 1 to 10.")> _
    <DefaultValue(5)> _
    Public Property ScrollSpeed() As Integer
        Get
            ScrollSpeed = m_ScrollSpeed
        End Get
        Set(ByVal Value As Integer)

            If Value < 1 Then
                m_ScrollSpeed = 1
            ElseIf Value > 10 Then
                m_ScrollSpeed = 10
            Else
                m_ScrollSpeed = Value
            End If

            Me.tmrMain.Interval = Value * 10
            Invalidate()
        End Set
    End Property

    <Category("Marquee")> _
    <Description("Gets/Sets the color of the shadow text.")> _
    Public Property ShadowColor() As Color
        Get
            ShadowColor = m_ShadowColor
        End Get
        Set(ByVal Value As Color)
            m_ShadowColor = Value
            Invalidate()
        End Set
    End Property

    Private Sub ScrollingMarquee_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.DoubleBuffer Or ControlStyles.ResizeRedraw Or ControlStyles.UserPaint, True)
    End Sub

    Private Sub tmrMain_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrMain.Tick
        If m_MarqueeText.Length = 0 Then Exit Sub
        Invalidate()
    End Sub

    Private Sub ScrollingMarquee_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Resize
        Invalidate()
    End Sub

    Private Sub ScrollingMarquee_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.SizeChanged
        Invalidate()
    End Sub

    Private Overloads Sub OnPaint(ByVal sender As Object, ByVal e As PaintEventArgs)
        Dim str As String = m_MarqueeText
        Dim g As Graphics = e.Graphics
        Dim szf As SizeF

        g.SmoothingMode = SmoothingMode.HighQuality
        szf = g.MeasureString(Me.Width, Me.Font)
        If m_LeftToRight = Direction.Right Then
            If startPosition > Me.Width Then
                startPosition = -szf.Width
            Else
                startPosition += 1
            End If
        ElseIf m_LeftToRight = Direction.Left Then
            If startPosition < -szf.Width - 120 Then
                startPosition = Me.Width
            Else
                startPosition -= 1
            End If
        End If
        Debug.WriteLine(startPosition)
        g.DrawString(m_MarqueeText, Me.Font, New SolidBrush(Me.ForeColor), startPosition, 0 + (Me.Height / 2) - (szf.Height / 2))
    End Sub

    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub
End Class

Getting a count with LINQ

Tue, 27 Oct 2009 11:45:39 GMT

Description: I couldn't find an example of how to do this ANYWHERE until I saw this on Mike McIntyres blog at http://cs.vbcity.com/blogs/mike-mcintyre/archive/2009/09/09/use-linq-to-count-occurrences-of-a-character-in-a-string.aspx

Link: http://www.codekeep.net/snippets/a1260db7-f97d-49fc-85bc-2815926d6f0c.aspx

Dim searchString As String = "This is the dawning of the age." 
Dim count As Integer = (From s In searchString.ToCharArray Where s = "i" Select s).Count

Paging with stored procedure for Data Page

Mon, 26 Oct 2009 06:05:25 GMT

Description: With the we can show pages with the data

Link: http://www.codekeep.net/snippets/6bcd64f3-2340-48d6-ae31-f117264cae34.aspx

http://www.codeproject.com/KB/custom-controls/ASPNETPagerControl.aspx
http://www.codeproject.com/KB/custom-controls/CollectionPager.aspx

EDIT CONTENT API

Fri, 23 Oct 2009 11:24:40 GMT

Description: EDIT CONTENT API EKTRON

Link: http://www.codekeep.net/snippets/bb8acc78-6e66-4162-9fef-76ee411c7951.aspx

    Protected Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim capi As New Ektron.Cms.API.Content.Content

        Dim cdata As New Ektron.Cms.ContentData

        Dim data As New Ektron.Cms.ContentEditData

        Dim saveContentID As Integer

        saveContentID = 954

        cdata = capi.GetContent(saveContentID, Ektron.Cms.Content.EkContent.ContentResultType.Published)

        capi.CheckOutContent(saveContentID)

        data = capi.GetContentForEditing(saveContentID)

        data.Title = "my new"

        capi.SaveContent(data)

        capi.PublishContent(saveContentID, data.FolderId, data.LanguageId, "", capi.UserId, "")
    End Sub
End Class

Advance Ajax toop tip for grid view and other tooptip example

Thu, 22 Oct 2009 15:46:57 GMT

Description: http://devarchive.net/advanced-tooltip-control-asp-net-ajax.aspx http://www.walterzorn.com/tooltip/tooltip_e.htm

Link: http://www.codekeep.net/snippets/7241ab67-1a20-4631-acb7-27588de2973b.aspx

http://devarchive.net/advanced-tooltip-control-asp-net-ajax.aspx
http://www.walterzorn.com/tooltip/tooltip_e.htm

row bind method

Thu, 22 Oct 2009 09:34:50 GMT

Description: here we can bind the data when row is creating

Link: http://www.codekeep.net/snippets/ca85442f-0561-4b8e-ab9f-69e82382cf1c.aspx

Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.GridViewRowEventArgs) Handles GridView1.RowDataBound

        If e.Row.FindControl("imgPackage") IsNot Nothing Then

            Dim imgPackage As Image = CType(e.Row.FindControl("imgPackage"), Image)

            imgPackage.ImageUrl = "..\images\" + DataBinder.Eval(e.Row.DataItem, "sp_smallimage").ToString()


        End If

    End Sub

Get child Taxonomy by depth Ektron

Tue, 20 Oct 2009 19:22:37 GMT

Description: Get child Taxonomy by depth Ektron

Link: http://www.codekeep.net/snippets/cee62cd5-30d1-48db-b54f-ff57966e0ff3.aspx

    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Dim taxid As Long
        taxid = 91
        Dim taxapi As New Ektron.Cms.API.Content.Taxonomy
        Dim taxrequest As New Ektron.Cms.TaxonomyRequest

        taxrequest.TaxonomyId = taxid
        taxrequest.Depth = -1
        taxrequest.IncludeItems = True
        taxrequest.TaxonomyLanguage = 2057


        Dim taxdata As Ektron.Cms.TaxonomyData = taxapi.LoadTaxonomy(taxrequest)
        Dim taxitem As Ektron.Cms.TaxonomyItemData
        Dim a As Integer = 0
        Dim b As Integer = 0

        ' Get items in current category
        For a = 0 To taxdata.TaxonomyItems.Length - 1
            Response.Write(taxdata.TaxonomyItems(a).TaxonomyItemTitle + "<br/>")
        Next

        ' get items in sub-categories
        For a = 0 To taxdata.Taxonomy.Length - 1
            For b = 0 To taxdata.Taxonomy(a).TaxonomyItems.Length - 1
                Response.Write(taxdata.Taxonomy(a).TaxonomyItems(b).TaxonomyItemTitle + "<br/>")
            Next
        Next
    End Sub
End Class

VS Macro : Collapse Solution

Tue, 20 Oct 2009 11:33:42 GMT

Description: Visual studio macro to collapse the Solution Explorer hierarchy.

Link: http://www.codekeep.net/snippets/7c441096-15cb-4aa2-a7d8-f85012f14f4b.aspx

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports System.Diagnostics

Public Module Collapse

    'keep a reference to the current project
    Dim project As EnvDTE.UIHierarchyItem

    Sub CollapseAll()

        ' Get the the Solution Explorer tree
        Dim solutionExplorer As UIHierarchy
        solutionExplorer = DTE.Windows.Item(Constants.vsext_wk_SProjectWindow).Object()

        ' Check if there is any open solution
        If (solutionExplorer.UIHierarchyItems.Count = 0) Then
            Return
        End If

        ' Get the top node (the name of the solution)
        Dim rootNode As UIHierarchyItem = solutionExplorer.UIHierarchyItems.Item(1)
        rootNode.DTE.SuppressUI = True

        ' Collapse each project node
        Collapse(rootNode, solutionExplorer)

        ' Select the solution node, or else when you click 
        ' on the solution window
        ' scrollbar, it will synchronize the open document 
        ' with the tree and pop
        ' out the corresponding node which is probably not what you want.

        rootNode.Select(vsUISelectionType.vsUISelectionTypeSelect)
        rootNode.DTE.SuppressUI = False

    End Sub
    Public Sub Collapse()

        Dim solutionExplorer As UIHierarchy
        solutionExplorer = DTE.Windows.Item(Constants.vsext_wk_SProjectWindow).Object()

        For Each innerItem As UIHierarchyItem In solutionExplorer.SelectedItems
            Collapse(innerItem, solutionExplorer)
            innerItem.UIHierarchyItems.Expanded = False
        Next

    End Sub

    Private Sub Collapse(ByVal item As UIHierarchyItem, ByRef solutionExplorer As UIHierarchy)

        For Each innerItem As UIHierarchyItem In item.UIHierarchyItems
            If innerItem.UIHierarchyItems.Count > 0 Then

                ' Re-cursive call
                Collapse(innerItem, solutionExplorer)

                ' Collapse
                If innerItem.UIHierarchyItems.Expanded Then
                    innerItem.UIHierarchyItems.Expanded = False
                    If innerItem.UIHierarchyItems.Expanded = True Then
                        ' Bug in VS 2005
                        innerItem.Select(vsUISelectionType.vsUISelectionTypeSelect)
                        solutionExplorer.DoDefaultAction()
                    End If
                End If

            End If
        Next

    End Sub


End Module

VS Macro : Remove and Sort Usings

Tue, 20 Oct 2009 11:31:15 GMT

Description: Visual Studio macro that removes and sorts all using statements from the top of classes.

Link: http://www.codekeep.net/snippets/dc61880f-161f-479b-b4eb-6c971552e667.aspx

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports EnvDTE90
Imports System.Diagnostics

Public Module RemoveAndSortUsings

    Sub OrganizeSolution()
        Dim sol As Solution = DTE.Solution
        For i As Integer = 1 To sol.Projects.Count
            OrganizeProject(sol.Projects.Item(i))
        Next
    End Sub

    Private Sub OrganizeProject(ByVal proj As Project)
        For i As Integer = 1 To proj.ProjectItems.Count
            OrganizeProjectItem(proj.ProjectItems.Item(i))
        Next
    End Sub

    Private Sub OrganizeProjectItem(ByVal projectItem As ProjectItem)
        Dim fileIsOpen As Boolean = False
        If projectItem.Kind = Constants.vsProjectItemKindPhysicalFile Then
            'If this is a c# file 
            If projectItem.Name.LastIndexOf(".cs") = projectItem.Name.Length - 3 Then
                'Set flag to true if file is already open 
                fileIsOpen = projectItem.IsOpen
                Dim window As Window = projectItem.Open(Constants.vsViewKindCode)
                window.Activate()
                projectItem.Document.DTE.ExecuteCommand("Edit.RemoveAndSort")
                'Only close the file if it was not already open 
                If Not fileIsOpen Then
                    window.Close(vsSaveChanges.vsSaveChangesYes)
                End If
            End If
        End If
        'Be sure to apply RemoveAndSort on all of the ProjectItems. 
        If Not projectItem.ProjectItems Is Nothing Then
            For i As Integer = 1 To projectItem.ProjectItems.Count
                OrganizeProjectItem(projectItem.ProjectItems.Item(i))
            Next
        End If
        'Apply RemoveAndSort on a SubProject if it exists. 
        If Not projectItem.SubProject Is Nothing Then
            OrganizeProject(projectItem.SubProject)
        End If
    End Sub
End Module

Console.Write/Read

Fri, 16 Oct 2009 09:11:22 GMT

Description: Console.Write/Read

Link: http://www.codekeep.net/snippets/af378b9d-4e64-4734-a2cb-d00a6925829a.aspx

        Console.Write("Enter user name: ")
        Dim un As String = Console.ReadLine()
        If un.Length = 0 Then
            Return False
        End If

        Console.Write("Enter password: ")
        Dim pw As String = Console.ReadLine()
        If pw.Length = 0 Then
            Return False
        End If

Update XML Node Using XMLDocument

Wed, 14 Oct 2009 02:04:03 GMT

Description: This code updates an XML Node with a new RSS feed web address.

Link: http://www.codekeep.net/snippets/df60ba59-6927-42bd-9cfb-096ee269a41c.aspx

'...code to pop a dialog and allow the user to update the feed address
'...
                Try
                    Dim nodeInnerText As String = ""
                    Dim channel_node As Xml.XmlNode
                    Dim item_node As Xml.XmlNode
                    Dim item_child As Xml.XmlNode
                    Dim xmlRssDoc As New Xml.XmlDocument
                    xmlRssDoc.Load(My.Computer.FileSystem.SpecialDirectories.MyDocuments.ToString + pgrss_constants.DEFAULT_RSS_FEEDS)
                    channel_node = xmlRssDoc.DocumentElement
                    For Each channel_node In channel_node.ChildNodes
                        For Each item_node In channel_node.ChildNodes
                            For Each item_child In item_node.ChildNodes
                                If item_child.Name = "link" Then
                                    nodeInnerText = item_child.InnerText
                                    If nodeInnerText.Equals(origUrl) Then 'if what we found is the feed URL we want to change
                                        Dim oxml As New XML_Parser        'create a new parser object
                                        oxml.SaveRss()                    'save user's current RSS Channels & Feeds to a date-timestamp
                                        oxml = Nothing
                                        item_child.InnerText = x.Url      'update the feeds URL with new one
                                    End If
                                End If
                            Next
                        Next
                    Next
                    'if the temporary file exists the modify will bomb so this first bit handles that issue
                    If System.IO.File.Exists(My.Computer.FileSystem.SpecialDirectories.MyDocuments.ToString + pgrss_constants.DEFAULT_RSS_TEMP) Then
                        File.Delete(My.Computer.FileSystem.SpecialDirectories.MyDocuments.ToString + pgrss_constants.DEFAULT_RSS_TEMP)
                    End If
                    'for some bizarre reason when saving to a file with the same name the change doesn't work.
                    'this could be due to the original file name being locked or otherwise engaged by the system.
                    'so this bit saves it to a "new" temporary name and then moves the temporary file to the correct name
                    xmlRssDoc.Save(My.Computer.FileSystem.SpecialDirectories.MyDocuments.ToString + pgrss_constants.DEFAULT_RSS_TEMP)
                    File.Move(My.Computer.FileSystem.SpecialDirectories.MyDocuments.ToString + pgrss_constants.DEFAULT_RSS_TEMP, My.Computer.FileSystem.SpecialDirectories.MyDocuments.ToString + pgrss_constants.DEFAULT_RSS_FEEDS)
'...
'...code to complete update to internal hashtable

VB.net Get data with Access and SQL

Tue, 06 Oct 2009 13:26:46 GMT

Description: Function that will return a dataset object from an access database

Link: http://www.codekeep.net/snippets/b85498b1-5cee-402c-a3e3-d2b1ae146867.aspx

Function GetData(byval x as String) As System.Data.DataSet

    

        Dim connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0; Ole DB Services=-4; Data Source=\\artemis\MHIS\ff\ff.mdb " 


        Dim dbConnection As System.Data.IDbConnection = New System.Data.OleDb.OleDbConnection(connectionString)

        Dim queryString As String = x

        Dim dbCommand As System.Data.IDbCommand = New System.Data.OleDb.OleDbCommand

        dbCommand.CommandText = queryString

        dbCommand.Connection = dbConnection

        

        Dim dataAdapter As System.Data.IDbDataAdapter = New System.Data.OleDb.OleDbDataAdapter

        dataAdapter.SelectCommand = dbCommand

        Dim dataSet As System.Data.DataSet = New System.Data.DataSet

        dataAdapter.Fill(dataSet)

        

        Return dataSet

    End Function

VB.net Set data with Access and SQL

Tue, 06 Oct 2009 13:23:53 GMT

Description: This function takes a SQL String and executes it against the relative access db. Use with ODBC drivers to get function for Sybase etc

Link: http://www.codekeep.net/snippets/58789227-81ba-4c3e-af15-2aeaa5fcd1e1.aspx

    Public Sub SetData(byval x as string)

  

	Dim connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0; Ole DB Services=-4; Data Source=\\artemis\MHIS\ff\ff.mdb"

        Dim dbConnection As System.Data.IDbConnection = New System.Data.OleDb.OleDbConnection(connectionString)

        

        Dim queryString As String = x

        Dim dbCommand As System.Data.IDbCommand = New System.Data.OleDb.OleDbCommand

        dbCommand.CommandText = queryString

        dbCommand.Connection = dbConnection

        

        Dim dataAdapter As System.Data.IDbDataAdapter = New System.Data.OleDb.OleDbDataAdapter

        dataAdapter.SelectCommand = dbCommand

        Dim dataSet As System.Data.DataSet = New System.Data.DataSet

        dataAdapter.Fill(dataSet)



    End Sub

Simple Encryption Systems

Mon, 05 Oct 2009 19:57:20 GMT

Description: Based on the XOR transform and a single security key

Link: http://www.codekeep.net/snippets/9ef7b0d3-c4d1-478c-8cc7-ac4c7a541c43.aspx

Private Function Transform(ByVal text As String, ByVal key As String) As String
       
    For i = 1 To Len(text)
         Dim  a = i Mod Len(key) : If a = 0 Then a = Len(key)
         Transform = Transform & Chr(Asc(Mid(key, a, 1)) Xor Asc(Mid(text, i, 1)))
    Next i

End Function

TaskBar Pop By Bisrat

Fri, 02 Oct 2009 19:35:06 GMT

Description: Make Your Form PopUp Frome You TaskBar

Link: http://www.codekeep.net/snippets/4b41bb06-f160-4cef-9a8e-2c1868982595.aspx

'for Timer 1
'To Hide
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        If Me.Top <= Screen.PrimaryScreen.WorkingArea.Height - Me.Height Then

            Me.Show()

        Else

            Me.Top -= 7

            If Timer1.Interval = 4000 Then
                Me.Hide()
            End If
        End If

       
    End Sub

'for Timer 2
'To Show
 Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick

        ''see if form is in position to hide itself because its below screen level
        If Me.Top = Screen.PrimaryScreen.WorkingArea.Height Then


            Me.Opacity = 0



        Else


            Me.Top -= 10
         
        End If
    End Sub
End Class
'All You Need To Do Is Enable Timers On Any Event

RSS Feed from list summary

Tue, 29 Sep 2009 09:51:15 GMT

Description: Ektron RSS Feed from list summary

Link: http://www.codekeep.net/snippets/eff25c6b-50d6-451c-9bba-43959f882482.aspx

    Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim cd As New Ektron.Cms.Controls.ListSummary
        cd.FolderID = 0
        cd.Recursive = True
        cd.Page = Me.Page
        cd.Fill()
        Response.Write(cd.GetRssFeed())

    End Sub

Get ListView Items

Tue, 29 Sep 2009 08:08:10 GMT

Description: Lists the columns and the items in a listview.

Link: http://www.codekeep.net/snippets/7b75574f-4712-4586-813f-d1ea28bfede8.aspx

        Dim lvi As ListViewItem
        Dim sublvi As ListViewItem.ListViewSubItem

        For Each column As ColumnHeader In MyListview.Columns
            PM(column.Text)
        Next

        For Each lvi In MyListview.Items
            For Each sublvi In lvi.SubItems
                PM(sublvi.Text)
            Next
        Next

MID Function in SQL statement

Mon, 28 Sep 2009 22:00:20 GMT

Description: How to use the MID

Link: http://www.codekeep.net/snippets/4554f9df-1487-434c-9471-c0a2472ee268.aspx

 cmd.CommandText = "UPDATE tblRentalPerm SET amount = " & changeAmt & " " _
            & " WHERE ( invoiceNum = '" & invoiceNum & "' AND (Invoiced = true OR RepairInvoice = true )" _
            & " AND MID(tblRentalPerm.barcode, 3, 4) = '" & name & "')"

Bypass SSL Errors when using HTTPWebRequest

Wed, 23 Sep 2009 15:57:26 GMT

Description: Assumes you're in an ASP.NET environment but can be modified to change this pretty easily

Link: http://www.codekeep.net/snippets/253c0913-27a3-4753-9aae-090a51270bff.aspx

'Above where you are about to make the web request
ServicePointManager.ServerCertificateValidationCallback = New RemoteCertificateValidationCallback(AddressOf ValidateRemoteCertificate)

 Function ValidateRemoteCertificate(ByVal sender As Object, ByVal certificate As X509Certificate, ByVal chain As X509Chain, ByVal policyErrors As SslPolicyErrors) As Boolean
        'Note: You need an AppSettings key called IgnoreSslErrors in the web.config
        If (Convert.ToBoolean(ConfigurationManager.AppSettings("IgnoreSslErrors"))) Then
            'Allow expired or untrusted certificate. Used for test servers that use self-signed certs.
            Return True
        Else
            Return (policyErrors = SslPolicyErrors.None)
        End If
        
    End Function

LINQ JOIN Sample

Wed, 16 Sep 2009 17:33:04 GMT

Description: Results are bound to a grid

Link: http://www.codekeep.net/snippets/9e8cb3f2-3dd4-44b8-80c3-4e3cd05d5952.aspx

        Dim dc As New FIXED_ASSETS_30DataContext
        Dim filterCount = From i In dc.INVENTORY_COUNTs _
                          Join al In dc.EMPLOYEE_LOCATION_MATCHes On i.LOCATION_ID Equals al.LOCATION_ID _
                          Where al.EMPLOYEE_ID = CurrentUser.EmployeeID _
                          Select i
        e.Result = filterCount

Using the HEX Colour Codes

Mon, 14 Sep 2009 11:56:48 GMT

Description: Code to use the HEX colour codes

Link: http://www.codekeep.net/snippets/0f8f3d80-3444-417a-b6ef-2cc5fd3a6571.aspx

System.Drawing.ColorTranslator.FromHtml("#006699")

Fetch Data From Sql

Fri, 11 Sep 2009 14:27:27 GMT

Description: This code is to fetch data from SQL Using DataAdapter & DataTable

Link: http://www.codekeep.net/snippets/9e009547-50a4-4e9e-b8d6-76cad3362677.aspx

Try
	'Declare Sql Connection String
         Dim Sqlconn As New SqlConnection("Data Source=SERVER;Initial Catalog=LMS;Persist Security Info=True;User ID=sa;Password=sa;")
         Dim Da As SqlDataAdapter
         Dim Dt As DataTable
         Dim Query As String

         Query = "SELECT * FROM Ltx_ContractDetails"
         '---------------------------------------------------------------------------------
         Sqlconn.Open()                          'open connection to sql
         '---------------------------------------------------------------------------------
         Dt = New DataTable                 
         Da = New SqlDataAdapter(Query, Sqlconn)
         Da.Fill(Dt)
	 '---------------------------------------------------------------------------------
         Sqlconn.Close()                         'Close Sql Connection
         Sqlconn.Dispose()                       'Dispose Sql Connection
         '---------------------------------------------------------------------------------
Catch ex As Exception
	messagebox.show(ex.message)
End Try

How to make a Unit Test project in VS 2008 read a config file

Thu, 10 Sep 2009 13:58:41 GMT

Description: Makes a test project read a setting from a config file, handy for unit testing class libraries that rely on a config file.

Link: http://www.codekeep.net/snippets/a5177ad5-c09b-42d6-9df8-f9a8bc445d74.aspx

Add an app.config file to your testing project and put the same connection string setting into it as you have in your real app.config or web.config

Go into the compile properties of your testing project, go into the build events screen and paste this into the post-build part.

copy /Y $(ProjectDir)app.config $(TargetPath).config

ASPxGridview set insert programatically

Tue, 08 Sep 2009 20:37:17 GMT

Description: Set values before inserting programatically when inserting with a DevExpress ASPxGridview

Link: http://www.codekeep.net/snippets/81fcc6c5-55d4-41dd-bf77-73d67ea8ba0c.aspx

Protected Sub gvINVENTORY_RowInserting(ByVal sender As Object, ByVal e As DevExpress.Web.Data.ASPxDataInsertingEventArgs) Handles gvINVENTORY.RowInserting
        If e.NewValues("CATEGORY_ID") = String.Empty Then
            e.NewValues("CATEGORY_ID") = "4"
        End If
        If e.NewValues("LOCATION_ID") = String.Empty Then
            e.NewValues("LOCATION_ID") = "10007"
        End If

        e.NewValues("RETIRED") = False
    End Sub