[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by banned, 6 May 2007.

Thread Status:
Not open for further replies.
Page 197 of 489
  1. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Как при помощи IdHTTP получить куки при авторизации на сайте Post запросом, а потом их отправить вместе с другим пост запросом???
     
    #3921 НTL, 17 Aug 2009
  2. cremator (c)

    cremator (c) Elder - Старейшина

    Joined:
    20 Jun 2008
    Messages:
    258
    Likes Received:
    72
    Reputations:
    0
    Вот пример авторизации в LJ
    Code:
    procedure TForm1.Button1Click(Sender: TObject);
var
  Http  : TidHttp;
  CM    : TidCookieManager;
  Data  : TStringList;
  StrPage, UserID,  UserName  :  String;
  i : integer;
begin
  try
    Http := TIdHTTP.Create(Self);
    Data := TStringList.Create;
    CM := TidCookieManager.Create(Http);
    Http.AllowCookies := true;
    Http.CookieManager := CM;
    Http.HandleRedirects := true;

    Http.Request.Host:='livejournal.com';
    Http.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 Firefox/3.0.10';
    Http.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
    Http.Request.AcceptLanguage:='ru,en-us;q=0.7,en;q=0.3';
    Http.Request.AcceptCharSet:='windows-1251,utf-8;q=0.7,*;q=0.7';
    Http.Request.Referer:='http://www.livejournal.com/';

    Data.Add('mode=login');
    Data.Add('user=Qwerty');
    Data.Add('password=PASS');
    StrPage := Http.Post('http://www.livejournal.com/login.bml?ret=1', Data);
  finally
    Data.Free;
    CM.Free;
    Http.Free;
  end;

  if Pos('<input class="logoutlj_hidden" id="user" name="user" type="hidden" value="'+Qwerty,StrPage) <> 0 then
    ShowMessage('Авторизация прошла успешно')
  else
    ShowMessage('Авторизация провалилась');

  Memo1.Lines.Text := StrPage;
end;

    Возвращенные заголовки (после ответа сервера) можно посмотреть так:

    idHttp.Response.RawHeaders.GetText;


    Сохраненные в CookieManager-е кукисы можно посмотреть так:

    Code:
    for i := 0 to Http.CookieManager.CookieCollection.Count - 1 do
  StrPage := StrPage + CM.CookieCollection.Items[i].CookieText + #13#10;
     
    #3922 cremator (c), 17 Aug 2009
    Last edited: 17 Aug 2009
    1 person likes this.
  3. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    cremator (c), ну вот я авторизировался, получил куки, а как эти куки передать в другом пост запросе, что-то до меня не дошло
     
    #3923 НTL, 17 Aug 2009
  4. cremator (c)

    cremator (c) Elder - Старейшина

    Joined:
    20 Jun 2008
    Messages:
    258
    Likes Received:
    72
    Reputations:
    0
    Эти куку сохраняет сам IdHttp. Http.AllowCookies := true; - значит все последующие запросы будут уходить с этими куками, которые он получил
     
    #3924 cremator (c), 17 Aug 2009
  5. s.p.a.m

    s.p.a.m Banned

    Joined:
    26 Jan 2009
    Messages:
    6
    Likes Received:
    2
    Reputations:
    0
    Как мне с помощью indy зайти на сайт со своими куками?
     
    #3925 s.p.a.m, 17 Aug 2009
  6. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Code:
    unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdCookieManager, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, ComCtrls;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdCookieManager1: TIdCookieManager;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Http  : TidHttp;
  CM    : TidCookieManager;
  Data, params  : TStringList;
  StrPage, UserID,  UserName  :  String;
  i : integer;
begin
  try
    Http := TIdHTTP.Create(Self);
    Data:= TStringList.Create;
    CM := TidCookieManager.Create(Http);
    Http.AllowCookies := true;
    Http.CookieManager := CM;
    Http.HandleRedirects := true;

    Http.Request.Host:=' testhtl.ucoz.ru';
    Http.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 Firefox/3.0.10';
    Http.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
    Http.Request.AcceptLanguage:='ru,en-us;q=0.7,en;q=0.3';
    Http.Request.AcceptCharSet:='windows-1251,utf-8;q=0.7,*;q=0.7';
    Http.Request.Referer:='http://testhtl.ucoz.ru/';

    Data.Add('user=qqq');
    Data.Add('password=123456');
    Data.Add('a=2');
    StrPage := Http.Post('http://testhtl.ucoz.ru/index/sub/', Data);

params:=TStringList.Create;
params.Add(AnsiToUTF8('uname=ывапыва'));
params.Add(AnsiToUTF8('message=ывпыва'));
params.Add(AnsiToUTF8('url=ваыпыва'));
params.Add('s=566012520275405242056');
params.Add('a=8');
IdHTTP1.Post('http://testhtl.ucoz.ru/mchat/', params);
  finally
    Data.Free;
    CM.Free;
    Http.Free;
  end;
 Memo1.Lines.Text := StrPage;
end;

end.
    Пост уходит без куков, в IdHTTP куки включёны, если бы куки в посте уходили то имя в чате было бы кликабельным

    ( Если сообщения в чате не добавляются то надо обновить s=566012520275405242056 , из исходнова кода странички http://testhtl.ucoz.ru/mchat/ )
     
    #3926 НTL, 17 Aug 2009
  7. cremator (c)

    cremator (c) Elder - Старейшина

    Joined:
    20 Jun 2008
    Messages:
    258
    Likes Received:
    72
    Reputations:
    0
    Что-то ты всё понаперепутал:D
    Куки у тебя сохранились в Http, а запрос ты делаешь через новый(с формы, одного TIdHttp показалось мало?))) IdHTTP1, в котором от родясь куков не было))
     
    #3927 cremator (c), 17 Aug 2009
  8. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Даже при замене на
    Code:
    Http.Post('http://testhtl.ucoz.ru/mchat/', params);
    Куки не уходят
     
    #3928 НTL, 17 Aug 2009
  9. cremator (c)

    cremator (c) Elder - Старейшина

    Joined:
    20 Jun 2008
    Messages:
    258
    Likes Received:
    72
    Reputations:
    0
    Вся проблема в корявых индейцах.. Они не принимают печеньки этого сайта..! После 2х часового исследования так и не понял в чём дело:D
     
    #3929 cremator (c), 18 Aug 2009
  10. slesh

    slesh Elder - Старейшина

    Joined:
    5 Mar 2007
    Messages:
    2,702
    Likes Received:
    1,224
    Reputations:
    455
    Еще дело усложняется, когда куки не одной строкой а, не сколько строк. бывают случае что идут куки, потом другие спец поля, а потом опять куки - вот это полный П.
    Особенно когда вторые перекрывают первые (т.е. переменные одинаковые, а значения разные)
     
    #3930 slesh, 18 Aug 2009
  11. BlackSilver

    BlackSilver New Member

    Joined:
    30 Jan 2009
    Messages:
    28
    Likes Received:
    4
    Reputations:
    0
    Вопрос
    При создании пытаюсь поменять свойство панели pCover.Align вот так
    Code:
    pCover.Align := alClient;
    При компиляции выдаёт ошибку "Incompatible types: 'Controls.TAlign' and 'uDocsReg.TAlign'". uDocsReg - это модуль, в котором строка.
    И, да, TAlign я нигде не обьявлял.
     
    #3931 BlackSilver, 18 Aug 2009
  12. cremator (c)

    cremator (c) Elder - Старейшина

    Joined:
    20 Jun 2008
    Messages:
    258
    Likes Received:
    72
    Reputations:
    0
    Возможно ты переопределил тип TAlign в своём модуле.. Кинь весь код, так не разобраться
     
    #3932 cremator (c), 18 Aug 2009
  13. slesh

    slesh Elder - Старейшина

    Joined:
    5 Mar 2007
    Messages:
    2,702
    Likes Received:
    1,224
    Reputations:
    455
    в файле Сontrols.pas описан этот тип
    TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient, alCustom);
    так что попробуй явно описать откуда брать
    pCover.Align := Controls.alClient;
    или
    pCover.Align := uDocsReg.alClient;
     
    #3933 slesh, 18 Aug 2009
  14. slesh

    slesh Elder - Старейшина

    Joined:
    5 Mar 2007
    Messages:
    2,702
    Likes Received:
    1,224
    Reputations:
    455
    Есть разные компоненты связанные с HTTP
    WinInet - пашет везде. Потому что это стандартная либа, которую придумали тогда когда фреймворка еще в задумках небыло.
    Delphi 7 - FW - врядли. Для этих целей есть BDS. Хотя вроде с D8 уже тянется FW
     
    #3934 slesh, 18 Aug 2009
  15. BlackSilver

    BlackSilver New Member

    Joined:
    30 Jan 2009
    Messages:
    28
    Likes Received:
    4
    Reputations:
    0
    2cremator:
    Внимательнее читай последнее предложение.

    Code:
    unit uDocsReg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, cxGraphics, cxCustomData, cxStyles, cxTL, cxTextEdit,
  cxInplaceContainer, cxControls, uDocsTreeMan, StdCtrls, ShlObj, QControls,
  cxShellCommon, cxContainer, cxShellListView, cxListView, cxMCListBox,
  cxEdit, cxCurrencyEdit, cxMaskEdit, cxSpinEdit, cxTimeEdit, uDBRecordsMan,
  cxDropDownEdit, cxCalendar, ExtCtrls, cxLabel, uObjOperationObject,
  uNewObjOperation, uConfig, Buttons, uFrDoc;

