Looking for a Full S.DS.AM Sample with many AD extensions already written - directoryservices
System.DirectoryServices.AccountManagement can be extended to support additional properties for reading and writing AD properties.
Is anyone aware of a full/complete sample implementation that works for AD, Exchange 2003 or 2010?
There isn't anything online that I know of, but you are welcome to my collection (which I've included).
One thing you'll probably notice about my code is that I've almost completely replaced the standard get/set operations with my own code which writes directly to the underlying DirectoryEntry. This is because the built in set operation is not designed to handle data types which are arrays of arrays (such as the jpegPhoto attribute which is an array of byte arrays, with each byte array representing a picture).
First is a bunch of extension methods which I use for my various get/set operations.
''' <summary>
''' Checks if an attribute is available on the underlying object.
''' </summary>
<Extension()> _
Public Function IsAttributeDefined(ByVal prin As Principal, ByVal attribute As String) As Boolean
'since some attributes may not exist in all schemas check to see if it exists first
Dim uo As DirectoryEntry = DirectCast(prin.GetUnderlyingObject(), DirectoryEntry)
'check for property, if it's not found return an empty array
Return uo.Properties.Contains(attribute)
End Function
#Region "Get Helpers"
''' <summary>
''' This function is the foundation for retrieving data
''' </summary>
<Extension()> _
Public Function ExtensionGetAttributeObject(ByVal prin As Principal, ByVal attribute As String) As Object()
'check if the attribute exists on this object
If IsAttributeDefined(prin, attribute) Then
'if property exists then return the data
Dim dirObj As DirectoryEntry = prin.GetUnderlyingObject()
Dim val As Object() = (From c As Object In dirObj.Properties(attribute) Select c).ToArray()
Return val
Else
'return an empty array if the attribute is not defined
Return New Object(-1) {}
End If
End Function
''' <summary>
''' This is the primary function for retrieving attributes that contain only one value
''' </summary>
<Extension()> _
Public Function ExtensionGetSingleValue(ByVal prin As Principal, ByVal attribute As String) As Object
'get the object
Dim attributeValues() As Object = ExtensionGetAttributeObject(prin, attribute)
'if the item length = 1 then return the first value, else don't
If attributeValues.Length = 1 Then
Return attributeValues(0)
Else
Return Nothing
End If
End Function
''' <summary>
''' Returns the string value of an attribute
''' </summary>
''' <remarks>(null if no value found)</remarks>
<Extension()> _
Public Function ExtensionGetSingleString(ByVal prin As Principal, ByVal attribute As String) As String
Dim o As Object = ExtensionGetSingleValue(prin, attribute)
If o IsNot Nothing Then
Return o.ToString()
Else
Return String.Empty
End If
End Function
''' <summary>
''' Returns all of the strings contained in a multi-value attribute
''' </summary>
<Extension()> _
Public Function ExtensionGetMultipleString(ByVal prin As Principal, ByVal attribute As String) As String()
'get the object array for this attribute
Dim attributeValues() As Object = ExtensionGetAttributeObject(prin, attribute)
'create a string array of the same length as the object array
Dim array As String() = New String(attributeValues.Length - 1) {}
'and copy over all items, converting them to strings as we go
For i As Integer = 0 To attributeValues.Length - 1
array(i) = attributeValues(i).ToString()
Next
'return the string array
Return array
End Function
''' <summary>
''' Returns the date value of an attribute
''' </summary>
''' <remarks>(null if no value found)</remarks>
<Extension()> _
Public Function ExtensionGetSingleDate(ByVal prin As Principal, ByVal attribute As String) As String
Dim o As Object = ExtensionGetSingleValue(prin, attribute)
If o IsNot Nothing Then
Dim dt As DateTime = Convert.ToDateTime(o)
Return dt
Else
Return Nothing
End If
End Function
''' <summary>
''' Returns the principle represented by a column containing a single distinguished name
''' </summary>
<Extension()> _
Public Function ExtensionGetSingleDistinguishedName(ByVal prin As Principal, ByVal attribute As String) As Principal
'get the distinguished name of the object as a string
Dim dn As String = ExtensionGetSingleString(prin, attribute)
'check for null
If String.IsNullOrEmpty(dn) Then
Return Nothing
End If
'get the principal represented by the DN
Dim prinF As Principal = Principal.FindByIdentity(prin.Context, dn)
'if it exists then prepare to return it
If prinF IsNot Nothing Then
'if the object is a userprincipal then get the user detailed principal for it.
If TypeOf prinF Is UserPrincipal Then
prinF = UserDetailedPrinciple.FindByIdentity(prin.Context, prinF.Name)
End If
'return the principal
Return prinF
End If
'if all else fails return nothing
Return Nothing
End Function
<Extension()> _
Public Function ExtensionGetMultipleDistinguishedNames(ByVal prinParent As Principal, ByVal attribute As String) As Principal()
'get the distinguished name of the object as a string
Dim dn() As String = ExtensionGetMultipleString(prinParent, attribute)
'array to hold list of principles
Dim al As New List(Of Principal)()
For Each d As String In dn
'get the principal represented by the DN
Dim prin As Principal = Principal.FindByIdentity(prinParent.Context, d)
'if it exists then prepare to return it
If prin IsNot Nothing Then
'if the object is a userprincipal then get the user detailed principal for it.
If TypeOf prin Is UserPrincipal Then
prin = UserDetailedPrinciple.FindByIdentity(prin.Context, prin.Name)
ElseIf TypeOf prin Is GroupPrincipal Then
prin = GroupPrincipal.FindByIdentity(prin.Context, prin.Name)
End If
'return the principal
al.Add(prin)
End If
Next
'return list of principles
Return al.ToArray()
End Function
''' <summary>
''' Gets the bytes contained in an Octet String
''' </summary>
<Extension()> _
Public Function ExtentsionGetBytes(ByVal prin As Principal, ByVal attribute As String) As Byte()
'get the data
Dim o As Object = ExtensionGetSingleValue(prin, attribute)
'check for nulls
If o Is Nothing Then
Return Nothing
End If
'get the byte array
Dim byteArray() As Byte = DirectCast(o, Byte())
'return the data
Return byteArray
End Function
''' <summary>
''' Gets the image contained in an Octet String type attribute
''' </summary>
<Extension()> _
Public Function ExtensionGetImage(ByVal prin As Principal, ByVal attribute As String) As Image
'get bytes for attribute
Dim bytearray() As Byte = ExtentsionGetBytes(prin, attribute)
'if none returned return nothing
If bytearray Is Nothing Then
Return Nothing
End If
'read the bytes into a memory stream
Dim ms As New MemoryStream(bytearray)
'convert the memory stream to a bitmap and return it
Return New Bitmap(ms)
End Function
<Extension()> _
Public Function ExtensionGetImages(ByVal prin As Principal, ByVal attribute As String) As Image()
'get all values in attribute
Dim vals() As Object = ExtensionGetAttributeObject(prin, attribute)
'array to hold images to be returned
Dim al As New List(Of Image)()
For Each o As Object In vals
'get bytes
Dim bytearray() As Byte = DirectCast(o, Byte())
'if no data skip entry
If bytearray Is Nothing Then
Continue For
End If
'read the bytes into a memory stream
Dim ms As New MemoryStream(bytearray)
'convert the memory stream to a bitmap and add to the array
al.Add(New Bitmap(ms))
Next
'return the list of images as an array.
Return al.ToArray()
End Function
#End Region
#Region "Set Helpers"
Private Sub ExtensionSetDE(ByVal de As DirectoryEntry, ByVal attribute As String, ByVal value As Object)
'check value, if it's null then don't add (null means clear only)
If value IsNot Nothing Then
de.Properties(attribute).Add(value)
End If
End Sub
<Extension()> _
Public Sub ExtensionSetValue(ByVal prin As Principal, ByVal attribute As String, ByVal value As Object)
Dim uo As DirectoryEntry = prin.GetUnderlyingObject()
uo.Properties(attribute).Clear()
ExtensionSetDE(uo, attribute, value)
End Sub
<Extension()> _
Public Sub ExtensionSetStringValue(ByVal prin As Principal, ByVal attribute As String, ByVal value As String)
If String.IsNullOrEmpty(value) Then
value = Nothing
End If
ExtensionSetValue(prin, attribute, value)
End Sub
<Extension()> _
Public Sub ExtensionSetMultipleValueDirect(ByVal prin As Principal, ByVal attribute As String, ByVal values() As Object)
'Normal ExtensionSet does not support saving array type values (octet string)
' so we set it directly on the underlying object
Dim uo As DirectoryEntry = prin.GetUnderlyingObject()
uo.Properties(attribute).Clear()
If values IsNot Nothing Then
For Each v As Object In values
ExtensionSetDE(uo, attribute, v)
Next
End If
End Sub
<Extension()> _
Public Sub ExtensionSetImage(ByVal prin As Principal, ByVal attribute As String, ByVal img As Image)
'set data to attribute
ExtensionSetValue(prin, attribute, img.SaveImageToByteArray())
End Sub
<Extension()> _
Public Sub ExtensionSetImages(ByVal prin As Principal, ByVal attribute As String, ByVal img() As Image)
'array list to hold the values temporarily
Dim al As New ArrayList()
'convert each image into a byte array
For Each i As Image In img
al.Add(i.SaveImageToByteArray())
Next
'set image array as value on attribute
ExtensionSetMultipleValueDirect(prin, attribute, al.ToArray())
End Sub
<Extension()> _
Public Function SaveImageToByteArray(ByVal img As Image) As Byte()
'create a memory strea
Dim ms As New MemoryStream()
'write the image to the stream
img.Save(ms, Imaging.ImageFormat.Jpeg)
'save data to a byte array
Dim bytes() As Byte = ms.ToArray()
Return bytes
End Function
<Extension()> _
Public Sub ExtensionSetMultipleDistinguishedNames(ByVal prin As Principal, ByVal attribute As String, ByVal dns() As Principal)
'convert user principles into distinguished names
Dim sc As New ArrayList()
For Each u As UserDetailedPrinciple In dns
sc.Add(u.DistinguishedName)
Next
ExtensionSetMultipleValueDirect(prin, attribute, sc.ToArray())
End Sub
''' <summary>
''' Helps set the Thumbnail photo by resizing main photo and also saving original (possibly resized to 300xvariable)
''' to JpegPhoto.
''' </summary>
''' <param name="imgO">The iamge to use as the users thumbnail photo</param>
''' <remarks>You still NEED to call .Save() after calling this sub
''' as this sub does not call save().
''' </remarks>
<Extension()> _
Public Sub SetUserPhoto(ByVal prin As Principal, ByVal imgO As Image)
'resize the image for thumbnail
Dim imgN As Bitmap = ResizeImage(imgO, 100)
'check if we need to resize for medium sized image (300px high max
Dim imgM As Bitmap
If imgO.Height > 300 Then
imgM = ResizeImage(imgO, 300)
Else
imgM = imgO
End If
'save small image to the users profile
ExtensionSetImage(prin, "thumbnailPhoto", imgN)
'save original to the jpegPhoto attribute
ExtensionSetImages(prin, "jpegPhoto", New Image() {imgM})
End Sub
Private Function ResizeImage(ByVal imgO As Bitmap, ByVal Height As Integer) As Bitmap
'if the image is smaller/equal to the requested height return original
If imgO.Height <= Height Then
Return imgO
End If
'images are fixedHeightxVariable, so we need to calculate the variable portion
Dim width As Integer = (Convert.ToDecimal(imgO.Width) / Convert.ToDecimal(imgO.Height)) * Height
'resize the image
Dim imgN As New Bitmap(width, Height)
Dim g As Graphics = Graphics.FromImage(imgN)
g.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
'draw in resized form
g.DrawImage(imgO, 0, 0, width, Height)
'return resized image
Return imgN
End Function
<Extension()> _
Public Function Rename(ByVal prin As Principal, ByVal NewName As String) As Principal
'escape commas
NewName = NewName.Replace(",", "\,")
'get directory object for move
Dim de As DirectoryEntry = prin.GetUnderlyingObject()
'move
de.Rename(String.Format("CN={0}", NewName))
de.CommitChanges()
'get the new object by name and return it
Return New ADConnection(prin.Context).GetPrincipalByName(prin.Guid.ToString())
End Function
#End Region
Here is the code in action in my custion UserPrinciple:
<DirectoryObjectClass("user")> _
<DirectoryRdnPrefix("CN")> _
Public Class UserDetailedPrinciple
Inherits UserPrincipal
<DirectoryProperty("initials")> _
Public Property MiddleInitial() As String
Get
Return ExtensionGetSingleString("initials")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("initials", value)
End Set
End Property
<DirectoryProperty("wWWHomePage")> _
Public Property HomePage() As String
Get
Return ExtensionGetSingleString("wWWHomePage")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("wWWHomePage", value)
End Set
End Property
<DirectoryProperty("url")> _
Public Property URLs() As String()
Get
Return ExtensionGetMultipleString("url")
End Get
Set(ByVal value As String())
ExtensionSetMultipleValueDirect("url", value)
End Set
End Property
<DirectoryProperty("info")> _
Public Property Notes() As String
Get
Return ExtensionGetSingleString("info")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("info", value)
End Set
End Property
Public ReadOnly Property ObjectType() As String
Get
Dim types() As String = ExtensionGetMultipleString("objectClass")
Return types.Last()
End Get
End Property
<DirectoryProperty("thumbnailPhoto")> _
Public Property ThumbnailPhoto() As Image
Get
Return ExtensionGetImage("thumbnailPhoto")
End Get
Set(ByVal value As Image)
ExtensionSetImage("thumbnailPhoto", value)
End Set
End Property
<DirectoryProperty("thumbnailLogo")> _
Public Property ThumbnailLogo() As Image
Get
Return ExtensionGetImage("thumbnailLogo")
End Get
Set(ByVal value As Image)
ExtensionSetImage("thumbnailLogo", value)
End Set
End Property
<DirectoryProperty("jpegPhoto")> _
Public Property JpegPhoto() As Image()
Get
Return ExtensionGetImages("jpegPhoto")
End Get
Set(ByVal value As Image())
ExtensionSetImages("jpegPhoto", value)
End Set
End Property
<DirectoryProperty("title")> _
Public Property Title() As String
Get
Return ExtensionGetSingleString("title")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("title", value)
End Set
End Property
<DirectoryProperty("department")> _
Public Property Department() As String
Get
Return ExtensionGetSingleString("department")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("department", value)
End Set
End Property
<DirectoryProperty("company")> _
Public Property Company() As String
Get
Return ExtensionGetSingleString("company")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("company", value)
End Set
End Property
<DirectoryProperty("manager")> _
Public Property Manager() As UserDetailedPrinciple
Get
Dim mgr As UserDetailedPrinciple = ExtensionGetSingleDistinguishedName("manager")
If mgr IsNot Nothing Then
If Me.Guid <> mgr.Guid Then
Return mgr
End If
End If
Return Nothing
End Get
Set(ByVal value As UserDetailedPrinciple)
'check for nulls
If value Is Nothing Then
ExtensionSetStringValue("manager", Nothing)
Else
ExtensionSetStringValue("manager", value.DistinguishedName)
End If
End Set
End Property
<DirectoryProperty("assistant")> _
Public Property Assistant() As UserDetailedPrinciple
Get
Dim assist As UserDetailedPrinciple = ExtensionGetSingleDistinguishedName("assistant")
If assist IsNot Nothing Then
Return assist
End If
Return Nothing
End Get
Set(ByVal value As UserDetailedPrinciple)
'check for nulls
If value Is Nothing Then
ExtensionSetStringValue("assistant", Nothing)
Else
ExtensionSetStringValue("assistant", value.DistinguishedName)
End If
End Set
End Property
<DirectoryProperty("directReports")> _
Public Property DirectReports() As Principal()
Get
Dim dReports As Principal() = ExtensionGetMultipleDistinguishedNames("directReports")
Return dReports
End Get
Set(ByVal value As Principal())
ExtensionSetMultipleDistinguishedNames("directReports", value)
End Set
End Property
<DirectoryProperty("homePhone")> _
Public Property HomePhone() As String
Get
Return ExtensionGetSingleString("homePhone")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("homePhone", value)
End Set
End Property
<DirectoryProperty("pager")> _
Public Property Pager() As String
Get
Return ExtensionGetSingleString("pager")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("pager", value)
End Set
End Property
<DirectoryProperty("otherTelephone")> _
Public Property OtherTelephone() As String()
Get
Return ExtensionGetMultipleString("otherTelephone")
End Get
Set(ByVal value As String())
ExtensionSetMultipleValueDirect("otherTelephone", value)
End Set
End Property
<DirectoryProperty("physicalDeliveryOfficeName")> _
Public Property PhysicalLocation() As String
Get
Return ExtensionGetSingleString("physicalDeliveryOfficeName")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("physicalDeliveryOfficeName", value)
End Set
End Property
<DirectoryProperty("l")> _
Public Property AddressCity() As String
Get
Return ExtensionGetSingleString("l")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("l", value)
End Set
End Property
<DirectoryProperty("postOfficeBox")> _
Public Property AddressPOBox() As String
Get
Return ExtensionGetSingleString("postOfficeBox")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("postOfficeBox", value)
End Set
End Property
<DirectoryProperty("st")> _
Public Property AddressState() As String
Get
Return ExtensionGetSingleString("st")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("st", value)
End Set
End Property
<DirectoryProperty("streetAddress")> _
Public Property Address() As String
Get
Return ExtensionGetSingleString("streetAddress")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("streetAddress", value)
End Set
End Property
<DirectoryProperty("postalCode")> _
Public Property AddressZipCode() As String
Get
Return ExtensionGetSingleString("postalCode")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("postalCode", value)
End Set
End Property
<DirectoryProperty("c")> _
Public Property AddressCountry() As String
Get
Return ExtensionGetSingleString("c")
End Get
Set(ByVal value As String)
ExtensionSetStringValue("c", value)
End Set
End Property
<DirectoryProperty("whenCreated")> _
Public ReadOnly Property Created() As Nullable(Of DateTime)
Get
Return ExtensionGetSingleDate("whenCreated")
End Get
End Property
<DirectoryProperty("whenChanged")> _
Public ReadOnly Property LastModified() As Nullable(Of DateTime)
Get
Return ExtensionGetSingleDate("whenChanged")
End Get
End Property
Public Sub New()
MyBase.New(ADConnection.CurrentADPrincipalContext)
End Sub
Public Sub New(ByVal context As PrincipalContext)
MyBase.New(context)
End Sub
Public Overloads Shared Function FindByIdentity(ByVal context As PrincipalContext, ByVal identityValue As String) As UserDetailedPrinciple
Return DirectCast(Principal.FindByIdentityWithType(context, GetType(UserDetailedPrinciple), identityValue), UserDetailedPrinciple)
End Function
Public Overloads Shared Function FindByIdentity(ByVal context As PrincipalContext, ByVal identityType As IdentityType, ByVal identityValue As String) As UserDetailedPrinciple
Return DirectCast(Principal.FindByIdentityWithType(context, GetType(UserDetailedPrinciple), identityType, identityValue), UserDetailedPrinciple)
End Function
End Class
Related
Using browscap.ini with VB.Net
Since 2013 now (more than 3 years), I have been using http://www.useragentstring.com/ in my main VB.Net project to get browser name/version and OS name/version from user agent string to add statistics to my local web application. But, recently, in last months, this web site has been unreliable with a lot of down times. So to avoid missing data in my statistics, I searched for a local solution instead of an online one. I found http://browscap.org/ is an old web site (since 1998) that still upload updated user agent information to this day (browscap.ini). It is designed for PHP, but I found a C# implementation there: https://www.gocher.me/C-Sharp-Browscap . But as a VB.Net developper, I did not find any VB implementation for it. I googled a lot but with no success. Does anyone get one for VB.NET?
I finally get to convert the C# solution to VB.NET with some head scratching. Public Class CompareByLength Implements IComparer(Of String) Private Function Compare(ByVal x As String, ByVal y As String) as Integer _ Implements IComparer(Of String).Compare If x Is Nothing Then If y Is Nothing Then Return 0 Else Return 1 End If Else If y Is Nothing Then Return -1 Else Dim retval As Integer = x.Length.CompareTo(y.Length) If retval <> 0 Then Return -retval Else return -x.CompareTo(y) End If End If End If End Function End Class Public Class BrowsCap Private Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" Alias "GetPrivateProfileSectionNamesA" (ByVal lpReturnedString As Byte(), ByVal nSize As Integer, ByVal lpFileName As String) As Integer Private Declare Function GetPrivateProfileSection Lib "kernel32.dll" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedBuffer As Byte(), ByVal nSize As Integer, ByVal lpFileName As String) As Integer Private Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedBuffer As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer Private path As String Private sections As String() Private Function GetSectionNames() As String() Dim maxsize As Integer = 500 Do Dim bytes(maxsize) As Byte Dim size As Integer = GetPrivateProfileSectionNames(bytes, maxsize, path) If size < maxsize - 2 Then Dim Selected As String = Encoding.ASCII.GetString(bytes, 0, size - (IIf(size > 0, 1, 0))) Return Selected.Split(New Char() {ControlChars.NullChar}) End If maxsize = maxsize * 2 Loop End Function Public Sub IniFileName(ByVal INIPath As String) path = INIPath sections = GetSectionNames() Array.Sort(sections, New CompareByLength()) End Sub public Function IniReadValue(ByVal Section As String, ByVal Key As String) As String Dim temp As New StringBuilder(255) Dim i As Integer = GetPrivateProfileString(Section, Key, "", temp.ToString(), 255, path) Return temp.ToString() End Function Private Function findMatch(ByVal Agent As String) As String If sections IsNot Nothing Then For Each SecHead As String In sections If (SecHead.IndexOf("*", 0) = -1) And (SecHead.IndexOf("?", 0) = -1) And (SecHead = Agent) Then If IniReadValue(SecHead, "parent") <> "DefaultProperties" Then Return SecHead End If End If Next For Each SecHead As String In sections Try If (SecHead.IndexOf("*", 0) > -1) Or (SecHead.IndexOf("?", 0) > -1) Then if Regex.IsMatch(Agent, "^" + Regex.Escape(SecHead).Replace("\*", ".*").Replace("\?", ".") + "$") Then Return SecHead End If End If Catch ex As Exception 'Console.WriteLine(ex) End Try Next Return "*" End If Return "" End Function Public Function getValues(ByVal Agent As String) As NameValueCollection Dim match As String = findMatch(Agent) Dim col As NameValueCollection = New NameValueCollection() Do Dim entries() As string Dim goon As Boolean = true Dim maxsize As Integer = 500 While goon Dim bytes(maxsize) As Byte Dim size As Integer = GetPrivateProfileSection(match, bytes, maxsize, path) If size < maxsize - 2 Dim section As String = Encoding.ASCII.GetString(bytes, 0, size - IIf(size > 0, 1, 0)) entries = section.Split(New Char() {ControlChars.NullChar}) goon = False End If maxsize = maxsize * 2 End While match = "" If entries.Length > 0 Then For Each entry As String In entries Dim ent As String() = entry.Split(New Char() {"="C}) If ent(0) = "Parent" Then match = ent(1) else if col(ent(0)) is nothing Then col.Add(ent(0), ent(1)) End If Next End If Loop While match <> "" Return col End Function End Class And here is how to use it: Dim dict As Dictionary(Of String, Object) = New Dictionary(Of String, Object) Dim bc As New BrowsCap bc.IniFileName(Server.MapPath("/App_Data/lite_asp_browscap.ini")) Dim Entry As NameValueCollection = bc.getValues(Request.UserAgent) For Each s As String In Entry.AllKeys dict.Add(s, Entry(s)) Next ' dict("Browser") will contains browser name like "IE" or "Chrome". ' dict("Version") will contains browser version like "11.0" or "56.0". ' dict("Platform") will contains OS name and version like "Win7". The only thing left to do is to refresh my browscap.ini (or lite_asp_browscap.ini) sometimes (like once a week).
how to use webmethod on webform in asp.net
I have a user control on my web form which is as follows I select the program year, category type , category and position group and then click search, it should return a collection which contains the programyearID, categorytypeID and positionGroupID for the corresponding selected items in the dropdownlist and pass it on to a webmethod which is already defined to get a specific certificationID. Interface Namespace SI.Certification.UserControl Public Interface IUserSearchResultList Property DataSource() As User.Learning.Business.HR.UserCollection ReadOnly Property List() As User.Web.UI.WebControls.PagedRepeater End Interface End Namespace here is this the code for my usercontrol1.vb Public Class curriculum_search Inherits System.Web.UI.UserControl Implements IUserSearchResultList Private _dataSource As UserCollection Public Property DataSource As UserCollection Implements UserControl.IUserSearchResultList.DataSource Get Return _dataSource End Get Set(value As UserCollection) End Set End Property Public ReadOnly Property List As PagedRepeater Implements UserControl.IUserSearchResultList.List Get Return ctlListControl End Get End Property #Region "Public Properties" Public Property ProgramYearID() As Int32 Get If Me.ShowProgramYearSearch Then If Me.lstProgramYear.SelectedValue = 0 Then Return Integer.MinValue Else Return Me.lstProgramYear.SelectedValue End If Else If ViewState("ProgramYearID") Is Nothing Then Return Integer.MinValue Else Return ViewState("ProgramYearID") End If End If End Get Set(ByVal Value As Int32) If Me.ShowProgramYearSearch Then Me.lstProgramYear.SelectedValue = Value.ToString() End If ViewState("ProgramYearID") = Value End Set End Property Public ReadOnly Property CategoryTypeID() As Int32 Get If Me.lstCategoryType.SelectedValue = 0 Then Return Integer.MinValue Else Return Me.lstCategoryType.SelectedValue End If End Get End Property Public ReadOnly Property CategoryID() As Int32 Get If Me.lstCategory.SelectedValue = 0 Then Return Integer.MinValue Else Return Me.lstCategory.SelectedValue End If End Get End Property Public Property PositionGroupID() As Int32 Get If Me.ShowPositionCodeSearch Then If Me.lstPositionGroup.Selected = -1 Then Return Integer.MinValue Else Return Me.lstPositionGroup.Selected End If Else If ViewState("PositionGroupID") Is Nothing Then Return Integer.MinValue Else Return ViewState("PositionGroupID") End If End If End Get Set(ByVal Value As Int32) If Me.ShowPositionCodeSearch Then Me.lstPositionGroup.Selected = Value.ToString() End If ViewState("PositionGroupID") = Value End Set End Property Public Property ShowPositionCodeSearch() As Boolean Get If ViewState("ShowPositionCodeSearch") Is Nothing Then Return True Else Return ViewState("ShowPositionCodeSearch") End If End Get Set(ByVal Value As Boolean) ViewState("ShowPositionCodeSearch") = Value If Not Value Then spnPositionGroup.Visible = False Else spnPositionGroup.Visible = True End If End Set End Property Public Property ShowProgramYearSearch() As Boolean Get If ViewState("ShowProgramYearSearch") Is Nothing Then Return True Else Return ViewState("ShowProgramYearSearch") End If End Get Set(ByVal Value As Boolean) ViewState("ShowProgramYearSearch") = Value If Not Value Then spnProgramYear.Visible = False End If End Set End Property #End Region #Region "Events" Public Event Submit(ByVal sender As Object, ByVal e As System.EventArgs) Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load, Me.Load If Page.IsPostBack = False Then If spnCategoryType.Visible = True Then BindCertificationCategoryTypeCollection() 'method to bind the category collection End If If spnProgramYear.Visible = True AndAlso Me.ShowProgramYearSearch Then BindProgramYearCollection(GetProgramYearCollection()) 'method to bind the porgram year collection End If If spnPositionGroup.Visible = True AndAlso Me.ShowPositionCodeSearch Then End If lstPositionGroup.DefaultToPrimary = False End If End Sub Public Sub btnSubmit_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles pnlSearch.SearchClick RaiseEvent Submit(sender, e) End Sub This is the webmethod I have to use in my usercontrol to pass the parameters <WebMethod(Description:="Get list of certification levels")> _ Public Function GetCertificationLevelsList(ByVal programYearId As Integer, ByVal PositionGroupId As String, ByVal CategoryId As String) As User.Department.Application.Curriculum.Items Dim items As User.Department.Application.Curriculum.Items = User.Department.Application.Curriculum.CategoryCollection.GetCategoryLevelsList(programYearId, PositionGroupId, CategoryId) items.Sort() Return items End Function I am stuck here.
You can't use webmethods on Usercontrols. Webmethods must live on webpages. Since UserControls can live on multiple pages, you can't put a webmethod in a codebehind page of a UserControl. So your options are: Create an .asmx for your webmethod and call it from your webcontrol (old-skool) Create a WCF enpoint (.svc) and call it from your webcontrol (semi-old-skool) Create a WebAPI Controller and call it from your webcontrol (new-skool) However, what you want to do is to call the webservice from the code-behind of your usercontrol. If you want to do this, you're mixing server-side and client-side. Your asmx is there to be used from the client-side. You will either need to copy the code from the asmx, or provide an abstraction that can be used in both the webservice and the usercontrol.
Convert string to list of custom objects
Say I have an object Fish with properties like Public Property ID As Integer Public Property Name As String Public Property Type As Integer Public Property Age As Integer And I have a string that looks like this: "Fishes[0].ID=1&Fishes[0].Name=Fred&Fishes[0].Type=1&Fishes[0].Age=3&Fishes[1].ID=2&Fishes[1].Name=George&Fishes[1].Type=2&Fishes[1].Age=5&..." Is there any way of converting/casting/whatever my string into a list of Fish objects? I can't seem to find anything to help. I do have some control over the format of the string if that would make things easier. Many thanks
What you need to do is to parse the input string to look for Fishes[X].PROPNAME=VALUE pattern. Loop through all matches found in the string and add into or set the existing object in Dictionary. Use X as each object key in the Dictionary. Create Fish structure: Structure Fish Public ID As String Public Name As String Public Type As Integer Public Age As Integer End Structure Codes to process the input string: Dim Fishes As New Dictionary(Of String, Fish) Dim m As Match = Regex.Match(str, "Fishes\[(?<key>\d+)]\.(?<prop>.+?)=(?<value>[^&]+)", RegexOptions.IgnoreCase) Do While m.Success Dim key As String = m.Groups("key").Value.Trim.ToUpper Dim prop As String = m.Groups("prop").Value.Trim.ToUpper Dim value As String = m.Groups("value").Value ' if the key not yet exist in the Dictionary, create and add into it. If Not Fishes.ContainsKey(key) Then Fishes.Add(key, New Fish) End If Dim thisFish As Fish = Fishes(key) ' get the Fish object for this key ' determine the object property to set Select Case prop Case "ID" : thisFish.ID = value Case "NAME" : thisFish.Name = value Case "TYPE" : thisFish.Type = CInt(value) Case "AGE" : thisFish.Age = CInt(value) End Select Fishes(key) = thisFish ' since the Fish object is declared as Structure, ' update the Dictionary item of key with the modified object. ' If Fish is declared as Class, then this line is useless m = m.NextMatch() Loop
Try this .. Structure Test Dim ID As String Dim Name As String Dim Type As Integer Dim Age As Integer End Structure In your Button click event .. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim Fishes As New List(Of Test) Dim Fish As New Test Fish.ID = "GF" Fish.Name = "Gold Fish" Fish.Age = 1 Fish.Type = 1 Fishes.Add(Fish) MsgBox(Fishes(0).Name) End Sub
this is vb.net converted Public Partial Class test Inherits System.Web.UI.Page Protected Sub Page_Load(sender As Object, e As EventArgs) If Not IsPostBack Then End If End Sub Public Sub MYtest() Dim ls As New List(Of Fish)() Dim f As New Fish() f.ID = 1 f.Name = "My name" f.Type = "My type" f.Age = 20 ls.Add(f) End Sub End Class Public Class Fish Public Property ID() As Integer Get Return m_ID End Get Set m_ID = Value End Set End Property Private m_ID As Integer Public Property Name() As String Get Return m_Name End Get Set m_Name = Value End Set End Property Private m_Name As String Public Property Type() As String Get Return m_Type End Get Set m_Type = Value End Set End Property Private m_Type As String Public Property Age() As Integer Get Return m_Age End Get Set m_Age = Value End Set End Property Private m_Age As Integer End Class
In the comments you mentioned that this is via ASP.Net MVC. The ModelBinder will do everything for you. public ActionResult UpdateFish(IList<Fish> listOfFish) { //the ModelBinder will figure out that the user has posted a list of Fish instances. //do something with listOfFish return View(listOfFish); }
WCF - Can I use an existing type to be passed through my WCF service
I have a service. I have an existing class of business objects. What I would like to know is how can I pass a class through WCF from the business object assembly without having to create a new class in my WCF site while appending or tags? Here is an existing UDT: Namespace example: Application.BusinessObjects.Appointments Public Structure AppointmentResource Private _id As String Private _type As ResourceTypeOption Private _name As String Property id() As String Get Return _id End Get Set(ByVal value As String) _id = value End Set End Property Property type() As ResourceTypeOption Get Return CType(_type, Int32) End Get Set(ByVal value As ResourceTypeOption) _type = value End Set End Property Property Name() As String Get Return _name End Get Set(ByVal value As String) _name = value End Set End Property Public Sub New(ByVal id As String, ByVal type As ResourceTypeOption, ByVal name As String) _id = id _type = type _name = name End Sub End Structure Here is the same one I created with the data contract attributes: Namespace example: Application.Service.Appointments <DataContract()> _ Public Structure AppointmentResource Private _id As String Private _type As ResourceTypeOption Private _name As String <DataMember()> _ Property id() As String Get Return _id End Get Set(ByVal value As String) _id = value End Set End Property <DataMember()> _ Property type() As ResourceTypeOption Get Return CType(_type, Int32) End Get Set(ByVal value As ResourceTypeOption) _type = value End Set End Property <DataMember()> _ Property Name() As String Get Return _name End Get Set(ByVal value As String) _name = value End Set End Property Public Sub New(ByVal id As String, ByVal type As ResourceTypeOption, ByVal name As String) _id = id _type = type _name = name End Sub End Structure
There is an easy way to share types between client and service, just by adding reference to shared type assembly to your client BEFORE adding the service reference. You can find the detailed scenario and sample project there: http://blog.walteralmeida.com/2010/08/wcf-tips-and-tricks-share-types-between-server-and-client.html
ResourceTypeOption also appears to be a custom class, so you would to define that as part of the contract in its own class. The client has to know about that and so it needs its own contract. Clients already know how to deal with CLR types like string. Any other custom types would also have to be defined in the contract.
Design-time trouble with ASP.NET v2.0 Custom Control, with List<T> for child items
Folks, I am having a devil of a time with a custom control. The control is very simple - it just displays a list of "StepItems" (rendered as table rows), each with an icon. When I first drag it onto a page, and add StepItems to its collection, it renders perfectly. If I provide some text for its Header property, that also renders perfectly. If I then look at the HTML source view, and then back to the design view, I get an error where my control should be. There are two kinds of errors: If I set the .Header property, the error reads "StepProgressControl1:'someheadertext' could not be set on property 'Header'. If I don't set the .Header, but add StepItems to the collection, I get this: "ErrorStepProgressControl1:'StepItems' could not be initialized. Details: Method not found: 'System.Collections.Generic.List`1 StepProgressControl.TKC.Experiment.StepProgressControl.get_StepItems()'." The complete code for my custom control is below. If you can provide any help, thank you a great deal! Tom '================================ Imports System Imports System.Collections Imports System.Web Imports System.Web.UI Imports System.Web.UI.WebControls Imports System.Security.Permissions Imports System.ComponentModel Namespace TKC.Experiment ' THIS IS THE INTERNAL "CHILD" ELEMENT < _ PersistenceMode(PersistenceMode.InnerProperty), _ TypeConverter(GetType(StepItemConverter)) _ > _ Public Class StepItem Private _name As String Public Sub New() Me.New("") End Sub Public Sub New(ByVal name As String) Me._name = name End Sub Public Property Name() As String Get Return _name End Get Set(ByVal value As String) _name = value End Set End Property End Class '===================================================================== ' THIS IS THE ACTUAL "PARENT" WEB CONTROL < _ ParseChildren(True, "StepItems"), _ PersistChildren(False) _ > _ Public NotInheritable Class StepProgressControl Inherits WebControl Private _header As String = String.Empty Private _stepItems As New List(Of StepItem) Public Sub New() Me.Header = "StepProgressControl" End Sub < _ PersistenceMode(PersistenceMode.Attribute) _ > _ Public Property Header() As String Get Return _header End Get Set(ByVal value As String) _header = value End Set End Property < _ DesignerSerializationVisibility(DesignerSerializationVisibility.Content), _ PersistenceMode(PersistenceMode.InnerProperty) _ > _ Public ReadOnly Property StepItems() As List(Of StepItem) Get If _stepItems Is Nothing Then _stepItems = New List(Of StepItem) End If Return _stepItems End Get 'Set(ByVal value As List(of stepitem)) ' _stepItems = value 'End Set End Property Public Overrides Sub RenderControl(ByVal writer As System.Web.UI.HtmlTextWriter) MyBase.RenderControl(writer) Dim label As New Label() label.Text = Header label.RenderControl(writer) Dim table As New Table() Dim htr As New TableRow() Dim hcell1 As New TableHeaderCell() hcell1.Text = "Name" htr.Cells.Add(hcell1) Dim hcell2 As New TableHeaderCell() hcell2.Text = "Title" htr.Cells.Add(hcell2) table.BorderWidth = Unit.Pixel(0) Dim stepItem As StepItem For Each stepItem In StepItems Dim tr As New TableRow() Dim cell1 As New TableCell() Dim img As New HtmlImage img.Src = "" img.Alt = "" cell1.Controls.Add(img) tr.Cells.Add(cell1) Dim cell2 As New TableCell() cell2.Text = stepItem.Name tr.Cells.Add(cell2) table.Rows.Add(tr) Next stepItem table.RenderControl(writer) End Sub End Class '======================================== 'THIS IS A "TYPE CONVERTER" - JUST A COSMETIC THING, NOT CAUSING TROUBLE... Public Class StepItemConverter Inherits TypeConverter Public Overloads Overrides Function ConvertTo(ByVal context As ITypeDescriptorContext, ByVal culture As System.Globalization.CultureInfo, ByVal value As Object, ByVal destinationType As Type) As Object Dim obj As StepItem = DirectCast(value, StepItem) Return obj.Name End Function End Class End Namespace
You will want to implement your own Collection object to represent the list - otherwise the designer will not display it properly. See the ICollection, IEnumerable, etc. interfaces.