Force Password Change At Next Logon

Category:

Network/Internet

Type:

Snippets

Difficulty:

Advanced

Author: Waty

Version Compatibility: Visual Basic 5

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _ As String) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal _ hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _ ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _ ByVal wFlags As Long) As Long Private Const SWP_HIDEWINDOW = &H80 Private Const SWP_SHOWWINDOW = &H40 ' #VBIDEUtils#**************************************** ' * Programmer Name : Waty Thierry ' * Web Site :www.geocities.com/ResearchTriangle/6311/ ' * E-Mail :waty.thierry@usa.net ' * Date :16/04/99 ' * Time :16:32 ' * Module Name :Force_Logon ' * Module Filename :logon.bas ' *********************************************************** ' * Comments : Force Password Change At Next Logon ' * ' * ' *********************************************** 'dw Limitations Public Const UNLEN = 256 ' Maximum user name length Public Const LM20_UNLEN = 20 ' LM 2.0 Maximum user name length Public Const MAXCOMMENTSZ = 256 ' Multipurpose comment length Public Const _ LM20_MAXCOMMENTSZ = 48 ' LM 2.0 Multipurpose comment length Public Const PWLEN = 256 ' Maximum password length Public Const LM20_PWLEN = 14 ' LM 2.0 Maximum password length Public Const GNLEN = UNLEN ' Group name Public Const LM20_GNLEN = LM20_UNLEN ' LM 2.0 Group name Public Const PATHLEN = 256 ' Max. path (not including drive name) Public Const LM20_PATHLEN = 256 ' LM 2.0 Max. path Public Const CNLEN = 15 ' Computer name length Public Const LM20_CNLEN = 15 ' LM 2.0 Computer name length Public Const DNLEN = CNLEN ' Maximum domain name length Public Const _ LM20_DNLEN = LM20_CNLEN ' LM 2.0 Maximum domain name length Public Const UNCLEN = (CNLEN + 2) ' UNC computer name length Public Const _ LM20_UNCLEN = (LM20_CNLEN + 2) ' LM 2.0 UNC computer name length 'dw Flags Public Const UF_SCRIPT = &H1 Public Const UF_ACCOUNTDISABLE = &H2 Public Const UF_HOMEDIR_REQUIRED = &H8 Public Const UF_LOCKOUT = &H10 Public Const UF_PASSWD_NOTREQD = &H20 Public Const UF_PASSWD_CANT_CHANGE = &H40 'Needs to be ORed with the other flags Public Const UF_NORMAL_ACCOUNT = &H200 Type TUser3 usri3_name As Long 'LPWSTR in SDK usri3_password As Long 'LPWSTR in SDK usri3_password_age As Long 'DWORD in SDK usri3_priv As Long 'DWORD in SDK usri3_home_dir As Long 'LPWSTR in SDK usri3_comment As Long 'LPWSTR in SDK usri3_flags As Long 'DWORD in SDK usri3_script_path As Long 'LPWSTR in SDK usri3_auth_flags As Long 'DWORD in SDK usri3_full_name As Long 'LPWSTR in SDK usri3_usr_comment As Long 'LPWSTR in SDK usri3_parms As Long 'LPWSTR in SDK usri3_workstations As Long 'LPWSTR in SDK usri3_last_logon As Long 'DWORD in SDK usri3_last_logoff As Long 'DWORD in SDK usri3_acct_expires As Long 'DWORD in SDK usri3_max_storage As Long 'DWORD in SDK usri3_units_per_week As Long 'DWORD in SDK usri3_logon_hours As Long 'PBYTE in SDK usri3_bad_pw_count As Long 'DWORD in SDK usri3_num_logons As Long 'DWORD in SDK usri3_logon_server As Long 'LPWSTR in SDK usri3_country_code As Long 'DWORD in SDK usri3_code_page As Long 'DWORD in SDK usri3_user_id As Long 'DWORD in SDK usri3_primary_group_id As Long 'DWORD in SDK usri3_profile As Long 'LPWSTR in SDK usri3_home_dir_drive As Long 'LPWSTR in SDK usri3_password_expired As Long 'DWORD in SDK End Type Declare Function NetUserGetInfo...

Code:

