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

'our defined constants for errors
'we might encounter
Private Const ERR_ACCOUNT_CHANGED As Long = &H0
Private Const ERR_ACCOUNT_ALREADY_DISABLED As Long = -&H10
Private Const ERR_ACCOUNT_ALREADY_ENABLED As Long = -&H20
Private Const ERR_ACCOUNT_NOT_FOUND As Long = -&H40
Private Const ERR_UPDATE_NOT_SUCCESSFUL As Long = -&H80

Private Type USER_INFO_3
   usri3_name              As Long
   usri3_password          As Long
   usri3_password_age      As Long
   usri3_priv              As Long
   usri3_home_dir          As Long
   usri3_comment           As Long
   usri3_flags             As Long
   usri3_script_path       As Long
   usri3_auth_flags        As Long
   usri3_full_name         As Long
   usri3_usr_comment       As Long
   usri3_parms             As Long
   usri3_workstations      As Long
   usri3_last_logon        As Long
   usri3_last_logoff       As Long
   usri3_acct_expires      As Long
   usri3_max_storage       As Long
   usri3_units_per_week    As Long
   usri3_logon_hours       As Long
   usri3_bad_pw_count      As Long
   usri3_num_logons        As Long
   usri3_logon_server      As Long
   usri3_country_code      As Long
   usri3_code_page         As Long
   usri3_user_id           As Long
   usri3_primary_group_id  As Long
   usri3_profile           As Long
   usri3_home_dir_drive    As Long
   usri3_password_expired  As Long
End Type

Private Declare Function NetUserGetInfo Lib "Netapi32" _
  (servername As Byte, _
   username As Byte, _
   ByVal level As Long, _
   bufptr As Long) As Long
   
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 Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pTo As Any, _
   uFrom As Any, _
   ByVal lSize 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 = "Disable this account"
      .Move 1000, 800, 2600, 345
   End With

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


End Sub


Private Sub Command1_Click()
   
   Dim bLockout As Boolean
   Dim sUser As String
   Dim buff As String
   Dim success As Long
   
  'set-up
   bLockout = Check1.Value = vbChecked
   sUser = Text1.Text
   
  'call
   success = DisableAccount(bLockout, sUser, "")
   
  'results (using our defined error codes)
   Select Case success
      Case ERR_ACCOUNT_CHANGED
         buff = "NetUserSetInfo completed successfully"
      Case ERR_ACCOUNT_ALREADY_DISABLED
         buff = "The specified account is already disabled"
      Case ERR_ACCOUNT_ALREADY_ENABLED
         buff = "The specified account is already enabled"
      Case ERR_ACCOUNT_NOT_FOUND
         buff = "The specified account or server was not found"
      Case ERR_UPDATE_NOT_SUCCESSFUL
         buff = "The call to NetUserSetInfo failed"
      Case Else
         buff = "Unknown error"
   End Select
   
   Label2.Caption = buff
   
End Sub


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

   Dim parm_err As Long
   Dim success As Long
   Dim buff As Long
   Dim bServer() As Byte
   Dim bUser() As Byte
   Dim ui3 As USER_INFO_3
   
   bUser = sUsername & vbNullChar
   bServer = QualifyServer(sServer) & vbNullChar
   
  'retrieve the user info into a buffer
   success = NetUserGetInfo(bServer(0), bUser(0), 3, buff)

   If success = ERROR_SUCCESS Then
   
     'copy it to a USER_INFO_3 structure
      CopyMemory ui3, ByVal buff, Len(ui3)

     'if the flag is disable
      If bDisableAccount = True Then
      
        'and the account already isn't
         If (ui3.usri3_flags And UF_ACCOUNTDISABLE) <> UF_ACCOUNTDISABLE Then
         
           'toggle the flag
            ui3.usri3_flags = ui3.usri3_flags Or UF_ACCOUNTDISABLE
            
         Else
         
           'it's already disabled
            DisableAccount = ERR_ACCOUNT_ALREADY_DISABLED
            Call NetApiBufferFree(buff)
            Exit Function
            
         End If  'ui3.usri3_flags)
      
      Else
      
        'the account should be enabled, 
        'so if it is currently disabled
         If (ui3.usri3_flags And UF_ACCOUNTDISABLE) = UF_ACCOUNTDISABLE Then
         
           'toggle the flag
            ui3.usri3_flags = ui3.usri3_flags Xor UF_ACCOUNTDISABLE
         Else
         
           'it's already enabled
            DisableAccount = ERR_ACCOUNT_ALREADY_ENABLED
            Call NetApiBufferFree(buff)
            Exit Function
            
         End If  'ui3.usri3_flags
      
      End If  'bDisableAccount
      
     'copy the structure back to the buffer,
     'call NetUserSetInfo and clean up
      CopyMemory ByVal buff, ui3, ByVal Len(ui3)
      success = NetUserSetInfo(bServer(0), _
                               bUser(0), _
                               3, _
                               ByVal buff, _
                               parm_err)
      NetApiBufferFree buff

      If success = ERROR_SUCCESS Then
         
         DisableAccount = ERR_ACCOUNT_CHANGED
         
      Else
      
        'something prevented the change
         DisableAccount = ERR_UPDATE_NOT_SUCCESSFUL
         
      End If

   Else
   
     'the call to obtain the userinfo failed,
     'probably because the account or server
     'passed was incorrect
      DisableAccount = ERR_ACCOUNT_NOT_FOUND
   
   End If  'success = 0
   
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
     'preceeding 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