Visual Basic

Imports System.Text
Imports System.Runtime.InteropServices

Public Class LsaUtils
    ' Import the LSA functions

    Private Shared Function LsaOpenPolicy(ByRef SystemName As LSA_UNICODE_STRING, _
        ByRef ObjectAttributes As LSA_OBJECT_ATTRIBUTES, _
        ByVal DesiredAccess As Int32, _
        ByRef PolicyHandle As IntPtr) As UInt32
    End Function

    Public Shared Function LsaQueryInformationPolicy(ByRef PolicyHandle As UInt32, _
        ByRef PolicyInformationClass As UIntPtr, ByRef Buffer As Int32) As UInt32
    End Function

    Private Shared Function LsaNtStatusToWinError(ByVal NTStatus As UInt32) As UInt32
    End Function

    Private Shared Function LsaClose(ByVal ObjectHandle As IntPtr) As Long
    End Function

    Private Shared Function GetLastError() As Long
    End Function

    ' Define the structures
    Private Structure LSA_UNICODE_STRING
        Public Length As UInt16
        Public MaximumLength As UInt16
        Public Buffer As IntPtr
    End Structure

    Private Structure LSA_OBJECT_ATTRIBUTES
        Public Length As Int32
        Public RootDirectory As IntPtr
        Public ObjectName As LSA_UNICODE_STRING
        Public Attributes As UInt32
        Public SecurityDescriptor As IntPtr
        Public SecurityQualityOfService As IntPtr
    End Structure

    Private Structure POLICY_AUDIT_EVENTS_INFO
        Public AuditingMode As Boolean
        Public EventAuditingOptions As POLICY_AUDIT_EVENT_TYPE
        Public MaximumAuditEventCount As UInt32
    End Structure

    ' Enum all policies
    Private Enum LSA_AccessPolicy As Long
        POLICY_VIEW_LOCAL_INFORMATION = &H1L
        POLICY_VIEW_AUDIT_INFORMATION = &H2L
        POLICY_GET_PRIVATE_INFORMATION = &H4L
        POLICY_TRUST_ADMIN = &H8L
        POLICY_CREATE_ACCOUNT = &H10L
        POLICY_CREATE_SECRET = &H20L
        POLICY_CREATE_PRIVILEGE = &H40L
        POLICY_SET_DEFAULT_QUOTA_LIMITS = &H80L
        POLICY_SET_AUDIT_REQUIREMENTS = &H100L
        POLICY_AUDIT_LOG_ADMIN = &H200L
        POLICY_SERVER_ADMIN = &H400L
        POLICY_LOOKUP_NAMES = &H800L
        POLICY_NOTIFICATION = &H1000L
    End Enum

    Private Enum POLICY_INFORMATION_CLASS As Long
        PolicyAuditLogInformation = &H1L
        PolicyAuditEventsInformation = &H2L
        PolicyPrimaryDomainInformation = &H4L
        PolicyPdAccountInformation
        PolicyAccountDomainInformation
        PolicyLsaServerRoleInformation
        PolicyReplicaSourceInformation
        PolicyDefaultQuotaInformation
        PolicyModificationInformation
        PolicyAuditFullSetInformation
        PolicyAuditFullQueryInformation
        PolicyDnsDomainInformation
    End Enum

    Private Enum POLICY_AUDIT_EVENT_TYPE As ULong
        AuditCategorySystem
        AuditCategoryLogon
        AuditCategoryObjectAccess
        AuditCategoryPrivilegeUse
        AuditCategoryDetailedTracking
        AuditCategoryPolicyChange
        AuditCategoryAccountManagement
        AuditCategoryDirectoryServiceAccess
        AuditCategoryAccountLogon
    End Enum

    Public Shared Function OpenHandle(ByVal strSystem As String) As Long
        Dim winErrorCode As Long = 0 ' contains the last error

        ' initialize an empty unicode-string
        Dim systemName As LSA_UNICODE_STRING = New LSA_UNICODE_STRING
        systemName.Buffer = Marshal.StringToHGlobalUni(strSystem)

        ' Combine policies required to grant/deny privileges
        Dim access As Int32 = CInt(LSA_AccessPolicy.POLICY_VIEW_AUDIT_INFORMATION)

        ' initialize a pointer for the policy handle
        Dim policyHandle As IntPtr = IntPtr.Zero
        Dim myBuff As IntPtr = IntPtr.Zero

        ' these attributes are not used, but LsaOpenPolicy wants them to exists
        Dim ObjectAttributes As LSA_OBJECT_ATTRIBUTES = New LSA_OBJECT_ATTRIBUTES
        ObjectAttributes.Length = 0
        ObjectAttributes.RootDirectory = IntPtr.Zero
        ObjectAttributes.Attributes = UInt32.Parse("0")
        ObjectAttributes.SecurityDescriptor = IntPtr.Zero
        ObjectAttributes.SecurityQualityOfService = IntPtr.Zero

        ' get a policy handle
        Dim resultPolicy As UInt32 = LsaOpenPolicy(systemName, ObjectAttributes, access, policyHandle)

        'MessageBox.Show(resultPolicy)
        If Not resultPolicy.ToString = "0" Then
            MsgBox("OpenPolicy failed: " & resultPolicy.ToString, "ServiceUtils")
        Else
            resultPolicy = LsaQueryInformationPolicy(policyHandle, POLICY_INFORMATION_CLASS.PolicyAuditEventsInformation, _
                myBuff)

            Debug.Print("Result = " & LsaNtStatusToWinError(resultPolicy))

            If resultPolicy = 0 Then
                Dim polInfo As POLICY_AUDIT_EVENTS_INFO
                polInfo = Marshal.PtrToStructure(myBuff, GetType(POLICY_AUDIT_EVENTS_INFO))

                MsgBox(polInfo.AuditingMode & " " & polInfo.MaximumAuditEventCount)

                Dim audPolicy As POLICY_AUDIT_EVENT_TYPE = Marshal.PtrToStringAuto(polInfo.EventAuditingOptions)
                Dim audRestartShutdown As String = polInfo.EventAuditingOptions
                'Dim audLogonLogoff As String
                'Dim audObjectAccess = Test(4)
                'Dim audUserRights = Test(6)
                'Dim audProcessTrack = Test(8)
                'Dim audPolicyChanges = Test(10)
                'Dim audUserGroupManagement = Test(12)

                'MsgBox(audRestartShutdown.ToString)
                'MsgBox(audLogonLogoff)
                'MsgBox(audObjectAccess)
                'MsgBox(audUserRights)
                'MsgBox(audProcessTrack)
                'MsgBox(audPolicyChanges)
                'MsgBox(audUserGroupManagement)
            Else
                MsgBox("Don't Know")

            End If
        End If


        Dim Help
        Help = LsaClose(policyHandle)
        MessageBox.Show("Help " & Help)

        Return winErrorCode
    End Function
End Class

Private Sub bAddFolder_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bAddFolder.Click

    For Each filePath As String In IO.Directory.GetFiles(DirListBox1.Path, "*.mp3", IO.SearchOption.AllDirectories)

        Dim Title(30) As Byte
        Dim Artist(30) As Byte
        Dim mp As FileStream = New FileStream(filePath, FileMode.Open)

        mp.Seek(-125, SeekOrigin.End)
        mp.Read(Title, 0, 30)
        mp.Seek(-95, SeekOrigin.End)
        mp.Read(Artist, 0, 30)
        mp.Close()

        Dim TxtTitle As String = System.Text.Encoding.Default.GetString(Title)
        Dim TxtArtist As String = System.Text.Encoding.Default.GetString(Artist)

        fMain.ListView1.Items.Add(TxtArtist + " - " + TxtTitle).SubItems.Add(filePath)

    Next

End Sub