【IDM】MSMQ を使って確実なユーザー登録を行う その7 ～ キューを移動する

  • Article

明日23日が休みだってことに、いま気付きました。

MSMQでユーザー登録シリーズです。で、すいません。最終回じゃないです。

今回はエラーとなったメッセージをErrorキューに移動します。

これは非常に簡単です。

単に、Send で Errorキューに送るだけです。InputにSendしたときとまったく同じですね。

以下の赤く示した部分が、前回から追記したコードで、メッセージをSendしているのが94行目です。今回は、特に難しいところは無いはずです。

アレンジするとすれば、キューの移動部分でしょうか。今回は、エラーが発生したメッセージを一律 再実行を想定して Errorキュー に移動していますが、エラーの種類によってキューを分けるのも良いかもしれません。

たとえば、「登録に失敗したユーザーについては即効で対応する必要がある」ということで、登録失敗専用のキューを作成しておき、キューにメッセージが投稿されたらその都度メールを送信するなどといった処理が考えられます。

ということで、ひとまず、AD登録用スクリプトについては、これで完成です。

01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91  92 93 94 95 96 97 98 99

Err.Clear Const MQ_RECEIVE_ACCESS  = 1  Const MQ_SEND_ACCESS     = 2  Const MQ_PEEK_ACCESS     = 32  Const MQ_ADMIN_ACCESS    = 128 Const MQ_DENY_NONE           = 0  Const MQ_DENY_RECEIVE_SHARE  = 1  Set objRootDSE      = GetObject("LDAP://RootDSE") strDomainPath       = objRootDSE.Get("DefaultNamingContext") strContainerADsPath = "LDAP://" & "CN=Users," & strDomainPath Set objContainer    = GetObject(strContainerADsPath) Set objConnection = CreateObject("ADODB.Connection") objConnection.Open "Provider=ADsDSOObject;" Set objCommand = CreateObject("ADODB.Command") objCommand.ActiveConnection = objConnection set objQueueInfo_Input = CreateObject("MSMQ.MSMQQueueInfo") set objQueueInfo_Error = CreateObject("MSMQ.MSMQQueueInfo") set objMsgQueue_Src = CreateObject("MSMQ.MSMQQueue") set objMsgQueue_Dst = CreateObject("MSMQ.MSMQQueue") set objMessage = CreateObject("MSMQ.MSMQMessage") set objManagement = CreateObject("MSMQ.MSMQManagement") objManagement.Init "Junichia03",,"DIRECT=OS:junichia03\private$\Input" objQueueInfo_Input.Formatname = "DIRECT=OS:junichia03\private$\Input" objQueueInfo_Error.Formatname = "DIRECT=OS:junichia03\private$\Error" Set objMsgQueue_Src  = objQueueInfo_Input.Open(MQ_Receive_ACCESS ,MQ_DENY_NONE) Set objMsgQueue_Dst = objQueueInfo_Error.Open(MQ_SEND_ACCESS ,MQ_DENY_NONE) If objManagement.MessageCount > 0 then      On Error Resume Next      wscript.echo objManagement.MessageCount & " 件のメッセージがあります"      Set objMessage = objMsgQueue_Src.Receive()      arrBody = Split(objMessage.Body,",")     strUserName = Trim(arrBody(0))     strPassword = Trim(arrBody(1))     strHomeDir  = Trim(arrBody(2))      Wscript.Echo "ユーザー名：" & strUserName     Wscript.Echo "パスワード：" & strPassword     Wscript.Echo "ホームパス：" & strHomeDir      objCommand.CommandText = _         "<LDAP://" & strDomainPath & ">;" & _         "(&(objectCategory=person)(objectClass=user)" & _         "(sAMAccountName=" & strUserName & "));" & _         "DistinguishedName, sAMAccountName;" & _         "subtree"     Set objRecordSet = objCommand.Execute      If NOT objRecordSet.EOF then         Set objNewUser = GetObject("LDAP://" & objRecordSet.Fields("DistinguishedName"))     Else         Set objNewUser = objContainer.Create("user", "CN=" & strUserName)         objNewUser.Put "sAMAccountName", strUserName         objNewUser.SetInfo()     End If       Call ErrorHandle(1,err.Number, err.Description)      objNewUser.HomeDirectory = strHomeDir     objNewUser.SetInfo()       Call ErrorHandle(2, err.Number, err.Description)      objNewUser.SetPassword(strPassword)       Call ErrorHandle(3, err.Number, err.Description) Else      Wscript.echo "メッセージがありません" End If Sub ErrorHandle(errPosition, errNumber, errDescription)      Select Case errNumber         Case 0          Case Else             objMessage.Send(objMsgQueue_Dst)             Wscript.Echo errPosition & "," & errNumber & "," & errDescription             Wscript.Quit(1)     End Select End Sub

さて、このスクリプトをキューのルールとして登録するのですが、その前にMSMQ トリガーの大切な性質（クセ） について解説しておかなければなりません。

これについては次回に（ひきのばしているわけではないのです。すいません。）。