Office365 と AD 間の ID 変換について

Question

フォーラムが違った場合はご容赦ください。

現状すでに O365 上のメール BOX を利用中のユーザがいます。

そこに AD のユーザを紐付けようとしているのですが、objectGUID を BASE64 でエンコードしても ImmutableID と同じ値になりませんでした（利用環境は Excel2013）。
＃BASE64 変換後の値に”==”が付与されない

PowerShell（GUID2ImmutableID.ps1）で変換可能なのは知っていますが、ユーザ数が多いため、一つ一つやることは現実的ではありません。

どなたか Excel 等を使って一括で objectGUID から ImmutableID に変換できる方法をご存じないでしょうか？

なお、変換後の ImmutableID は別担当が流し込みます。

以上よろしくお願いいたします。

Answer 1

GUID2ImmutableID.ps1の実装を見てもわかる通り、objectGUIDの示す16byteのバイナリデータをbase64エンコードする必要がありますが、objectGUIDを文字列としてbase64エンコードしているというようなことはないでしょうか？

変換しているソースコードを出していただいたほうが的確なコメントが出ると思います。

Answer 2

そうです、文字列としてエンコードしていました！

一度バイナリに変換しないといけないのですね。

その方法で探ってみたいと思います。

もし、関連する情報のあるサイトなどをご存知であれば、教えていただけますか？

以上よろしくお願いいたします。

Answer 3

Private Const clOneMask = 16515072          '000000 111111 111111 111111
Private Const clTwoMask = 258048            '111111 000000 111111 111111
Private Const clThreeMask = 4032            '111111 111111 000000 111111
Private Const clFourMask = 63               '111111 111111 111111 000000

Private Const clHighMask = 16711680         '11111111 00000000 00000000
Private Const clMidMask = 65280             '00000000 11111111 00000000
Private Const clLowMask = 255               '00000000 00000000 11111111

Private Const cl2Exp18 = 262144             '2 to the 18th power
Private Const cl2Exp12 = 4096               '2 to the 12th
Private Const cl2Exp6 = 64                  '2 to the 6th
Private Const cl2Exp8 = 256                 '2 to the 8th
Private Const cl2Exp16 = 65536              '2 to the 16th

Public Function Encode64(sString As String) As String

    Dim bTrans(63) As Byte, lPowers8(255) As Long, lPowers16(255) As Long, bOut() As Byte, bIn() As Byte
    Dim lChar As Long, lTrip As Long, iPad As Integer, lLen As Long, lTemp As Long, lPos As Long, lOutSize As Long

    For lTemp = 0 To 63                                 'Fill the translation table.
        Select Case lTemp
            Case 0 To 25
                bTrans(lTemp) = 65 + lTemp              'A - Z
            Case 26 To 51
                bTrans(lTemp) = 71 + lTemp              'a - z
            Case 52 To 61
                bTrans(lTemp) = lTemp - 4               '1 - 0
            Case 62
                bTrans(lTemp) = 43                      'Chr(43) = "+"
            Case 63
                bTrans(lTemp) = 47                      'Chr(47) = "/"
        End Select
    Next lTemp

    For lTemp = 0 To 255                                'Fill the 2^8 and 2^16 lookup tables.
        lPowers8(lTemp) = lTemp * cl2Exp8
        lPowers16(lTemp) = lTemp * cl2Exp16
    Next lTemp

    iPad = Len(sString) Mod 3                           'See if the length is divisible by 3
    If iPad Then                                        'If not, figure out the end pad and resize the input.
        iPad = 3 - iPad
        sString = sString & String(iPad, Chr(0))
    End If

    bIn = StrConv(sString, vbFromUnicode)               'Load the input string.
    lLen = ((UBound(bIn) + 1) \ 3) * 4                  'Length of resulting string.
    lTemp = lLen \ 72                                   'Added space for vbCrLfs.
    lOutSize = ((lTemp * 2) + lLen) - 1                 'Calculate the size of the output buffer.
    ReDim bOut(lOutSize)                                'Make the output buffer.

    lLen = 0                                            'Reusing this one, so reset it.

    For lChar = LBound(bIn) To UBound(bIn) Step 3
        lTrip = lPowers16(bIn(lChar)) + lPowers8(bIn(lChar + 1)) + bIn(lChar + 2)    'Combine the 3 bytes
        lTemp = lTrip And clOneMask                     'Mask for the first 6 bits
        bOut(lPos) = bTrans(lTemp \ cl2Exp18)           'Shift it down to the low 6 bits and get the value
        lTemp = lTrip And clTwoMask                     'Mask for the second set.
        bOut(lPos + 1) = bTrans(lTemp \ cl2Exp12)       'Shift it down and translate.
        lTemp = lTrip And clThreeMask                   'Mask for the third set.
        bOut(lPos + 2) = bTrans(lTemp \ cl2Exp6)        'Shift it down and translate.
        bOut(lPos + 3) = bTrans(lTrip And clFourMask)   'Mask for the low set.
        If lLen = 68 Then                               'Ready for a newline
            bOut(lPos + 4) = 13                         'Chr(13) = vbCr
            bOut(lPos + 5) = 10                         'Chr(10) = vbLf
            lLen = 0                                    'Reset the counter
            lPos = lPos + 6
        Else
            lLen = lLen + 4
            lPos = lPos + 4
        End If
    Next lChar

    If bOut(lOutSize) = 10 Then lOutSize = lOutSize - 2 'Shift the padding chars down if it ends with CrLf.

    If iPad = 1 Then                                    'Add the padding chars if any.
        bOut(lOutSize) = 61                             'Chr(61) = "="
    ElseIf iPad = 2 Then
        bOut(lOutSize) = 61
        bOut(lOutSize - 1) = 61
    End If

    Encode64 = StrConv(bOut, vbUnicode)                 'Convert back to a string and return it.

