ONLY VBNET! куплю PRIVATE SUBs сделать по такому приципу на другие сайты http://hubpages.com/hubtool/create/name/ http://linux-installation-info.wetpaint.com/page/how+to+convert+linux+to+unix+crap сколько стоит 1 SUB()? example ...
Antigate.com captcha vb.net module
Разместите заказ на фриланс-бирже и предложения поступят уже через несколько минут.
Fix vb.net
Function Bmp2JpgUrl(ByVal LoadU As String) As Stream
Dim Req As HttpWebRequest = CType(WebRequest.Create(LoadU), HttpWebRequest)
Req.Method = "GET"
Req.UserAgent = "Mozilla/4.0+(compatible;+MSIE+5.01;+Windows+NT+5.0)"
Dim resp As HttpWebResponse = CType(Req.GetResponse(), HttpWebResponse)
Dim receiveStream As Stream = resp.GetResponseStream()
Dim Bmp As New Bitmap(receiveStream)
Dim ResStream As New MemoryStream()
Bmp.Save(ResStream, ImageFormat.Jpeg)
Return ResStream
End Function
Function UploadFileStream(ByVal Url As String, ByVal nvc As NameValueCollection, ByVal FStream As Stream) As String
Dim length As Long = 0
Dim boundary As String = "----------------------------" & DateTime.Now.Ticks.ToString("x")
Dim httpWebRequest2 As HttpWebRequest = CType(WebRequest.Create(Url), HttpWebRequest)
httpWebRequest2.ContentType = "multipart/form-data; boundary=" + boundary
httpWebRequest2.Method = "POST"
httpWebRequest2.KeepAlive = True
Dim memStream As New MemoryStream()
Dim boundarybytes() As Byte = Encoding.ASCII.GetBytes(Chr(13) & Chr(10) & "--" & boundary & Chr(13) & Chr(10))
Dim formdataTemplate As String = Chr(13) & Chr(10) & "--" & boundary & Chr(13) & Chr(10) & "Content-Disposition: form-data; name=""{0}"";" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "{1}"
For Each key As String In nvc.Keys
Dim formitem As String = String.Format(formdataTemplate, key, nvc(key))
Dim formitembytes() As Byte = Encoding.GetEncoding(1251).GetBytes(formitem)
memStream.Write(formitembytes, 0, formitembytes.Length)
Next
memStream.Write(boundarybytes, 0, boundarybytes.Length)
Dim headerTemplate As String = "--" & boundary & Chr(13) & Chr(10) & "Content-Disposition: form-data; name=""file""; filename=""captcha.jpg""" & Chr(13) & Chr(10) & "Content-Type: image/pjpeg" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
Dim headerbytes() As Byte = System.Text.Encoding.GetEncoding(1251).GetBytes(headerTemplate)
memStream.Write(headerbytes, 0, headerbytes.Length)
'Dim tmpBuf(memStream.Length) As Byte
'memStream.Position = 0
'memStream.Read(tmpBuf, 0, tmpBuf.Length)
'Dim tmpStr As String = Encoding.GetEncoding(1251).GetString(tmpBuf)
'Return tmpStr
FStream.Position = 0
Dim buffer(FStream.Length) As Byte
Dim bytesRead As Integer = 0
bytesRead = FStream.Read(buffer, 0, buffer.Length)
memStream.Write(buffer, 0, bytesRead)
memStream.Write(boundarybytes, 0, boundarybytes.Length)
httpWebRequest2.ContentLength = memStream.Length + 1
Dim requestStream As Stream = httpWebRequest2.GetRequestStream()
memStream.Position = 0
Dim tempBuffer(memStream.Length) As Byte
memStream.Read(tempBuffer, 0, tempBuffer.Length)
memStream.Close()
requestStream.Write(tempBuffer, 0, tempBuffer.Length)
requestStream.Close()
Dim webResponse2 As WebResponse = httpWebRequest2.GetResponse()
Dim stream2 As Stream = webResponse2.GetResponseStream()
Dim reader2 As New StreamReader(stream2, Encoding.GetEncoding(1251))
Dim Res As String = reader2.ReadToEnd()
webResponse2.Close()
Return Res
End Function
Function GetStatusCaptcha(ByVal CID As String, ByVal KeyC As String) As String
Dim LoadU = "http://antigate.com/res.php?key=" & KeyC & "&action=get&id=" & CID
Dim Req As HttpWebRequest = CType(WebRequest.Create(LoadU), HttpWebRequest)
Req.Method = "GET"
Req.UserAgent = "Mozilla/4.0+(compatible;+MSIE+5.01;+Windows+NT+5.0)"
Dim respreq As HttpWebResponse
Dim receiveStream As Stream
respreq = CType(Req.GetResponse(), HttpWebResponse)
receiveStream = respreq.GetResponseStream()
Dim StrRead As New StreamReader(receiveStream, Encoding.GetEncoding(1251))
Dim Res As String = StrRead.ReadToEnd()
Dim Sp(1) As String
Sp(0) = "|"
Dim ResStr = "ERROR"
Dim Resp() As String = Res.Split(Sp, StringSplitOptions.RemoveEmptyEntries)
If Resp.Length
Return ResStr
End If
If Resp(0)
Return ResStr
End If
ResStr = Resp(1)
Return ResStr
End Function
Function GetCaptcha(ByVal UrlCaptcha As String, ByVal KeyC As String) As String
Dim MyStr As MemoryStream = Bmp2JpgUrl(UrlCaptcha)
'TestBox.Image = New Bitmap(MyStr)
Dim nvc As New NameValueCollection()
nvc.Add("method", "post")
nvc.Add("key", KeyC)
nvc.Add("file", "captcha.jpg")
Dim Res As String = UploadFileStream("http://antigate.com/in.php", nvc, MyStr)
Dim ResStr = "ERROR"
Dim Sp(1) As String
Sp(0) = "|"
Dim Resp() As String = Res.Split(Sp, StringSplitOptions.RemoveEmptyEntries)
If Resp.Length
Return ResStr
End If
If Resp(0)
Return ResStr
End If
Dim CID As String = Resp(1)
Thread.Sleep(10000)
ResStr = GetStatusCaptcha(CID, KeyC)
Dim ip As String = 0
While ResStr = "ERROR" And ip
Thread.Sleep(5000)
ResStr = GetStatusCaptcha(CID, KeyC)
End While
Return ResStr
End Function
End Class
Заявки фрилансеров
Похожие заказы
- Прикладное ПОнет заявокЗакрыт15 лет назад
Доброе время суток! Требуется написать функцию на Java осуществляющую сопоставление url и домена поясню на примере На входе имеем список доменов, вида 1) domain.com 2) ...
Прикладное ПО1 исполнительЗавершен15 лет назад- $100
Необходимо сделать плагин для пиджина Pidgin.im (есть готовые соурсы примеры похожих плагинов) чтобы все сообщения отправляло на сервера Simkl (по готовой простой API). Плагины ложатся в виде .dll в папку C:\Program Files ...
Прикладное ПО1 заявкаЗакрыт15 лет назад - $1000
Потоковое вещание видео и звука в реальном времени на сайт имеется сервер достаточно мощный канал на 100Mb домен куплен хостинг есть установлен и разработан сайт ...
Прикладное ПО3 заявкиЗакрыт15 лет назад Есть программа. Она рисует круг по определенному алгоритму(методу полярных векторно-параметричних поликоординатных)... Рисуется этот круг кривым, а надо, чтобы ровным. Нужно или исправить ошибку или написать заново прогу. Формулы + теорию дам!
Прикладное ПО12 заявокЗакрыт15 лет назад- $500
Создание для торгующей компании прайс листов в Exel на основе прайс листов поставщиков и производителей. Обязательные требования: Продвинутые знания Exel, возможность выполнять работы в дневное время. Готовность к ...
Прикладное ПО4 заявкиЗакрыт15 лет назад Вкратце - программа должна искать не запароленные счётчики LiveInternet на сайтах находящихся в ТОП50 выдаче яндекса по заданному запросу(ам). Контакты в профиле. Пишите и сразу указывайте сроки и бюджет.
Прикладное ПО6 заявокЗакрыт15 лет назадПервая задача: Надо из программы на Delphi открыть имеющуюся таблицу Excel и добавить в нее одну строку (набор данных строковых и целых). Закрыть таблицу, вернуться в программу. Вторая задача: Из ...
Прикладное ПО1 исполнительЗавершен15 лет назадНужно переименовать файлы из title в имя файла
Прикладное ПО1 исполнительЗавершен15 лет назадВбивается список букв, необходимо сгенерировать всевозможные комбинации длинной не более 4 символов в слове. Интересует, чтобы было: - выбор количества символов (1, 2, 3, 4, 5 и т.д.) - выбор ...
Прикладное ПО1 исполнительЗавершен15 лет назад