HOME FORUMS MEMBERS RECENT POSTS LOG IN  
× Авторизация
Имя пользователя:
Пароль:
Нет аккаунта? Регистрация
Баннер 1   Баннер 2
НОВЫЕ ТОРГОВАЯ НОВОСТИ ЧАТ
loading...
Скрыть
Вернуться   ANTICHAT > ПРОГРАММИРОВАНИЕ > С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby
   
Ответ
 
Опции темы Поиск в этой теме Опции просмотра

  #1  
Старый 22.10.2009, 15:18
Пуховой
Banned
Регистрация: 25.11.2007
Сообщений: 62
С нами: 9715564

Репутация: 89
По умолчанию

Сама функция (определение и распознавание капчи, детект валида / невалида, детект невалид. прокси). В параметрах передаем аккаунт вида mailass, и 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..
 
Ответить с цитированием

  #2  
Старый 22.10.2009, 17:01
Rebit
Участник форума
Регистрация: 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, определить его площадь и координаты центра тяжести с помощью модифицированной формулы Грина. Сравнить с ручным расчетом.
 
Ответить с цитированием

  #3  
Старый 22.10.2009, 19:54
CaLLIka
Новичок
Регистрация: 31.08.2009
Сообщений: 24
С нами: 8787214

Репутация: 31
По умолчанию

Ребят,нужна помощь есть прога маленькая,написана походу на делфи 7,исходников нет,
Вводишь данные,она производит расчет и выводит отчет,надо убрать некоторые формы для ввода данных,которые используются только в отчете.возможно?пробовал через де де,я не понимаю нихрена в этом,что менять и как кто может помочь стукните в асю
 
Ответить с цитированием

  #4  
Старый 23.10.2009, 01:58
ErrorNeo
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..
 
Ответить с цитированием

  #5  
Старый 23.10.2009, 08:33
s0l_ir0n
Участник форума
Регистрация: 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.
з.ы.: в итерации ошибка скорее всего =)
 
Ответить с цитированием

  #6  
Старый 23.10.2009, 09:36
slesh
Познавший АНТИЧАТ
Регистрация: 05.03.2007
Сообщений: 1,985
С нами: 10097606

Репутация: 3349


По умолчанию

т.к. файл не большой, то проще былобы замаппить его в оперативу с правами на запись. Сразу память просканить на наличие данной сигнатуры, затем сразу изменить значение в памяти и отмаппить файл. Скорость бы была напорядок выше.

Последний раз редактировалось slesh; 23.10.2009 в 10:23..
 
Ответить с цитированием

  #7  
Старый 23.10.2009, 10:19
slesh
Познавший АНТИЧАТ
Регистрация: 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..
 
Ответить с цитированием

  #8  
Старый 23.10.2009, 11:16
s0l_ir0n
Участник форума
Регистрация: 14.03.2009
Сообщений: 237
С нами: 9031410

Репутация: 314
По умолчанию

slesh, твоя захардкоденая функция CompareMem - это ведь тоже самое, что и lstrcpyn?
 
Ответить с цитированием

  #9  
Старый 23.10.2009, 12:06
slesh
Познавший АНТИЧАТ
Регистрация: 05.03.2007
Сообщений: 1,985
С нами: 10097606

Репутация: 3349


По умолчанию

нет lstrcpyn - это копирование строки, а CompareMem сравнение памяти
 
Ответить с цитированием

  #10  
Старый 24.10.2009, 14:36
DiHWO
Участник форума
Регистрация: 23.10.2009
Сообщений: 103
С нами: 8710432

Репутация: 7
По умолчанию

ребят, есть статья по отправке сокетов через хттп протокол? оч надо.
 
Ответить с цитированием
Ответ



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
[Wi-Fi, BT] Задай вопрос - получи ответ! Alexsize Беспроводные технологии/Wi-Fi/Wardriving 2569 10.05.2026 13:27
[jQuery] - Задай вопрос, получи ответ Isis PHP 62 25.12.2009 03:25



Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
 


Быстрый переход




ANTICHAT ™ © 2001- Antichat Kft.