Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей.
Здесь обсуждаются безопасность, программирование, технологии и многое другое.
Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz

05.02.2010, 18:01
|
|
Постоянный
Регистрация: 12.05.2009
Сообщений: 395
Провел на форуме: 4761503
Репутация:
229
|
|
Сообщение от Nightmarе
Если не работает, то логично что не решен.
Вот самописная (ибо маленько не понимаю как функция у тебя работает):
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Winsock, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
hworktread:THandle;
implementation
{$R *.dfm}
procedure GetHost();
var
addr:sockaddr_in;
sock:tsocket;
send1:string;
send1buffer, recv1buffer:array [1..4096] of char;
dsize:dword;
begin
sock:=socket(af_inet, sock_stream, 0);
addr.sin_family:=AF_INET;
addr.sin_addr.S_addr:=inet_addr('94.103.89.31');
addr.sin_port:=htons(80);
form1.Memo1.Clear;
if connect(sock, addr, sizeof(addr))=0 then
begin
send1:='GET http://pr-cy.ru/ HTTP/1.0'+#13#10+
'User-Agent: Opera/9.80 (Windows NT 5.1; U; en) Presto/2.2.15 Version/10.20'+#13#10+
'Host: pr-cy.ru'+#13#10+
'Cookie: 1=1;'+#13#10+
'Cookie2: $Version=1'+#13#10+
'Connection: Keep-Alive'+#13#10+#13#10;
CopyMemory(@send1buffer, pchar(send1), length(send1));
send(sock, send1buffer, sizeof(send1buffer), 0);
repeat
dSize:=recv(sock, recv1buffer, 4096, 0);
Application.ProcessMessages; //В ЭТОЙ СТРОКЕ -> ВСЯ ФИШКА, ЕСЛИ ЕЕ УБРАТЬ, ПРОГРАММА ЗАВИСНЕТ
form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+recv1buffer;
until (dSize = 0) or (dSize = SOCKET_ERROR);
end;
closesocket(sock);
form1.Label1.Caption:=inttostr(strtoint(form1.Label1.Caption)+1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dummy:Cardinal;
i:integer;
begin
while true do
begin
gethost;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ws:wsadata;
begin
WSAStartup($101, ws);
end;
end.
Работает нормально
//Переделаешь как тебе нужно, думаю не составит проблем
Последний раз редактировалось wolmer; 05.02.2010 в 18:21..
|
|
|
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|