httpasy1.pas

文件名称：新曦 我的资源 搜索软件 源程序(Borland Delphi 7)说明

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Execute button click handler. Start sequential or simultaneous execution  }
procedure THttpAsyForm.ExecButtonClick(Sender: TObject);
begin
    ExecButton.Enabled := FALSE;
    FFLagAbort         := FALSE;
    if SimultCheckBox.Checked then
        ExecSimultaneous
    else
        ExecSequential;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Start simultaneous execution by creating as much THttpCli components as   }
{ there are URL in the list box. (We could alternatively limit the number   }
{ of THttpCli components and use them sequentially. It would be a           }
{ combination of the sequential and simultaneous implementations.)          }
{ A TList is used to keep track of all the component created. This is only  }
{ needed to abort each one if requested by the user.                        }
{ The Tag property is used to store the item number, just for display.      }
procedure THttpAsyForm.ExecSimultaneous;
var
    Count    : Integer;
    Item     : Integer;
    AHttpCli : THttpCli;
begin
    { Check if the list if empty }
    if FHttpCliList.Count > 0 then begin
        MessageBeep(MB_OK);
        Exit;
    end;

    { Get the URL count }
    Count := URLListBox.Items.Count;
    if Count <= 0 then
        Exit;  { Nothing to do ! }

    { Create a new HTTP component for each URL, }
    { add it to the list and start the request  }
    for Item := 1 to Count do begin
        AHttpCli := THttpCli.Create(Self);
        FHttpCliList.Add(AHttpCli);
        AHttpCli.Tag           := Item;
        AHttpCli.URL           := URLListBox.items[Item - 1];
        AHttpCli.OnRequestDone := HttpCliItemRequestDone;
        AHttpCli.OnHeaderData  := HttpCli1HeaderData;
        AHttpCli.OnDocData     := HttpCli1DocData;
        DisplayMemo.Lines.Add('Start item ' + IntToStr(Item) + ': ' +
                              AHttpCli.Url);
        AHttpCli.GetAsync;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This OnRequestDone handler is used for the simultaneous request model.    }
{ It search the THttpCli component in the list and remove it.               }
procedure THttpAsyForm.HttpCliItemRequestDone(
  Sender : TObject;
  RqType : THttpRequest;
  Error  : Word);
var
    Item     : Integer;
    AHttpCli : THttpCli;
    Count    : Integer;
begin
    AHttpCli := Sender as THttpCli;
    Item     := AHttpCli.Tag;
    DisplayMemo.Lines.Add(
        'Finished Item ' + IntToStr(Item) +
        ' StatusCode = ' + IntToStr(AHttpCli.StatusCode) +
        ' ' + AHttpCli.URL +
        ' Error = ' + IntToStr(Error));
    DisplayMemo.Lines.Add('');

    { Remove the item form the list }
    Count := FHttpCliList.Count;
    for Item := 1 to Count do begin
        if AHttpCli = FHttpCliList.Items[Item - 1] then begin
            FHttpCliList.Delete(Item - 1);
            break;
        end;
    end;

    { Free the item }
    AHttpCli.Free;

    { Check if the list is empty. If yes, we have all requests finished. }
    if FHttpCliList.Count <= 0 then begin
        ExecButton.Enabled := TRUE;
        DisplayMemo.Lines.Add('All Finished');
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAsyForm.ExecSequential;
begin
    if FCurrentItem >= 0 then begin
        MessageBeep(MB_OK);
        Exit;
    end;
    FCurrentItem := 0;
    StartNext;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Start the next request (this could also be the first).                    }
procedure THttpAsyForm.StartNext;
begin
    if FFlagAbort then begin
        DisplayMemo.Lines.Add('Abort requested');
        FCurrentItem       := -1;
        ExecButton.Enabled := TRUE;
        Exit;
    end;

    Inc(FCurrentItem);
    if FCurrentItem > URLListBox.Items.Count then begin
        DisplayMemo.Lines.Add('All Finished');
        FCurrentItem       := -1;
        ExecButton.Enabled := TRUE;
        Exit;
    end;
    HttpCli1.Url := URLListBox.Items[FCurrentItem - 1];
    HttpCli1.Tag := FCurrentItem;
    DisplayMemo.Lines.Add('Start item ' + IntToStr(FCurrentItem) + ': ' +
                          HttpCli1.Url);
    HttpCli1.GetASync;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This OnRequestDone event handler is called during the sequential model.   }
{ Just start the next request.                                              }
procedure THttpAsyForm.HttpCli1RequestDone(Sender: TObject;
  RqType: THttpRequest; Error: Word);
begin
    DisplayMemo.Lines.Add('Finished item ' + IntToStr(FCurrentItem) +
                          ' StatusCode = ' + IntToStr(HttpCli1.StatusCode) +
                          ' Error = ' + IntToStr(Error));
    DisplayMemo.Lines.Add('');
    StartNext;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAsyForm.URLListBoxClick(Sender: TObject);
begin
    UrlEdit.Text := UrlListBox.Items[URLListBox.ItemIndex];
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAsyForm.ReplaceButtonClick(Sender: TObject);
var
    Item : Integer;
begin
    Item := URLListBox.ItemIndex;
    if Item < 0 then
        Exit;
    URLListBox.Items.Delete(Item);
    URLListBox.Items.Insert(Item, UrlEdit.Text);
    URLListBox.ItemIndex := Item;
    ActiveControl := URLEdit;
    URLEdit.SelectAll;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure THttpAsyForm.ClearDisplayButtonClick(Sender: TObject);
begin
    DisplayMemo.Clear;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This OnHeaderData event handler is used in both sequential and            }
{ simultaneous requests models.                                             }
procedure THttpAsyForm.HttpCli1HeaderData(Sender: TObject);
var
    AHttpCli : THttpCli;
begin
    if not HeaderCheckBox.Checked then
        Exit;
    AHttpCli := Sender as THttpCli;
    DisplayMemo.Lines.Add('Item ' + IntToStr(AHttpCli.Tag) + ': ' +
                          AHttpCli.LastResponse);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This OnDocData event handler is used in both sequential and               }
{ simultaneous requests models.                                             }
procedure THttpAsyForm.HttpCli1DocData(Sender: TObject; Buffer: Pointer;
  Len: Integer);
var
    AHttpCli : THttpCli;
begin
    if not DataCheckBox.Checked then
        Exit;

    AHttpCli := Sender as THttpCli;
    { Display a message stating that data is available }
    DisplayMemo.Lines.Add('Item ' + IntToStr(AHttpCli.Tag) + ' Data');

    { We could display the data, but it use a huge space in the display }
    { DisplayMemo.Lines.Add(StrPas(Buffer)); }

    { We could also store the data somewhere (with the help of OnDocBegin }
    { and OnDocEnd events. Or using the RcvdStream property.              }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Abort all the running request.                                            }
{ In the simultaneous model, we use the list to abort all.                  }
{ We just need to call abort. We will get the OnRequestDone event with an   }
{ error code stating that the request has been aborted.                     }
procedure THttpAsyForm.AbortButtonClick(Sender: TObject);
var
    Count    : Integer;
    Item     : Integer;
    AHttpCli : THttpCli;
begin
    FFLagAbort := TRUE;
    if SimultCheckBox.Checked then begin
        Count := FHttpCliList.Count;
        for Item := 1 to Count do begin
            AHttpCli := THttpCli(FHttpCliList.Items[Item - 1]);
            AHttpCli.Abort;
        end;
    end
    else
        HttpCli1.Abort;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.