Форум программистов [Powered by Invision Power Board]

Код

+++++++++++++++++++++++++++++++++++++++
unit Main;
....
implementation
{$R *.dfm}
uses uLoadPage,uGlobalVar;

(*нажимает эту кнопку и понеслось*)
procedure TMainForm.Btn_StartLoadURLsClick(Sender: TObject);
var
UrlList:TStringList; (*эквивалент передаваемого массива строк из ПМ*)
i:integer;
Url:string; (*строка = УРЛ из массива*)
begin
   UrlList:=TStringList.Create;
   UrlList.Text:=Mm_InsSMUrls.Text; (*ввод массива строк УРЛ*)
     (*----ЦИКЛ мульти закачки страниц по числу УРЛ в Mm_InsSMUrls---*)
     for i := 0 to UrlList.Count-1 do
       begin
          Url:=UrlList[i]; (*передача УРЛ*)
          Loader(Url); (*вызов процедуры запуска потока закачки страницы*)
          Sleep(10);  (*страховка от перегрева процессора а также от толпы потоков, которые мешают друг другу?*)
       end;
   FreeAndNil(UrlList);
end;
+++++++++++++++++++++++++++++++++++++++
unit uLoadPage;
interface
uses SysUtils, uThreadLoader, Classes;
Procedure Loader(Url:string);
implementation
Procedure Loader(Url:string);
var ThreadLdr: TLoader;
begin
    ThreadLdr:=Tloader.Create(True);
    ThreadLdr.Priority:=tpNormal;   
    ThreadLdr.FreeOnTerminate:=True;
    ThreadLdr.Url:=Url;
    ThreadLdr.Start;
  end;
end.
+++++++++++++++++++++++++++++++++++++++
unit uThreadLoader;
interface
uses
  System.Classes, idHTTP, SysUtils, Dialogs;
type
  TLoader = class(TThread)
  private
     FUrl:string;
     FHtml:string;
    { Private declarations }
  protected
    procedure Execute; override;
    procedure CallStore;
    function LoadHtmlCode(const Url:string):string;
  public
    property Url: string read FUrl write FUrl;  (*свойство класа, доступное для всей программы*)
    property Html: string read FHtml write FHtml;
  end;

implementation
uses uPageLoader, uLoadPage, uGlobalVar;

function TLoader.LoadHtmlCode(const Url:string):string;
begin
  Result:=LoadPage(Url); (*вызываем функцию загрузки страницы из uPageLoader*)
end;

procedure TLoader.CallStore;
begin
   gStore.Add(Html); (*ввод новой строки в ГлобПерем*)
end;

procedure TLoader.Execute;
begin
   Html:=LoadHtmlCode(Url);  (*загрузка страницы в Поле Класса(свойство)*)
    CS.Enter;  (*вход в КС*)
       CallStore; (*передаем результат в ГП*)
    Cs.Leave;  (*выход из КС*)
end;

end.
++++++++++++++++++++++++++++++++++++++++++++
unit uPageLoader;
interface
uses Classes, SysUtils, idHTTP, StrUtils, IdSSL, IdSSLOpenSSL;
    function LoadPage(const Url:string):string;  (*Основная функция Юнита*)
    procedure ErrorLog(Url:string);
    function LoadHtmlPage(const PageUrl:string):string;
    function DelJS(const Code:string):string;
    function RestoreFrame(const Code:string):string;
    function RestoreFullUrl(const Code:string; const RootUrl:string):string;
    function GetRandomUserAgent: string;
    var
    Loader:TidHTTP;
    SSL:TIdSSLIOHandlerSocketOpenSSL;

implementation
тут много чего, но все работает, смотри в начало
end.
++++++++++++++++++++++++++++++++++++++++++++
unit uGlobalVar;
interface
uses Classes, SysUtils, SyncObjs;
var
gStore: TStringList=nil; (*ГП для хранения закачанных страниц*)
CS:TCriticalSection; (*используем КС для передачи результата в основной поток*)
implementation

initialization
   gStore:=TStringList.Create;
   gStore.Duplicates:=dupAccept;
   gStore.Sorted:=False;
   Cs:=TCriticalSection.Create;
finalization
  FreeAndNil(gStore);
  FreeAndNil(CS);
end.
++++++++++++++++++++++++++++++++++++++++++++