Równoległe ściąganie plików

Poniższy kod ściąga równolegle w pięciu (MAX_THREADS) wątkach podane strony internetowe.
Jak uruchomić? Stwórz nowy projekt, do kodu źródłowego Unit1 wklej kod z dołu artykułu; usuń z wklejonego tekstu linijki 12 i 13:

    ListBox1: TListBox;
    Memo1: TMemo;

a następnie wrzuć na formę listboksa (ListBox1) i memo (Memo1). Ctrl+F9 i zobaczysz jak równolegle ściąga się kilka stron z 4programmers (a jak masz pecha, to zobaczysz listę błędów ;-) ).

Podany kod został napisany i przetestowany pod Delphi 7.

unit Unit1;

interface

uses
  Windows, Messages, Classes, Forms, WinInet, StdCtrls, Controls;

const
  MAX_THREADS = 5;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    procedure DownloadComplete(const url: string; const content: string);
  end;

  TOnDownloadComplete = procedure(const url: string; const content: string) of object;
  TOnProgress = procedure() of object;

  
  TDownloadThread = class(TThread)
    private
      FUrl: string;
      FContent: string;
      FOnDownloadComplete: TOnDownloadComplete;
      FOnProgress: TOnProgress;
    protected
      procedure Execute; override;
    public
      constructor Create(url:string; OnDownloadComplete: TOnDownloadComplete; OnProgress: TOnProgress);
      procedure storeResult();
  end;

  TBossThread = class(TThread)
    private
      FUrlList: array of string;
      FOnDownloadComplete: TOnDownloadComplete;
      FOnProgress: TOnProgress;
    protected
      procedure Execute; override;
    public
      constructor Create(UrlList: array of string; OnDownloadComplete: TOnDownloadComplete; OnProgress: TOnProgress);
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}



var
  threadCount: integer;
  cs: TRTLCriticalSection;


  function IntToStr(Value: Integer): string;
  begin
    str(value, result);
  end;

  function GetInetFile (const fileURL: String): string;
  var
    hSession, hURL: HInternet;
    output: TMemoryStream;
    buffer: array[1..4096] of char;
    bufferLen: DWORD;
  begin
    output := TMemoryStream.Create();
    result := '';
    hSession := InternetOpen('Mozilla/4.0(compatible; Kopiczek 3.0; WyderOS 1.1; pl)', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
    try
      hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);
      try
        repeat
          InternetReadFile(hURL, @buffer, sizeOf(buffer), bufferLen);
          if (bufferLen > 0) then output.write(buffer, bufferLen);
         until bufferLen = 0;
      finally
        InternetCloseHandle(hURL);
      end;
    finally
      InternetCloseHandle(hSession);
    end;

    setLength(result, output.Size);
    output.Seek(0, soFromBeginning);
    move(output.Memory^, result[1], output.Size);
//    output.read(result[1], output.Size);
  end;

  

  constructor TDownloadThread.Create(url:string; OnDownloadComplete: TOnDownloadComplete; OnProgress: TOnProgress);
  begin
    inherited Create(false);
    FreeOnTerminate := true;
    FUrl := url;
    FOnDownloadComplete := OnDownloadComplete;
    FOnProgress := OnProgress;

    EnterCriticalSection(cs);
    inc(threadCount);
    LeaveCriticalSection(cs);
  end;


  procedure TDownloadThread.Execute();
  begin
    FContent := getInetFile(FUrl);
    Synchronize(storeResult);

    enterCriticalSection(cs);
    dec(threadCount);
    leaveCriticalSection(cs);
  end;




  procedure TDownloadThread.storeResult();
  begin
    if (Assigned(FOnDownloadComplete)) then FOnDownloadComplete(FUrl, FContent);
  end;


  constructor TBossThread.Create(UrlList: array of string; OnDownloadComplete: TOnDownloadComplete; OnProgress: TOnProgress);
  var
    i : integer;
  begin
    inherited Create(false);
    FreeOnTerminate := true;
    FOnDownloadComplete := OnDownloadComplete;
    FOnProgress := OnProgress;

    SetLength(FUrlList, Length(UrlList));
    for i := 0 to Length(UrlList)-1 do FUrlList[i] := UrlList[i];
  end;


  procedure TBossThread.Execute();
  var
    cursor: integer;
  begin
    threadCount := 0;

    cursor := 0;

    InitializeCriticalSection(cs);

    while (cursor < length(FUrlList)) do
    begin

      EnterCriticalSection(cs);
      if (threadCount >= MAX_THREADS) then
      begin
        LeaveCriticalSection(cs);
        sleep(10);
        continue;
      end;
      LeaveCriticalSection(cs);

      TDownloadThread.Create(FUrlList[cursor], FOnDownloadComplete, FOnProgress);
      inc(cursor);
    end;
  end;




  procedure TForm1.DownloadComplete(const url: string; const content: string);
  var
    s : string;
  begin
    s := content;
    Form1.ListBox1.Items.AddObject(url, TObject(s));
  end;


  procedure TForm1.FormCreate(Sender: TObject);
  var
    i: integer;
    urls: array[0..10] of string
    { = (
      'http://4programmers.net',
      'http://4programmers.net/Forum',
      'http://4programmers.net/Forum/495902',
    )};
  begin
    for i := 0 to length(urls)-1 do urls[i] := 'http://4programmers.net/Forum/viewtopic.php?p=' + inttostr(495902-i);
    TBossThread.Create(urls, DownloadComplete, nil);
  end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  Memo1.Text := string(ListBox1.Items.Objects[ListBox1.ItemIndex]);
end;

end.