
22.10.2009, 15:18
|
|
Banned
Регистрация: 25.11.2007
Сообщений: 62
С нами:
9715564
Репутация:
89
|
|
Сама функция (определение и распознавание капчи, детект валида / невалида, детект невалид. прокси). В параметрах передаем аккаунт вида mail  ass, и tidhttp компонент. "antikey" - ваш ас-ключ.
Код:
function login_vk (account : string; http : tidhttp) : string;
var
s, imageurl, captcha : widestring;
post : tstringlist;
fs : Tmemorystream;
begin
post := tstringlist.Create;
post.Add ('op=a_login_attempt');
s := httpget (http, 'http://vkontakte.ru/');
s := httppost (http, 'http://vkontakte.ru/login.php', post);
post.Clear;
if (countpos ('vklogin', s) = 0) and (countpos ('captcha_sid', s) = 0) then
begin
Result := 'falseproxy'; post.Free; exit;
end;
if countpos ('captcha_sid', s) <> 0 then
begin
fs := TmemoryStream.Create;
imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
post.Add ('op=a_login_attempt');
post.Add ('captcha_sid=' + imageurl);
try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
captcha := recognize ('jpg', antikey, fs);
while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
post.Add ('captcha_key=' + captcha);
s := httppost (http, 'http://vkontakte.ru/login.php', post);
fs.Free; post.Clear;
end;
if countpos ('captcha_sid', s) <> 0 then
begin
fs := TmemoryStream.Create;
imageurl := Extract (Extract (s, '"[\d]*"'), '[\d]*[\w]');
post.Add ('op=a_login_attempt');
post.Add ('captcha_sid=' + imageurl);
try http.Get ('http://vkontakte.ru/captcha.php?s=1&sid=' + imageurl, fs); except end;
captcha := recognize ('jpg', antikey, fs);
while captcha = 'ERROR_NO_SLOT_AVAILABLE' do captcha := recognize ('jpg', antikey, fs);
post.Add ('captcha_key=' + captcha);
s := httppost (http, 'http://vkontakte.ru/login.php', post);
fs.Free; post.Clear;
end;
post.Add ('email=' + Extractproxy (account, '[^:]*[^:]', 0));
post.Add ('pass=' + Extractproxy (account, '[^:]*[^:]', 1));
post.Add ('expire=');
post.Add ('vk=');
s := httppost (http, 'http://login.vk.com/?act=login', post);
post.Clear;
if (countpos ('vklogin', s) > 0) and (http.ResponseCode = 302) then
begin
Result := 'false'; post.Free; exit;
end;
if ((countpos ('vklogin', s) > 0) and (http.ResponseCode = 200)) or (s = '') then
begin
Result := 'falseproxy'; post.Free; exit;
end;
post.Add ('op=slogin');
post.Add ('redirect=1');
post.Add ('expire=0');
post.Add ('to=');
post.Add ('s=' + deletestr (extract (s, '''s''\svalue=''[^'']*[^'']'), '''s'' value='''));
s := httppost (http, 'http://vkontakte.ru/login.php', post);
Result := 'true';
end;
Ну и пример использования:
Код:
procedure login;
var
http : tidhttp;
coo : tidcookiemanager;
s, account : widestring;
begin
http := tidhttp.create; http.handleredirects := true; http.readtimeout := 20000;
coo := tidcookiemanager.create; http.allowcookies := true; http.cookiemanager := coo;
account := 'vasya4333@mail.ru:mega-password';
showmessage (login_vk (http, account));
end;
***
А вот функции, треб. для работы этой функции (используются в каждом приложении) :
Код:
function httpGet (http : tidhttp; adr : widestring) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.Get (adr, str); except end;
Result := str.DataString;
str.Free;
end;
function httpPost (http : tidhttp; adr : widestring; post : tstringlist) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.post (adr, post, str); except end;
Result := str.DataString;
str.Free;
end;
function httpPostMulti (http : tidhttp; adr : widestring; post : Tidmultipartformdatastream) : widestring;
var
str : tstringstream;
begin
str := tstringstream.Create('');
try http.post (adr, post, str); except end;
Result := str.DataString;
str.Free;
end;
function ExtractProxy (const AInputString : string ; buf : string; pos : integer) : string;
var
r : TRegExpr;
begin
Result := '';
r := TRegExpr.Create;
try
r.Expression := buf;
r.Exec (AInputString);
Result := r.Match [0];
if pos = 1 then
begin
r.ExecNext;
Result := r.Match [0];
end;
finally r.Free;
end;
end;
function Extract (const AInputString : string ; buf : string) : string;
var
r : TRegExpr;
begin
Result := '';
r := TRegExpr.Create;
try
r.Expression := buf;
if r.Exec (AInputString) then
REPEAT
Result := r.Match [0];
UNTIL not r.ExecNext;
finally r.Free;
end;
end;
function deletestr (str, target : widestring) : widestring;
var
p : integer;
begin
while pos (target, str) > 0 do
begin
p := pos (target, str);
delete (str, p, length (target));
end;
Result := str;
end;
function countpos (const subtext: string; Text: string): Integer;
begin
if (Length(subtext) = 0) or (Length(Text) = 0) or (Pos(subtext, Text) = 0) then Result := 0 else Result := (Length(Text) - Length(StringReplace(Text, subtext, '', [rfReplaceAll]))) div Length(subtext);
end;
function recognize (itype: string; key: string; image : tmemorystream) : string;
var
ftype, s, id: string;
i: integer;
http: tidhttp;
multi: tidmultipartformdatastream;
begin
if strpos (pchar (itype), 'jpg') <> nil then ftype := 'image/pjpeg';
if strpos (pchar (itype), 'gif') <> nil then ftype := 'image/gif';
if strpos (pchar (itype), 'png') <> nil then ftype := 'image/png';
multi := Tidmultipartformdatastream.Create;
multi.AddFormField ('method', 'post');
multi.AddFormField ('key', key);
multi.AddObject ('file', ftype, 'UTF8',image, 'captcha.' + itype);
http := tidhttp.Create;
s := http.Post ('http://antigate.com/in.php', multi);
http.Free; multi.Free;
id := '';
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then id := AnsiReplaceStr (s, 'OK|', '');
if id = '' then result := 'ERROR: bad captcha id';
for i := 1 to 20 do
begin
sleep (5000);
http := tidhttp.Create;
s := http.Get ('http://antigate.com/res.php?key=' + key + '&action=get&id=' + id);
http.Free;
if strpos (Pchar (s), 'ERROR_') <> nil then begin result := s; exit; end;
if strpos (Pchar (s), 'OK|') <> nil then
begin
result := AnsiReplaceStr (s, 'OK|', '');
exit;
end;
end;
result := 'ERROR_TIMEOUT';
end;
Последний раз редактировалось Пуховой; 22.10.2009 в 15:24..
|
|
|

22.10.2009, 17:01
|
|
Участник форума
Регистрация: 07.08.2007
Сообщений: 136
С нами:
9874363
Репутация:
653
|
|
Помогите решить =) С мну +10
Лабораторна робота № 8 Обчислення площі контуру та координати центра його ваги.
Заданий замкнений контур намалювати на міліметровці, обчислити його площу та координати центра ваги за допомогою простих геометричних формул. Створити програму для обчислення за допомогою модифікованої формули Гріна, порівняти результати (вони повинні співпадати).
9. Замкнений контур розташовується між графіком функції Y=(1+|X|)(2-|X|) та віссю Х у диапазоні Х= -2 -- +2, визначити його площу та координати центра ваги за допомогою модифікованої формули Гріна. Порівняти із ручним розрахунком.
Лабораторная работа № 8 Вычисление площади контура и координаты центра его веса.
Заданный замкнутый контур нарисовать на милиметровци, вычислить его площадь и координаты центра тяжести с помощью простых геометрических формул. Создать программу для вычисления с помощью модифицированной формулы Грина, сравнить результаты (они должны совпадать).
9. Замкнутый контур располагается между графиком функции Y = (1 + | X |) (2 - | X |) и осью Х в диапазоне Х = -2 - 2, определить его площадь и координаты центра тяжести с помощью модифицированной формулы Грина. Сравнить с ручным расчетом.
|
|
|

22.10.2009, 19:54
|
|
Новичок
Регистрация: 31.08.2009
Сообщений: 24
С нами:
8787214
Репутация:
31
|
|
Ребят,нужна помощь есть прога маленькая,написана походу на делфи 7,исходников нет,
Вводишь данные,она производит расчет и выводит отчет,надо убрать некоторые формы для ввода данных,которые используются только в отчете.возможно?пробовал через де де,я не понимаю нихрена в этом,что менять и как  кто может помочь стукните в асю
|
|
|

23.10.2009, 01:58
|
|
Moderator - Level 7
Регистрация: 02.05.2009
Сообщений: 894
С нами:
8960826
Репутация:
2261
|
|
задача
есть бинарный файл(200кб), в его теле 1 раз (смещение заранее не известно) содержится последовательность из заранее заданных 5 байт.
Требуется заменить эти 5 байт на другие заранее заданные 5 байт, сохранив все остальное, в.т.ч. и название файла.
(если более точно, то требуется заменить CD 16 0F 85 09 на CD 16 90 90 90 в одном системном файле)
вопрос в том как сделать это с минимумом камасутры, за ответы спс :-)
побайтово читать и сохраняя буффер из последних 5 символов писать новый файл, а затем удалить оригинал и на его место записать "новый" - в голову пришло. Но как-то это тупо...
кто-нибудь знает менее нерациональные способы?
Последний раз редактировалось ErrorNeo; 23.10.2009 в 02:03..
|
|
|

23.10.2009, 08:33
|
|
Участник форума
Регистрация: 14.03.2009
Сообщений: 237
С нами:
9031410
Репутация:
314
|
|
Сообщение от ErrorNeo
задача
есть бинарный файл(200кб), в его теле 1 раз (смещение заранее не известно) содержится последовательность из заранее заданных 5 байт.
Требуется заменить эти 5 байт на другие заранее заданные 5 байт, сохранив все остальное, в.т.ч. и название файла.
(если более точно, то требуется заменить CD 16 0F 85 09 на CD 16 90 90 90 в одном системном файле)
вопрос в том как сделать это с минимумом камасутры, за ответы спс :-)
побайтово читать и сохраняя буффер из последних 5 символов писать новый файл, а затем удалить оригинал и на его место записать "новый" - в голову пришло. Но как-то это тупо...
кто-нибудь знает менее нерациональные способы?
Код:
program Project1;
{$APPTYPE CONSOLE}
uses
windows;
var
FHWND:HWND;
OFS: OFSTRUCT;
buf:array [1..6] of byte;
tmpDW:DWORD;
i, fsize:integer;
const
sMask:array [1..6] of byte=($CD, $16, $0F, $85, $09, $00);
rMask:array [1..6] of byte=($CD, $16, $90, $90, $90, $00);
begin
FHWND:= OpenFile('Relase.exe', OFS, OF_READWRITE);
if FHWND = INVALID_HANDLE_VALUE then Exit;
fsize:=GetFileSize(FHWND,@tmpDW);
for I:=1 to fsize-5 do
begin
ReadFile(FHWND, buf, 5, tmpDW, nil);
if lstrcmp(@buf,@sMask)=0
then begin
SetFilePointer(FHWND, -5, nil, FILE_CURRENT);
WriteFile(FHWND, rMask, 5, tmpDW, nil);
Exit;
end;
SetFilePointer(FHWND, i, nil, FILE_BEGIN);
end;
CloseHandle(FHWND);
end.
з.ы.: в итерации ошибка скорее всего =)
|
|
|

23.10.2009, 09:36
|
|
Познавший АНТИЧАТ
Регистрация: 05.03.2007
Сообщений: 1,985
С нами:
10097606
Репутация:
3349
|
|
т.к. файл не большой, то проще былобы замаппить его в оперативу с правами на запись. Сразу память просканить на наличие данной сигнатуры, затем сразу изменить значение в памяти и отмаппить файл. Скорость бы была напорядок выше.
Последний раз редактировалось slesh; 23.10.2009 в 10:23..
|
|
|

23.10.2009, 10:19
|
|
Познавший АНТИЧАТ
Регистрация: 05.03.2007
Сообщений: 1,985
С нами:
10097606
Репутация:
3349
|
|
для тех кто не умеет юзать файл маппинг вот пример:
Код:
program Project2;
{$APPTYPE CONSOLE}
uses
Windows;
const
find_data : array [0..4] of byte = ($CD, $16, $0F, $85, $09);
replace_data : array [0..4] of byte = ($CD, $16, $90, $90, $90);
// выдрал sysutils
function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler;
asm
PUSH ESI
PUSH EDI
MOV ESI,P1
MOV EDI,P2
MOV EDX,ECX
XOR EAX,EAX
AND EDX,3
SAR ECX,2
JS @@1 // Negative Length implies identity.
REPE CMPSD
JNE @@2
MOV ECX,EDX
REPE CMPSB
JNE @@2
@@1: INC EAX
@@2: POP EDI
POP ESI
end;
var
hFile : THANDLE;
hFileMap : THANDLE;
Mem : pointer;
FileSize : dword;
x : dword;
begin
hFile := CreateFileA('c:\Relase.exe', GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hFile <> INVALID_HANDLE_VALUE then
begin
FileSize := GetFileSize(hFile, nil);
hFileMap := CreateFileMappingA(hFile, nil, PAGE_READWRITE , 0, FileSize, nil);
if hFileMap <> INVALID_HANDLE_VALUE then
begin
Mem := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, FileSize);
if Mem <> nil then
begin
for x := 0 to FileSize - 6 do
begin
if CompareMem(pointer(dword(Mem) + x), @find_data[0], 5) then
begin
CopyMemory(pointer(dword(Mem) + x), @replace_data[0], 5);
break;
end;
end;
UnmapViewOfFile(Mem);
end;
CloseHandle(hFileMap);
end;
CloseHandle(hFile);
end;
end.
Такими методом можно очень быстро найти данные любой длинные и также быстро заменить их.
Хотя вместо CompareMem можно было просто проверить 4 байта, а потом 1 байт и это было бы быстрее при небольшом размере проверяемых данных. т.е. примерно так проверять
Код:
if (dword(pointer(dword(Mem) + x)^) = dword(pointer(@find_data[0])^)) and
(byte(pointer(dword(Mem) + x + 4)^) = find_data[4]) then
И теперь главное. если таким методом патчить виндовые проги (незапущенные) то вл:егкую обходится WFP защита. Я так патчил эксплорер.
Когда его прибиваеш, патчиш, и потом опять запускаеш, то на Win XP WFP молчал.
Последний раз редактировалось slesh; 23.10.2009 в 10:27..
|
|
|

23.10.2009, 11:16
|
|
Участник форума
Регистрация: 14.03.2009
Сообщений: 237
С нами:
9031410
Репутация:
314
|
|
slesh, твоя захардкоденая функция CompareMem - это ведь тоже самое, что и lstrcpyn?
|
|
|

23.10.2009, 12:06
|
|
Познавший АНТИЧАТ
Регистрация: 05.03.2007
Сообщений: 1,985
С нами:
10097606
Репутация:
3349
|
|
нет lstrcpyn - это копирование строки, а CompareMem сравнение памяти
|
|
|

24.10.2009, 14:36
|
|
Участник форума
Регистрация: 23.10.2009
Сообщений: 103
С нами:
8710432
Репутация:
7
|
|
ребят, есть статья по отправке сокетов через хттп протокол? оч надо.
|
|
|
|
 |
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|