Модератор: Модераторы
HTTPSSL.SSLActive := DecomposeURL(HTTPServerURL+'client_update.php', aHost, aURI, aPort);
HTTPClient.Host := aHost;
HTTPClient.URI := aURI;
HTTPClient.Port := aPort;
HTTPClient.Method:=hmPost;
PostData:='login='+Login+'&password='+Password+'&port='+IntToStr(TCPServer.Port)+'&time='+FormatDateTime('yyyy"-"mm"-"dd hh":"nn":"ss',LocalTimeToGMT(Now));
HTTPClient.AddExtraHeader('Content-Type: application/x-www-form-urlencoded');
HTTPClient.AddExtraHeader('Content-Length: '+IntToStr(Length(PostData))+#13#10);
HTTPClient.AddExtraHeader(PostData);
HTTPClient.SendRequest;
Прости сразу не заметил. Спасибо за ответ.FedeX писал(а):Так там же есть стандартная демка.
unit unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Menus, ComCtrls, StdCtrls, ExtCtrls, Buttons, Windows, lNetComponents, lhttp, lNet, lHTTPUtil;
type
{ TForm1 }
TForm1 = class(TForm)
HTTPClient: TLHTTPClientComponent;
SSL: TLSSLSessionComponent;
MemoHTML: TMemo;
MemoStatus: TMemo;
TESTBUTON: TBitBtn;
procedure HTTPClientDisconnect(aSocket: TLSocket);
procedure HTTPClientDoneInput(ASocket: TLHTTPClientSocket);
procedure HTTPClientError(const msg: string; aSocket: TLSocket);
function HTTPClientInput(ASocket: TLHTTPClientSocket;ABuffer: pchar; ASize: integer): integer;
procedure HTTPClientProcessHeaders(ASocket: TLHTTPClientSocket);
procedure SSLSSLConnect(aSocket: TLSocket);
procedure TESTBUTONClick(Sender: TObject);
private
{ private declarations }
HTTPBuffer: string;
procedure AppendToMemo(aMemo: TMemo; const aText: string);
public
{ public declarations }
end;
var
Form1: TForm1;
Done: boolean;
implementation
{ TForm1 }
procedure TForm1.TESTBUTONClick(Sender: TObject);
var
retURL, email, password, URL: string;
aHost, aURI: string;
aPort: Word;
begin
MemoHTML.Text := '';
MemoStatus.Text := '';
HTTPBuffer := '';
SSL.SSLActive := DecomposeURL('http://www.yandex.ru/', aHost, aURI, aPort);
HTTPClient.Host := aHost;
HTTPClient.Method:=hmGet;
HTTPClient.URI := aURI;
HTTPClient.Port := aPort;
HTTPClient.SendRequest;
Done := false;
while not Done do HttpClient.CallAction; // C этой строкой повисает. Без неё TEST2.html будет пуст.
MemoHTML.Lines.SaveToFile('TEST2.html');
//*********************************************
URL:=MemoHTML.Text;
URL:=copy(URL,pos('Погода',URL),MaxInt);
URL:=copy(URL,pos('href="',URL)+6,pos('">',URL)-1-pos('href="',URL)-6);
MemoHTML.Text := '';
MemoStatus.Text := '';
HTTPBuffer := '';
SSL.SSLActive := DecomposeURL(URL, aHost, aURI, aPort);
HTTPClient.Host := aHost;
HTTPClient.Method:=hmGet;
HTTPClient.URI := aURI;
HTTPClient.Port := aPort;
HTTPClient.SendRequest;
Done := false;
end;
procedure TForm1.HTTPClientError(const msg: string; aSocket: TLSocket);
begin
MessageDlg(msg, mtError, [mbOK], 0);
end;
function TForm1.HTTPClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; ASize: integer): integer;
var
oldLength: dword;
begin
oldLength := Length(HTTPBuffer);
setlength(HTTPBuffer,oldLength + ASize);
move(ABuffer^,HTTPBuffer[oldLength + 1], ASize);
MemoHTML.Text := HTTPBuffer;
MemoHTML.SelStart := Length(HTTPBuffer);
AppendToMemo(MemoStatus, IntToStr(ASize) + '...');
Result := aSize;
end;
procedure TForm1.AppendToMemo(aMemo: TMemo; const aText: string);
begin
aMemo.Append(aText);
aMemo.SelStart := Length(aMemo.Text);
end;
procedure TForm1.HTTPClientProcessHeaders(ASocket: TLHTTPClientSocket);
begin
AppendToMemo(MemoStatus, 'Заголовок: ' + IntToStr(HTTPStatusCodes[ASocket.ResponseStatus]) +
' ' + ASocket.ResponseReason);
end;
procedure TForm1.SSLSSLConnect(aSocket: TLSocket);
begin
AppendToMemo(MemoStatus,'Подключение по TLS успешно,');
end;
procedure TForm1.HTTPClientDisconnect(aSocket: TLSocket);
begin
AppendToMemo(MemoStatus,'Отключаюсь');
done := true;
MemoHTML.Lines.SaveToFile('TEST1.html');
end;
procedure TForm1.HTTPClientDoneInput(ASocket: TLHTTPClientSocket);
begin
aSocket.Disconnect;
AppendToMemo(MemoStatus,'Завершено');
end;
initialization
{$I unit1.lrs}
end.
...
while not Done do
begin
HttpClient.CallAction;
Application.ProcessMessages;
end;
...
Sharfik писал(а):Другое дело как он это делает!
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6