Chris
06-06-2013, 06:04 PM
I came across this thread some days ago, and saw my own posts..
I'm sorry for being that immature and stupid back then, so I have made something.
You'll need Appa (villavu.com/forum/showthread.php?t=82426) to try this.
program new; {$loadlib Appa_Simba.dll}
type
TheColor = (Roze, Blauw, Wit, Groen, Rood);
var
Captcha: Integer;
CaptchaColor: TheColor;
procedure WaitForPage;
var
t: Integer;
begin
t := GetSystemTime + 1000;
while (not appa_PageLoaded) and appa_Showing and (GetSystemTime < t)do
Wait(10);
end;
procedure appa_NavigateTo(URL: string);
begin
if not appa_Showing then
Exit;
appa_Navigate(URL);
WaitForPage;
end;
procedure appa_UpdateBitmap(var BMP: Integer);
var
w, h:Integer;
Bitmap: TBitmap;
begin
appa_GetSize(w, h);
BMP := CreateBitmap(w, h);
Bitmap := GetMufasaBitmap(BMP).ToTBitmap();
Bitmap.Canvas.Pixels[0, 0] := 0;
try
appa_CopyContentToBitmapDC(Bitmap.Canvas.Handle);
GetMufasaBitmap(BMP).LoadFromTBitmap(Bitmap);
except
writeln('Error at appa_UpdateBitmap');
finally
Bitmap.Free;
end;
end;
procedure Setup;
begin
if not(appa_Showing) then
begin
appa_ShowForm;
appa_Caption('Mafiaroots.com - Captcha');
appa_SetSize(400, 200);
end;
appa_NavigateTo('http://mafiaroots.com/images/captcha/captcha.php?key=rld');
wait(50);
end;
procedure SetTarget;
var
CaptchaImg: Integer;
begin
appa_UpdateBitmap(CaptchaImg);
SetTargetBitmap(CaptchaImg);
Captcha := BitmapfromClient(12, 17, 111, 58);
SetTargetBitmap(Captcha);
FreeBitmap(CaptchaImg);
end;
procedure FreeRuntimeBMPs;
begin
FreeTarget(GetImageTarget);
FreeBitmap(Captcha);
FreeBitmap(1);
end;
procedure AddOnTerminate(const proc: string); // Copied from SRL.
var
OldProcs: TVariantArray;
i: integer;
begin
GetScriptProp(SP_OnTerminate,OldProcs);
for i := 0 to high(OldProcs) do
if lowercase(OldProcs[i]) = lowercase(proc) then
exit;
setlength(OldProcs,Length(OldProcs) + 1);
OldProcs[high(OldProcs)] := proc;
SetScriptProp(SP_OnTerminate,oldprocs);
end;
function GetBitmap(WhatColor: TheColor): Integer;
begin
case WhatColor of
Roze: Result := BitmapFromString(6, 9, 'meJxzc3NzdXV1QwL/UQGy1IIFC1at' +
'WgXnzp07d/fu3XDurFmzzpw54+HhAeFOnz795s2bvr6+xJiMBwAAZ' +
'9BL6w==');
Rood: Result := BitmapFromString(7, 10, 'meJxtyjEOABEQheHTLQlRSRzDQRQ' +
'apd4ddO6gcAalRENj7U52Ctm/evNlCHm63iil5AvPtdbegFvgcyOI' +
'UirnPMaIMSKmlEIIjDFjDGLvXUoJG3HOyTk/sJRirRVCeO8Rtda11' +
'taacw7xtxtG/GCv');
Wit: Result := BitmapFromString(13, 10, 'meJxzc3NzdXV1IwTc3d3RGHjA//' +
'//4Wy44RBBZC4ywC+I3wqSlP369QtTGabgxYsXCwoKgJ4NDg7GI5 i' +
'VlfX48eM/f/68ffsWrgyrIH4AAEMKotA=');
Groen: Result := BitmapFromString(13, 8, 'meJyNjzEKxCAURE+nhYLEykL0DDm' +
'HOYWYW1hGAoHUyRHSpggJkYD58HeX3S2WnWIYngPzpfQhQgj9 1DtZ' +
'1xVcaz1NU84ZHDI+SSn7vj/Pc1mWUgqQYRi894yxtm0hYy3G6JwDW' +
'Nc1kuM4qqqCAA4Z4bZt5akfta7rvq4dxxFHQwiv0ZRS0zSccy EEEm' +
'vtPM/XdcEXjDEIlVLQ3Pcd1ul/ugGBKZNn');
Blauw: Result := BitmapFromString(11, 9, 'meJx1jSEOxCAQRU8HdaSqhnACDNW' +
'1vQAJCYdAVqNQNRyApKoKgQKDYidLtkF0v3r5/2UGYzxNE/4FGCEE' +
'gL7pU29GbZRTSkKI3rTWnhX4ui4Axpj3/lUIIczzDFBrfRWcc/340' +
'z+wLAuwMUZKue87MCEE+pwz55xSep4nlEopOHIch7U2xgiC1r qUct' +
'/3uq4gbNs2Pv2XD+Kvj8g=');
end;
end;
procedure GetCorrectColor;
var
BMP, x, y, I: Integer;
begin
//(Roze, Blauw, Wit, Groen, Rood)
for I := 0 to 4 do
begin
BMP := GetBitmap(TheColor(I));
if FindBitmapToleranceIn(BMP, x, y, 0, 25, 50, 41, 5) then
begin
CaptchaColor := TheColor(I);
Break;
end;
FreeBitmap(BMP);
end;
FreeBitmap(BMP);
end;
procedure SetCaptchaOnlyAsTarget;
begin
Captcha := BitmapfromClient(0, 0, 99, 25);
SetTargetBitmap(Captcha);
end;
function MakeBitmap(TPA: TPointArray): Integer;
var
BMP, i: Integer;
TBox: TBox;
begin
TBox := GetTPABounds(TPA);
BMP := CreateBitmap(TBox.x2 - TBox.x1 + 2, TBox.y2 - TBox.y1 + 1);
for i := 0 to high(TPA) do
FastSetPixel(BMP, TPA[i].x - TBox.x1, TPA[i].y - TBox.y1, 255);
Result := BMP;
end;
function FindColorOnAllBoxBounds(Color, xs, ys, xe, ye: Integer): Boolean;
var
i, a, X, Y: Integer;
begin
X := xs
for a := 0 to 1 do
begin
for i := ys to ye do
if not (GetColor(X, i) = Color) then
begin
Result := False;
Exit;
end;
X := xe
end;
Y := ys;
for a := 0 to 1 do
begin
for i := xs to xe do
if not (GetColor(i, Y) = Color) then
begin
Result := False;
Exit;
end;
Y := ye;
end;
Result := True;
end;
function CheckAll(w, h: Integer): string;
var
TPA: TPointArray;
L, x, y, DTM: Integer;
begin {Done: 0, 1, 2, 4, 5, 6, 8, 9} {Nodig: 3, 7}
{Finding 9's}
if FindColors(TPA, 0, 2, 2, 6, 7) then
begin
L := Length(TPA);
if (L >= 6) and (L <= 10) then
begin
if FindColorOnAllBoxBounds(255, 2, 2, 6, 7) then
begin
Result := '9';
Exit;
end;
end;
end;
{Finding 8's}
if FindColors(TPA, 0, 2, 1, 6, 5) then
begin
L := Length(TPA);
if (L >= 2) and (L <= 5) then
begin
if FindColorOnAllBoxBounds(255, 2, 1, 6, 5) then
begin
Result := '8';
Exit;
end;
end;
end;
{Finding 4's}
if FindColors(TPA, 0, 2, 5, 5, 9) then
begin
L := Length(TPA);
if (L <= 4) then
begin
if FindColorOnAllBoxBounds(255, 2, 5, 5, 9) then
begin
Result := '4';
Exit;
end;
end;
end;
{Finding 0's}
DTM := DTMFromString('mUAIAAHick2FgYGABYlYgZgNidiDmIBKj62 MmEjNhwcw43MEJxFxAzI0DE6P3P53xSAYAeAQdUQ==');
if FindDTM(DTM, x, y, 0, 0, w-1, h-1) then
begin
Result := '0';
FreeDTM(DTM);
Exit;
end else
FreeDTM(DTM);
{Finding 1's}
DTM := DTMFromString('miwMAAHic02aAAEYgZgJiZiBmAWJWIGYDYn Yi5JmJwCxEYFYiMBcBzE0A4/IDBxBzQs2glpr/QwiPggEHAG8gLO8=');
if FindDTM(DTM, x, y, 0, 0, w-1, h-1) then
begin
Result := '1';
FreeDTM(DTM);
Exit;
end else
FreeDTM(DTM);
{Finding 6's}
if FindColors(TPA, 0, 2, 6, 6, 11) then
begin
L := Length(TPA);
if (L >= 6) and (L <= 10) then
begin
//writeln('Checking number 6');
if FindColorOnAllBoxBounds(255, 2, 6, 6, 11) then
begin
Result := '6';
Exit;
end;
end;
end;
{Finding 2's}
DTM := DTMFromString('mfgEAAHicE2JgYGABYnYgZkbCIDFWKGaDYn YoZoLyWaHqmKFiHFAxTiDmAmJuJMwO1QPj8yDR6Pg/lfDgBwBN9RMK');
if FindDTM(DTM, x, y, 0, 0, w-1, h-1) then
begin
Result := '2';
FreeDTM(DTM);
Exit;
end else
FreeDTM(DTM);
{Finding 5's}
DTM := DTMFromString('mKgEAAHic42NgYGBGwyxAzArETEiYGYkNk2 dEkmOB8hnRxFmR1IMwGxD/JxMPLAAA4NoOVw==');
if FindDTM(DTM, x, y, 0, 0, w-1, h-1) then
begin
Result := '5';
FreeDTM(DTM);
Exit;
end else
FreeDTM(DTM);
DTM := DTMFromString('mrAAAAHic42BgYGACYg4gZgZiFiBmBWI2KG YHYm4gZgRiLqg6Nqg6Zqje/wQwtQAAAdEIVw==');
if FindDTM(DTM, x, y, 0, 0, w-1, h-1) then
begin
Result := '7';
FreeDTM(DTM);
Exit;
end else
FreeDTM(DTM);
// No numbers found, assuming it's a 3.
Result := '3';
end;
function FindNumbers(ATPA: T2DPointArray): string;
var
i, w, h, BMP: Integer;
begin
Result := '';
FreeTarget(GetImageTarget);
for i := 0 to high(ATPA) do
begin
BMP := MakeBitmap(ATPA[i]);
GetBitmapSize(BMP, w, h);
SetTargetBitmap(BMP);
Result := Result + CheckAll(w, h);
FreeTarget(GetImageTarget);
FreeBitmap(BMP);
end;
SetTargetBitmap(Captcha);
end;
procedure AddIntArray(var Arr: TIntegerArray; Value: Integer);
var L: Integer;
begin
L := Length(Arr);
SetLength(Arr, L + 1);
Arr[L] := Value;
end;
function Modus(Arr: TIntegerArray): Integer;
var // Calculates the mode, it's "Modus" in dutch.
I, LastNum, Count, HighestCount: Integer;
begin
Quicksort(Arr);
Inverttia(Arr);
for i := 0 to high(Arr) do
begin
if Arr[i] = LastNum then
begin
inc(Count);
if Count > HighestCount then
begin
HighestCount := Count;
Result := Arr[i];
end;
end else
Count := 0;
LastNum := Arr[i];
end;
end;
procedure EditATPA(var ATPA: T2DPointArray);
var
ATPA2: T2DPointArray;
i, L, x, y, Mode, Mode2, Dif, Dif2: Integer;
TBox: TBox;
IntArr, IntArr2: TIntegerArray;
begin
ATPA2 := [];
for i := 0 to high(ATPA) do
begin
TBox := GetTPABounds(ATPA[i]);
if ((TBox.x2 - TBox.x1) > 5) and ((TBox.y2 - TBox.y1) > 10) and ((TBox.x2 - TBox.x1) < 12) then
if FindColor(x, y, 16645629, TBox.x1, TBox.y1, TBox.x2, TBox.y2) then
begin
L := Length(ATPA2) + 1;
SetLength(ATPA2, L);
ATPA2[L - 1] := ATPA[i];
AddIntArray(IntArr, TBox.y1);
AddIntArray(IntArr2, TBox.y2);
end;
end;
ATPA := [];
Mode := Modus(IntArr);
Mode2 := Modus(IntArr2);
for i := 0 to high(ATPA2) do
begin
TBox := GetTPABounds(ATPA2[i]);
Dif := (TBox.y1 - Mode);
Dif2 := (TBox.y2 - Mode2);
if (Dif <= 1) and (Dif >= -1) and (Dif2 <= 1) and (Dif2 >= -1) then
begin
L := Length(ATPA) + 1;
SetLength(ATPA, L);
ATPA[L - 1] := ATPA2[i];
end;
end;
end;
procedure SplitIntoBoxes(var ATPA: T2DPointArray);
var
Color, Tolerance: Integer;
TPA: TPointArray;
begin
case CaptchaColor of
Roze:
begin
Color := 16580861; // <100
Tolerance := 80;
end;
Blauw:
begin
Color := 16480304; // >50, <75
Tolerance := 65;
end;
Wit:
begin
Color := 16711422; // > 75, >91, >93, <100
Tolerance := 94
end;
Groen:
begin
Color := 64768; // > 50
Tolerance := 60;
end;
Rood:
begin
Color := 3289852;
Tolerance := 60;
end;
end;
FindColorsTolerance(TPA, Color, 0, 0, 99, 25, Tolerance);
SplitTPAWrap(TPA, 1, ATPA);
if CaptchaColor = Wit then
EditATPA(ATPA);
// Background gives trouble in that case, EditATPA() sorts it out.
end;
procedure Run;
var
ATPA: T2DPointArray;
begin
SetTarget;
GetCorrectColor;
SetCaptchaOnlyAsTarget;
AddOnTerminate('FreeRuntimeBMPs');
SplitIntoBoxes(ATPA);
SortATPAFromMidPoint(ATPA, point(0, 10));
Writeln('Result: ' + FindNumbers(ATPA));
end;
begin
Setup;
Run;
end.
Powered by vBulletin® Version 4.2.1 Copyright © 2024 vBulletin Solutions, Inc. All rights reserved.