UpWap.ru Parser (VB6) - Proxy-Base Community - Анонимность и безопасность в интернете.
Бесплатные прокси. Количество:
Прокси для пользователей форума (API). Количество:
Купить доступ к прокси-листам (API). Количество:
 



Информация по хайдам / репутации

(РЕКОМЕНДУЮ) №1 >>>DDos Атака<<|>>DDoS Service<<< ДДОС СЕРВИС<<|>>Заказать DDOS
Бесплатные прокси уже в Telegram
Все инфопродукты и приватная информация бесплатно
Старый 23.05.2011, 15:39   #1 (permalink)
VPN
 
Аватар для C00LPack
 
Регистрация: 11.01.2011
Сообщений: 324
Member ID: 11190
ICQ 364867

Репутация: 844
Репутация: 844
Сказал(а) спасибо: 166
Поблагодарили 548 раз(а) в 280 сообщениях
Топикстартер (автор темы) По умолчанию UpWap.ru Parser (VB6)

давно мной был написал парсер файлов с upwap.ru на барсике.


выкладываю код вообщемта, используется компонент msinet
Код:
Option Explicit
Private Const CP_ACP = 0
Private Const CP_UTF8 = 65001
Private Declare Function GetACP Lib "kernel32.dll" () As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Dim i As Long
Public Running As Boolean
Private Function WToA(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    Dim pwz As Long
    Dim pwzBuffer As Long
    Dim lpUsedDefaultChar As Long
    
    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
    WToA = Left$(stBuffer, cwch - 1)
End Function

Private Function AToW(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    Dim pwz As Long
    Dim pwzBuffer As Long
        
    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
    AToW = Left$(stBuffer, cwch - 1)
End Function

Public Function DecodeUTF8(ByVal cnvUni As String) As String
    If cnvUni = vbNullString Then Exit Function
    DecodeUTF8 = AToW(WToA(cnvUni, CP_ACP), CP_UTF8)
End Function

Private Function ParsingTXT(sData As String, startstr As String, endstr As String) As String
    Dim sStart, ssEnd As Long

    sStart = InStr(1, sData, startstr)
    ssEnd = InStr(sStart + Len(startstr), sData, endstr)

    If sStart > 0 And ssEnd > 0 Then
        ParsingTXT = Mid$(sData, sStart + Len(startstr), ssEnd - sStart - Len(startstr))
    Else
        ParsingTXT = ""
    End If
End Function

Private Sub Check1_Click()
    If Check1.Value = 1 Then
        Text4.Enabled = True
        Command3.Enabled = True
    End If
    If Check1.Value = 0 Then
        Text4.Enabled = False
        Command3.Enabled = False
    End If
End Sub

Private Sub Command1_Click()
    Dim i As Long
    Dim mLink As String
    
    End If
    Running = True
    Command1.Enabled = False
    Command2.Enabled = True
    For i = Text2 To Text3
        If Running = False Then Exit For
        Text7 = Val(i)
        mLink = "upwap.ru/" & i
        Text1.Text = Text1.Text & "http://" & mLink & vbTab & ParsingTXT(DecodeUTF8(Inet1.OpenURL(mLink)), "<title>Файл &laquo;", "&raquo;</title>") & vbCrLf
        Text1.SelStart = Len(Text1)
        Text6.Text = Val(Text6) + Val(1)
        Text5.Text = Val(Text3) - Val(i)
        If Check1.Value = 1 Then
            Open Text4 For Append As #1
            Print #1, "http://" & mLink & vbTab & ParsingTXT(DecodeUTF8(Inet1.OpenURL(mLink)), "<title>Файл &laquo;", "&raquo;</title>")
            Close #1
        End If
    Next i
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Private Sub Command2_Click()
    Running = False
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Private Sub Command3_Click()
    CommonDialog1.InitDir = App.Path
    CommonDialog1.ShowOpen
    Text4 = CommonDialog1.FileName
End Sub


Private Sub Command5_Click()
    Unload Me
End Sub


Private Sub Form_Load()
    Dim buff As String
    If Dir(App.Path & "\config.ini") <> "" Then
        Open App.Path & "\config.ini" For Input As #1
        Line Input #1, buff
        Line Input #1, buff
        Text2.Text = buff
        Line Input #1, buff
        Text3.Text = buff
        Line Input #1, buff
        Line Input #1, buff
        Text4.Text = buff
        Line Input #1, buff
        Check1.Value = buff
        Close #1
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Dir(App.Path & "\config.ini") <> "" Then
        Open App.Path & "\config.ini" For Output As #2
    
            Print #2, "[Range]"
            Print #2, Text2.Text
            Print #2, Text3.Text
            Print #2, "[SaveToFile]"
            Print #2, Text4.Text
            Print #2, Check1.Value
        Close #2
    End If
    Shell "Taskkill " & App.EXEName
End Sub
расписывать что и куда было впадлу, если что не понятно спрашивайте.
C00LPack вне форума   Ответить с цитированием
2 пользователя(ей) сказали cпасибо:
Ответ

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Вкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Proxy Parser By Chuck .Chuck Proxy SOFT 7 27.04.2015 13:00
UpWap.ru Parser C00LPack SOFT (Варезник) 15 24.08.2012 13:40
Dedicated Server Parser gattuso Флейм 6 08.07.2011 14:35
[Вконтакте] UIN Parser [VK] .thereal Cоциальные сети 1 09.02.2011 15:45
Mail-parser by stels hide Cоциальные сети 0 25.01.2010 18:28




DDoS Protected




Мы в твиттере, Proxy-Base.Org Twitter

Proxy-Base Community - Анонимность и безопасность в интернете.
Наши партнеры: CRC Labs, SEO-Crack.Com, Garsuk.Com, SED Team, Skladchik.com, BSS Family

Powered by vBulletin® | Булка сделана в пекарне®
Copyright © 2000 - , Jelsoft Enterprises Ltd. Перевод: zCarot
Вся информация на сайте выложена исключительно в ознакомительных целях.