' #VBIDEUtils#************************************************************
' * Programmer Name  : Adrian Maull
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : adrianm@zebra.net
' * Date             : 28/06/99
' * Time             : 12:48
' **********************************************************************
' * Comments         : Finds the file on *any* connected drive
' *
' * Send this class only a filename And it finds the file
' * On *any* connected drive. No need To send a full path!
' * It searches the local hard drive, connected network drives, etc.
' * You even have the Option of choosing whether Or Not you want
' * To include the floppy, CD-Rom, Or remote drive(s) In the search.
' * If you don't download anything else you've got to get this one!
' *
' **********************************************************************

Option Explicit

'private consts

Private Const MAX_PATH = 260
Private Const SLASH = "\"
Private Const VB_EMPTYSTRING = ""

'GetDriveType return values
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
'------------------------------------------------------------------

'private types

Private Type FILETIME
   dwLowDateTime     As Long
   dwHighDateTime    As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes  As Long
   ftCreationTime    As FILETIME
   ftLastAccessTime  As FILETIME
   ftLastWriteTime   As FILETIME
   nFileSizeHigh     As Long
   nFileSizeLow      As Long
   dwReserved0       As Long
   dwReserved1       As Long
   cFileName         As String * MAX_PATH
   cAlternate        As String * 14
End Type

'------------------------------------------------------------------

'Private declares

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'------------------------------------------------------------------

'private members

Private msDriveArray()  As String
Private mbSkipFloppy    As Boolean
Private mbSkipCD        As Boolean
Private mbSkipRemote    As Boolean
Private mbStopFlag      As Boolean
Private msFullPath      As String  'this only gets set in StartSearch if path is found

Public Property Let SkipFloppy(b As Boolean)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : SkipFloppy
   ' * Parameters       :
   ' *                    b As Boolean
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

mbSkipFloppy = b
End Property

Public Property Let SkipCD(b As Boolean)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : SkipCD
   ' * Parameters       :
   ' *                    b As Boolean
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

mbSkipCD = b
End Property

Public Property Let SkipRemote(b As Boolean)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : SkipRemote
   ' * Parameters       :
   ' *                    b As Boolean
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

mbSkipRemote = b
End Property

Private Sub GetSystemDrives()
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : GetSystemDrives
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

Dim sDrives          As String
   Dim sCurrentDrive    As String
   Dim lUbound          As Long
   Dim lIndex           As Long
   Dim lret             As Long

ReDim msDriveArray(0)
   lIndex = 0

sDrives = GetDrives()

Do Until sDrives = Chr$(0)

'strip off one drive item from the sDrives$
      sCurrentDrive = StripNulls(sDrives)

'check to see if drive is fixed...
      lret = GetDriveType(sCurrentDrive)

'could place the reptitious in-line code below with a
      'function or procedure but it's only four cases and in-line
      'code runs faster...
      Select Case lret
         Case DRIVE_REMOVABLE
            If Not mbSkipFloppy Then
               'add to the drive array
               msDriveArray(lIndex) = sCurrentDrive
               lIndex = lIndex + 1
               lUbound = UBound(msDriveArray)
               ReDim Preserve msDriveArray(lUbound + 1)
            End If
         Case DRIVE_FIXED
            msDriveArray(lIndex) = sCurrentDrive
            lIndex = lIndex + 1
            lUbound = UBound(msDriveArray)
            ReDim Preserve msDriveArray(lUbound + 1)
         Case DRIVE_REMOTE
            'take into account the skip options
            If Not mbSkipRemote Then
               msDriveArray(lIndex) = sCurrentDrive
               lIndex = lIndex + 1
               lUbound = UBound(msDriveArray)
               ReDim Preserve msDriveArray(lUbound + 1)
            End If
         Case DRIVE_CDROM
            If Not mbSkipCD Then
               msDriveArray(lIndex) = sCurrentDrive
               lIndex = lIndex + 1
               lUbound = UBound(msDriveArray)
               ReDim Preserve msDriveArray(lUbound + 1)
            End If
      End Select
   Loop

End Sub

Private Function GetDrives() As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : GetDrives
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'returns a single string of available drive
   'letters, each separated by a chr$(0)

Dim lret             As Long
   Dim sTmp             As String