type
  TfDocsReg = class(TForm)
    bRefresh: TButton;
    DocsTree: TTreeView;
    pEdit: TPanel;
    bUpdate: TButton;
    cxLabel2: TcxLabel;
    bAdd: TButton;
    bDelete: TButton;
    frDoc: TfrDoc;
    pCover: TPanel;
    pObject: TPanel;
    lCoef: TcxLabel;
    cxLabel1: TcxLabel;
    cxLabel3: TcxLabel;
    cxLabel4: TcxLabel;
    procedure bRefreshClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DocsTreeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bUpdateClick(Sender: TObject);
    procedure bAddClick(Sender: TObject);
    procedure bDeleteClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure bCalcCostClick(Sender: TObject);
  private
    { Private declarations }
    procedure LoadEdits;
    procedure SetPanelEnabled( PanelNum: integer );

  public
    { Public declarations }
    procedure ShowDocs(FilterObjId: integer=-1);
    procedure ClearActiveOperation;

  end;

var
  fDocsReg: TfDocsReg;

implementation

{$R *.dfm}

procedure TfDocsReg.bRefreshClick(Sender: TObject);
begin
	DocsTreeMan.Refresh;
end;

procedure TfDocsReg.FormCreate(Sender: TObject);
begin
	DocsTreeMan := TDocsTreeMan.Create(DocsTree);
  ClearActiveOperation;
  //pCover.Align := alClient;
  //pObject.Align := alClient;
