HTML исходный код (парсинг) - Работа с сетью в Delphi - Страница 3

DjDram · 10.09.2011, 23:58

теперь стопориться на

Код:

[DCC Hint] unit1.pas(75): H2077 Value assigned to 'SaveResult' never used

Код:

procedure SaveHTMLSourceToStream(s:TStream;
 WB: TWebBrowser);
var
 PersistStream: IPersistStreamInit;
 Stream: IStream;
 SaveResult: HRESULT;
begin
 PersistStream := WB.Document as IPersistStreamInit;
try
 Stream := TStreamAdapter.Create(s, soReference) as IStream;
 SaveResult := PersistStream.Save(Stream, True);
except
end;
end;

в этой процедуре

Пепел Феникса · 11.09.2011, 00:00

показывайте код, и переписывайте ошибку сюда.

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
WebBrowser1:TWebBrowser;
StringStream:TStringStream;
RegExp: TRegExpr;
S:string;
begin
     WebBrowser1:=TWebBrowser.Create(nil);
     WebBrowser1.Navigate('http://www.youtube.com/watch?v=lkKhfP4fZZs&feature=relmfu'); 
     while WebBrowser1.readyState<>4 do Application.ProcessMessages;
     StringStream:=TStringStream.Create;
     SaveHTMLSourceToStream(StringStream,WebBrowser1);
     RegExp := TRegExpr.Create;
     RegExp.InputString := StringStream.DataString;
     RegExp.Expression := 'url_encoded_fmt_stream_map=url%3D(.*?)%253B';
     if RegExp.Exec then
               begin
                 S:=(RegExp.Match[1]);
                 S:=ReplaceStr(S,'%253A',':');
                 S:=ReplaceStr(S,'%252F','/');
                 S:=ReplaceStr(S, '%253F', '?');
                 S := ReplaceStr(S, '%253D', '=');
                 S := ReplaceStr(S, '%253F', '?');
                 S := ReplaceStr(S, '%25252C', '%2C');
                 S := ReplaceStr(S, '%2526', '&');
                 S := ReplaceStr(S, '%26', '&');//
                 S := ReplaceStr(S, '%3D', '=');
                 S := ReplaceStr(S, '%25253A', '%3A');
 WindowsMediaPlayer1.URL:=S;
 memo1.Text:=S;
end;
RegExp.Free;
StringStream.Free;
WebBrowser1.Free;
end;
end.

так должно поидее работать, если нет то пишите ошибку.

Цитата:

теперь стопориться на

это просто подсказка.

Код:

procedure SaveHTMLSourceToStream(s:TStream;
 WB: TWebBrowser);
var
 PersistStream: IPersistStreamInit;
 Stream: IStream;
begin
 PersistStream := WB.Document as IPersistStreamInit;
 try
  Stream := TStreamAdapter.Create(s, soReference) as IStream;
  PersistStream.Save(Stream, True);
  except
 end;
end;

DjDram · 11.09.2011, 00:07

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Wininet, OleCtrls, ActiveX, MSHTML, SHDocVw, RegExpr,
  WMPLib_TLB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    WindowsMediaPlayer1: TWindowsMediaPlayer;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public

    { Public declarations }
  end;

var
  Form1: TForm1;
       URL:STRING;

implementation

{$R *.dfm}

function ReplaceStr(const S, Srch, Replace: string): string;
var
 I:Integer;
 Source:string;
begin
 Source:= S;
 Result:= '';
 repeat
  I:=Pos(Srch, Source);
  if I > 0 then begin
   Result:=Result+Copy(Source,1,I-1)+Replace;
   Source:=Copy(Source,I+Length(Srch),MaxInt);
  end else Result:=Result+Source;
 until I<=0;
end;


procedure SaveHTMLSourceToStream(s:TStream;
 WB: TWebBrowser);
var
 PersistStream: IPersistStreamInit;
 Stream: IStream;
 SaveResult: HRESULT;
