Imports System.Globalization
    .... 
    Dim CurrentCalendar As System.Globalization.Calendar = _
                CultureInfo.CurrentUICulture.Calendar

    'We want to output all the dates in the current year for every month.
    For iMonth As Integer = 1 To 12
        Dim sOutput As String
        'accumulate all the dates
        For iDay As Integer = 1 To CurrentCalendar.GetDaysInMonth(Now.Year, iMonth)
            sOutput &= iDay & ","
        Next
         'print out all the accumulated dates
        Console.WriteLine(sOutput.TrimEnd(","c))
    Next

I’d say it must be

1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31

but, the hell, no, it is:

(1st line)
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31
(2nd line)
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,1,2,3,
                   ...other Februray dates..28
(3rd line)
...January dates...February dates...March dates...
(4th line)
...January dates...February dates...March dates...April dates...
(5th line)
...January dates...February dates...March dates...May dates...   
....
(12th line)
...January dates...February dates...March dates...May dates...December dates...

This means that even though the variable s is re-declared, it is not being re-initialized! Just… keep it in mind.

Hint: instead of being Dim sOutput As String it should be Dim sOutput As String="" if we still want to keep this syntax.

Usage:

If IsUserInGroup("Contoso\JohnDoe", "Contoso\Managers") Then
   '...do something
End If

Notes:

• Option Strict Off. Sorry, I’m using the GetObject magic function here, so there’s no way I could leave the option strict on.
• Seems to be quite slow when local groups are scanned from outside.
• Could be a problem when you have users from two different domains + local users.

'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2006.04.26</date>
'''</created>
'''<summary>Checks if a user belongs to the specified group.</summary>
'''<remarks>Should now work both on domain and local groups/users</remarks>
'''<param name="spUserLogin">Login name, e.g. Contoso\JohnDoe</param>
'''<param name="spGroupLogin">Group name, e.g. Contoso\Managers</param>
Public Function IsUserInGroup(ByVal spUserLogin As String, _
                              ByVal spGroupLogin As String) As Boolean
    Dim oSeenGroups As New Specialized.StringCollection
    Return IsUserInGroup(spUserLogin, spGroupLogin, oSeenGroups)
End Function


'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2006.04.26</date>
'''</created>
'''<summary>Performs a recursive check if the user specified belongs to the 
'''group.</summary>
'''<param name="spUserLogin">User login name, authority\account</param>
'''<param name="spGroupLogin">Group login name, authority\account</param>
'''<param name="opSeenGroups">A collection of previously visited groups</param>
'''<param name="opUserObj">An instance of COM object for user entry (saving resources)</param>
'''<returns>Boolean</returns>
Private Function IsUserInGroup(ByVal spUserLogin As String, _
                              ByVal spGroupLogin As String, _
                              ByVal opSeenGroups As Collections.Specialized.StringCollection, _
                              Optional ByVal opUserObj As Object = Nothing) As Boolean
    Dim oUserObj As Object
    Dim oGroupObj As Object
    Dim oGroupsToCheck As New Specialized.StringCollection

    'it's theoretically possible to get a loop - "A includes B" and "B includes A"
    'so it's more safe to remember the seen groups
    If opSeenGroups.Contains(spGroupLogin) Then Return False
    opSeenGroups.Add(LCase(spGroupLogin))


    If opUserObj Is Nothing Then
        oUserObj = GetAdsiObj(spUserLogin)
    Else
        'if we already have found the "user object" use that one
        oUserObj = opUserObj
    End If

    'get an ADSI object instance for the group
    oGroupObj = GetAdsiObj(spGroupLogin)

    'chek all the group members, perform a recursive call
    'when a member of type "group" is found
    For Each oMember As Object In oGroupObj.Members
        If LCase(oMember.class) = "user" Then
            '"normal" case when a group contains members of type "user"
            If SidsEqual(oMember.objectsid, oUserObj.objectsid) Then
                'assume the user is in group if SIDs of both objects are equal
                Return True
            End If
        ElseIf LCase(oMember.class) = "group" Then
            'if a group contains a member of type "group"
            'have to check - if the user object we're looking is probably a group itself.
            If LCase(oUserObj.class) = "group" Then
                If SidsEqual(oMember.objectsid, oUserObj.objectsid) Then
                    'if so - see if sids are equal or not
                    Return True
                End If
            Else
                'we've found a group within a group. have to perform a recursive check
                If LCase(oGroupObj.parent).indexof("ldap://") > -1 Then
                    'a domain group contains a subgroup
                    Dim sTmpDomain, sTmpAccount As String
                    SplitLogin(spGroupLogin, sTmpDomain, sTmpAccount)
                    oGroupsToCheck.Add(LCase(sTmpDomain & "\" & oMember.samaccountname))
                Else
                    'a local group contains a subgroup (a domain group can be registered as a
                    'member of a local group
                    oGroupsToCheck.Add(LCase(LastAuthority(oMember.parent) & "\" & oMember.name))
                End If
            End If
        End If
    Next

    'see if we have found sub-groups
    If oGroupsToCheck.Count > 0 Then
        'if any of the subgroups contains the member we're looking for- return true
        For Each sGroupLogin As String In oGroupsToCheck
            If IsUserInGroup(spUserLogin, sGroupLogin, opSeenGroups, oUserObj) = True Then
                Return True
            End If
        Next
    End If

    'if we have come this far - the member is not found
    Return False
End Function

'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2006.04.27</date>
'''</created>
'''<summary>Checks if the object is registered in local security authority
'''or it is a domain level entry.</summary>
'''<remarks>Assumes WINNT provider format</remarks>
'''<param name="spParentURI">WinNT://blabla</param>
'''<returns>Boolean</returns>
Private Shared Function IsLocal(ByVal spParentURI As String) As Boolean
    If spParentURI Is Nothing OrElse spParentURI.Length < 7 Then
        Throw New FormatException("Incorrect parent property! " & spParentURI)
    End If
    Return Not (spParentURI.LastIndexOf("/") = 7)
End Function

'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2006.04.27</date>
'''</created>
'''<summary>Gets the last security authority name</summary>
'''<remarks>Can be WinNT://domain/computer or WinNT://domain. The first case
''' returns 'computer', the second one - 'domain'</remarks>
'''<param name="spParentUri"></param>
'''<returns>String</returns>
Private Shared Function LastAuthority(ByVal spParentUri As String) As String
    If spParentUri Is Nothing OrElse spParentUri.Length < 7 Then
        Return "" 'must have WinNT providers
    End If
    Return spParentUri.Substring(spParentUri.LastIndexOf("/") + 1)
End Function

'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2006.04.26</date>
'''</created>
'''<summary>Creates the ADSI object for a member.</summary>
'''<remarks>Returns LDAP:// or WINNT:// object, according to member type</remarks>
'''<param name="spGroupLogin">Members login name</param>
Private Function GetAdsiObj(ByVal spLogin As String) As Object
    Try
        Dim sDomain, sAccount As String
        Dim oAdsiObj As Object
        SplitLogin(spLogin, sDomain, sAccount)

        oAdsiObj = GetObject("WinNT://" & sDomain & "/" & sAccount)

        'if the member found is not local, upgrade to an LDAP object
        If Not IsLocal(oAdsiObj.parent) Then
            oAdsiObj = GetObject("LDAP://" & Me.DistingishedNameFromLogin(spLogin))
        End If
        Return oAdsiObj
    Catch ex As Exception
        Throw New Exception("Member not found: " & spLogin, ex)
    End Try
End Function

'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2006.04.26</date>
'''</created>
'''<summary>Checks if two SIDs are equal</summary>
'''<remarks>Compares two byte arrays.</remarks>
Public Function SidsEqual(ByVal bapFirst As Byte(), ByVal bapSecond As Byte()) As Boolean
    'if one of arrays is not initiated or sizes differ
    If bapFirst Is Nothing Or bapSecond Is Nothing Then Return False
    If bapFirst.Length <> bapSecond.Length Then Return False

    For i As Integer = 0 To bapFirst.Length - 1
        If bapFirst(i) <> bapSecond(i) Then
            Return False
        End If
    Next
    Return True