end;

procedure TfDocsReg.DocsTreeClick(Sender: TObject);
begin
	DBRecords.Release( frDoc.ActiveItem );
  frDoc.ActiveItem := DocsTreeMan.ActiveOperation;

  if frDoc.ActiveItem <> nil then
    SetPanelEnabled( 1 )
  else
    SetPanelEnabled( 0 );
end;

procedure TfDocsReg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
	DBRecords.Release( frDoc.ActiveItem );
  SavePosition(self);
end;

procedure TfDocsReg.bUpdateClick(Sender: TObject);
Var NewId: integer;
begin
  frDoc.SaveEdits;
  if frDoc.ActiveItem.IsNew then
  begin
  	NewId := frDoc.ActiveItem.Insert;
  	DBRecords.Release( frDoc.ActiveItem );
    ClearActiveOperation;
    DocsTreeMan.Refresh;
    DocsTreeMan.SelectNode( NewId );
    frDoc.ActiveItem := DBRecords.TakeObjOperation( NewId );
    SetPanelEnabled( 1 );
  end else
  begin
  	frDoc.ActiveItem.Update;
    DocsTreeMan.Refresh;
    DocsTreeMan.SelectNode( frDoc.ActiveItem.id );
  end;
end;

procedure TfDocsReg.bAddClick(Sender: TObject);
var NewOperation: TObjOperation;
begin
  if (frDoc.ActiveItem <> nil) and
     (frDoc.ActiveItem.id = -1) then
  begin
    DBRecords.Release( frDoc.ActiveItem );
    ClearActiveOperation;
  end;
  NewOperation := TObjOperation.New;
	if fNewObjOperation.ShowModal = mrOk then
  begin
    if (fNewObjOperation.cbDocs.EditValue = Null) or
			 (fNewObjOperation.cbObjects.EditValue = Null) then
    begin
       Beep;
       NewOperation.Free;
       Exit;
    end;
  	NewOperation.SetField('id_doc', fNewObjOperation.cbDocs.EditValue);
  	NewOperation.SetField('id_object', fNewObjOperation.cbObjects.EditValue);
    DBRecords.Release( frDoc.ActiveItem );
    DBRecords.ObjOperations.Add( Pointer( NewOperation.id ), Pointer( NewOperation ) );
    frDoc.ActiveItem := NewOperation;
	  SetPanelEnabled( 1 );
  end else
  	NewOperation.Free;
