folder Tahribat.com Forumları
linefolder Visual Basic - Basic - PicBasic ve Türevleri
linefolder Captcha Çözmek [VB6 Yarım Kalan Program]



Captcha Çözmek [VB6 Yarım Kalan Program]

  1. KısayolKısayol reportŞikayet pmÖzel Mesaj
    DE5TROY3R
    DE5TROY3R's avatar
    Kayıt Tarihi: 04/Nisan/2007
    Erkek

    Örnek olarak tanıttığım captchaları tanıyor. Yeni captcha gösterince, renk uyumsuzluğu(Renk tonlarından) sorunu oluyor. Siyah beyaz denedim onun bile tonları var galiba

    http://imageshack.us/a/img121/9940/captv.jpg

     


    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Boolean

    Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    Dim hexcolor As Boolean
    Dim PosXY As POINTAPI
    Dim fareY As Long
    Dim fareX As Long
    Dim denenenKarakter
    Dim DenenenKarakterBasamagi

    Private Function LongToRGB(lColor As Long) As String
        Dim iRed As Long, iGreen As Long, iBlue As Long
        
        iRed = lColor Mod 256
        iGreen = ((lColor And &HFF00) / 256&) Mod 256&
        iBlue = (lColor And &HFF0000) / 65536
        
        LongToRGB = Format$(iRed, "000") & ", " & Format$(iGreen, "000") & ", " & Format$(iBlue, "000")
    End Function

    Private Function GetPixelColor(x As Long, y As Long, Optional HexCode As Boolean = False) As String
        Dim DC As Long
        
        DC = CreateDC("DISPLAY", vbNullString, vbNullString, 0&)
        
        GetPixelColor = Format$(GetPixel(DC, x, y), "00000000") 'long
        
        If HexCode = True Then GetPixelColor = LongToHexColor(GetPixelColor)
        
        DeleteDC DC
    End Function

    Private Function LongToHexColor(ByVal lngColor As Long) As String
    Dim hColor As String

        hColor = Right$("000000" & Hex(lngColor), 6)
        LongToHexColor = Mid$(hColor, 5, 2) & Mid$(hColor, 3, 2) & Mid$(hColor, 1, 2)
    End Function

    Private Function GetMousePosX() As Long
        GetCursorPos PosXY
        GetMousePosX = PosXY.x
     
    End Function

    Private Function GetMousePosY() As Long
        GetCursorPos PosXY
        GetMousePosY = PosXY.y
    End Function

    Private Sub Command1_Click()
    Open App.Path & "\list.txt" For Append As #1
     
    For i5 = 0 To List1.ListCount - 1
    Print #1, List1.List(i5)
    Next

    Close #1
    End Sub



    Sub karakteryukle()
    On Error Resume Next
    ' Open App.Path & "\" & DenenenKarakterBasamagi & ".karakter\" & denenenKarakter & ".txt" For Input Access Read Shared As #1
    wait 100
     Open App.Path & "\1.karakter\" & denenenKarakter & ".txt" For Input Access Read Shared As #1
        Do Until EOF(1)
          Line Input #1, strText
          List1.AddItem strText & " "
        Loop
        Close #1
        
    End Sub

    Private Sub Command2_Click()
    karakteryukle

    End Sub

    Private Sub Command3_Click()

    For i = 0 To 17
    wait 100
    fareY = TagYakala(List1.List("0"), "Y:", " ")
    fareX = TagYakala(List1.List("0"), "X:", " ")
    fareColor = TagYakala(List1.List("0"), "HColor:", " ")
    alinanRenk = GetPixelColor(fareX, fareY, True)

    If alinanRenk = fareColor Then

    List1.RemoveItem "0"

    If List1.ListCount = 1 Then

    MsgBox denenenKarakter
    'GuvenlikKodu = GuvenlikKodu & denenenKarakter
    'DenenenKarakterBasamagi = DenenenKarakterBasamagi + 1
    denenenKarakter = "0"
    List1.Clear

    Exit For

    End If


    Else
    List1.RemoveItem "0"
    List1.Clear
    denenenKarakter = denenenKarakter + 1
    'DenenenKarakterBasamagi = DenenenKarakterBasamagi + 1
    karakteryukle

    End If
    Next i

    End Sub
    Function TagYakala(veri As String, tagb As String, tags As String)
    On Error Resume Next
    On Local Error Resume Next
    arrs = Split(veri, tagb)
    arrB = Split(arrs(1), tags)
    TagYakala = arrB(0)
    End Function
    Private Sub Form_Load()
        Timer1.Enabled = True
        denenenKarakter = "0"
        DenenenKarakterBasamagi = "1"
    End Sub

    Private Sub Image1_Click()
    secilenhexcolor = GetPixelColor(GetMousePosX, GetMousePosY, True)
    List1.AddItem "Y:" & GetMousePosY & " X:" & GetMousePosX & " HColor:" & secilenhexcolor
    End Sub

    Private Sub Timer1_Timer()
        Picture1.BackColor = GetPixelColor(GetMousePosX, GetMousePosY)
        Label1.Caption = GetPixelColor(GetMousePosX, GetMousePosY)
        Label2.Caption = GetPixelColor(GetMousePosX, GetMousePosY, True)
        Label3.Caption = LongToRGB(GetPixelColor(GetMousePosX, GetMousePosY))
    End Sub

     

    modül:

    Public Declare Function GetTickCount Lib "kernel32" () As Long

    Public Sub wait(ByVal dblMilliseconds As Double)
        Dim dblStart As Double
        Dim dblEnd As Double
        Dim dblTickCount As Double
        dblTickCount = GetTickCount()
        dblStart = GetTickCount()
        dblEnd = GetTickCount + dblMilliseconds
        Do
        DoEvents
        dblTickCount = GetTickCount()
        Loop Until dblTickCount > dblEnd Or dblTickCount < dblStart
    End Sub



    https://dl.dropbox.com/u/71260200/captcha_vb6.rar

     

  2. KısayolKısayol reportŞikayet pmÖzel Mesaj
    unbalanced
    unbalanced's avatar
    Kayıt Tarihi: 14/Haziran/2006
    Erkek

    image processing den çok anlamam ancak şöyle bir mantık yürütsen, tüm captcheleri renksiz hale çevirsen siyah ve beyaz şeklinde. arkaplan

    beyaz, yazının kendisi siyah olsun. ve bundan sonra pixel tarama işlemini yapsan? madem renk tonlarında sıkıntı var, iki tona düşürebilirsin


    Ülkesini Seven Her Türk Vatandasi, Ülkesinin Sessiz Istilasi'na karsi durmak zorunda.
  3. KısayolKısayol reportŞikayet pmÖzel Mesaj
    rappermcs
    rappermcs's avatar
    Kayıt Tarihi: 04/Ekim/2002
    Erkek
    DE5TROY3R bunu yazdı

    Örnek olarak tanıttığım captchaları tanıyor. Yeni captcha gösterince, renk uyumsuzluğu(Renk tonlarından) sorunu oluyor. Siyah beyaz denedim onun bile tonları var galiba

    http://imageshack.us/a/img121/9940/captv.jpg

     



     

    Konuyu hortlatmış olucam fakat bu kodu c# a nasıl çevirebiliriz arkadaşlar?

     

    özellikle aşağıdaki bölüm olsa işimi görür..

     

    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Boolean

    Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
    Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

    Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    Dim hexcolor As Boolean
    Dim PosXY As POINTAPI
    Dim fareY As Long
    Dim fareX As Long
    Dim denenenKarakter
    Dim DenenenKarakterBasamagi

    Private Function LongToRGB(lColor As Long) As String
        Dim iRed As Long, iGreen As Long, iBlue As Long
        
        iRed = lColor Mod 256
        iGreen = ((lColor And &HFF00) / 256&) Mod 256&
        iBlue = (lColor And &HFF0000) / 65536
        
        LongToRGB = Format$(iRed, "000") & ", " & Format$(iGreen, "000") & ", " & Format$(iBlue, "000")
    End Function

     

    rappermcs tarafından 14/Oca/15 17:27 tarihinde düzenlenmiştir

    Paslanmış bir uygulama geliştirici.. #AnalistŞart
Toplam Hit: 2813 Toplam Mesaj: 3