End Function


'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2005.10.12</date>
'''</created>
'''<summary>Gets the full user reference from login name (domain members only!)</summary>
'''<param name="spLogin">domain\user</param>
Public Shared Function DistingishedNameFromLogin(ByVal spLogin As String) As String
    Dim sLogin, sDomain As String
    Dim sFilter As String
    Dim dsEntryObj As DirectoryEntry
    Dim dsSearcher As DirectorySearcher
    Dim dsResult As SearchResultCollection

    If Trim(spLogin) = "" Then Return ""

    'get the domain and login part
    If Not (SplitLogin(spLogin, sDomain, sLogin)) Then
        Return ""
    End If

    Try
        'meklēšana LDAP://LB
        dsEntryObj = New DirectoryEntry("LDAP://" & sDomain)
    Catch e As Exception
        Throw New System.Exception(String.Format("Can't create the LDAP object!" & "LDAP://" & sDomain))
    End Try

    'izveido meklētāja objektu
    dsSearcher = New DirectorySearcher(dsEntryObj)

    'looking for a specific SAMAccountName - persons or groups only
    dsSearcher.Filter = String.Concat("(&(sAMAccountName=", sLogin, ")(|(objectCategory=group)(objectCategory=person)))")
    Try
        dsSearcher.SearchScope = SearchScope.Subtree
        dsResult = dsSearcher.FindAll()
    Catch e As Exception
        Throw New Exception(String.Format("Error in directory lookup. Filter: {0}", dsSearcher.Filter))
    End Try

    '''have to dispose this kind of objects
    dsEntryObj.Dispose()
    dsSearcher.Dispose()

    Try
        If dsResult.Count = 0 Then
            Return ""
        ElseIf dsResult.Count > 1 Then
            Throw New ArgumentException("More than one entries found having the same account name! Account:" & spLogin)
        Else
            'the good case
            Return dsResult(0).Properties("distinguishedname")(0).ToString
        End If
    Finally
        dsResult.Dispose()
    End Try
End Function

