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>
  




yahoo  google  MSDN  MSDN(us)  WinFAQ  Win Howto  tohoho  ie_DHTML  vector  wdic  辞書  天気 


[asp]
claudebot
24/03/29 20:54:01
InfoBoard Version 1.00 : Language=Perl

1 BatchHelper COMprog CommonSpec Cprog CprogBase CprogSAMPLE CprogSTD CprogSTD2 CprogWinsock Cygwin GameScript HTML HTMLcss InstallShield InstallShieldFunc JScript JScriptSAMPLE Jsfuncs LLINK OldProg OracleGold OracleSilver PRO PRObrowser PROc PROconePOINT PROcontrol PROftpclient PROjscript PROmailer PROperl PROperlCHAT PROphp PROphpLesson PROphpLesson2 PROphpLesson3 PROphpfunction PROphpfunctionArray PROphpfunctionMisc PROphpfunctionString PROsql PROvb PROvbFunction PROvbString PROvbdbmtn PROvbonepoint PROwebapp PROwin1POINT PROwinSYSTEM PROwinYOROZU PROwindows ProjectBoard RealPHP ScriptAPP ScriptMaster VBRealtime Vsfuncs a1root access accreq adsi ajax amazon argus asp aspSample aspVarious aspdotnet aw2kinst cappvariety centura ckeyword classStyle cmaterial cmbin cmdbapp cmenum cmlang cmlistbox cmstd cmstdseed cmtxt cs daz3d db dbCommon dbaccess dnettool dos download flex2 flex3 flex4 framemtn framereq freeWorld freesoft gimp ginpro giodownload google hdml home hta htmlDom ie9svg install java javaSwing javascript jetsql jquery jsp jspTest jspVarious lightbox listasp listmsapi listmsie listmsiis listmsnt listmspatch listmsscript listmsvb listmsvc memo ms msde mysql netbeans oraPlsql oracle oracleWiper oraclehelper orafunc other panoramio pear perl personal pgdojo pgdojo_cal pgdojo_holiday pgdojo_idx pgdojo_ref pgdojo_req php phpVarious phpguide plsql postgres ps r205 realC realwebapp regex rgaki ruby rule sboard sc scprint scquest sdb sdbquest seesaa setup sh_Imagick sh_canvas sh_dotnet sh_google sh_tool sh_web shadowbox shgm shjquery shvbs shweb sjscript skadai skywalker smalltech sperl sqlq src systemdoc tcpip tegaki three toolbox twitter typeface usb useXML vb vbdb vbsfunc vbsguide vbsrc vpc wcsignup webanymind webappgen webclass webparts webtool webwsh win8 winofsql wmi work wp youtube