sTmp = Space$(255)
   lret = GetLogicalDriveStrings(Len(sTmp), sTmp)

GetDrives = Trim$(sTmp)

End Function

Private Function StripNulls(sStringIn As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : StripNulls
   ' * Parameters       :
   ' *                    sStringIn As String
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'Take a string separated by a chr$(0), and split off 1 item, and
   'shorten the string so that the next item is ready for removal.

Dim iPos As Integer

iPos = InStr(sStringIn, Chr$(0))

If iPos Then
      StripNulls = Mid$(sStringIn, 1, iPos - 1)
      sStringIn = Mid$(sStringIn, iPos + 1, Len(sStringIn))
      Exit Function
   Else
      sStringIn = Trim$(sStringIn)
   End If

End Function

Public Function FindFullPath(sFileToRun As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : FindFullPath
   ' * Parameters       :
   ' *                    sFileToRun As String
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'this is the function exposed to the world.  Accepts a full
   'path to a file.

Dim l As Long
   Dim lUbound As Long

'find all drives to build the drive array
   GetSystemDrives

lUbound = UBound(msDriveArray)
   If lUbound = 0 Then Exit Function

'search all the drives in the array for the file wanted
   For l = 0 To lUbound - 1
      If mbStopFlag Then Exit For
      StartSearch msDriveArray(l), sFileToRun
   Next

'this is an empty string if the file was not found
   FindFullPath = msFullPath

End Function

Private Function StartSearch(sPathIn As String, sFileToRun As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : StartSearch
   ' * Parameters       :
   ' *                    sPathIn As String
   ' *                    sFileToRun As String
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'In this search routine I ReDim the file array every 50 items.
   'That way I don't have to ReDim Preserve for every item added to
   'the array -- that's slow.

Dim sFileArray()     As String
   Dim wfdStruct        As WIN32_FIND_DATA
   Dim hFile            As Long
   Dim sFile            As String
   Dim sPath            As String
   Dim i                As Integer
   Dim iFound           As Integer
   Dim lret             As Long

'find the first file matching the parameter .*
   hFile = FindFirstFile(sPathIn & "*.*" & Chr$(0), wfdStruct)

iFound = 0
   ReDim sFileArray(50)

If hFile <> -1 Then
      sFile = StripNulls(wfdStruct.cFileName)

'check for file match here.  I had to add this code here
      'because on floppies the file wanted may be the very
      'first one...
      If UCase(sFile) = UCase(sFileToRun) Then
         'this is it; flag stop true; assign path to
         'function
         mbStopFlag = True
         msFullPath = sPathIn & sFile
         Exit Function
      End If

wfdStruct.dwFileAttributes = vbDirectory

While FindNextFile(hFile, wfdStruct)

sFile = StripNulls(wfdStruct.cFileName)

'ignore the 2 standard root entries
         If (sFile <> ".") And (sFile <> "..") Then

If (wfdStruct.dwFileAttributes And vbDirectory) Then

iFound = iFound + 1
               'if iFound is at 50, then add some more array elements
               If iFound Mod 50 = 0 Then ReDim Preserve sFileArray(iFound + 50)

sFileArray(iFound) = sPathIn & sFile
            Else
               If UCase(sFile) = UCase(sFileToRun) Then
                  'this is it; flag stop true; assign path to
                  'function
                  mbStopFlag = True
                  msFullPath = sPathIn & sFile
                  Exit Function
               End If
            End If
         End If
      Wend
   End If

lret = FindClose(hFile)

'trim down the array to equal the elements found...
   ReDim Preserve sFileArray(iFound)

'recursion is necessary to search all subfolders...
   For i = 1 To iFound
      '...unless I already found the file
      If mbStopFlag Then Exit For
      sPath = sFileArray(i) & SLASH
      StartSearch sPath, sFileToRun
   Next

End Function

Private Sub Class_Initialize()
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : Class_Initialize
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'init the skip drive bools
   mbSkipFloppy = True
   mbSkipCD = True

'just making sure...
   mbStopFlag = False

msFullPath = VB_EMPTYSTRING

End Sub

Private Sub Class_Terminate()
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : Class_Terminate
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'free array space used
   ReDim msDriveArray(0)

End Sub