'''<created>
'''  <author>Krišs Rauhvargers</author>
'''  <date>2005.10.12</date>
'''</created>
'''<summary>Splits login name into parts (domain\user)</summary>
'''<remarks></remarks>
'''<param name="spLogin">Full login name</param>
'''<param name="spDomain">OUT: domain</param>
'''<param name="spAccount">OUT: account</param>
'''<returns>Boolean</returns>
Public Shared Function SplitLogin(ByVal spLogin As String, ByRef spDomain As String, ByRef spAccount As String) As Boolean
    Dim iSlashPos As Integer
    spLogin = spLogin.Replace("/"c, "\"c)
    iSlashPos = spLogin.IndexOf("\"c)
    If iSlashPos > -1 Then
        With spLogin.Split("\"c)
            spAccount = .GetValue(1).ToString
            spDomain = .GetValue(0).ToString
        End With
        Return True
    Else
        Return False
    End If
End Function

If we know two things – a login name of a user for instance northwind\JohnDoe and a domain group northwind\board. We want to check if John Doe belongs to the “board” group or not.

This is how you find it: IsUserMember( "northwind\JohnDoe", "northwind\board")

Here is the VB.Net code you need :

'''<summary>Checks if a user belongs to the domain group</summary>
'''<param name="spLogin">Full  login name domain\user</param>
'''<param name="spGroupLogin">Group full login name domain\group</param>
'''<returns>True if belongs, False if not</returns>
Public Function IsUserMember(ByVal spLogin As String, _
                             ByVal spGroupLogin As String) As Boolean
    Dim sUserDistinguish, sGroupDistinguish As String
    Dim sFilter As String
    Dim sAccount, sGroupAccount, sDomain As String


    If Not Me.SplitLogin(spLogin, sDomain, sAccount) Then
        'if username is not formed as domain\user, return false
        Return False
    End If

    If Not Me.SplitLogin(spGroupLogin, sDomain, sGroupAccount) Then
        'if group name is not formed as domain\group, return false
        Return False
    End If

    'get the distinguishedName of both user and group
    sUserDistinguish = DistingishedNameFromLogin(spLogin)
    sGroupDistinguish = DistingishedNameFromLogin(spGroupLogin)

    'check in a recursive manner if user belongs to group (or its subgroups)
    Return Me.IsUserInGroupRecursive(sUserDistinguish, sGroupDistinguish, sDomain, New Specialized.StringDictionary)
End Function


'''<summary>Recursively (in subgroups, too) finds a user in a group</summary>
'''<remarks></remarks>
'''<param name="spUserDistinguish">DistinguishedName of a user</param>
'''<param name="spGroupDistinguish">DistinguishedName of a group</param>
'''<param name="spDomain">domain name</param>
'''<param name="opCheckedGroups">Groups already sought</param>
'''<returns>Boolean</returns>
Public Function IsUserInGroupRecursive(ByVal spUserDistinguish As String, _
                                       ByVal spGroupDistinguish As String, _
                                       ByVal spDomain As String, _
                                       ByRef opCheckedGroups As Collections.Specialized.StringDictionary) As Boolean

    If opCheckedGroups(spGroupDistinguish) = "DONE" Then
        'there may be occasions when a group is somehow a subgroup of itself 
        'so we have to remember if the group is already sought or not
        'if thr group is already sought, there is NO such user
        Return False
    Else
        'mark the group as sought otherwise
        opCheckedGroups(spGroupDistinguish) = "DONE"
    End If

    If Me.IsUserDirectlyInGroup(spUserDistinguish, spGroupDistinguish, spDomain) Then
        'if the user is can be found in the group directly
        Return True
    Else
        'if not in the group directly, get all the subgroups
        For Each sSubGroup As String In Me.GetSubGroups(spGroupDistinguish, spDomain)
            'check subgroup recursively 
            If IsUserInGroupRecursive(spUserDistinguish, sSubGroup, spDomain, opCheckedGroups) Then
                'if user is found in a subgroup, return true
                Return True
                'otherwise check the next subgroup
            End If
        Next
    End If

    'if we are here, the user is not found
    Return False
End Function


'''<summary>Finds all subgroups of a group</summary>
'''<remarks></remarks>
'''<param name="spGroupDistinguishName">Distinguished name of the parent group</param>
'''<param name="spDomain">Domain name</param>
'''<returns>Collections.Specialized.StringCollection</returns>
Public Function GetSubGroups( _
        ByVal spGroupDistinguishName As String, _
        ByVal spDomain As String) As Collections.Specialized.StringCollection

    Dim sFilter As String
    Dim oResults As SearchResultCollection
    Dim oRet As Collections.Specialized.StringCollection

    'searches for subgroups that are members of this group
    sFilter = "(&(objectCategory=group)(memberof=" & spGroupDistinguishName & "))"

    oResults = Me.FindByFilter(sFilter, spDomain)

    oRet = New Collections.Specialized.StringCollection
    For Each oResult As SearchResult In oResults
        oRet.Add(oResult.Properties("distinguishedname")(0).ToString)
    Next
    Return oRet
End Function


'''<summary>According to the filter specified, searches LDAP</summary>
'''<remarks></remarks>
'''<param name="spFilter">what to search for</param>
'''<param name="spDomain">The domain to search</param>
'''<returns>DirectoryServices.SearchResultCollection</returns>
Private Function FindByFilter(ByVal spFilter As String, ByVal spDomain As String) As SearchResultCollection
    Dim dsEntryObj As DirectoryEntry
    Dim dsSearcher As DirectorySearcher
    Dim dsResult As SearchResultCollection
    Try
        'search LDAP://domain
        dsEntryObj = New DirectoryEntry("LDAP://" & spDomain)
    Catch e As Exception
        Throw New System.Exception(String.Format("Error creating LDAP directory object {0}!", "LDAP://" & spDomain))
    End Try

    'create the searcher object
    dsSearcher = New DirectorySearcher(dsEntryObj)
    dsSearcher.Filter = spFilter
    Try
        'search in the directory
        dsResult = dsSearcher.FindAll()
    Catch e As Exception
        Throw New Exception(String.Format("Error searching in directory. Filter {0}", dsSearcher.Filter))
    End Try

    Return dsResult
End Function


'''<summary>Does user belong to the group directly?(i.e. not in subgroups)</summary>
'''<param name="spUserDistinguishName">Distinguished name of the user</param>
'''<param name="spGroupDistinguishName">distinguished name of the group</param>
'''<param name="spDomain">domain name</param>
Public Function IsUserDirectlyInGroup(ByVal spUserDistinguishName As String, _
                                      ByVal spGroupDistinguishName As String, _
                                      ByVal spDomain As String) As Boolean
    Dim sFilter As String
    sFilter = "(&(&(objectCategory=group)" & _
                  "(distinguishedname=" & spGroupDistinguishName & ")" & _
                 ")" & _
                "(member=" & spUserDistinguishName & "))"

    Return (Me.FindByFilter(sFilter, spDomain).Count > 0)
End Function


'''<summary>Gets the distinguished name from user name</summary>
'''<param name="spLogin">Full login name domain\user</param>
Public Function DistingishedNameFromLogin(ByVal spLogin As String) As String
    'empty input results in empty output
    If Trim(spLogin) = "" Then Return ""
    Dim sLogin, sDomain As String
    Dim sFilter As String
    Dim oResult As SearchResultCollection

    'separate the login name into parts
    If Not (SplitLogin(spLogin, sDomain, sLogin)) Then
        Return ""
    End If

    'search by sam account, only groups and users
    sFilter = "(&(sAMAccountName=" & sLogin & ")(|(objectCategory=group)(objectCategory=person)))"

    oResult = Me.FindByFilter(sFilter, sDomain)


    If oResult.Count = 0 Then
        Return ""
    ElseIf oResult.Count > 1 Then
        Throw New ArgumentException("More than one entry for this sAMAccountName")
    Else
        Return oResult(0).Properties("distinguishedname")(0).ToString
    End If
End Function


'''<summary>Splits the login name into parts - domain and account</summary>
'''<param name="spLogin">Full login name:  domain\account</param>
'''<param name="spDomain">OUT: Domain name</param>
'''<param name="spAccount">OUT: Account</param>
'''<returns>Boolean</returns>
Public Function SplitLogin(ByVal spLogin As String, ByRef spDomain As String, ByRef spAccount As String) As Boolean
    Dim iSlashPos As Integer
    spLogin = spLogin.Replace("/"c, "\"c)
    iSlashPos = spLogin.IndexOf("\"c)
    If iSlashPos > -1 Then
        With spLogin.Split("\"c)
            spAccount = .GetValue(1).ToString
            spDomain = .GetValue(0).ToString
        End With
        Return True
    Else
        Return False
    End If
End Function

Note: Add system.directoryservices.dll to project references, import System.DirectoryServices namespace!

'month names in Latvian
Dim sMonth() As String = _
            {"Janvāris", "Februāris", "Marts", "Aprīlis", _
            "Maijs", "Jūnijs", "Jūlijs", "Augusts", _
            "Septembris", "Oktobris", "Novembris", "Decembris"}

Dim oListItem as ListItem
For iMonth as Integer = 1 To 12
  oListItem = New ListItem(sMonth(iMonth-1),  iMonth.ToString())
  Me.lstYears.Items.Add(oListItem)
Next

Explanation – if MS Windows knows quite well how months are named in Latvia, why should you try to be smarter than the big brother? Another explanation – if this is a web project (and in my case it is), you should think of internationalization whenever possible.

So a more correct way to add month names to a dropdown menu is:

Imports System.Globalization
....
Dim oListItem as ListItem
For iMonth As Integer = 0 To 11
   oEntry = New Web.UI.WebControls.ListItem( _
         CultureInfo.CurrentUICulture.DateTimeFormat.MonthNames(iMonth), _
            iMonth.ToString)
   Me.lstMonths.Items.Add(oEntry)
Next

And, to be even more precise, you could first check how many months there are in the current culture:

For iMonth As Integer = 0 To _
                CultureInfo. CurrentUICulture.Calendar. _ 
                GetMonthsInYear(Now.Year) - 1
    ....

/Just trying to be a good boy and use the facilities provided by the framework/

For instance, we have the following code:

Dim eDay As System.DayOfWeek = DayOfWeek.Monday

So now we can get a textual representation of eDay using the built-in ToString() method:

MessageBox.Show(eDay.ToString())

This yields a messagebox saying “Monday”. But how do we do the reverse (i.e., we know only the string representation “Monday”, but we need the enum value)? The trivial approach would be:

    Dim sStr As String = "Monday"
    Dim eDay As System.DayOfWeek
    Select Case sStr
        Case "Monday" : eDay = DayOfWeek.Monday
        Case "Tuesday" : eDay = DayOfWeek.Tuesday
            '...
    End Select

No, this sounds too dumb. We can use the built-in shared function Parse of the System.Enum class. Method accepts two parameters, the type of enumeration and the actual value being parsed.

eDay = System.Enum.Parse(GetType(System.DayOfWeek), "Monday")

This only works with option strict set to off, because Enum.Parse() returns a System.Object value. So when using option strict set to on, the code gets more obfuscated:

eDay = CType( _ 
          System.Enum.Parse(GetType(System.DayOfWeek), "Monday"),  _ 
          System.DayOfWeek)

Anyway, now we have the value! :)

Dim s as String = ""
s &= "<"
s &= spFieldName
s &= ">"
s &= spFieldValue
s &= "</"
s &= spFieldName
s &= ">"

This is no good because a new String object is being created for every line of this code and the value is being copied to the newly created object and no optimizations can be made during compilation. One could avoid this using a StringBuilder object and calling ToString() method to achieve the same result. However the readability wouldn’t be too good.

So today I was paging through code of some library not written by me. I used Lutz Roeder’s Reflector. I came accross the following approach of string concatenation:

Dim s as String
s = String.Concat("<",  spFieldName,  ">", spFieldValue, "</", spFieldName, ">")

They had used the “Dotfuscator” to obfuscate the code of the library. As far as I know, the Reflector also makes some optimizations to the code. That’s why I’m not really sure if this is a coding approach or an effect by Dotfuscator/Reflector. Anyway, I believe it is quite a good solution: it doesn’t use much memory for execution and it’s quite readable!

Function getFullPath(ByVal spRoot As String, ByVal spSub As String) As String
    Return spRoot & "/" & spSub
End Function

Viss būtu labi, bet gadījumos , ja spRoot jau beidzas ar “/” simbolu, izveidosies neglīta taka ar divām slīpsvītrām pēc kārtas. Tāpēc kārtīgāks programmētājs cenšas notīrīt liekos “/” no Root beigām:

Function getFullPath(ByVal spRoot As String, ByVal spSub As String) As String
    'korekti ir nemainīt parametra vērtību funkcijā - nokopēsim
    Dim sRoot As String = spRoot

    'kamēr vien rinda beidzas ar /, dzēšam tos nost
    While Right(sRoot, 1) = "/"
        'ja būs atkārtoti / beigās, notīrīs visus
        sRoot = Left(spRoot, Len(sRoot) - 1)
    End While

    Return sRoot & "/" & spSub
End Function

Ir jau labi, tikai darba daudz. Un vispār – kāpēc tā darīt, ja ir izveidota String klases funkcija TrimEnd. Lietojot to, varam atkal funkcijas būtību ierakstīt vienā rindiņā:

Function getFullPath(ByVal spRoot As String, ByVal spSub As String) As String
    Return spRoot.TrimEnd("/"c) & "/" & spSub
End Function

TrimEnd un TrimStart funkcijām parametros var nodot sarakstu ar dažādiem simboliem, kurus mēģināt nodzēst no rindas beigām. Piemēram, ja gribam pārliecināties, ka apakšdirektorijas daļa spSub patiesībā nav līdzīga šai “../../../../windows/system32/”, varam nodzēst arī punkta simbolus no otrā parametra abu parametru savienojamajiem galiem.

Function getFullPath(ByVal spRoot As String, ByVal spSub As String) As String
    Return spRoot.TrimEnd("/"c, "/"c) & "/" & spSub.TrimStart("."c, "/"c)
End Function

Cīņa par drošu kodu? Nu, tā laikam būs.

P.S. Uzmanīgi, ja kāds no parametriem būs Nothing, funkcija metīs kļūdu!

Dim i, j As Integer

Šādas deklarācijas rezultātā i bija ar tipu Variant, bet j bija Integer (nevis kā varētu šķist, abi Integer).

Toties VB.net šī pieeja ir tiek atbalstīta un saprasta tieši tā, kā tā izskatās.

<input id="myFile" type="file" runat="server" />
<input type=button id="cmdUp" runat="server" />

Pēc tam varam ķert notikumu, kad nospiesta upload poga. Pēc MSDN rādītā piemēra, pietiek pārbaudīt vai UploadedFile atribūts nav nothing, tas ir, šādi:

Private Sub Uploads (ByVal s As System.Object, ByVal e As System.EventArgs) Handles cmdUp.ServerClick
         If  Not Me.myFile.PostedFile Is Nothing Then
        '... darām kaut ko
        End If
End Sub

Tomēr patiesībā “Not Me.myFile.PostedFile is Nothing” vienmēr atgriež True – pat tad, ja faila nav. Vismaz pie konfigurācijas, kāda tā ir man. Līdz ar to vienīgais veids, kā pārbaudīt, ka tiešām kaut kas ir uploadēts, ir:

Private Sub Uploads (ByVal s As System.Object, ByVal e As System.EventArgs) Handles cmdUp.ServerClick
         If  (Not Me.myFile.PostedFile Is Nothing) AndAlso _ 
            (Me.myFile.PostedFile.ContentLength>0) Then
        '... darām kaut ko
        End If
End Sub

Tā, redz!

Savajadzējās pašam “notēlot Outlook-u”, lai lasītu vēstules. Tādēļ nācās iegūt nelielu pieredzi darbā ar MAPI, konkrētāk, ar tā “frontendu” MS CDO 1.2.1., lai piekļūtu Microsoft Exchange server direktorijām un “lasītu” e-pasta vēstules. Par to tad arī uzrakstīšu.

Nosaukumu murgs

Jāsāk ar to, ka Microsoft ir krietni pacentušies, lai sajauktu nomenklatūru šajos jautājumos.

Termins MAPI ir atšifrējams kā Messaging API, kuru nodrošina MAPI subsistēma. MAPI aptver daudz plašākas iespējas kā tikai e-pasta sistēmu veidošana, tas ir dzinējs gandrīz jebkāda veida ziņojumapmaiņai (skatīt aprakstu par subsistēmu).

Savukārt CDO jeb Collaboration Data Objects, kas sākotnēji saucies kā “OLE messaging” un mazliet vēlāk “Active messaging”, ir MAPI implementācija, kas paredzēta, lai no klientaplikācijām varētu pieslēgties MAPI serverim. Taču CDO neatbalsta pilno MAPI implementāciju, bet tikai daļu no tās. Tādēļ Microsoft apgalvo, ka CDO implementē “Collaboration Data Objects API specification” otro versiju.

Bez šiem diviem terminiem parādās vēl arī trešais – Simple MAPI, kas ļauj no klientaplikācijām veikt pavisam vienkāršas darbības ar MAPI serveri. To šobrīd neapskatīsim. Mazliet precīzāk par atšķirībām starp MAPI, CDO, SimpleMAPI Microsoft paši skaidro šeit.

Kas kur atrodams

Nu, lūk. Tātad ir mums tāda bibliotēka MAPI32.dll, kas atrodas %windows%\system32 katalogā. Tā nu nemaz nav pareizā bibliotēka (ak jā, te vēl jāpiebilst, ka mērķa valoda, kurā jāveido mana programma, ir MS Visual Basic .net) – ar šo bibliotēku var programmēt tie, kas pārvalda C/C++. Cik saprotu, MAPI objekti neatbalsta IDispatch interfeisu, līdz ar to nav piemērojami valodām, kuras izmanto late-binding. Piemēram, skriptu valodām vai VB.Net. Vēl turpat system32 ir arī bibliotēka cdo32.dll – arī tā nav “pareizā” – tā ir Crystal Data Objects, pavisam cita bibliotēka. Turpat system32 atrodas arī vēl viena bibliotēka ar uzvedinošu nosaukumu cdosys.dll – tā paredzēta SMTP un tamlīdzīgām lietām, vismaz tā skaidro Microsoft. “Pareizais” fails ir meklējams takā C:\Program Files\Common Files\System\MSMAPI\1033. Ja jautāsiet, vai šis fails tur atrodas, ja datorā instalēts “pliks” Windows, atbildēšu, ka nē, neatrodas vis. CDO tiek instalēts tikai tad, ja uz datora instalēts MS Outlook (pilnais, nevis Outlook Express, ja nepieciešama piekļuve Ms Exchange serverim) vai arī pats MS Exchange server.

Interop asamblejas

Lai šo bibliotēku varētu izmantot VB.net projektā, nepieciešams izveidot tai Interop asambleju (man bija nepieciešams parakstīt manis veidoto programmu, tādēļ visām referencētajām bibliotēkām arī jābūt parakstītām). To darām šādi:

rem aizejam uz MAPI direktoriju
C:>cd C:\Program Files\Common Files\System\MSMAPI\1033
rem izveidojam savu atslēgas failu, ja nu tāda vēl nav
C:\Progra~1\Commo~1\System\MSMAPI\1033>sn -k snk.key
rem ģenerējam interop asambleju
C:\Progra~1\Commo~1\System\System\MSMAPI\1033>tlbimp cdo.dll /keyfile:snk.key /out:interop.cdo.dll

Šeit gan tiek pieņemts, ka uz datora ir instalēts .NET SDK un taka C:\Program Files\Microsoft Visual Studio .NET 2003\SDK\v1.1\Bin ir iekļauta PATH.

Kad nu ir izdevies sagatavot interop asambleju, var sākt kodēt. Veidojam jaunu VB.net projektu, liekam referencēs šo interop.cdo.dll, rakstām kodu. Protams, kodu, kas darbosies tikai uz datoriem, kur uzstādīts MS Outlook.

Sesijas veidošana

Pirmā lieta, kas jādara, lai varētu strādāt gandrīz jebkurā klienta-servera vidē, ir ielogošanās. Ar to arī sāksim. Exchange konekciju veidojam šādi:

Dim oSession As New CDO.Session
Dim sServerName As String = "server"
Dim sProfileName As String = "user"
oSession.Logon(NewSession:=True, NoMail:=False, ProfileInfo:=sServerName & vbLf & sProfileName)

Šeit fonā notiek NTLM autorizācija, kuras rezultātā tiek uzjautāta arī lietotāja parole un pārējās lietas. Par to manā gadījumā nebija jāuztraucas. Interesanti ir tas, ka nepareizi norādīts profils vai servera vārds nenozīmē, ka šis koda gabals izpildīsies ar kļūdām. Laba pārbaude ir tests, vai CurrentUser atribūts sesijai atšķiras no Nothing.

Public folders meklēšana

Kas tālāk? Man bija nepieciešams piekļūt nevis paša lietotāja Inbox folderim, bet folderiem no “Public folders” zara. Tātad, meklējam, kur ir publiskie folderi. Sākums jau ir pavisam vienkāršs:

Dim oInfoStores As CDO.InfoStores 'InfoStoru kolekcija, ko dabū no sesijas objekta
Dim oInfoStore, otInfoStore As CDO.InfoStore 'InfoStore objekts, kur atrodam "Public Folders"


'šeit dabūjam visas InfoStores, kas zināmas lietotāja sesijai
'tur būs "Inbox", "Public Folders" un varbūt vēl kāds
oInfoStores = CType(oSession.InfoStores, CDO.InfoStores)

'folderu kolekcijā meklējam "Public Folders"
'jāņem vērā 1-bāzētās kolekcijas!!!
For i As Integer = 1 To CInt(oInfoStores.Count)
   otInfoStore = oInfoStores.Item(i)
    If CStr(otInfoStore.Name) = "Public Folders" Then
       oInfoStore = CType(oInfoStores.Item(i), CDO.InfoStore)
       '"Public folders" ir atrasts, oInfoStore satur referenci uz to
        Exit For
   End If
Next 

Tomēr tas, ko esam atraduši, NAV tas, kas mums vajadzīgs. Mums ir vajadzīgs CDO.Folder tipa objekts, bet atraduši esam CDO.InfoStore objektu. Tāpēc no InfoStore objekta atribūtiem jāatrod foldera ID un jādabū pats foldera objekts. To darām šādi:

Dim oFields As CDO.Fields
Dim oFieldsItem As CDO.Field
Const PRIPMPUBLICFOLDERSENTRYID As Integer = &H66310102
'noskaidrojam visus public folders atribūtus
oFields = CType(oInfoStore.Fields, MAPI.Fields)
'atrodam atribūtos Public folders ID
oFieldsItem = CType(oFields.Item(PRIPMPUBLICFOLDERSENTRYID), MAPI.Field)


'dabū referenci uz Public Folders FOLDERA (nevis InfoStore) objektu
'te jālieto GetFolder pēc foldera ID, citādi notiek kļūda.
oFolder = CType(ocMapiSession.Session.GetFolder(oFieldsItem.Value, oInfoStore.ID), MAPI.Folder)

Ja viss būtu bijis normāli, es būtu varējis šo jocīgo koda gabalu aizvietot ar vienkāršu oFolder=oInfoStore.RootFolder. Taču nē. Kā microsoft raksta šeit, “If your application is running as a Microsoft Windows NT® service, you cannot access the Microsoft Exchange Public Folders through the normal hierarchy because of a notification conflict.”, tas ir, ja kods darbojas kā Windows serviss (kas arī tieši mans gadījums), tad publiskajiem folderiem nevar piekļūt “pa tiešo”.

Apakšfoldera atrašana

Pēc tam atliek publiskajos folderos sameklēt nepieciešamo apakšfolderi. Arī mazliet netriviāli, jo apakšfolderu kolekcija nav pieejama pēc nosaukumiem, bet tikai apstaigājama pēc kārtas numuriem. Pieņemsim, ka gribu piekļūt pie “Public Folders/All Public folders/Internet Newsgroups/alt/2600″

Dim strFolderi() As String = {"All public folders", "Internet Newsgroups", "alt", "2600hz"}
oFolders = CType(oFolder.Folders, CDO.Folders)
For Each sFolder As String In strFolderi
    For iSk As Integer = 1 To CInt(oFolders.Count)
          'iterē cauri objektiem darba folderī, 
          'līdz atrod nākamo līmeni
          oFolder = CType(oFolders.Item(iSk), CDO.Folder)
           If CStr(oFolder.Name) = sFolder Then
              'ja vārds sakrīt, tad varam iet vienu līmeni zemāk
              oFolders = CType(oFolder.Folders, CDO.Folders)
              Exit For
          End If
      Next
Next

Ziņojumu lasīšana

Tā, tagad nu gan esam atraduši vajadzīgo taku. Sāksim lasīt ziņojumus. Pirmkārt jau, negribas kārtējo reizi pārlasīt visus ziņojumus. Filtrēsim tikai nelasītos.

Dim oMessages As CDO.Messages
Dim oMessage As CDO.Message
Dim oFilter As CDO.MessageFilter


oMessages = CType(oFolder.Messages, CDO.Messages)
oFilter = CType(oMessages.Filter, CDO.MessageFilter)
oFilter.Unread = True
For iCnt As Integer = CInt(oMessages.Count) To 1 Step -1
      oMessage = CType(oMessages.Item(iCnt), CDO.Message)
      Debug.WriteLine(CStr(oMessage.Subject))
Next

Kodam izpildoties, debug logā tiek izdrukātas rindas ar atrasto e-pasta vēstuļu nosaukumiem. Jaukāk gan faktiski būtu izdrukāt arī sūtītāju vārdus. Pieliekam papildus koda rindu:

Debug.Write(CStr(CType(oMessage.Sender, CDO.AddressEntry).Address))

Outlook security patch

Un tagad sākas… Diemžēl šis kods vairs neizpildīsies, ja vien būs instalētas relatīvi jaunas MS Exchange server un Outlook versijas. Kāpēc? Pirms dažiem gadiem populāri kļuva dažādi e-pasta vīrusi. Vēstulēm tika pielikti VBS attachmenti un, tos izpildot, tie darīja savu slikto darbu. Sākotnēji dažādu MS Outlook nekorektas izpildes dēļ šie VBS faili izpildījās paši, tikai PASKATOTIES uz tiem caur “preview pane”, vēlāk Outlook tika labots un atradās citi veidi, kā šos VBS izpildīt. Taču galvenā īpatnība bija tā, ka šie skripti, lietojot SimpleMAPI un CDO, mēģināja Outlook Address Book meklēt adreses, uz kurām pārsūtīties tālāk, lai izplatītu vīrusu. Microsoft-ieši izdomāja šo problēmu “nocirst pašā saknē”, proti, izveidot drošības ielāpu, kas aizliedz šiem skriptiem piekļūt noteiktiem MAPI laukiem. Ne gluži aizliegt, bet, tikko programma mēģināja nolasīt kāda “aizliegtā” lauka vērtību, tā uz ekrāna parādījās jautājums “Šī programma grib darīt sliktas lietas. Vai atļaut?”… un podziņas ar iespējām “yes/no”. Viss jau būtu jauki, tikai – kur parādīsies paziņojums, ja kods tiek izpildīts kā MSWindows serviss? Nu, tieši tā, nekur neparādīsies! Un, pat ja parādītos uz servera ekrāna, kurš tad to visu laiku spaidītu?

Pilna informācija par to, kuri MAPI lauki tiek bloķēti ar zināmo security patch un kāda funkcionalitāte vairs nav pieejama, atrodama Microsoft Knowledge Base. MapiLab arī publicējuši apakstu, kā izkļūt no situācijas, lai neredzētu drošības paziņojumus. Cik saprotu, viens no pagaidām labākajiem veidiem ir lietot Outlook Redemption, kas patiesībā ir virsbūve virs MAPI.dll bibliotēkas, uz kuru šis patch neattiecas. Bet tā ir trešās puses slēgta koda bibliotēka, kas bez maksas pieejama tikai izstrādes mērķiem.

Ir arī citas iespējas, proti, šos aizliegumus var “atspējot” kādam noteiktam lietotāja profilam. To var izdarīt MS Exchange administrators norādot, ka dotajam profilam MAPI security patch nav spēkā. Papildus tam uz lietotāja datora jāizdara izmaiņas Windows reģistrā:

[HKEYCURRENTUSER\Software\Policies\Microsoft\Security]
"CheckAdminSettings"=dword:00000001

Kad šīs izmaiņas ir veiktas, jāpārstartē MS Outlook un varam darboties tālāk. Minētais koda fragments, kas izdrukā arī vēstules sūtītāju, izpildās veiksmīgi.

Piekļuve MSExchange profiliem

Bet ja nu mēs iedomājamies palasīt vēstules kādā citā publiskajā folderī, kurā var iesūtīt gan vēstules no ārpuses, gan arī no paša MS Exchange? Bammm… kļūda. Kā izrādās darbs ar Sender atribūtu nebūt nav triviāls gadījumā, kad par to ir zināms kas vairāk nekā, piemēram “Kriss Rauhvargers <kriss@naivist.net>”, proti, ja lietotājs ir MS Exchange lietotājs. Šajā gadījumā lietotāja informācija ir sinhrona ar MS Active Directory ierakstu par lietotāju un, kā zināms, AD vienam un tam pašam lietotājam var reģistrēt daudzas e-pasta adreses. Bez visa šeit minētā vismaz pie tādas konfigurācijas, kāda pieejama man, Sender atribūta lielākā daļa atribūtu man nebija pieejami (un apskatāmi atkļūdošanas laikā tos apskatot, meta kļūdas).

Microsoft iesaka interesantu šīs problēmas apkārtceļu. Proti, ņemam vēstules objektu, veidojam tam Reply (itin kā taisītos sūtīt atbildi) un pēc tam no iegūtās atbildes vēstules nokopējam saņēmēju. Atbildi izmetam. Un, lūk, šim te objektam jau ir pieejams Name atribūts un viss pārējais nepieciešamais. Kodā tas izskatās šādi:

Private Function MessageSender(ByVal opMsg As CDO.Message) As String
    Dim sAddr As String = ""
    Dim oMsgRepl As CDO.Message
    Dim oRec As CDO.Recipient
    Dim bRightsOk As Boolean = False
    Try
        'mēģina izveidot reply vēstuli
        oMsgRepl = CType(opMsg.Reply(), CDO.Message)
        oRec = CType(CType(oMsgRepl.Recipients, CDO.Recipients).Item(1), CDO.Recipient)
        sAddr = UCase(CStr(oRec.Address()))   'paņem atbildes saņēmēja adresi
        bRightsOk = True
    Catch ex As Exception
        sAddr = Nothing 'dabūta kļūda skatoties uz e-pasta adresi
    Finally
        'outlook security brīdinājums mēģināts izmest servisam, 
        'bet tas nav iespējams. Izpilde uzreiz nokļuvusi šeit.
        If Not bRightsOk Then sAddr = Nothing
    End Try
    Return sAddr
End Function

Funkcijas rezultāts atgriež saņēmēja adresi, kas gan ir nedaudz neparasta. Gadījumā, ja saņēmējs ir no ārpuses, adrese būs, piemēram SMTP:kriss@naivist.net, savukārt tad, kad lietotājs ir MS Exchange lietotājs, tā būs, piemēram, EX:/O=Org/OU=SomeUnit/CN=RECIPIENTS/CN=Katalogs/CN=Kriss (ieraksts atbilst Active Directory shēmai. Tomēr skaidrs, ka no šī “izlobīt” vajadzīgos fragmentus ir pavisam vienkārši. Šī funkcija bez kļūdām (bet arī bez pozitīviem rezultātiem) apstrādā arī situāciju, kad nav ir ieslēgta Outlook Security un Recipient objekts nav pieejams. Tādā brīdī ir novērojama interesanta anomālija, kad koda izpilde pēc rindas, kur paņem atbildes saņēmēja adresi, izpildes uzreiz nokļūst Finally blokā, bet ne Catch blokā, ja kods tiek izpildīts kā windows serviss. Zinu, tas izklausās neiespējami, jo patiesībā bija vai nu a) jānotiek kļūdai b) jāizpildās nākamjai rindai, tomēr tā tas nav.

Tādas kā beigas

Ar šo laikam varu arī beigt savu aprakstu. Jā, galvenais- neaizmirst pasaukt Logoff sesijas objektam. Tikai uzmanīgi – arī tajā brīdī var kaut kas “uzkārties” :-)

Downloads