delphi idhttp Пост связанный вопрос - PullRequest
Новая
       25

delphi idhttp Пост связанный вопрос

0 голосов
/ 20 мая 2010

я новичок в Delphi. а также почти новичок в мире программирования.

Я сделал несколько простых программ, использующих модуль idhttp.

но когда он выполняется, он не работает правильно.

эта простая программа проверяет статус моего аккаунта.

при успешном входе в аккаунт возвращается исходный код, включающий 'top.location ='

в источнике, и если вход в систему не удался, возвращение не включено 'top.location ='

внутри account.txt является следующим первым, а третий аккаунт был живым аккаунтом

но может проверить только первый аккаунт, после первого аккаунта другой аккаунт не может проверить

Понятия не имею, что с ним не так

ph896011 pk1089

fsadfasdf dddddss

ph896011 pk1089

следующие источники delphi

Если кто-нибудь поможет мне очень ценится!

единица измерения Unit1; 

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    IdCookieManager1: TIdCookieManager;
    lstAcct: TListBox;
    result: TLabel;
    Edit1: TEdit;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    //procedure FormCreate(Sender: TObject);
    //procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    AccList: TStringList;
    IdCookie: TIdCookieManager;
    CookieList: TList;
    StartCnt: Integer;
    InputCnt: Integer;
    WordList: TStringList;
    WordNoList: TStringList;
    WordCntList: TStringList;
    StartTime: TDateTime;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var

  i: Integer;
  //temp: String;
  lsttemp: TStringList;
  sl : tstringlist;
  //userId,userPass: string;
begin
  InputCnt:= 0;
  WordList := TStringList.Create;
  CookieList := TList.create;
  IdCookie := TIdCookieManager.Create(self);


  if FileExists(ExtractFilePath(Application.ExeName) + 'account.txt') then
    WordList.LoadFromFile(ExtractFilePath(Application.ExeName) + 'account.txt');

  WordNoList:= TStringList.Create;
  WordCntList := TStringList.Create;
  lsttemp := TStringList.create;
  sl :=Tstringlist.Create;
try
  try
    for i := 0  to  WordList.Count -1 do
    begin
      ExtractStrings([' '], [' '], pchar(WordList[i]), lsttemp);
      WordNoList.add(lsttemp[0]);
      //ShowMessage(lsttemp[0]);
      WordCntList.add(lsttemp[1]);
      //ShowMessage(lsttemp[1]);

      sl.Add('ID='+ lsttemp[0]);
      sl.add('PWD=' + lsttemp[1]);
      sl.add('SECCHK=0');
      IdHTTP1.HandleRedirects := True;
      IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
      memo1.Text:=idhttp1.Post('http://user.buddybuddy.co.kr/Login/Login.asp',sl);

      if pos('top.location =',Memo1.Text)> 0 then

       begin
        application.ProcessMessages;
       ShowMessage('Alive Acc!');
        //result.Caption := 'alive acc'  ;
        sleep(1000);
        Edit1.Text := 'alive acc';
        lsttemp.Clear;
        Memo1.Text := '';
        //memo1.Text := IdHTTP1.Get('https://user.buddybuddy.co.kr/Login/Logout.asp');
        Sleep(1000);
       end;


      if pos('top.location =', memo1.Text) <> 1 then

      begin
      application.ProcessMessages;
      ShowMessage('bad');
      Edit1.Text := 'bad';
      //edit1.Text := 'bad';
      lsttemp.Clear;
      memo1.Text := '';
      sleep(1000) ;
      end;
      Edit1.Text := '';
    end;

  finally
    lsttemp.free;
  end;
  StartCnt := lstAcct.items.Count;
  StartTime := Now;

finally
  sl.Free;
end;
end;



end.

1 Ответ

2 голосов
/ 20 мая 2010

Прямо перед: 

sl.Add('ID='+ lsttemp[0]);

Do: 

sl.Clear;

При первом запуске ваш "SL" содержит два параметра POST, но если вы не очистите его во втором запуске, вы просто продолжите добавлять параметры, что приведет к путанице с сервером HTTP, к которому вы пытаетесь подключиться!

Возможно, это не единственная ваша проблема, но это, безусловно, одна из проблем.

...