Visual Basic - Basic - PicBasic ve Türevleri
Captcha Çözmek [VB6 Yarım Kalan Program]
Captcha Çözmek [VB6 Yarım Kalan Program]
-
Ö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
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 Submodü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 -
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
-
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
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