end;

procedure TfDocsReg.LoadEdits;
begin
  frDoc.ActiveItem.Seize;
  frDoc.LoadEdits;

  pEdit.Enabled := true;
end;

procedure TfDocsReg.ShowDocs(FilterObjId: integer=-1);
begin
	DocsTreeMan.FilterObjId := FilterObjId;
  DocsTreeMan.Refresh;
	ShowModal;
end;

procedure TfDocsReg.bDeleteClick(Sender: TObject);
begin
  if frDoc.ActiveItem.Delete then
  begin
	  DocsTreeMan.Refresh;
  	ClearActiveOperation;
  end;
end;

procedure TfDocsReg.ClearActiveOperation;
begin
  frDoc.ActiveItem := nil;
  SetPanelEnabled( 0 );
end;

procedure TfDocsReg.FormShow(Sender: TObject);
begin
	LoadPosition(self);
end;

procedure TfDocsReg.bCalcCostClick(Sender: TObject);
begin
  frDoc.eCost.Value := TObjOperation( frDoc.ActiveItem ).CalcCost;
end;

procedure TfDocsReg.SetPanelEnabled( PanelNum: integer );
// Устанавливает видимую панель. При PanelNum =
// 0 - Заглушка
// 1 - Редактирование
begin
  pCover.Visible := (PanelNum = 0);
  if PanelNum = 1 then
    LoadEdits;
end;

