Текущий архив: 2007.04.15;
Скачать: CL | DM;
Вниз
Прибежали в избу дети, Второпях зовут отца... Найти похожие ветки
← →
ProgRAMmer Dimonych © (2007-03-18 14:21) [0]Тятя, тятя, наши сети
Притащили мертвеца... :(
А как вообще правильно подключиться к своему сайту и выхватить результат выполнения скрипта в своей программе? Пробовал через Inet API, но InternetOpenURL возвращает nil.
Заранее спс.
← →
antonn © (2007-03-18 14:49) [1]по реке плывет кирпич
волосатый как стекло.
ну и пусть себе плывет,
на не нужен пенопласт.
что бы проверить наличие файла на диске, воспользуйся функцией fileexists()
← →
Юрий © (2007-03-18 14:53) [2]Плохо пробовал.
procedure TMainForm.LoadData;
var
hHttpSession, hReqUrl: HINTERNET;
buffer: array [1..1023] of char;
nRead: cardinal;
strRead: string;
begin
if (edUrl.Text = "") then exit;
strRead := "";
hHttpSession := InternetOpen("IE", INTERNET_OPEN_TYPE_PRECONFIG, NIL, NIL, 0);
try
hReqUrl := InternetOpenUrl(hHttpSession, PChar(AUrl), NIL, 0, 0, 0);
try
repeat
InternetReadFile(hReqUrl, @buffer, sizeof(buffer), nRead);
strRead := strRead + string(buffer);
until nRead = 0;
finally
InternetCloseHandle(hReqUrl);
end;
finally
InternetCloseHandle(hHttpSession);
end;
Memo.Text := strRead;
end;
← →
Юрий © (2007-03-18 14:54) [3]> [2] Юрий © (18.03.07 14:53)
Строчку уберёшь.if (edUrl.Text = "") then exit;
← →
ProgRAMmer Dimonych © (2007-03-18 14:55) [4]Хм, заработало. Осталось только одну проблему решить, но она уже связана с HTTP... Спасибо.
← →
ProgRAMmer Dimonych © (2007-03-18 15:15) [5]А может и не совсем с HTTP... :(
Проблема в том, что к php-скрипту я добавил вывод информации о броузере. Вот так...
<?
$Browser=$_SERVER["HTTP_USER_AGENT"];
echo("<HTML>\r\n");
echo(" <HEAD>\r\n");
echo(" <TITLE>\r\n");
echo(" Здесь чего-нибудь\r\n");
echo(" </TITLE>\r\n");
echo(" </HEAD>\r\n");
echo(" <BODY>\r\n");
echo(" ".$Browser."\r\n");
echo(" </BODY>\r\n");
echo("</HTML>");
?>
Но при повторной загрузке страницы с этого адреса программа возвращает то, что было...
<HTML>
<HEAD>
<TITLE>
Здесь чего-нибудь
</TITLE>
</HEAD>
<BODY>
</BODY>
</HTML>
Пробовал флаги INTERNET_FLAG_DONT_CACHE, INTERNET_FLAG_PRAGMA_NOCACHE и т.п. - не помогло...
← →
clickmaker © (2007-03-18 15:20) [6]<head>
...
<meta http-equiv="Pragma" content="no-cache" />
<meta http-equiv="Cache-Control" content="no-cache, must-revalidate" />
</head>
оно?
← →
ProgRAMmer Dimonych © (2007-03-18 17:56) [7]> clickmaker © (18.03.07 15:20) [6]
Не получилось. Видно, ещё что-то есть...
Код PHP-скрипта такой...
<?
$Browser=$_SERVER["HTTP_USER_AGENT"];
echo("<HTML>\r\n");
echo(" <HEAD>\r\n");
echo(" <TITLE>\r\n");
echo(" Текст\r\n");
echo(" </TITLE>\r\n");
echo(" <META HTTP-EQUIV=\"Pragma\" CONTENT=\"no-cache\" />\r\n");
echo(" <META HTTP-EQUIV=\"Cache-Control\" CONTENT=\"no-cache, must-revalidate\" />\r\n");
echo(" </HEAD>\r\n");
echo(" <BODY>\r\n");
echo(" ".$Browser."\r\n");
echo(" </BODY>\r\n");
echo("</HTML>");
?>
В броузере всё нормально отображает.
Код процедуры...
procedure TForm1.Button1Click(Sender: TObject);
var
Internet,Forum:HINTERNET;
Buffer:array [0..1023] of Char;
BytesRead:Cardinal;
Res:ANSIString;
begin
Internet:=InternetOpen("Some Program",0,nil,nil,0);
try
Forum:=InternetOpenURL(Internet,"http://www.SomeSite.com/SomeScript.php","",0,INTERNET_FLAG_EXISTING_CONNECT or INTERNET_FLAG_RELOAD,0);
try
Res:="";
while True do
begin
ZeroMemory(@Buffer,SizeOf(Buffer));
InternetReadFile(Forum,@Buffer,SizeOf(Buffer),BytesRead);
if BytesRead=0 then Break;
Res:=Res+Buffer;
end;
finally
InternetCloseHandle(Forum);
end;
finally
InternetCloseHandle(Internet);
end;
Res:=Copy(Res,1,Pos("</HTML>",Res)+6);
Memo.Lines.Add(Res);
end;
Чего здесь может быть не так?
← →
clickmaker © (2007-03-18 18:10) [8]
> [7] ProgRAMmer Dimonych © (18.03.07 17:56)
а точно у тебя этот $browser на серверной стороне заполняется?
если в body просто текст вставить - вернет?
← →
ProgRAMmer Dimonych © (2007-03-18 21:38) [9]> clickmaker © (18.03.07 18:10) [8]
Скрипт нормально отображается в броузере (GreenBrowser, на движке IE).
← →
ProgRAMmer Dimonych © (2007-03-18 21:38) [10]P.S. Не скрипт, а результат его работы.
← →
clickmaker © (2007-03-19 10:26) [11]
> [10] ProgRAMmer Dimonych © (18.03.07 21:38)
ну то есть если написать
echo(" <BODY>\r\n");
echo(" Типа тело\r\n");
echo(" </BODY>\r\n");
то вернет
</HEAD>
<BODY>
Типа тело
</BODY>
</HTML>
?
← →
ProgRAMmer Dimonych © (2007-03-19 15:11) [12]> clickmaker © (19.03.07 10:26) [11]
> > [10] ProgRAMmer Dimonych © (18.03.07 21:38)
> ну то есть если написать
> echo(" <BODY>\r\n");
> echo(" Типа тело\r\n");
> echo(" </BODY>\r\n");
> то вернет
> </HEAD>
> <BODY>
> Типа тело
> </BODY>
> </HTML>
> ?
Ну, да. Только для приведённого в цитате фрагмента (3 echo) никаких HEAD"ов не будет :). А вообще, да: возвращает то, что там указано.
← →
ProgRAMmer Dimonych © (2007-03-19 15:34) [13]Самое забавное, что в вышеприведённом коде на Дельфи переменная Forum после попытки соединения равна nil.
← →
ProgRAMmer Dimonych © (2007-03-19 16:30) [14]> ProgRAMmer Dimonych © (19.03.07 15:34) [13]
Последнее устранил, вроде работает. Но только, кажется, кеширует где-то результат соединения :(
Убрал www после http:// - заработало (хотя хостер предлагает адрес с и без www одновременно). Потом исправил скрипт так, чтобы вывод информации о пользователе ($Browser) происходил не один, а три раза. Программа принимает только 1.
Как можно отрубить этот долбаный кэш? Флаг INTERNET_FLAG_RELOAD при вызове InternetOpenURL используется.
← →
clickmaker © (2007-03-19 17:30) [15]
> [14] ProgRAMmer Dimonych © (19.03.07 16:30)
даже любопытно стало... попробовал у себя.
Вот кодprocedure TForm1.Button1Click(Sender: TObject);
var
Internet,Forum:HINTERNET;
Buffer:array [0..1023] of Char;
BytesRead:Cardinal;
Res:ANSIString;
begin
Internet:=InternetOpen("Some Program",INTERNET_OPEN_TYPE_PRECONFIG,
nil,nil,0);
try
Forum:=InternetOpenURL(Internet,"http://relaxander.webest.net/somescript.php","",0,0,0);
try
Res:="";
while True do
begin
ZeroMemory(@Buffer,SizeOf(Buffer));
InternetReadFile(Forum,@Buffer,SizeOf(Buffer),BytesRead);
if BytesRead=0 then Break;
Res:=Res+Buffer;
end;
finally
InternetCloseHandle(Forum);
end;
finally
InternetCloseHandle(Internet);
end;
Res:=Copy(Res,1,Pos("</HTML>",Res)+6);
Memo1.Lines.Add(Res);
end;
Вот результат
<HTML>
<HEAD>
<TITLE>
Текст
</TITLE>
<META HTTP-EQUIV="Pragma" CONTENT="no-cache" />
<META HTTP-EQUIV="Cache-Control" CONTENT="no-cache, must-revalidate" />
</HEAD>
<BODY>
Some Program
</BODY>
</HTML>
← →
clickmaker © (2007-03-19 17:38) [16]забыл...
флаги INTERNET_FLAG_HYPERLINK or INTERNET_FLAG_RELOAD
INTERNET_FLAG_EXISTING_CONNECT - это больше для ФТП
← →
ProgRAMmer Dimonych © (2007-03-20 00:20) [17]> clickmaker © (19.03.07 17:38) [16]
> забыл...
> флаги INTERNET_FLAG_HYPERLINK or INTERNET_FLAG_RELOAD
> INTERNET_FLAG_EXISTING_CONNECT - это больше для ФТП
Уже готов был радоваться, но... после одной нормальной загрузки снова выводит одно и то же.
Код...
Internet:=InternetOpen("Grace Forum Viewer",0,nil,nil,0);
if Assigned(Internet) then
begin
Forum:=InternetOpenURL(Internet,"http://www.grace.ueuo.com/forum.php",nil,0,INTERNET_FLAG_HYPERLINK or INTERNET_FLAG_RELOAD,0);
MessageBox(Form1.Handle,PChar(GetErrorText(False)),"",64);
if Assigned(Forum) then
begin
Res:="";
while True do
begin
ZeroMemory(@Buffer,SizeOf(Buffer));
InternetReadFile(Forum,@Buffer,SizeOf(Buffer),BytesRead);
if BytesRead=0 then Break;
Res:=Res+Buffer;
end;
end;
InternetCloseHandle(Forum);
end;
InternetCloseHandle(Internet);
Res:=Copy(Res,1,Pos("</HTML>",Res)+6);
Memo.Lines.Add(Res);
Кэш, похоже, не хочет отрубаться :(
← →
Пиит (2007-03-20 04:59) [18]
> Прибежали в избу дети,
> Второпях зовут отца...
> Тятя, тятя, наши сети
> Притащили ...
... подлеца.
← →
clickmaker © (2007-03-20 12:02) [19]
> [17] ProgRAMmer Dimonych © (20.03.07 00:20)
у меня натурально работает...
меняю user agent в InternetOpen - возвращает каждый раз новый
← →
ProgRAMmer Dimonych © (2007-03-20 14:58) [20]> clickmaker © (20.03.07 12:02) [19]
> > [17] ProgRAMmer Dimonych © (20.03.07 00:20)
> у меня натурально работает...
> меняю user agent в InternetOpen - возвращает каждый раз
> новый
С выделенного места поподробнее, если можно...
← →
VirEx © (2007-03-20 17:05) [21]function DelHttp(URL: String): String;
begin
if Pos("http://", URL) > 0 then Delete(Url, 1, 7);
Result := Copy(Url, 1, Pos("/", Url) - 1);
if Result = "" then Result := URL;
end;
function TForm1.GetUrl(const URL: String; Header, Content: string;
IsImage: boolean; ImageFileName: string): String;
var
FSession, FConnect, FRequest: HINTERNET;
FHost, FScript: String;
Buff: array [0..1023] of byte;
BytesRead: Cardinal;
f: File;
begin
Result := "";
// Небольшой парсинг
// вытаскиваем имя хоста и параметры обращения к скрипту
FHost := DelHttp(Url);
FScript := Url;
Delete(FScript, 1, Pos(FHost, FScript) + Length(FHost));
// Инициализируем WinInet
form1.StatusBar1.SimpleText:="Инициализация подключения...";
//X это по умолчанию "юзер агент"
FSession := InternetOpen("X", INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if not Assigned(FSession) then begin
form1.StatusBar1.SimpleText:="Ошибка инициализации подключения";
Exit;
end;
try
// Попытка соединения с сервером
form1.StatusBar1.SimpleText:="Соедиенние с сервером...";
FConnect := InternetConnect(FSession, PChar(FHost), 80, nil, "HTTP/1.0", INTERNET_SERVICE_HTTP, 0, 0);
if not Assigned(FConnect) then begin
form1.StatusBar1.SimpleText:="Ошибка подключения к серверу";
Exit;
end;
try
// Подготавливаем запрос страницы
if IsImage then
FRequest := HttpOpenRequest(FConnect, "GET", PChar(FScript), "HTTP/1.1", "", nil, INTERNET_FLAG_RELOAD, 0)
else
FRequest := HttpOpenRequest(FConnect, "POST", PChar(FScript), "HTTP/1.1", "", nil, INTERNET_FLAG_RELOAD, 0);
if not Assigned(FConnect) then Exit;
try
// Добавляем заголовки
// вот здесь перезаписывается заголовок - Head, и юзер агент
if not (HttpAddRequestHeaders(FRequest, PChar(Header), Length(Header), HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD)) then Exit;
// Отправляем запрос
form1.StatusBar1.SimpleText:="Отправка запроса...";
if not (HttpSendRequest(FRequest, nil, 0, PChar(Content), Length(Content))) then begin
form1.StatusBar1.SimpleText:="Ошибка отправки запроса";
Exit;
end;
// Получаем ответ
FillChar(Buff, SizeOf(Buff), 0);
if IsImage then begin
assignfile(f,ImageFileName{"1.jpg"});
try
Rewrite(F,1);
except
if messagebox(form1.handle,"файл невозможно записать, продолжить?","ОшЫбка!",MB_YESNO or MB_ICONHAND)=ID_NO then begin
InternetCloseHandle(FRequest);
InternetCloseHandle(FConnect);
InternetCloseHandle(FSession);
ExitProcess(1);
end else begin
InternetCloseHandle(FRequest);
InternetCloseHandle(FConnect);
InternetCloseHandle(FSession);
form1.StatusBar1.SimpleText:="Загрузка прервана";
exit;
end
end;
form1.ProgressBar1.Max:=2383;
form1.StatusBar1.SimpleText:="Получение изображения...";
repeat
application.ProcessMessages;
//FillChar(Buff, SizeOf(Buff), 0);
InternetReadFile(FRequest, @Buff, SizeOf(Buff), BytesRead);
BlockWrite(F, Buff, BytesRead);
form1.ProgressBar1.Position:=BytesRead;
//inc(BytesIn,BytesRead); //<-- увеличиваем счетчик
until BytesRead = 0;
CloseFile(F);
form1.StatusBar1.SimpleText:="Изображение получено, вводите символы";
end else begin
form1.StatusBar1.SimpleText:="Загрузка данных...";
repeat
Result := Result + PChar(@Buff);
FillChar(Buff, SizeOf(Buff), 0);
InternetReadFile(FRequest, @Buff, SizeOf(Buff), BytesRead);
//inc(BytesIn,BytesRead); //<-- увеличиваем счетчик
until BytesRead = 0;
form1.StatusBar1.SimpleText:="Данные загружены";
end;
finally
InternetCloseHandle(FRequest);
end;
finally
InternetCloseHandle(FConnect);
end;
finally
InternetCloseHandle(FSession);
end;
end;
procedure Exec;
var
s,msg:string;
FindData: _WIN32_FIND_DATAA;
h:THandle;
Header:string;
begin
case Identification of
mOpera9:Header:=Opera9Header;
mIE6 :Header:=IE6Header;
end;
//загружаем контент
s:=form1.GetUrl("http://site.com",Header,"",false,"");
//загружаем картинку
form1.GetUrl("http://site.com/image.jpg",Header,"",true,"1.jpg");//урл картинки
GetCurrentDirectory(259,PChar(s));
h:=FindFirstFile(PChar(s+"1.jpeg"), FindData);
if h<>INVALID_HANDLE_VALUE then begin
try
g.LoadFromFile("1.jpg");
//файл пустой длины, избежание ошибки EJpeg #42
if g.Height+g.Width>2 then form1.Image1.Picture.Assign(g);
except
form1.StatusBar1.SimpleText:="Ошибка, перезапустите";
end;
end else form1.StatusBar1.SimpleText:="Ошибка загрузки изображения, перезапустите";
SuspendThread(t);
TerminateThread(t,DETACHED_PROCESS);
CloseHandle(t);
end;
//кнопочка "load" :)
procedure TForm1.Button1Click(Sender: TObject);
begin
if t=0 then begin
form1.StatusBar1.SimpleText:="Старт...";
t:=CreateThread(nil,0,@Exec,nil,IDLE_PRIORITY_CLASS{CREATE_SUSPENDED},tId)
end else begin
form1.StatusBar1.SimpleText:="Перезапуск...";
SuspendThread(t);
TerminateThread(t,DETACHED_PROCESS);
CloseHandle(t);
t:=CreateThread(nil,0,@Exec,nil,IDLE_PRIORITY_CLASS{CREATE_SUSPENDED},tId)
end;
end;
← →
VirEx © (2007-03-20 17:07) [22]вот еще, заголовки оперы и ИЕ
Opera9Header="User-Agent: Opera/9.00 (Windows NT 5.1; U; ru)"#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+
"Connection: Keep-Alive, TE"#13#10+
"TE: deflate, gzip, chunked, identity, trailers"#13#10+
"Content-Type: application/x-www-form-urlencoded ";
IE6Header="Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*"#13#10+
"Accept-Language: ru"#13#10+
"Content-Type: application/x-www-form-urlencoded"#13#10+
"Accept-Encoding: gzip, deflate"#13#10+
"User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"#13#10+
"Connection: Keep-Alive"#13#10+
"Cache-Control: no-cache";
Страницы: 1 вся ветка
Текущий архив: 2007.04.15;
Скачать: CL | DM;
Память: 0.54 MB
Время: 0.033 c