begin
 PersistStream := WB.Document as IPersistStreamInit;
try
 Stream := TStreamAdapter.Create(s, soReference) as IStream;
SaveResult := PersistStream.Save(Stream, True);
except
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
WebBrowser1:TWebBrowser;
StringStream:TStringStream;
RegExp: TRegExpr;
S:string;
begin
     WebBrowser1:=TWebBrowser.Create(nil);
     WebBrowser1.Navigate('http://www.youtube.com/watch?v=lkKhfP4fZZs&feature=relmfu');
   while WebBrowser1.readyState<>4 do Application.ProcessMessages;
     StringStream:=TStringStream.Create;
     SaveHTMLSourceToStream(StringStream,WebBrowser1);
     RegExp := TRegExpr.Create;
     RegExp.InputString := StringStream.DataString;
     RegExp.Expression := 'url_encoded_fmt_stream_map=url%3D(.*?)%253B';
     if RegExp.Exec then
               begin
                 S:=(RegExp.Match[1]);
                 S:=ReplaceStr(S,'%253A',':');
                 S:=ReplaceStr(S,'%252F','/');
                 S:=ReplaceStr(S, '%253F', '?');
                 S := ReplaceStr(S, '%253D', '=');
                 S := ReplaceStr(S, '%253F', '?');
                 S := ReplaceStr(S, '%25252C', '%2C');
                 S := ReplaceStr(S, '%2526', '&');
                 S := ReplaceStr(S, '%26', '&');//
                 S := ReplaceStr(S, '%3D', '=');
                 S := ReplaceStr(S, '%25253A', '%3A');
 WindowsMediaPlayer1.URL:=S;
 memo1.Text:=S;
end;
RegExp.Free;
StringStream.Free;
 WebBrowser1.Free;
end;
end.

вот код парсера запускается ошибок не выдаёт но и не какого действия не происходит
P.S. на форме EDIT1,Button1,Memo1,WindowsMediaPla yer1

Пепел Феникса · 11.09.2011, 00:08

а чего же вы ожидание выкинули?

DjDram · 11.09.2011, 01:16

Цитата:

Сообщение от Пепел Феникса

а чего же вы ожидание выкинули?

вернул ситуация не изменилась прога висит закрыть можно только через диспетчер

DjDram · 11.09.2011, 15:11

Последняя редакция

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Wininet, OleCtrls, ActiveX, MSHTML, SHDocVw, RegExpr,
  WMPLib_TLB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    WindowsMediaPlayer1: TWindowsMediaPlayer;
    Edit1: TEdit;
    WebBrowser1: TWebBrowser;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public

    { Public declarations }
  end;
var
  Form1: TForm1;
  Url:STRING;
implementation

{$R *.dfm}
// функция замены подстроки в строке
function ReplaceStr(const S, Srch, Replace: string): string;
var
 I:Integer;
 Source:string;
begin
 Source:= S;
 Result
 := '';
 repeat
  I:=Pos(Srch, Source);
  if I > 0 then begin
   Result:=Result+Copy(Source,1,I-1)+Replace;
   Source:=Copy(Source,I+Length(Srch),MaxInt);
  end else Result:=Result+Source;
 until I<=0;
end;

// функция получения потока иходного кода страницы
procedure SaveHTMLSourceToStream(s:TStream;
 WB: TWebBrowser);
var
 PersistStream: IPersistStreamInit;
 Stream: IStream;
 SaveResult: HRESULT;
begin
 PersistStream := WB.Document as IPersistStreamInit;
try
 Stream := TStreamAdapter.Create(s, soReference) as IStream;
 PersistStream.Save(Stream, True);
except
end;
end;

