Imports System.Net Imports System.Text ' Author: Simon A. Frank ' Projekt Homepage: http://frank-it-beratung.com/blog/access-token-manager/ ' Lizenz: Opensource and Free, License CC BY 3.0 DE (http://creativecommons.org/licenses/by/3.0/de/) ' Version: 1.3 vom 7.9.2013 (erste Version vom 5.12.2010) ' Auf Wunsch eines Kollegen nicht in C# sondern in "ganz ganz einfachen VisualBasic" - wer es ' etwas "komplizierter" haben möchte findet viele Anleitungen dazu hier: ' http://www.frank-it-beratung.de/blog/ Public Class frmMain Private Sub cmdGetToken_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdGetToken.Click If txtClientID.Text = "" Then MsgBox("client_id needed!") Exit Sub End If cmdGetToken.Enabled = False webMeinBrowser.Navigate(txtURL.Text) End Sub Private Sub txtClientID_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtClientID.TextChanged BaueURL() End Sub Private Sub BaueURL() ' bisher: ' Dim u As String = "https://graph.facebook.com/oauth/authorize?" ' neu ab Septmber 2013: Dim u As String = "https://www.facebook.com/dialog/oauth?" Dim s As String = "" If chkScope1.Checked Then s = s + chkScope1.Text + "," End If If chkScope2.Checked Then s = s + chkScope2.Text + "," End If If chkScope3.Checked Then s = s + chkScope3.Text + "," End If If chkScope4.Checked Then s = s + chkScope4.Text + "," End If If chkScope5.Checked Then s = s + chkScope5.Text + "," End If If chkScope6.Checked Then s = s + chkScope5.Text + "," End If If chkScope6.Checked Then s = s + chkScope6.Text + "," End If If chkScope7.Checked Then s = s + chkScope6.Text + "," End If ' offline_access gibt es nicht mehr, Detail siehe ' http://frank-it-beratung.com/blog/2013/04/05/facebook-api-alternative-losungen-fur-unbegrenzt-gultige-access-tokens-als-ersatz-fur-offline_access/ If txtScope.Text <> "" Then s = s + txtScope.Text End If s = s.Trim(",") u = u + "client_id=" + txtClientID.Text u = u + "&scope=" + s u = u + "&redirect_uri=http://www.facebook.com/connect/login_success.html" ' neu ab September 2013 - ersetzt das bisherige "type" u = u + "&response_type=token" ' Update September 2013: diese Parameter gibt es nicht mehr 'u = u + "&type=user_agent" 'u = u + "&display=popup" txtURL.Text = u End Sub Private Sub chkScope_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkScope1.CheckedChanged, chkScope2.CheckedChanged, chkScope3.CheckedChanged, chkScope4.CheckedChanged, chkScope5.CheckedChanged BaueURL() End Sub Private Sub txtScope_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtScope.TextChanged BaueURL() End Sub Private Sub webMeinBrowser_Navigated(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserNavigatedEventArgs) Handles webMeinBrowser.Navigated Dim q As String = webMeinBrowser.Url.ToString() If q.Contains("#access_token=") Then q = q.Substring(q.IndexOf("access_token=") + 13) txtAToken.Text = q.Substring(0, q.IndexOf("&")) End If Dim t As String = webMeinBrowser.DocumentTitle Dim c As String = "" If t.Contains("code=") Then c = t.Substring(t.IndexOf("code=") + 5) GetGoogleAccessToke(c) End If cmdGetToken.Enabled = True End Sub Private Sub cmdPageAccessToken_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdPageAccessToken.Click Dim u As String = "https://graph.facebook.com/me/accounts/?access_token=" + txtAToken.Text Dim Antwort As Byte() Dim AntwortJson As String Dim myWebClient As New WebClient() If txtAToken.Text = "" Then MsgBox("Not possible - Get or type Access-Token with manage_page Scope first!") Exit Sub End If cmdPageAccessToken.Enabled = False Try Antwort = myWebClient.DownloadData(u) AntwortJson = System.Text.Encoding.ASCII.GetString(Antwort) ' Ausgabe ein wenig schöner gestalten ... webMeinBrowser.DocumentText = JsonReformat(AntwortJson) Catch ex As Exception webMeinBrowser.DocumentText = "
" & ex.Message.ToString & "
" End Try cmdPageAccessToken.Enabled = True End Sub Private Sub lblLink_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles lblLink.LinkClicked Process.Start("http://frank-it-beratung.com/blog/access-token-manager/") End Sub Private Sub cmdZuFacebook_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdZuFacebook.Click webMeinBrowser.Navigate("http://www.facebook.com") End Sub Private Sub cmdTesteToken_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdTesteToken.Click Dim u As String = "https://graph.facebook.com/me/?access_token=" + txtAToken.Text Dim Antwort As Byte() Dim AntwortJson As String Dim myWebClient As New WebClient() If txtAToken.Text = "" Then MsgBox("Not possible - Get or type Access-Token first!") Exit Sub End If Try Antwort = myWebClient.DownloadData(u) AntwortJson = System.Text.Encoding.ASCII.GetString(Antwort) webMeinBrowser.DocumentText = JsonReformat(AntwortJson) Catch ex As Exception webMeinBrowser.DocumentText = "
" & ex.Message.ToString & "
" End Try End Sub Private Sub frmMain_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed Process.Start("http://frank-it-beratung.com/etc/danke/") End Sub Private Sub GetGoogleAccessToke(ByVal code As String) Dim u As String = "https://accounts.google.com/o/oauth2/token" Dim AntwortJson As String Dim myWebClient As New WebClient() Dim postData As String = "client_id=" + txtGoogleClientID.Text + "&" postData = postData + "client_secret=" + txtGoogleClientSecret.Text + "&" postData = postData + "code=" + code + "&" postData = postData + "redirect_uri=" + txtGoogleRedirect.Text + "&" postData = postData + "grant_type=authorization_code" myWebClient.Headers.Add("Content-Type", "application/x-www-form-urlencoded") Dim byteArray As Byte() = Encoding.ASCII.GetBytes(postData) Try Dim responseArray As Byte() = myWebClient.UploadData(u, "POST", byteArray) AntwortJson = System.Text.Encoding.ASCII.GetString(responseArray) ' Ausgabe ein wenig schöner gestalten ... webMeinBrowser.DocumentText = JsonReformat(AntwortJson) Catch ex As Exception webMeinBrowser.DocumentText = "
" & ex.Message.ToString & "
" End Try End Sub Private Function JsonReformat(ByVal s As String) 'in .net ist Json etwas umständlicher zu handeln - deshalb 'wird es hier einfach halbwegs lesbar im Browser ausgegeben 'wie es "richtig" mit Json geht findet das z. B. in meinem Tutorial zur Facebook-API 'http://frank-it-beratung.com/2011/02/18/tutorial-facebook-vb-csharp-pinnwandeintrag-bei-freund/ s = s.Replace(",", "," & vbLf) s = s.Replace("{", vbLf & "{") s = "
 " + s + "
" Return s End Function Private Sub cmdGetGoogleAccessToken_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdGetGoogleAccessToken.Click Dim u As String If txtGoogleClientID.Text = "" Or txtGoogleClientSecret.Text = "" Or txtGoogleRedirect.Text = "" Or cmbGoogleScope.Text = "" Then MsgBox("Not possible - fill in all fields!") Return End If u = "https://accounts.google.com/o/oauth2/auth?" u = u + "client_id=" + txtGoogleClientID.Text + "&" u = u + "redirect_uri=" + txtGoogleRedirect.Text + "&" u = u + "scope=" + cmbGoogleScope.Text + "&" u = u + "response_type=code" webMeinBrowser.Navigate(u) End Sub Private Sub cmdShowGoogleApiConsole_Click(sender As System.Object, e As System.EventArgs) Handles cmdShowGoogleApiConsole.Click Process.Start("https://code.google.com/apis/console/") End Sub Private Sub lblShowFbDocu_LinkClicked(sender As System.Object, e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles lblShowFbDocu.LinkClicked Process.Start("https://developers.facebook.com/docs/reference/login/") End Sub Private Sub cmdOpenGoogleConsoleIntern_Click(sender As System.Object, e As System.EventArgs) Handles cmdOpenGoogleConsoleIntern.Click webMeinBrowser.Navigate("https://code.google.com/apis/console/") End Sub End Class