Imports System.Xml
Imports System.DirectoryServices
Imports System.Runtime.InteropServices
Imports System.Security.Principal
Imports System.Security.Permissions
Imports System.Configuration
Public Module Module1

    <DllImport("advapi32.dll")> _
    Private Function LogonUserA(ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, _
    ByVal dwLogonType As Integer, ByVal dwLogonProvider As Integer, ByRef phToken As IntPtr) As Boolean
    End Function
    <DllImport("Kernel32.dll")> _
    Public Function GetLastError() As Integer
    End Function

    <DllImport("Kernel32.dll")> _
    Private Function CloseHandle(ByVal handle As IntPtr) As Long
    End Function

    <DllImport("advapi32.dll")> _
       Private Function DuplicateToken(ByVal ExistingTokenHandle As IntPtr, _
                                                  ByVal ImpersonationLevel As Integer, _
                                              ByRef DuplicateTokenHandle As IntPtr) As Integer
    End Function

    '<DllImport("advapi32.dll")> _
    'Private Function RevertToSelf() As Long
    'End Function

    Dim LOGON32_LOGON_INTERACTIVE As Integer = 2
    Dim LOGON32_PROVIDER_DEFAULT As Integer = 0
    Dim LOGON32_LOGON_NETWORK_CLEARTEXT As Integer = 8
    Public LogOnUsed As Boolean
    Public mWIC As WindowsImpersonationContext

    Public Enum ADSIOperationType
        ENTRY_EXIST = 0
        DELETE_ENTRY = 1
        ADD_VIRTUAL_DIR = 2
        GET_HOME_DIR = 3
        GET_GROUPS_OF_THE_DOMAIN = 4
        GET_MEMBERS_OF_THE_DOMAIN = 5
        GET_GROUPS_OF_THE_USER = 6
        GET_FULL_NAME = 7
    End Enum

    Private Function DeleteDangerouseSymbols(ByRef Str As String) As String
        If Str <> "" Then
            Str = Str.Replace("\", "")
            Str = Str.Replace("/", "")
            Str = Str.Replace("""", "")
            Str = Str.Replace("[", "")
            Str = Str.Replace("]", "")
            Str = Str.Replace(":", "")
            Str = Str.Replace("|", "")
            Str = Str.Replace("<", "")
            Str = Str.Replace(">", "")
            Str = Str.Replace("+", "")
            Str = Str.Replace("=", "")
            Str = Str.Replace(";", "")
            Str = Str.Replace(",", "")
            Str = Str.Replace("?", "")
            Str = Str.Replace("*", "")
            Str = Str.Replace("@", "")
            Return Str
        Else
            Return ""
        End If
    End Function

    Private Sub LogOn(Optional ByRef RetError As String = "")
        LogOnUsed = False
        Dim RunType As String = ConfigurationSettings.AppSettings("GET_AD_INFO_TYPE").ToUpper
        If RunType <> "HCADSI_USER" Then
            Exit Sub
        End If
        Dim LogonAccount As String = ConfigurationSettings.AppSettings("HCADSI_USER_NAME")
        Dim LogonName As String
        Dim LogonDomain As String
        Dim LogonPassword As String



        If LogonAccount <> "" AndAlso LogonAccount.IndexOf("\") = -1 Then
            RetError = "No domain or computer name in HCADSI_USER_NAME parameter. Please use format DOMAIN\Username or COMPUTERNAME\UserName"
            Exit Sub
        ElseIf LogonAccount <> "" Then
            LogonDomain = LogonAccount.Split("\")(0)
            LogonName = LogonAccount.Split("\")(1)
            LogonPassword = ConfigurationSettings.AppSettings("HCADSI_USER_PASSWORD")
        End If

        If LogonName <> "" Then
            'If RevertToSelf() Then
            LogOnUsed = True
            Dim token1 As IntPtr = IntPtr.Zero
            Dim token2 As IntPtr = IntPtr.Zero
            Dim loggedOn As Boolean = LogonUserA(LogonName, LogonDomain, LogonPassword, LOGON32_LOGON_NETWORK_CLEARTEXT, LOGON32_PROVIDER_DEFAULT, token1)
            Dim ret As Integer = GetLastError()


            'If ret <> 0 Then
            '    RetError = "Error while impersonation user(Running function LogonUserA from advapi32.dll) in hcADSI module. Error code: " & ret.ToString() & _
            '    "See codes descriptions here http://msdn.microsoft.com/library/default.asp?url=/library/en-us/debug/base/system_error_codes.asp" & _
            '    "Or see how to fix most well known errors in Readme.htm, troubleshooting section. Or contact with developer, sprunsky@http-com.com"
            '    If Not token1.Equals(IntPtr.Zero) Then
            '        CloseHandle(token1)
            '    End If
            '    Exit Sub
            'End If
            Try
                If DuplicateToken(token1, 2, token2) <> 0 Then
                    Dim mWI2 As WindowsIdentity = New WindowsIdentity(token2)
                    mWIC = mWI2.Impersonate()
                    If mWIC Is Nothing Then
                        RetError = "Can't impersonate token. See Readme.htm, troubleshooting section. Or contact with developer, sprunsky@http-com.com"
                    End If
                End If
            Catch ex As Exception
                RetError = "Error in hcADSI module, LogOn function: " & ex.Message
            End Try

            If Not token1.Equals(IntPtr.Zero) Then
                CloseHandle(token1)
            End If
            If Not token2.Equals(IntPtr.Zero) Then
                CloseHandle(token2)
            End If
            'End If
        End If
    End Sub

    Private Sub LogOff()
        If LogOnUsed AndAlso Not mWIC Is Nothing Then mWIC.Undo()
    End Sub

    ' Function  ADGetInfo only for HTTP Commander Active Directory version
    Public Function ADGetInfo(ByVal ADSIOperationType As ADSIOperationType, ByRef AuthDomain As String, Optional ByRef UserName As String = "", Optional ByRef RetError As String = "") As Object
        LogOn(RetError)
        Try
            Dim DomainName As String = DeleteDangerouseSymbols(AuthDomain)
            Dim User As String = DeleteDangerouseSymbols(UserName)

            Select Case ADSIOperationType
                Case ADSIOperationType.GET_HOME_DIR
                    Dim RetVal As Object
                    Dim de As DirectoryServices.DirectoryEntry
                    de = New DirectoryServices.DirectoryEntry("WinNT://" + DomainName + "/" + User)
                    RetVal = de.Properties("HomeDirectory").Value
                    de.Close()
                    de.Dispose()
                    LogOff()
                    Return RetVal
                Case ADSIOperationType.GET_FULL_NAME
                    Dim RetVal As Object
                    Dim de As DirectoryServices.DirectoryEntry
                    de = New DirectoryServices.DirectoryEntry("WinNT://" + DomainName + "/" + User)
                    RetVal = de.Properties("displayName").Value
                    de.Close()
                    de.Dispose()
                    LogOff()
                    Return RetVal
                Case ADSIOperationType.GET_GROUPS_OF_THE_DOMAIN
                    Dim Items() As Object
                    Dim de As DirectoryServices.DirectoryEntry
                    Dim Child As DirectoryServices.DirectoryEntry
                    Dim k As Integer = 0
                    de = New DirectoryServices.DirectoryEntry("WinNT://" + DomainName)
                    de.Children.SchemaFilter.Add("group")
                    For Each Child In de.Children
                        ReDim Preserve Items(k)
                        Items(k) = Child.Name
                        k += 1
                    Next
                    de.Close()
                    Child.Close()
                    de.Dispose()
                    Child.Dispose()
                    LogOff()
                    Return Items
                Case ADSIOperationType.GET_MEMBERS_OF_THE_DOMAIN
                    Dim Items() As Object
                    Dim de As DirectoryServices.DirectoryEntry
                    Dim Child As DirectoryServices.DirectoryEntry
                    Dim k As Integer = 0
                    de = New DirectoryServices.DirectoryEntry("WinNT://" + DomainName)
                    de.Children.SchemaFilter.Add("user")
                    For Each Child In de.Children
                        ReDim Preserve Items(k)
                        Items(k) = Child.Name
                        k += 1
                    Next
                    de.Close()
                    Child.Close()
                    de.Dispose()
                    Child.Dispose()
                    LogOff()
                    Return Items
                Case ADSIOperationType.GET_GROUPS_OF_THE_USER
                    Dim Items() As Object
                    Dim de As DirectoryServices.DirectoryEntry
                    Dim obGroups As Object
                    Dim ob As Object
                    Dim k As Integer = 0
                    de = New DirectoryServices.DirectoryEntry("WinNT://" + DomainName + "/" + User)
                    obGroups = de.Invoke("Groups")
                    For Each ob In obGroups
                        ReDim Preserve Items(k)
                        Items(k) = ob.Name
                        k += 1
                    Next
                    de.Close()
                    de.Dispose()
                    LogOff()
                    Return Items
            End Select
        Catch ex As Exception
            LogOff()
            RetError = "Error in hcADSI module, ADGetInfo function: " & ex.Message & ". See Readme.htm, Troubleshooting section or contact with developer, sprunsky@http-com.com"
        End Try

        LogOff()
        Return Nothing
    End Function

    ' Function  FTPOperation creates and deletes FTP folders
    Public Function FTPOperation(ByVal ADSIOperationType As ADSIOperationType, Optional ByRef RetError As String = "", Optional ByRef Path As String = "", Optional ByRef VDirName As String = "", Optional ByRef VDirPath As String = "", Optional ByVal AccessCanRead As Boolean = True, Optional ByVal AccessCanWrite As Boolean = True) As Object
        LogOn(RetError)
        Try
            Dim ftpvdirname = DeleteDangerouseSymbols(VDirName)
            Select Case ADSIOperationType
                Case ADSIOperationType.ENTRY_EXIST
                    Dim RetVal As Object = DirectoryServices.DirectoryEntry.Exists(Path)
                    LogOff()
                    Return RetVal
                Case ADSIOperationType.DELETE_ENTRY
                    Dim deRoot As DirectoryServices.DirectoryEntry
                    deRoot = New DirectoryServices.DirectoryEntry(Path)
                    deRoot.DeleteTree()
                    deRoot.Close()
                    deRoot.Dispose()
                Case ADSIOperationType.ADD_VIRTUAL_DIR
                    Dim deRoot As DirectoryServices.DirectoryEntry
                    Dim deNewVDir As DirectoryServices.DirectoryEntry
                    deRoot = New DirectoryServices.DirectoryEntry(Path)
                    deRoot.RefreshCache()
                    deNewVDir = deRoot.Children.Add(ftpvdirname, "IIsFtpVirtualDir")
                    deNewVDir.Properties("Path")(0) = VDirPath
                    deNewVDir.Properties("AccessRead")(0) = AccessCanRead
                    deNewVDir.Properties("AccessWrite")(0) = AccessCanWrite
                    deNewVDir.Properties("DontLog")(0) = True
                    deNewVDir.CommitChanges()
                    deRoot.CommitChanges()
                    deNewVDir.Close()
                    deRoot.Close()
                    deRoot.Dispose()
                    deNewVDir.Dispose()
                    LogOff()
            End Select
        Catch ex As Exception
            LogOff()
            If ADSIOperationType = ADSIOperationType.ENTRY_EXIST Then
                Return False
            End If
            RetError = "Error in hcADSI module: " & ex.Message & ". See Readme.htm, Troubleshooting section or contact with developer, sprunsky@http-com.com"
        End Try
        LogOff()
        Return Nothing
    End Function



    Public Function FTPUploadDownload(ByRef isUpload As Boolean, ByRef RootPath As String, ByRef FirstFolderName As String, ByRef SecondFolderName As String, ByRef VDirPath As String, Optional ByRef RetError As String = "") As Object
        LogOn(RetError)
        Try
            Dim ffname As String = DeleteDangerouseSymbols(FirstFolderName)
            Dim sfname As String = DeleteDangerouseSymbols(SecondFolderName)

            Dim deRoot As DirectoryServices.DirectoryEntry
            Dim deNewVDir As DirectoryServices.DirectoryEntry

            ' Delete folder if it is exists
            Try
                deRoot = New DirectoryServices.DirectoryEntry(RootPath & "/" & FirstFolderName)
                deRoot.DeleteTree()
                deRoot.Close()
                deRoot.Dispose()
            Catch ex As Exception
            End Try

            ' Create first virtual folder
            deRoot = New DirectoryServices.DirectoryEntry(RootPath)
            deRoot.RefreshCache()
            deNewVDir = deRoot.Children.Add(ffname, "IIsFtpVirtualDir")
            deNewVDir.Properties("Path")(0) = ""
            deNewVDir.Properties("AccessRead")(0) = False
            deNewVDir.Properties("AccessWrite")(0) = False
            deNewVDir.Properties("DontLog")(0) = True
            deNewVDir.CommitChanges()
            deRoot.CommitChanges()
            deNewVDir.Close()
            deRoot.Close()
            deRoot.Dispose()
            deNewVDir.Dispose()

            ' Create second virtual folder
            deRoot = New DirectoryServices.DirectoryEntry(RootPath & "/" & FirstFolderName)
            deRoot.RefreshCache()
            deNewVDir = deRoot.Children.Add(sfname, "IIsFtpVirtualDir")
            deNewVDir.Properties("Path")(0) = VDirPath
            If isUpload Then
                deNewVDir.Properties("AccessRead")(0) = True
                deNewVDir.Properties("AccessWrite")(0) = True
            Else
                deNewVDir.Properties("AccessRead")(0) = True
                deNewVDir.Properties("AccessWrite")(0) = False
            End If
            deNewVDir.Properties("DontLog")(0) = True
            deNewVDir.CommitChanges()
            deRoot.CommitChanges()
            deNewVDir.Close()
            deRoot.Close()
            deRoot.Dispose()
            deNewVDir.Dispose()

        Catch ex As Exception
            LogOff()
            RetError &= "Error in hcADSI module, FTPDownload function: " & ex.Message & ". See Readme.htm, Troubleshooting section or contact with developer, sprunsky@http-com.com"
        End Try
        LogOff()
        Return Nothing
    End Function

End Module
