Авторизация VK перестала работать - Visual Basic .NET
Формулировка задачи:
Доброе время суток!
Не поможете сделать авторизацию в Вк .. Раньше нормально всё работало..
Теперь как не пытаюсь в vk.com и в m.vk.com не как не могу авторизоваться программно
Перерыл тонну сайтов с этой темой , но увы старые варианты тоже не работают.. Если есть
время попробуйте сами .. Убил дня 4-е перед тем как сюда написать.. Надеюсь поможете !
Заранее благодарен...
Решение задачи: «Авторизация VK перестала работать»
textual
Листинг программы
- Imports System.IO
- Imports System.Net
- Module Module1
- Structure Session
- Public USER_ID As String
- Public ACCESS_TOKEN As String
- Public EXPIRES_IN As String
- Function ToString() As String
- Return "USER_ID: " & USER_ID & " ACCESS_TOKEN: " & ACCESS_TOKEN & " EXPIRES_IN: " & EXPIRES_IN
- End Function
- End Structure
- Sub Main()
- Dim CContainer As New CookieContainer
- Dim SUrl As String = "https://login.vk.com/"
- Dim PData As String = "email=79999999999&pass=12345" 'ЛОГИН И ПАРОЛЬ
- Dim CSession As Session = AuthCookie(SUrl, PData)
- Console.WriteLine(GetUser(CSession))
- Console.ReadLine()
- End Sub
- 'ТЕСТОВАЯ Ф-ИЯ
- Function GetUser(ByVal CSession As Session) As String
- Dim request As HttpWebRequest
- Dim response As HttpWebResponse
- request = HttpWebRequest.Create("https://api.vk.com/method/users.get?user_id=" & CSession.USER_ID & "&v=5.50&access_token=" & CSession.ACCESS_TOKEN)
- request.Method = "GET"
- request.KeepAlive = True
- request.ContentType = "application/x-www-form-urlencoded"
- response = request.GetResponse
- Return (New StreamReader(response.GetResponseStream()).ReadToEnd())
- End Function
- Function GetToken(ByRef CContainer As CookieContainer) As String
- Dim request As HttpWebRequest
- Dim response As HttpWebResponse
- 'ТУТ ПЕРЕДАЕМ ID ПРИЛОЖЕНИЯ (client_id), scope - РАЗРЕШЕНИЯ (в общем в документацию)
- request = HttpWebRequest.Create("https://oauth.vk.com/authorize?client_id=000000&scope=2047&redirect_uri=http://oauth.vk.com/blank.html&display=mobile&response_type=token")
- request.Method = "GET"
- request.KeepAlive = True
- request.ContentType = "application/x-www-form-urlencoded"
- request.UserAgent = "Mozilla/5.0 (Windows NT 10.0; WOW64; rv: 44.0) Gecko/20100101 Firefox/44.0"
- request.CookieContainer = CContainer
- response = request.GetResponse
- Dim Temp As String = (New StreamReader(response.GetResponseStream()).ReadToEnd())
- Temp = PARS.GetPars(Temp, "<form method=""post"" action=""", """")
- Dim PostData As String = ""
- request = CType(WebRequest.Create(Temp), HttpWebRequest)
- request.ContentType = "application/x-www-form-urlencoded"
- request.ContentLength = PostData.Length
- request.Method = "POST"
- request.AllowAutoRedirect = True
- request.CookieContainer = CContainer
- Dim requestStream As Stream = request.GetRequestStream()
- Dim postBytes As Byte() = System.Text.Encoding.ASCII.GetBytes(PostData)
- requestStream.Write(postBytes, 0, postBytes.Length)
- requestStream.Close()
- response = CType(request.GetResponse(), HttpWebResponse)
- Return Convert.ToString(response.ResponseUri)
- End Function
- Function AuthCookie(ByVal SUrl As String, ByVal PData As String) As Session
- Dim CContainer As New CookieContainer
- Dim request As HttpWebRequest
- Dim response As HttpWebResponse
- Dim Cookie As New CookieContainer
- request = HttpWebRequest.Create("https://m.vk.com/")
- request.Method = "GET"
- request.KeepAlive = True
- request.UserAgent = "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:44.0) Gecko/20100101 Firefox/44.0"
- request.CookieContainer = CContainer
- response = request.GetResponse
- Dim R As New StreamReader(response.GetResponseStream, System.Text.Encoding.Default)
- Dim NUrl As String = PARS.GetPars(R.ReadToEnd, "<form method=""post"" action=""", """")
- 'NEW SEND DATA
- request = CType(WebRequest.Create(NUrl), HttpWebRequest)
- request.ContentType = "application/x-www-form-urlencoded"
- request.ContentLength = PData.Length
- request.Method = "POST"
- request.AllowAutoRedirect = True
- request.CookieContainer = CContainer
- Dim requestStream As Stream = request.GetRequestStream()
- Dim postBytes As Byte() = System.Text.Encoding.ASCII.GetBytes(PData)
- requestStream.Write(postBytes, 0, postBytes.Length)
- requestStream.Close()
- response = CType(request.GetResponse(), HttpWebResponse)
- Dim Result As String = GetToken(CContainer)
- Result = Result.Split("#")(1)
- Dim Temp(2) As String
- For I As Integer = 0 To 2 Step 1
- Temp(I) = Result.Split("&")(I)
- Next
- Dim CSession As Session
- CSession.ACCESS_TOKEN = Temp(0).Split("=")(1)
- CSession.EXPIRES_IN = Temp(1).Split("=")(1)
- CSession.USER_ID = Temp(2).Split("=")(1)
- Return CSession
- End Function
- 'ФУНКЦИЯ ПАРСИНГА
- Structure PARS
- Public Shared Function GetPars(ByVal strSource As String, ByRef strStart As String, ByRef strEnd As String, Optional ByVal Index As Integer = 0, Optional ByRef startPos As Integer = 0) As String
- Dim iPos As Integer, iEnd As Integer, lenStart As Integer = strStart.Length
- Dim strResult As String
- strResult = String.Empty
- For i = 0 To Index - 1 Step 1
- iPos = strSource.IndexOf(strStart, startPos)
- iEnd = strSource.IndexOf(strEnd, iPos + lenStart)
- iEnd = iEnd + strEnd.Length
- If iPos <> -1 AndAlso iEnd <> -1 Then
- strSource = strSource.Substring(iEnd, strSource.Length - (0 + iEnd))
- Else
- Exit For
- End If
- Next
- iPos = strSource.IndexOf(strStart, startPos)
- iEnd = strSource.IndexOf(strEnd, iPos + lenStart)
- If iPos <> -1 AndAlso iEnd <> -1 Then
- strResult = strSource.Substring(iPos + lenStart, iEnd - (iPos + lenStart))
- End If
- Return strResult
- End Function
- Public Shared Function Count(ByRef strSource As String, ByRef strStart As String, ByRef strEnd As String, Optional ByRef startPos As Integer = 0) As Integer
- Dim iPos As Integer, iEnd As Integer, lenStart As Integer = strStart.Length
- Dim IntResult As Integer
- Dim BooL As Boolean = False
- Do While BooL = False
- iPos = strSource.IndexOf(strStart, startPos)
- iEnd = strSource.IndexOf(strEnd, iPos + lenStart)
- If iPos <> -1 AndAlso iEnd <> -1 Then
- IntResult = IntResult + 1
- startPos = iEnd + 1
- Else
- BooL = True
- End If
- Loop
- Return IntResult
- End Function
- End Structure
- End Module
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д