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
