ASP + ADSI

  目次







  ユーザー一覧・作成・削除・パスワード変更 ( WinNT プロバイダ )



ユーザのリストは常に表示されます。
( 削除処理を実装しているので、ユーザ名は入力値の前に "MyUser_" を付加しています )

0x10000 はパスワードを無期限にする事を意味します

ユーザのフラグについては、Microsoft の こちら を参照して下さい

  
<%
<%
Call Response.AddHeader( "Content-Type", "text/html; Charset=shift_jis" )
Response.ExpiresAbsolute=#May 31,2000 23:59:59#

Dim strListUser,strMessage

' **********************************************************
' MODEL
' **********************************************************
function DeleteUser()

	if Trim( Request.Form( "user" ) ) = "" then
		strMessage = "ユーザ名を入力して下さい"
		Exit Function
	end if

	Set objComputer = GetObject("WinNT://.")
	on error resume next
	Call objComputer.Delete( "User", "MyUser_" & Request.Form("user") )
	if Err.Number <> 0 then
		strMessage = "MyUser_" & Request.Form("user") & "は存在しません"
		Exit Function
	end if
	on error goto 0

	strMessage = "MyUser_" & Request.Form("user") & "を削除しました"

end function

function AddUser()

	if Trim( Request.Form( "user" ) ) = "" then
		strMessage = "ユーザ名を入力して下さい"
		Exit Function
	end if
	if Trim( Request.Form( "pass" ) ) = "" then
		strMessage = "パスワードを入力して下さい"
		Exit Function
	end if

	Set objComputer = GetObject("WinNT://.")
	Set objUser = objComputer.Create( "User", "MyUser_" & Request.Form("user") )
	objUser.SetPassword Request.Form("pass")

	on error resume next
	objUser.SetInfo
	if Err.Number <> 0 then
		Err.Clear
		Set objUser = Nothing
		Set objUser = GetObject("WinNT://./" & _
			"MyUser_" & Request.Form("user") & ",User")
		objUser.SetPassword Request.Form("pass")
		objUser.SetInfo
		if Err.Number <> 0 then
			strMessage = "パスワード変更に失敗しました"
		else
			strMessage = "MyUser_" & Request.Form("user") _
				& " のパスワードを変更しました"
		end if
		Exit Function
	end if
	on error goto 0

	nUserFlags = objUser.Get("UserFlags")
	nUserFlags = nUserFlags OR &H10000
	objUser.Put "UserFlags", nUserFlags
	objUser.SetInfo

	strMessage = "ユーザを追加しました"

end function

function ListUser()

	strListUser = ""
	For Each objUser In objAll
		strListUser = strListUser & objUser.Name & vbCrLf
	Next

end function

' **********************************************************
' CONTROL
' **********************************************************
	Set objAll = GetObject("WinNT://.")
	objAll.Filter = Array("User")

	if Request.Form( "send" ) = "追加・パスワード変更" then
		Call AddUser()
	end if
	if Request.Form( "send" ) = "削除" then
		Call DeleteUser()
	end if

	Call ListUser()

%>

<!-- **********************************************************
  VIEW
*********************************************************** -->
<FORM method=POST>

ユーザ名 <INPUT type=text name=user value="<%= Request.Form("user") %>">
パスワード <INPUT type=text name=pass value="<%= Request.Form("pass") %>">
<INPUT type=submit name=send value="追加・パスワード変更">
<INPUT type=submit name=send value="削除">
<HR>
<%= strMessage %>

<PRE>
<%= strListUser %>
</PRE>

</FORM>
  



  ユーザー一覧・作成・削除・パスワード変更 ( LDAP プロバイダ )

  
<%
Call Response.AddHeader( "Content-Type", "text/html; Charset=shift_jis" )
Response.ExpiresAbsolute=#May 31,2000 23:59:59#

Dim strListUser,strMessage,strDomain

' **********************************************************
' MODEL
' **********************************************************
function DeleteUser()

	if Trim( Request.Form( "user" ) ) = "" then
		strMessage = "ユーザ名を入力して下さい"
		Exit Function
	end if

	Set objComputer = GetObject("LDAP://CN=Users," &  strDomain )
	on error resume next
	Call objComputer.Delete( "User", "CN=MyUser_" & Request.Form("user") )
	if Err.Number <> 0 then
		strMessage = "MyUser_" & Request.Form("user") & "は存在しません"
		Exit Function
	end if
	on error goto 0

	strMessage = "MyUser_" & Request.Form("user") & "を削除しました"

end function

function AddUser()

	if Trim( Request.Form( "user" ) ) = "" then
		strMessage = "ユーザ名を入力して下さい"
		Exit Function
	end if
	if Trim( Request.Form( "pass" ) ) = "" then
		strMessage = "パスワードを入力して下さい"
		Exit Function
	end if

	Set objComputer = GetObject("LDAP://CN=Users," &  strDomain )
	Set objUser = objComputer.Create( "User", _
		"CN=MyUser_" & Request.Form("user") )
	objUser.Put "sAMAccountName", "MyUser_" & Request.Form("user")
	on error resume next
	objUser.SetInfo
	if Err.Number <> 0 then
		Err.Clear
		Set objUser = Nothing
		Set objUser = GetObject("LDAP://" & _
			"CN=MyUser_" & Request.Form("user") _
			& ",CN=Users," & strDomain )
		objUser.SetPassword Request.Form("pass")
		objUser.SetInfo
		if Err.Number <> 0 then
			strMessage = "パスワード変更に失敗しました"
		else
			strMessage = "MyUser_" & Request.Form("user") _
				& " のパスワードを変更しました"
		end if
		Exit Function
	end if 
	on error goto 0
	objUser.AccountDisabled = False
	objUser.AccountExpirationDate = "01/01/1970"
	objUser.SetPassword Request.Form("pass")
	objUser.Put "userAccountControl", &H10000
	objUser.SetInfo 

	strMessage = "ユーザを追加しました"

end function

function ListUser()

	strListUser = ""
	For Each objUser In objAll
		strListUser = strListUser & objUser.Name & vbCrLf
	Next

end function

' **********************************************************
' CONTROL
' **********************************************************
	Set rootDSE = GetObject("LDAP://RootDSE")
	strDomain = rootDSE.Get("defaultNamingContext")
	Set objAll = GetObject("LDAP://CN=Users," &  strDomain )
	objAll.Filter = Array("User")

	if Request.Form( "send" ) = "追加・パスワード変更" then
		Call AddUser()
	end if
	if Request.Form( "send" ) = "削除" then
		Call DeleteUser()
	end if

	Call ListUser()

%>

<!-- **********************************************************
  VIEW
*********************************************************** -->
<FORM method=POST>

ユーザ名 <INPUT type=text name=user value="<%= Request.Form("user") %>">
パスワード <INPUT type=text name=pass value="<%= Request.Form("pass") %>">
<INPUT type=submit name=send value="追加・パスワード変更">
<INPUT type=submit name=send value="削除">
<HR>
<%= strMessage %>

<PRE>
<%= strListUser %>
</PRE>

</FORM>
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