' ' office365 oauth2パラメータ取得スクリプト(office365-oauth2.vbs) ' 2020.7.17 B21Soft, Inc. ' 2022.7.29 更新 ブラウザを Edge に変更 BTYPE="e" ' c:Chrome e:Edge i:IE ''============== ★ご注意 修正後にSJIS で保存してください。 UTF-8 だとエラーになります。 '' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '' ログファイルセット LOGFILE="C:\●●slog.txt" ' '' curl トレースファイル設定 CURLTRACE1="--trace-ascii C:\●●clog1.txt" CURLTRACE2="--trace-ascii C:\●●clog2.txt" CID="●●" '... クライアントID CSS="●●" '... クライアントシークレット TID="●●" '... テナントID RURI="http%3A%2F%2Flocalhost%2Fmyapp%2F" '... リダイレクトURI http://localhost/myapp/ ACC="" REF="" Set objShell = WScript.CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set logf = fso.OpenTextFile(LOGFILE, 8, true) ' @認証コード取得フェーズ If ACC = "" then Putlog Date() & " " & Time() & ":@認証コード取得フェーズ" URL1="https://login.microsoftonline.com/#TID#/oauth2/v2.0/authorize" & _ "?client_id=#CID#&response_type=code&redirect_uri=#RURI#" & _ "&response_mode=query&scope=offline_access%20" & _ "https%3A%2F%2Foutlook.office.com%2FSMTP.Send%20" & _ "https%3A%2F%2Foutlook.office.com%2FPOP.AccessAsUser.All" ret=Replace(URL1,"#CID#",CID) ret=Replace(ret,"#CSS#",CSS) ret=Replace(ret,"#TID#",TID) ret=Replace(ret,"#RURI#",RURI) Putlog ret ' ブラウザが開くので、アクセスしたいOffice365メールアカウントでログイン BTYPE="e" ' c:Chrome e:Edge i:IE If BTYPE = "c" Then objShell.Exec "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe -url " & ret Wscript.Quit End If If BTYPE = "e" Then CreateObject("Shell.Application").ShellExecute "microsoft-edge:" & ret Wscript.Quit End If If BTYPE = "i" Then set IE = CreateObject ("InternetExplorer.Application") IE.Visible = True IE.Navigate(ret) End If Wscript.Quit End If ' Aリフレッシュトークン取得フェーズ If REF = "" Then Putlog Date() & " " & Time() & ":Aリフレッシュトークン取得フェーズ" CURL1="curl " & CURLTRACE1 & " -d ""code=#ACC#"" -d ""client_id=#CID#"" -d ""client_secret=#CSS#""" & _ " -d ""redirect_uri=#RURI#"" -d ""grant_type=authorization_code""" & _ " -d ""scope=offline_access%20https%3A%2F%2Foutlook.office.com%2FSMTP.Send%20" & _ "https%3A%2F%2Foutlook.office.com%2FPOP.AccessAsUser.All""" & _ " https://login.microsoftonline.com/#TID#/oauth2/v2.0/token" ret=Replace(CURL1,"#ACC#",ACC) ret=Replace(ret,"#CID#",CID) ret=Replace(ret,"#CSS#",CSS) ret=Replace(ret,"#TID#",TID) ret=Replace(ret,"#RURI#",RURI) Putlog ret ' refresh_token内容を 変数REFに設定 ' 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 REF = "" Then REF = Get_Token(strLine,"refresh_token") End If If ATK = "" Then ATK = Get_Token(strLine,"access_token") End If Loop If ATK <> "" Then Putlog "access_token=" & ATK End If If REF <> "" Then Putlog "refresh_token内容を 変数REFに設定" Putlog "refresh_token=" & REF End If Putlog "" Putlog "done." Wscript.Quit End If ' Bリフレッシュトークンによるアクセストークン取得テスト If REF <> "" Then Putlog Date() & " " & Time() & ":Bリフレッシュトークンによるアクセストークン取得テスト" CURL1="curl " & CURLTRACE2 & " -d ""client_id=#CID#"" -d ""client_secret=#CSS#""" & _ " -d ""grant_type=refresh_token""" & _ " -d ""refresh_token=#REF#""" & _ " https://login.microsoftonline.com/#TID#/oauth2/v2.0/token" ret=Replace(CURL1,"#ACC#",ACC) ret=Replace(ret,"#CID#",CID) ret=Replace(ret,"#CSS#",CSS) ret=Replace(ret,"#TID#",TID) ret=Replace(ret,"#RURI#",RURI) ret=Replace(ret,"#REF#",REF) Putlog ret Set objExec = objShell.Exec(ret) Putlog "" Putlog "curl grant_type=refresh_token..... 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 "" Putlog "リフレッシュトークンによるアクセストークン取得テスト完了" Putlog "access_token=" & ATK End If Putlog "" Putlog "-------------- basp21p.ini -------------" Putlog "[office365]" Putlog "# " & Date() & " Office365 OAuth2" 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 "refresh_token=" & REF Putlog "----------------------------------------" Putlog "done." Wscript.Quit End If 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