вот что говорит tcpview спустя 3 минуты: ты на какой сервер запросы шлешь? и чему равняется mstimeout?
я имел в виду "апач или nginx или еще какой-то зверь.." апач сдох от 5 минут этих запросов, а shttp нормально работает!
вот что получается: апач: сервер умирает сразу, на клиенте немерено открытых соединений апач + nginx, nginx - front-end: сервер держится чуть дольше за счет ограничения на кол-во подключений с одного хоста nginx`ом, но все равно падает, на клиенте немерено открытых соединений nginx: 2 соединения как на сервере, так и на клиенте, независимо от времени SHTTP: до 4-х соединений, как на сервере так и на клиенте вывод напрашивается сам собой.. даже не знаю что в этом случае делать.
Code: procedure TForm1.startClick(Sender: TObject); begin for I := 0 to 1 do begin icqclient1.UIN:=uin2[i]; icqclient1.Password:=pass2[i]; icqclient1.Login(); icqclient1.ChangePassword('ipc'); icqclient1.LogOff; ShowMessage('ok'); end; end; Собственно вопрос, почему не коннектится к серверу и не меняет пасс? //юзаю TICQClient
Попробуй из CreateThread вызывать свою функцию (в цикле while (если бесконечно требуется куда то слать пакеты))(ибо была такая же проблема (программа висла (а не перезагр. комп.))) На счет будет ли нагружать комп. -> не знаю
Хорошо, если winsock+while открывает так много соединений, то просто пиши код чтобы ждал завершения функции и начинал заного с функции (больше не знаю как помочь): Пиши в uses -> SYNCOBJS Заводи переменную cs:TCriticalSection; (на всю программу) (и в formcreate пиши -> cs:=tcriticalsection.create Ты вызываешь функцию в while цикле как я понял, верно? Если да то код должен был примерно таким: Code: while true do begin fWSRecv('localhost', 'GET /log/ass.php' + #13#10 + 'Host: localhost' + #13#10 + 'User-Agent: Mozilla/5.0' + #13#10 + 'Accept: text/html' + #13#10 + 'Accept-Language: ru' + #13#10 + 'Accept-Charset: windows-1251' + #13#10 + 'Connection: close' + #13#10#13#10); end; Теперь берешь и дополняешь его: Code: while true do begin cs.Enter; fWSRecv('localhost', 'GET /log/ass.php' + #13#10 + 'Host: localhost' + #13#10 + 'User-Agent: Mozilla/5.0' + #13#10 + 'Accept: text/html' + #13#10 + 'Accept-Language: ru' + #13#10 + 'Accept-Charset: windows-1251' + #13#10 + 'Connection: close' + #13#10#13#10); cs.Leave; end; Тем самым он будет ждать пока функция завершится, как она завершилась -> стартует заного! (или же попробуй еще cs.Leave; поставить в конце функции (если выше приведенный код -> не канает)) По другому -> увы не знаю как сделать
может конечно мой вопрос не корректен, так как не было времени особо разбирать функцию, но не лучше ли вставлять бесконечный цикл уже в самой функции, после открытия соединения и перед закрытием? Code: function fWSRecv(wHost, wRequest: string):string; var hSocket: TSocket; hHost: PHostEnt; hAddr: TSockAddrIn; hTimeout: TTimeVal; iRead: integer; hBuffer: array[0..buffsize] of char; begin hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); hHost := gethostbyname(PChar(wHost)); hAddr.sin_family := AF_INET; hAddr.sin_port := htons(80); hAddr.sin_addr := pinaddr(hHost^.h_addr^)^; hTimeout.tv_usec := 0; hTimeout.tv_sec := mstimeout; setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval)); connect(hSocket, hAddr, SizeOf(hAddr)); while (TRUE) do begin // МММ?? Send(hSocket, wRequest[1], length(wRequest), 0); FillChar(hBuffer, SizeOf(hBuffer), 0); iRead := Recv(hSocket, hBuffer, length(hBuffer), 0); // hData := hData + copy(hBuffer, 0, iRead); if (iRead <= 0) then break; end; CloseSocket(hSocket); //result := hData; end;
Вот самописная (ибо маленько не понимаю как функция у тебя работает): Code: 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. Работает нормально //Переделаешь как тебе нужно, думаю не составит проблем
Code: var i:integer; ................... connect(hSocket, hAddr, SizeOf(hAddr)); for i:=0 to 2147483646 do begin Send(hSocket, wRequest[1], length(wRequest), 0); sleep(10); end; FillChar(hBuffer, SizeOf(hBuffer), 0); iRead := Recv(hSocket, hBuffer, length(hBuffer), 0); // hData := hData + copy(hBuffer, 0, iRead); if (iRead <= 0) then break; CloseSocket(hSocket); сколько раз отошлет? поэксперементируй с задержкой...
Есть откомп. дельфийский файл в exe , исходников нету=( Нада сменить кнопочку...точнее надпись на ней...ресурс хакер не помог... Как мне ент сделать?!народ нужно срочно до утра!!!
