faqts : Computers : Programming : Languages : PHP

+ Search
Add Entry AlertManage Folder Edit Entry Add page to http://del.icio.us/
Did You Find This Entry Useful?

16 of 24 people (67%) answered Yes
Recently 5 of 10 people (50%) answered Yes

Entry

How do I change an NT password (IIS)?

Feb 23rd, 2007 00:44
Articles Hosting, Manuel Guzman,


This solution has only been tested using VB 6.0, PHP 4.2, IIS 4.0, NT 
4.0 sp6a.  You must be able to register a COM object on the web server.
Overview: Create a dll that performs authentication using Windows 
API.  
Register the dll on the web server.  Use COM function from PHP to 
reference the dll.
-----------------------------------
Create DLL:
In VB create a New Active X DLL Project.  In the Class1 properties 
change the name (ex: CUserChangePassword).  Change the Project name 
(ex: UserChangePassword).  Paste the Visual Basic source code from 
below into the empty class.  Go to File and Make dll.
-----------------------------------
Register DLL:
Copy DLL to server, remember what directory you copy it into.  At 
server click Start, Run, cmd, OK.  Change to the directory the dll is 
in. regsvr32 dllname (ex: regsvr32 UserChangePassword.dll).  You 
should 
see a message saying registration succeeded.
-----------------------------------
Create your PHP page. Sample code below:
$obj = new COM("UserChangePassword.CUserChangePassword");
$result = $obj->UserChangePassword
($strLogin,$strDomain,$strPassword,$newPassword);
$obj = null;
unset($obj);
if ($result == "SUCCESS")	{ // do what you want }
else  { // $result stores error message }
-----------------------------------
Visual Basic Source Code:
-----------------------------------
    Option Explicit
' modified from microsoft knowledge base article: q187535
    Const FORMAT_MESSAGE_FROM_HMODULE = &H800
    Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
    Const NERR_BASE = 2100
    Const MAX_NERR = NERR_BASE + 899 ' This is the last error in
                                     ' NERR   range.
    Const LOAD_LIBRARY_AS_DATAFILE = &H2
    Private Declare Function LoadLibraryEx Lib "kernel32" Alias _
       "LoadLibraryExA" (ByVal lpLibFileName As String, _
       ByVal hFile As Long, ByVal dwFlags As Long) As Long
    Private Declare Function FreeLibrary Lib "kernel32" _
       (ByVal hLibModule As Long) As Long
    Private Declare Function NetApiBufferFree& Lib "netapi32" _
       (ByVal Buffer As Long)
    Private Declare Sub lstrcpyW Lib "kernel32" _
       (dest As Any, ByVal src As Any)
    Private Declare Function FormatMessage Lib "kernel32" Alias _
       "FormatMessageA" (ByVal dwFlags As Long, _
       ByVal lpSource As Long, _
       ByVal dwMessageId As Long, _
       ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
       ByVal nSize As Long, Arguments As Any) As Long
    Private Declare Function NetUserSetInfo Lib "netapi32.dll" _
       (ByVal ServerName As String, ByVal Username As String, _
       ByVal Level As Long, UserInfo As Any, ParmError As Long) As Long
    Private Declare Function NetGetDCName Lib "netapi32.dll" ( _
       ServerName As Long, domainname As Byte, bufptr As Long) As Long
    Private Declare Function NetUserChangePassword Lib "netapi32.dll" 
( 
_
       ByVal domainname As String, ByVal Username As String, _
       ByVal OldPassword As String, ByVal NewPassword As String) As 
Long
    Private Type USER_INFO_1003
       usri1003_password As Long
    End Type
    Public Function UserChangePassword(txtUser As Variant, txtDomain 
As 
Variant, _
        txtOld As Variant, txtNew As Variant)
      Dim sServer As String, sUser As String
      Dim sNewPass As String, sOldPass As String
      Dim UI1003 As USER_INFO_1003
      Dim dwLevel As Long
      Dim lRet As String
      Dim sNew As String
      ' StrConv Functions are necessary since VB will perform
      ' UNICODE/ANSI translation before passing strings to the NETAPI
      ' functions
      sUser = StrConv(txtUser, vbUnicode)
      sNewPass = StrConv(txtNew, vbUnicode)
      'See if this is Domain or Computer referenced
      If Left(txtDomain, 2) = "\\" Then
        sServer = StrConv(txtDomain, vbUnicode)
      Else
        ' Domain was referenced, get the Primary Domain Controller
        sServer = StrConv(GetPrimaryDCName(txtDomain), vbUnicode)
      End If
      If txtOld = "" Then
      ' NOT USED
         ' Administrative over-ride of existing password.
         ' Does not require old password
         'dwLevel = 1003
         'sNew = txtNew
         'UI1003.usri1003_password = StrPtr(sNew)
         'lRet = NetUserSetInfo(sServer, sUser, dwLevel, UI1003, 0&)
      Else
         ' Set the Old Password and attempt to change the user's 
password
         sOldPass = StrConv(txtOld, vbUnicode)
         lRet = NetUserChangePassword(sServer, sUser, sOldPass, 
sNewPass)
      End If
      If lRet <> 0 Then
         UserChangePassword = DisplayError(lRet)
      Else
         UserChangePassword = "SUCCESS"
      End If
    End Function
    Private Function DisplayError(ByVal lCode As Long)
       Dim sMsg As String
       Dim sRtrnCode As String
       Dim lFlags As Long
       Dim hModule As Long
       Dim lRet As Long
        hModule = 0
        sRtrnCode = Space$(256)
        lFlags = FORMAT_MESSAGE_FROM_SYSTEM
         ' if lRet is in the network range, load the message source
         If (lCode >= NERR_BASE And lCode <= MAX_NERR) Then
            hModule = LoadLibraryEx("netmsg.dll", 0&, _
                      LOAD_LIBRARY_AS_DATAFILE)
            If (hModule <> 0) Then
                lFlags = lFlags Or FORMAT_MESSAGE_FROM_HMODULE
            End If
         End If
        ' Call FormatMessage() to allow for message text to be acquired
        ' from the system or the supplied module handle.
        '
        lRet = FormatMessage(lFlags, hModule, lCode, 0&, _
                             sRtrnCode, 256&, 0&)
        If lRet = 0 Then
           sMsg = "FormatMessage Error : " & Err.LastDllError & vbCrLf
        End If
        ' if you loaded a message source, unload it.
        '
        If (hModule <> 0) Then
          FreeLibrary (hModule)
        End If
     '//... now display this string
     sMsg = sMsg & "ERROR: " & lCode & " - " & sRtrnCode
     DisplayError = sMsg
    End Function
    Public Function GetPrimaryDCName(ByVal DName As String) As String
       Dim DCName As String, DCNPtr As Long
       Dim DNArray() As Byte, DCNArray(100) As Byte
       Dim result As Long
       DNArray = DName & vbNullChar
       ' Lookup the Primary Domain Controller
       result = NetGetDCName(0&, DNArray(0), DCNPtr)
       If result <> 0 Then
          Exit Function
       End If
       lstrcpyW DCNArray(0), DCNPtr
       result = NetApiBufferFree(DCNPtr)
       DCName = DCNArray()
       GetPrimaryDCName = Left(DCName, InStr(DCName, Chr(0)) - 1)
    End Function
-----------------------------------
codeguru.com/forum/archive/index.php/t-183390.html
i hope that helps.
http://americanahost.com
http://www.qwesz.com