End Function

Answer 4

VBAでバイナリデータをbase64エンコードする方法としてこちらのサイトが参考になります。
https://www.ka-net.org/blog/?p=4479

文字列のGUIDをバイナリに変換するにはAccessだとGUIDFromStringという便利な関数があるようなのですがExcelだと使えないみたいなので自作します。

objectGUIDとして使われているGUID表記(例 748b2d72-706b-42f8-8b25-82fd8733860f)は左から順に

　4byte整数×1、2byte整数×2、1byte整数×8

をリトルエンディアンで表す16進数になりますのでVBAであれば以下のように自作できます。

'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'自作のGUIDFromString関数
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Function GUIDFromString(ByVal strGuid As String) As Byte()

 Dim byteGuid(15) As Byte

 strGuid = Replace(strGuid, "-", "")
 
 If Len(strGuid) = 32 Then
 
    byteGuid(0) = CByte("&H" & Mid(strGuid, 7, 2))
    byteGuid(1) = CByte("&H" & Mid(strGuid, 5, 2))
    byteGuid(2) = CByte("&H" & Mid(strGuid, 3, 2))
    byteGuid(3) = CByte("&H" & Mid(strGuid, 1, 2))
   
    byteGuid(4) = CByte("&H" & Mid(strGuid, 11, 2))
    byteGuid(5) = CByte("&H" & Mid(strGuid, 9, 2))
   
    byteGuid(6) = CByte("&H" & Mid(strGuid, 15, 2))
    byteGuid(7) = CByte("&H" & Mid(strGuid, 13, 2))
   
    byteGuid(8) = CByte("&H" & Mid(strGuid, 17, 2))
    byteGuid(9) = CByte("&H" & Mid(strGuid, 19, 2))
    byteGuid(10) = CByte("&H" & Mid(strGuid, 21, 2))
    byteGuid(11) = CByte("&H" & Mid(strGuid, 23, 2))
    byteGuid(12) = CByte("&H" & Mid(strGuid, 25, 2))
    byteGuid(13) = CByte("&H" & Mid(strGuid, 27, 2))
    byteGuid(14) = CByte("&H" & Mid(strGuid, 29, 2))
    byteGuid(15) = CByte("&H" & Mid(strGuid, 31, 2))
   
 End If
 
 GUIDFromString = byteGuid

End Function
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

バイナリデータをbase64エンコードするには上記の参考サイトのコードを元に以下のように作れます。

'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'EncodeBase64関数 (バイナリデータ引数版)
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Function EncodeBase64(ByRef data() As Byte) As String
 
  Dim elm As Object
  Dim ret As String
  Const adTypeBinary = 1
  Const adReadAll = -1
  
  ret = ""
  On Error Resume Next
  Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
  With CreateObject("ADODB.Stream")
    .Type = adTypeBinary
    .Open
    .Write data
    .Position = 0
    elm.DataType = "bin.base64"
    elm.nodeTypedValue = .Read(adReadAll)
    ret = elm.Text
    .Close
  End With
  On Error GoTo 0
 
  EncodeBase64 = ret
 
End Function
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

上記で試した結果、GUID2ImmutableID.ps1と同じ結果を得られていますのでこれで問題ないと思います。

Sheet1.Cells(1, 1) = EncodeBase64(GUIDFromString("748b2d72-706b-42f8-8b25-82fd8733860f"))

ご参考までに。

Answer 5

ありがとうございます、一度試してみたいと思います！