Выкладываю сырцы свою старой утилиты - многопоточный UniversalBIDs чекер.

У нас в проекте всего 2 unit. Один для многопоточной обработки. И главный - для отображения потоков. Кто помнит, можно было определять цену бида для 3х ppc - Umax, Klick, Peack.

Я выложу как обычно код и дам небольшие комментарии.

Файл проекта.

program UniversalBIDs;

uses
Forms,
Main in 'Main.pas' {Form1},
threadHTTP in 'ThreadHTTP.pas';

{$R *.res}

begin
Application.Initialize;
Application.Title := 'UniversalBIDs';
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Файл настроек - gpda.ini.

[setup]
Threads = 10
UMAXaid =
KLIKaid =
Peackaid =

Главная форма.

unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Grids, ComCtrls, ExtCtrls, StdCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
LoadKeys1: TMenuItem;
Startcheck1: TMenuItem;
StringGrid1: TStringGrid;
OpenDialog1: TOpenDialog;
Savechecked1: TMenuItem;
Exit1: TMenuItem;
Panel1: TPanel;
Label1: TLabel;
procedure LoadKeys1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Startcheck1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Savechecked1Click(Sender: TObject);
procedure Stopcheck1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
private
{ Private declarations }
public
thrCount: Integer;
procedure ThreadDone(Sender: TObject);
end;

var
Form1: TForm1;

implementation
{$R *.dfm}
uses HTTPApp, ThreadHTTP, IniFiles, ShellAPI;

var
MaxThreads: Integer;
BreakParse: Boolean;
UMAXaid, KLIKaid, Peackaid: Integer;

procedure TForm1.ThreadDone(Sender: TObject);
begin
Dec(thrCount); // уменьшаем колво потоков
end;

procedure TForm1.LoadKeys1Click(Sender: TObject); // загрузка кеев
var
tmpK: TStrings;
i: integer;
begin
if OpenDialog1.Execute then
begin
tmpK := TStringList.Create;
tmpK.LoadFromFile(OpenDialog1.FileName);
StringGrid1.RowCount := tmpK.Count + 1;

for i := 0 to tmpK.Count - 1 do StringGrid1.Cells[0, i + 1] := tmpK.Strings[i];
tmpK.Free;
Startcheck1.Enabled := True;
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
StringGrid1.Cells[0, 0] := 'Keyword';
StringGrid1.Cells[1, 0] := 'UmaxMax';
StringGrid1.Cells[2, 0] := 'UmaxMin';
StringGrid1.Cells[3, 0] := 'KlickMax';
StringGrid1.Cells[4, 0] := 'KlickMin';
StringGrid1.Cells[5, 0] := 'PeackMaX';
StringGrid1.Cells[6, 0] := 'PeackMin';
thrCount := 0;
end;

procedure TForm1.Startcheck1Click(Sender: TObject); // начало проверки
var
i: integer;
begin
BreakParse := False;
i := 0;
while i <= StringGrid1.RowCount do
begin

with TGrabThread.Create(true) do // Umax
begin
while thrCount > MaxThreads do Application.ProcessMessages;
while (StringGrid1.Cells[0, i + 1] = '') and (i <= StringGrid1.RowCount) do
inc(i);
if BreakParse then Exit;
if i <= StringGrid1.RowCount then
begin
url := 'http://xml.umaxfeed.com/xmlfeed.php?aid=1&said' + IntToStr(UMAXaid) + '=&ip=69.161.77.90&q=' + HTTPEncode(StringGrid1.Cells[0, i + 1]) + '&ref=http://yahoo.com/&l=en';
index := i + 1;
tagID := 1;
FreeOnTerminate := true;
OnTerminate := ThreadDone;
inc(thrCount);
Resume;
end;
end;

with TGrabThread.Create(true) do // Klick
begin
while thrCount > MaxThreads do Application.ProcessMessages;
while (StringGrid1.Cells[0, i + 1] = '') and (i <= StringGrid1.RowCount) do
inc(i);
if BreakParse then Exit;
if i <= StringGrid1.RowCount then
begin
url := 'http://xml.klikvip.com/xml.php?aff=' + IntToStr(KLIKaid) + '&ip=200.109.45.38&q=' + HTTPEncode(StringGrid1.Cells[0, i + 1]) + '&ref=http://yahoo.com/&l=en&st=link&n=20';
index := i + 1;
tagID := 2;
FreeOnTerminate := true;
OnTerminate := ThreadDone;
inc(thrCount);
Resume;
end;
end;

