downloaddemo_u.pas

EmbeddedWB_D5-D2009_Version_14.67.8 最新版本,开发WEB浏览器.

  UpdateThreadDetails(Sender);
  memHeaders.Lines.Add('AdditionalHeaders:' + #13#10 + szAdditionalHeaders);
  memEvents.Lines.Add('Beginning Transaction Event.');
  Result := S_OK;
end;

function TForm1.IEDownload1CodeInstallProblem(Sender: TBSCB;
  ulStatusCode: Cardinal; szDestination, szSource: PWideChar;
  dwReserved: Cardinal; stResult: string): HRESULT;
begin {The event will fire only under this terms:
  http://msdn.microsoft.com/en-us/library/ms775136(VS.85).aspx}
  memEvents.Lines.Add('Code Install Problem Event.');
  memErrors.Lines.Add('An error accrued:  ' + stResult);
  Result := S_OK;
end;

procedure TForm1.IEDownload1Complete(Sender: TIEDownload; aFileNameAndPath,
  aFileName, aFolderName, aExtension: WideString;
  const ActiveConnections: Integer);
  var
  lvTItem: TListItem;
  idx: integer;
begin

  memEvents.Lines.Add('Complete Event:' + aFileName);
  with memDetails.Lines do
  begin
    Add(#13#10 + 'Downloading from: ' + IEDownload1.ServerAddress);
    Add(#13#10 + 'Server IP: ' + IEDownload1.ServerIP);
    Add(#13#10 + 'File mime type: ' + IEDownload1.MimeType);
    Add(#13#10 + 'Display Name: ' + IEDownload1.DisplayName);
    case IEDownload1.DownloadMethod of
      dmStream:Add(#13#10 + 'Download method: Stream');
      dmFile:
        begin
          Add(#13#10 + 'Download method: File');
          Add(#13#10 + 'Download folder: ' + aFolderName);
          Add(#13#10 + 'Downloaded File name: ' + aFileName);
          Add(#13#10 + 'Downloaded File Extension: ' + aExtension);
          Add(#13#10 + 'File size: ' + (FormatSize(IEDownload1.FileSize)));
          if not FileExists(aFileNameAndPath) then
            memErrors.Lines.Add('Can not Locate The File.')
          else
          begin
          if IEDownload1.MimeType = 'text/html' then
            EmbeddedWB1.Go(aFileNameAndPath)
          else
            EmbeddedWB1.LoadFromString('Done.');
          end;
        end;
    end;
    Add(#13#10 + 'Total Downloads: ' + IntToStr(IEDownload1.DownloadsCounter));
    edtFile.Text := IEDownload1.DownloadFolder + IEDownload1.FileName;
  end;
    for idx := 0 to lvThread.Items.Count - 1 do
    if (lvThread.Items[idx].Caption = IEDownload1.FileName) then
    begin
      lvTItem := lvThread.Items[idx];
      if (Assigned(lvTItem)) then
        lvTItem.SubItems[3] := IntToStr(IEDownload1.ActiveConnections);
   end;
end;

procedure TForm1.IEDownload1Connect(Sender: TBSCB; Res: HRESULT;
  stMessage: string);
begin
  memEvents.Lines.Add('Connect Event:' + stMessage);
end;

function TForm1.IEDownload1SecurityProblem(Sender: TBSCB; dwProblem: Cardinal;
  Problem: string): HRESULT;
begin
  memEvents.Lines.Add('SecurityProblem Event.');
  Result := S_OK;
end;

procedure TForm1.IEDownload1StartBinding(var Sender: TBSCB; var Cancel: Boolean;
  pib: IBinding);
begin
  memEvents.Lines.Add('Start Binding Event.');
end;

procedure TForm1.IEDownload1StateChange(State: TState);
begin
  btnStart.Enabled := not IEDownload1.Busy;
  btnGoList.Enabled := not IEDownload1.Busy;
  btnToCache.Enabled := not IEDownload1.Busy;
  btnToFile.Enabled := not IEDownload1.Busy;
  btnStop.Enabled := IEDownload1.Busy;
  btnStopAll.Enabled := IEDownload1.Busy;
  case State of
    sBusy:
      begin
        memEvents.Lines.Add('StateChange: Busy');
        lblState.Caption := 'Busy';
      end;
    sReady:
      begin
        memEvents.Lines.Add('StateChange: Ready');
        lblState.Caption := 'Ready';
      end;
    sStopped:
      begin
        memEvents.Lines.Add('StateChange: Stopped');
        lblState.Caption := 'Stopped';
      end;
  end;
end;

procedure TForm1.IEDownload1StopBinding(Sender: TBSCB; HRESULT: HRESULT;
  szError: PWideChar);
begin
  memEvents.Lines.Add('StopBinding Event. ' + ResponseCodeToStr(HRESULT));
  if HRESULT <> S_OK then
    memErrors.Lines.Add('On Stop Binding Error: ' + szError);
end;

procedure TForm1.IEDownload1StreamComplete(Sender: TBSCB; Stream: TStream;
  Result: HRESULT);
var
  MS: TMemoryStream;
begin
  memEvents.Lines.Add('DownloadComplete Event.');
  counter := 0;
  MS := TMemoryStream.Create;
  with ms do
  begin
    Seek(0, 0);
    LoadFromStream(Stream);
  end;
  memPreviewStream.Lines.LoadFromStream(MS);
  MS.Free;
  if IEDownload1.DownloadMethod = dmStream then
     EmbeddedWB1.LoadFromStream(Stream);
end;

procedure TForm1.IEDownload1Terminate(const Sender: TBSCB;
  const ThreadId: Integer; const aFileName: WideString; var bCancel: Boolean);
begin
   UpdateThreadDetails(Sender);
   memEvents.Lines.Add('Termination Event.');
  // if IEDownload1.ProcessCounter > 0 then
  begin
 //   if MessageDlg('Threads active. Do you still want to quit?',
  //    mtWarning, [mbYes, mbNo], 0) = mrNo then
      //  CanClose := false;
  end;
end;

function TForm1.IEDownload1GetBindInfo(Sender: TBSCB; out grfBINDF: Cardinal;
  var BindInfo: _tagBINDINFO): HRESULT;
begin
  memEvents.Lines.Add('GetBindInfo Event.');
  Result := S_OK;
end;

function TForm1.IEDownload1GetBindInfoEx(Sender: TBSCB; out grfBINDF: Cardinal;
  pbindinfo: _tagBINDINFO; out grfBINDF2: Cardinal): HRESULT;
begin
  memEvents.Lines.Add('GetBindInfoEx Event.');
  Result := S_OK;
end;

procedure TForm1.IEDownload1GetBindResults(var Sender: TBSCB;
  out clsidProtocol: TGUID; out dwResult: Cardinal; out szResult: PWideChar;
  const stResult: string);
begin
  memEvents.Lines.Add('GetBindResults Event. ' + stResult);
  if dwResult <> S_OK then
    memErrors.Lines.Add(szResult + ' GetBindResults.' + stResult);
end;

function TForm1.IEDownload1GetRootSecurityId(var SecurityIdBuffer: TByteArray;
  var BufferSize: Cardinal): HRESULT;
begin
  Result := S_OK;
  memEvents.Lines.Add('Get Root Security Id Event.');
end;

function TForm1.IEDownload1GetSerializedClientCertContext(var Sender: TBSCB;
  out ppbCert: Byte; var pcbCert: Cardinal): HRESULT;
begin
  memEvents.Lines.Add('GetSerializedClientCertContext Event.');
  Result := S_OK;
end;

function TForm1.IEDownload1GetWindow(Sender: TBSCB; const GUIDReason: TGUID;
  out hwnd: Cardinal): HRESULT;
begin
  memEvents.Lines.Add('GetWindow Event.');
  Result := S_OK;
end;

procedure TForm1.IEDownload1Progress(Sender: TBSCB; ulProgress, ulProgressMax,
  ulStatusCode, FileSize: Cardinal; szStatusText: PWideChar; Downloaded,
  ElapsedTime, Speed, RemainingTime, Status, Percent: string);
var
  ListItem: TListItem;
begin
  memProgress.Lines.Add(szStatusText);
  memProgress.Lines.Add(Status);
  lblProgress.Caption := Format('Downloaded %d of %d bytes', [ulProgress,
    ulProgressMax]) + '   |  in KB: ' + FormatSize(IEDownload1.FileSize);
  ProgressBar1.Max := ulProgressMax;
  ProgressBar1.Position := ulProgress;
  if (ulStatusCode = BINDSTATUS_BEGINDOWNLOADDATA) then
    memEvents.Lines.Add('Progress Event.');
  if (ulStatusCode = BINDSTATUS_DOWNLOADINGDATA) or (ulStatusCode =
    BINDSTATUS_ENDDOWNLOADDATA) then
  begin
    with ListView do
    begin
      Items.BeginUpdate;
      try
        ListItem := ListView.Items.Add;
        ListItem.Caption := IEDownload1.FileName;
        with ListItem.SubItems do
        begin
          Add(Speed);
          Add(Downloaded);
          Add(RemainingTime);
          Add(ElapsedTime);
          Add(Status);
          Add(' (' + IntToStr(ulProgress) + ' of: ' + IntToStr(ulProgressMax) +
            ')');
          Add(Percent);
        end;
      finally
        Items.EndUpdate;
      end;
    end;
  end;
end;

function TForm1.IEDownload1PutProperty(Sender: TBSCB; mkp: _MONIKERPROPERTY;
  val: PWideChar): HRESULT;
begin
   memEvents.Lines.Add('Put Property Event');
   Result:= S_OK;
end;

procedure TForm1.IEDownload1Redirect(Sender: TBSCB; var AbortRedirect: Boolean;
  const FromUrl, DestUrl: string);
begin
  AbortRedirect := False;
  memEvents.Lines.Add('Redirect Event from address:' + FromUrl + #13#10 +
    'To address: ' + DestUrl);
end;

function TForm1.IEDownload1Response(Sender: TBSCB; dwResponseCode: Cardinal;
  szResponseHeaders, szRequestHeaders: PWideChar;
  out szAdditionalRequestHeaders: PWideChar): HRESULT;
{Use OnResponse to get response headers and eventually add additional request headers.}
begin
  memEvents.Lines.Add('Response Event.');
  with memResponse.Lines do
  begin
    Add('dwResponseCode:');
    Add(ResponseCodeToStr(dwResponseCode));
    Add('Response szResponseHeaders:');
    Add(szResponseHeaders);
  end;
  Result := S_OK;
end;

procedure TForm1.IEDownload1Resume(Sender: TBSCB; FileName: string;
  var Action: Cardinal);
begin
  //Useless, the event is not supprted by Microsoft yet.
  memEvents.Lines.Add('Response Event.');
end;

{Some procedures-----------------------------------------------------------------}

procedure TForm1.ClearComponents;
begin
  lvThread.Clear;
  memHeaders.Lines.Clear;
  memEvents.Lines.Clear;
  memPreviewData.Lines.Clear;
  memPreviewStream.Lines.Clear;
  memResponse.Lines.Clear;
  memProgress.Lines.Clear;
  MemErrors.Lines.Clear;
  ListView.Items.Clear;
  MemDetails.Lines.Clear;
  edtFile.Text := '';
end;

procedure TForm1.InitialComponents;
begin
  EmbeddedWB1.AddHtmlToAboutBlank('Working. Please wait..');
  //PageControl1.ActivePageIndex := 0;
  ProgressBar1.Position := 0;
  counter := 0;
  with IEDownload1 do
  begin
    case rgBind.ItemIndex of
      0: BindVerb := Get;
      1: BindVerb := Post;
      2: BindVerb := Put;
      3: BindVerb := Custom;
    end;
    case rgBind.ItemIndex of
      0: DownloadMethod := dmFile;
      1: DownloadMethod := dmStream;
    end;
    if (cbOpenFolder.Checked) and (DownloadMethod = dmFile) then
      OpenDownloadFolder := True
    else
      OpenDownloadFolder := False;

    if cbAsyn.Checked then
      BindF := BindF  + [Asynchronous]
    else
      BindF := BindF - [Asynchronous];
  end;
end;

procedure TForm1.UpdateThreadDetails(aSender: TBSCB);
  var
  lvTItem: TListItem;
begin
  if (aSender <> nil) then
  begin
    lvTItem := lvThread.Items.Add;
     with lvTItem do
     begin
       Caption := IEDownload1.FileName;
       SubItems.Add(IntToStr(aSender.ThreadID));
       SubItems.Add(IntToStr(aSender.Handle));
       case aSender.ThreadStatus of
         tsRunning:  SubItems.Add('Running');
         tsSuspended:  SubItems.Add('Suspended');
         tsWaiting:  SubItems.Add('Waiting');
         tsTerminated:  SubItems.Add('Terminated');
       end;
       SubItems.Add(IntToStr(IEDownload1.ActiveConnections));
     end;
  end;
end;
end.