'
' office365 oauth2 アクセストークン取得テストスクリプト(office365-oauth2-2025.vbs)
'                                                         2025.1.4 B21Soft, Inc.
' 前バージョンからの修正点
'  (1)Entra管理者ログイン不要
'  (2)リフレッシュトークンを使わない
'  (3)scope 変更   scope=https://outlook.office365.com/.default
''============== ★ご注意　修正後にSJIS で保存してください。 UTF-8 だと実行エラーになります。
''               ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DATEX = Replace(Date(),"/","")
ENTRAAPP="●●" '.... Entra アプリケーション名
CID="●●"  '... クライアントID
CSS="●●"  '... クライアントシークレット
TID="●●"  '... テナントID
'' ログファイルセット
LOGFILE="C:\●●\#EAP#-vbslog#DATE#.txt"
LOGFILE=Replace(LOGFILE,"#EAP#",ENTRAAPP)
LOGFILE=Replace(LOGFILE,"#DATE#",DATEX)
'  
'' curl トレースファイル設定
CURLTRACE="--trace-ascii C:\●●\#EAP#-curllog#DATE#.txt"
CURLTRACE=Replace(CURLTRACE,"#EAP#",ENTRAAPP)
CURLTRACE=Replace(CURLTRACE,"#DATE#",DATEX)


Set objShell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set logf = fso.OpenTextFile(LOGFILE, 8, true)

' アクセストークン取得フェーズ
 Putlog Date() & " " & Time() & ":アクセストークン取得フェーズ " & ENTRAAPP
 CURL1="curl " & CURLTRACE & " -d ""client_id=#CID#"" -d ""client_secret=#CSS#""" & _
 " -d ""grant_type=client_credentials""" & _
 " -d ""scope=https%3A%2F%2Foutlook.office365.com%2F.default""" & _
 " https://login.microsoftonline.com/#TID#/oauth2/v2.0/token"

 ret=Replace(CURL1,"#CID#",CID)
 ret=Replace(ret,"#CSS#",CSS)
 ret=Replace(ret,"#TID#",TID)
 Putlog ret

Set objExec = objShell.Exec(ret)
Putlog ""
Putlog "curl grant_type=authorization_code..... done."
Putlog ""
Do While objExec.Status = 0
 WScript.Sleep 100
Loop
Do Until objExec.StdOut.AtEndOfStream
 strLine = objExec.StdOut.ReadLine
 Putlog strLine
 If ATK = "" Then
   ATK = Get_Token(strLine,"access_token")
 End If
Loop

If ATK <> "" Then
  Putlog "access_token=" & ATK
End If
Putlog ""
Putlog "-------------- basp21p.ini -------------"
Putlog "[office365-" & DATEX & "]"
Putlog "# " & Date() & " Office365 OAuth2 " & ENTRAAPP
Putlog "allow=all"
Putlog "sslver=12"
Putlog "server=TLS Smtp.office365.com:587"
Putlog "popserver=Outlook.office365.com:995"
Putlog "client_id=" & CID
Putlog "client_secret=" & CSS
Putlog "token_uri=" & "https://login.microsoftonline.com/" & TID & "/oauth2/v2.0/token"
Putlog "----------------------------------------"
Putlog "done."
Wscript.Quit

Function Get_Token(line,key)
 Get_Token = ""
 key2 = """" & key & """"
 i = InStr(line,key2)
 If i > 0 Then
  wk = Mid(line,i+len(key2))
  i = InStr(wk,"""")
  wk = Mid(wk,i+1)
  i = InStr(wk,"""")
  If i > 0 Then Get_Token = Mid(wk,1,i-1)
 End If
End Function


Sub Putlog(data)
 logf.WriteLine data
End Sub