// процедура обработки строки и открытие её в плеере
procedure TForm1.Button1Click(Sender: TObject);
var
StringStream:TStringStream;
RegExp: TRegExpr;
S:string;
begin
 Url:=Edit1.text;
 WebBrowser1.Navigate(URL);
 while WebBrowser1.ReadyState < READYSTATE_INTERACTIVE do
 Application.ProcessMessages;
 while WebBrowser1.ReadyState<>4 do Application.ProcessMessages;
  StringStream:=TStringStream.Create;
  SaveHTMLSourceToStream(StringStream,WebBrowser1);
  RegExp := TRegExpr.Create;
   RegExp.InputString := StringStream.DataString;
     RegExp.Expression := 'itag%3D34%2Curl%3D(.*?)mp4';
         if RegExp.Exec then
          begin
             S:=(RegExp.Match[1]);
             S:=ReplaceStr(S,'%253A',':');
             S:=ReplaceStr(S,'%252F','/');
             S:=ReplaceStr(S, '%253F', '?');
             S := ReplaceStr(S, '%253D', '=');
             S := ReplaceStr(S, '%253F', '?');
             S := ReplaceStr(S, '%25252C', '%2C');
             S := ReplaceStr(S, '%2526', '&');
             S := ReplaceStr(S, '%26', '&');
             S := ReplaceStr(S, '%3D', '=');
             S := ReplaceStr(S, '%25253A', '%3A');
             S :=S+'mp4';
               WindowsMediaPlayer1.URL:=S;
               WebBrowser1.Stop;
               Edit1.text:='';
StringStream.Free;
WebBrowser1.Free;
end;end;
end.

На форме Button1, WindowsMediaPlayer1, Edit1, WebBrowser1

Вообщем получается так в edit вводим ссылку на ролик она открывается в плеере после первого прохода останавливаем WebBrowser1.Stop; очищаем Edit1.text:=''; теперрь когда вводим снова ссылку и жмём на кнопку выскакивает ошибка на строке WebBrowser1.Navigate(URL); может надо как то выгрузить предыдущую страницу хотя вроде и так WebBrowser1.Stop; в конце писал

Пепел Феникса · 11.09.2011, 15:36

Код:

WebBrowser1.Free;

убрать.
компоненты не стоит явно освобождать.

DjDram · 12.09.2011, 00:21

Цитата:

Сообщение от Пепел Феникса

Код:

WebBrowser1.Free;

убрать.
компоненты не стоит явно освобождать.

А точно слишком рано отписался потом до самого дошло

А как быть с WindowsMediaPlayer1 я его импортнул как ActiveX
в uses добавилось WMPLib_TLB
У меня стоит WMP12 у друга WMP10 и у него ошибку выбивает программа

11.09.2011, 00:08	#24
Пепел Феникса Старожил Регистрация: 28.01.2009 Сообщений: 21,000	а чего же вы ожидание выкинули? Хорошо поставленный вопрос это уже половина ответа. \| Каков вопрос, таков ответ. Программа делает то что написал программист, а не то что он хотел. Функции/утилиты ждут в параметрах то что им надо, а не то что вы хотите.

11.09.2011, 15:36	#27
Пепел Феникса Старожил Регистрация: 28.01.2009 Сообщений: 21,000	Код: `WebBrowser1.Free;` убрать. компоненты не стоит явно освобождать. Хорошо поставленный вопрос это уже половина ответа. \| Каков вопрос, таков ответ. Программа делает то что написал программист, а не то что он хотел. Функции/утилиты ждут в параметрах то что им надо, а не то что вы хотите.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Исходный код сайта. 2	Тутонхамон	Работа с сетью в Delphi	0	22.05.2011 14:38
Исходный код сайта.	Тутонхамон	Работа с сетью в Delphi	7	22.05.2011 07:59
преобразовать исходный код	Оля	Паскаль, Turbo Pascal, PascalABC.NET	0	18.04.2010 20:47
Исходный код страницы	Abuhamed	PHP	5	02.02.2010 00:34
Расформатировать исходный код страницы	OdNairy	Работа с сетью в Delphi	5	19.09.2009 18:13