with TGrabThread.Create(true) do // Peack
begin
while thrCount > MaxThreads do Application.ProcessMessages;
while (StringGrid1.Cells[0, i + 1] = '') and (i <= StringGrid1.RowCount) do
inc(i);
if BreakParse then Exit;
if i <= StringGrid1.RowCount then
begin
url := 'http://feed.peakclick.com/res.php?aff=' + IntToStr(Peackaid) + '&subaff=3&ip=200.109.45.38&keyword=' + HTTPEncode(StringGrid1.Cells[0, i + 1]) + '&num=15&xml=1';
index := i + 1;
tagID := 3;
FreeOnTerminate := true;
OnTerminate := ThreadDone;
inc(thrCount);
Resume;
end;
end;
inc(i);
end;

end;

procedure TForm1.FormCreate(Sender: TObject); // Загрузка настроек из ini файла
var
AppIni: TIniFile;
begin
thrCount := 0;
// в случае если нет данных в настройках, или нет ини файла - загружаем дефолтные значения
AppIni := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'gpda.ini');
MaxThreads := AppIni.ReadInteger('setup', 'Threads', 5);
UMAXaid := AppIni.ReadInteger('setup', 'UMAXaid', 1);
KLIKaid := AppIni.ReadInteger('setup', 'KLIKaid', 1);
Peackaid := AppIni.ReadInteger('setup', 'Peackaid', 1);
dec(MaxThreads);
AppIni.Free;
BreakParse := False;
end;

procedure TForm1.Savechecked1Click(Sender: TObject); // сохранение csv файла
var
i, j: Integer;
tmpK: TStrings;
tmp: string;
begin
if thrCount <> 0 then ShowMessage('Wait to checker stopped or stop manual') else
begin
if thrCount <> 0 then ShowMessage('Wait to checker stopped or stop manual') else
begin
tmpK := TStringList.Create;
for i := 0 to StringGrid1.RowCount do
begin
tmp := '';
for j := 0 to StringGrid1.ColCount do
tmp := tmp + StringGrid1.Cells[j, i] + ';';
tmpK.Add(tmp);
end;
tmpK.SaveToFile(ExtractFilePath(Application.ExeName) + 'bids.csv');
ShowMessage('Result saved in file  - ' + ExtractFilePath(Application.ExeName) + 'bids.csv');
tmpK.Free;
end;
end;
end;

procedure TForm1.Stopcheck1Click(Sender: TObject);
begin
BreakParse := True;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
if BreakParse and (thrCount = 0) then Close
else
begin
ShowMessage('Wait for threads stop');
BreakParse := True;
end;
end;

procedure TForm1.Label1Click(Sender: TObject);
const
URL: string = 'http://www.seocoder.org/';
begin
ShellExecute(0, 'open', pChar(URL), nil, nil, SW_SHOWNORMAL);
end;

end.

Юнит для потоков.

unit threadHTTP;

interface

uses
Classes, SysUtils, IdHTTP, Dialogs, HTTPApp, forms, StrUtils;

type
TGrabThread = class(TThread)
private

protected
procedure Execute; override;
public
http: TIdHTTP;
url: string;
index: integer;
tagID: integer;
html: string;
count: Integer;
procedure Sync;
constructor Create(Suspended: boolean);
procedure ParseBids(html: string; index: Integer);
end;

implementation
uses main;

constructor TGrabThread.Create(Suspended: boolean);
begin
inherited;
http := TIdHTTP.Create(nil);
end;

procedure TGrabThread.Execute;
begin
html := '';
try
html := http.Get(url);
finally
http.Free;
end;
Synchronize(Sync);
end;

procedure TGrabThread.ParseBids(html: string; index: Integer);
var
i, j: integer;
tmp: string;

begin
i := Pos('<bid>', html);
j := Pos('</bid>', html);
if j <> 0 then tmp := copy(html, i + 5, j - i - 5);
case tagID of
1: form1.StringGrid1.Cells[1, index] := tmp;
2: form1.StringGrid1.Cells[3, index] := tmp;
3: form1.StringGrid1.Cells[5, index] := tmp;
end;

while i <> 0 do
begin
i := Pos('<bid>', html);
j := Pos('</bid>', html);
if j <> 0 then
begin
tmp := copy(html, i + 5, j - i - 5);
Delete(html, 1, j);
end;
end;
case tagID of
1: form1.StringGrid1.Cells[2, index] := tmp;
2: form1.StringGrid1.Cells[4, index] := tmp;
3: form1.StringGrid1.Cells[6, index] := tmp;
end;
end;

procedure TGrabThread.Sync;
begin
if html = '' then showmessage('Need do edit gpda.ini. Change You aid') else ParseBids(html, index);
end;

end.