end.
     
    #3935 BlackSilver, 18 Aug 2009
  16. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Обшарил 15 страниц гугла и не нашол толкова ответа как с помощью WinSock отправить пост запром, к примеру на mail.ru

    Help me...
     
    #3936 НTL, 18 Aug 2009
  17. wolmer

    wolmer Member

    Joined:
    12 May 2009
    Messages:
    438
    Likes Received:
    97
    Reputations:
    9
    http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1021
    http://www.delphikingdom.com/asp/viewitem.asp?catalogid=1060

    Если не разберешся, пиши в пм, кину сорцы простенькие
     
    #3937 wolmer, 18 Aug 2009
    2 people like this.
  18. slesh

    slesh Elder - Старейшина

    Joined:
    5 Mar 2007
    Messages:
    2,702
    Likes Received:
    1,224
    Reputations:
    455
    o_O тыбы еще искал в инете как регить пример x=2/0
    Кидаю кусок из первого моего бота который был писан в далёкие времена на Delphi
    Code:
     if WSAStartup($202, WSData)=-1 then exit;
 MyID:=Get_ID;
 reply:='';
 while true do
  begin
   ServIP:=GetIPAddress(server_host);
   post_data:='id='+MyID+'&reply='+reply;
   reply:='';
   sbuf:='POST '+server_script+' HTTP/1.0'#13#10+
         'Host: '+server_host+#13#10+
         'Content-Type: application/x-www-form-urlencoded'+#13#10+
         'Content-Length: '+inttostr(length(post_data))+#13#10#13#10+post_data+#13#10;
  if (send_packs(ServIP,server_port,sbuf,rbuf)>0) then
  begin
  rbuf содержит ответ сервера без служебных заголовков

  end;
......................
function GetIPAddress(name: string): string;
var
 p:PHostEnt;
begin
 p:=GetHostByName(PChar(name));
 if p=nil then result:=name else result:=inet_ntoa(PInAddr(p.h_addr_list^)^);
end;

procedure GetContend(var data:string);
begin
delete(data,1,pos(#13#10#13#10,data)+3);
end;

function send_packs(ip:string; port:word; send_buf:string; var recv_buf:string):integer;
var
 SockAddrIn:TSockAddrIn;
 tmp_buf:array [0..255] of char;
 len:longint;
 socket_id:LongWord;
begin
 result:=-10;
 socket_id:=socket(2, 1, 6);
 if socket_id=LongWord(-1) then exit;
 SockAddrIn.sin_family := 2;
 SockAddrIn.sin_port := htons(port);
 SockAddrIn.sin_addr.s_addr := inet_addr(Pansichar(ip));
 result:=-20;
 if connect(socket_id, @SockAddrIn, SizeOf(SockAddrIn))<>0 then
  begin
   closesocket(socket_id);
   exit;
  end;
 send(socket_id,send_buf[1],length(send_buf),0);
 recv_buf:='';
 repeat
  len:=recv(socket_id,tmp_buf,255,0);
  recv_buf:=recv_buf+copy(tmp_buf,1,len);
 until len<=0;
 GetContend(recv_buf);
 result:=length(recv_buf);
 closesocket(socket_id);
end;
     
    #3938 slesh, 19 Aug 2009
    1 person likes this.
  19. Uname-A

    Uname-A Elder - Старейшина

    Joined:
    19 Aug 2008
    Messages:
    73
    Likes Received:
    12
    Reputations:
    5
    приветствую всех!
    Есть компонент TLabel в нём большое кол-во текста
    Нужно сделать перенос текста не по словам как при WordWrap а по буквам
    Может быть есть аналог Tlabel где перенос идёт по буквам?
    Была идея после 99 (длинна одной строки) символа добавлять #13 Тоесть перенос Но это для меня не совсем подходит так как позже мне этот текст нужно будет удалять по 4 символа с начала...
    Очень надеюсь на вашу помощь
     
    #3939 Uname-A, 19 Aug 2009
  20. НTL

    НTL Elder - Старейшина

    Joined:
    26 Jan 2008
    Messages:
    715
    Likes Received:
    205
    Reputations:
    -26
    Такой вопрос:

    Есть 2 события:
    Например:
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

    как при нажатии на вторую кнопку выполнить все действия из обработчика первой кнопки?

    Про Ctrl+C , я знаю, но здесь это не очень актуально
     
    #3940 НTL, 19 Aug 2009
(You must log in or sign up to post here.)
Page 197 of 489
Thread Status:
Not open for further replies.
Language
English (US)
    ANTICHAT ™ © 2001-2027 Antichat Kft.