禁用系統帳號(USER_INFO_1008)的例項

[@more@]

Option Explicit

Private Const ERROR_SUCCESS As Long = 0
Private Const UF_SCRIPT As Long = &H1
Private Const UF_ACCOUNTDISABLE As Long = &H2

Private Type USER_INFO_1008
   usri1008_flags As Long
End Type

Private Declare Function NetUserSetInfo Lib "Netapi32" _
  (servername As Byte, _
   username As Byte, _
   ByVal level As Long, _
   bufptr As Long, _
   parm_err As Long) As Long

Private Declare Function NetApiBufferFree Lib "Netapi32" _
  (ByVal Buffer As Long) As Long



Private Sub Form_Load()

   With Label1
      .Caption = "Account:"
      .AutoSize = True
      .Move 200, 400
   End With
   
   With Text1
      .Text = "(enter a user name)"
      .Move 1000, 360, 1600, 285
   End With
   
   With Label2
      .Caption = "(result)"
      .AutoSize = True
      .WordWrap = True
      .Move 2800, 400, 2200
   End With
      
   With Check1
      .Caption = "Check to confirm disable of this account"
      .Move 1000, 800, 3400, 345
   End With

   With Command1
      .Caption = "Disable Account"
      .Move 1000, 1200, 1600, 345
   End With

End Sub


Private Sub Command1_Click()
   
   Dim bLockout As Boolean
   Dim sUser As String
   Dim success As Boolean
   
  'set up
   bLockout = Check1.Value = vbChecked
   sUser = Text1.Text
   Label2.Caption = "working..."
   Label2.Refresh
   
  'call
   success = DisableAccount(bLockout, sUser, "")
   
  'result
   Select Case success
      Case True
         Label2.Caption = "NetUserSetInfo successful: account disabled"
      Case Else
         Label2.Caption = "Unknown error"
   End Select
      
End Sub


Private Function DisableAccount(bDisableAccount As Boolean, _
                                sUsername As String, _
                                Optional sServer As String = vbNullString) As Long

   Dim bServer() As Byte
   Dim bUser() As Byte
   Dim parm_err As Long
   Dim ui1008 As USER_INFO_1008
   
  'safety check
   If bDisableAccount = True Then
   
      bUser = sUsername & vbNullChar
      bServer = QualifyServer(sServer) & vbNullChar

     'Set the flags. UF_SCRIPT is required
     'for LAN Manager 2.0 and Windows NT and later
      ui1008.usri1008_flags = UF_SCRIPT Or UF_ACCOUNTDISABLE
   
     'Because the UDT contains only
     'one member defined As Long, pass
     'the value directly in NetUserSetInfo.
     'Otherwise we need to use CopyMemory.
      DisableAccount = NetUserSetInfo(bServer(0), _
                               bUser(0), _
                               1008, _
                               ui1008.usri1008_flags, _
                               parm_err) = ERROR_SUCCESS
      
      NetApiBufferFree ui1008.usri1008_flags
   
   End If  'bDisableAccount
   
End Function


Private Function QualifyServer(ByVal sServer As String) As String

  'if nullstring was passed, the
  'API does not expect slashes in
  'the server name
   If Len(sServer) > 0 Then
  
     'are already two slashes
     'preceding the server name?
      If Left$(sServer, 2) = "" Then
   
        'there are, so the server is already
        'qualified; return the passed string
         QualifyServer = sServer
   
      Else
   
        'there aren't two, but is there one?
         If Left$(sServer, 1) = "" Then
      
           'yes, so add one more
            QualifyServer = "" & sServer
      
         Else
      
           'the string needs both
            QualifyServer = "" & sServer
      
         End If  'Left$(sServer, 1) <> ""
      End If  'Left$(sServer, 2) = ""
   
   Else
   
     'empty string passed, so return it
      QualifyServer = sServer
      
   End If  'Len(sServer)
   
End Function