Можно ли загрузить в TWebBrowser html текст плюс картинку из stream?

Можно, если из стрима ее скинуть во временный файл :-)
Что-то я не слышал про html-тэги, которые указывают на стрим...
Можно конечно перехватывать обращения к файловой системе и пытаться подсунуть свою информацию, но это не просто извращение, это маловероятно.

Цитата(Alex @ 19.1.2005, 17:19)

Можно ли загрузить в TWebBrowser html текст плюс картинку из stream?

Кажется, нет... Разве что какой-то хитрый IPersistStorage, но, кажется, через эти интерфейсы все равно только HTML сохраняется.

а как в mht сохранить?

Можно указать картинку из ресурса файла (например из твоего EXE)
А еще можно запустить собственный WWW сервер и через него предоставлять браузеру данные (так вроде раньше работал HTML Help)

Вообще, насколько я понял, способов впихнуть какие-то данные в TWebBrowser всего 3.
1) Navigate
2) IHTMDocument.Write (совершенно не одно и то же с Navigate!)
3) IPersist*
Возможно, ещё где-то IDataObject скрывается, но у меня уже нет времени исследовать эту тему
Может, кто-то подскажет ещё варианты?

Всем спасибо за ответы. Я уже сделал с временным выкладыванием картинок на жесткий диск. Получилось очень даже не плохо.

Цитата(Alex @ 23.1.2005, 17:21)

Я уже сделал с временным выкладыванием картинок на жесткий диск.

Я тоже Последние 8 часов посвятил именно этому. Точнее, сохранению с картинками и открытию html'a без метода Navigate.

Цитата(December @ 23.1.2005, 17:38)

Я тоже  Последние 8 часов посвятил именно этому. Точнее, сохранению с картинками и открытию html'a без метода Navigate.

Я думаю стоит выложить свои наработки (если можно) - потом многим пригодиться...

Цитата(p0s0l @ 23.1.2005, 17:52)

Я думаю стоит выложить свои наработки (если можно) - потом многим пригодиться...

ОК, я ещё потестирую хорошенько в боевых условиях и выложу через пару дней.

Меня тоже стала интересовать эта тема. Может кто-нибцдь выложит рабочий пример чтобы посмотреть. Для отображения картинок в webbrowser нужно каждый раз менять путь для картинок, может кто напишит как???

всем привет, такая же проблема, я одновременно закачиваю в одном потоке страницу, а в другом обрабатываю все тэги, меняю адреса картинок на локальные, но выходит Access violation... все попробовал: изменял ссылки на картинку и т.д. причем когда просто вставляешь этот путь в HTML документ и открываешь, все нормально, а когда пытаешься загрузить через write в HTMLDocument выходит ошибка ... замучился уже

Цитата(Guest @ 11.3.2005, 17:35)

всем привет, такая же проблема, я одновременно закачиваю в одном потоке страницу, а в другом обрабатываю все тэги, меняю адреса картинок на локальные, но выходит Access violation... все попробовал: изменял ссылки на картинку и т.д. причем когда просто вставляешь этот путь в HTML документ и открываешь, все нормально, а когда пытаешься загрузить через write в HTMLDocument выходит ошибка ... замучился уже

Код в студию.

Ну, раз так надо - могу предложить свой вариант.
Disclaimer: данный код является следствием экспериментов. Он не является оптимальным, безглючным, красивым, хорошим etc. Его можно оптимизировать до умопомрачения. Единственный его плюс - он работает. Не всегда, но работает. И настраивается... в определённых пределах.
Фактически самое сложное в этом - пропарсить HTML. Я искал хороший компонент-парсер, но бесплатных хороших нет, платить не хочется, а крякать пока лень. Так что я вернусь к этой задаче, как только она станет первоочередной , а пока - вот код. Он сохраняет загруженную в TWebBrowser страничку вместе с картинками и скриптами. Эти файлы либо берутся из кэша Осла, либо докачиваются из инета. Код проверен на D7.

Unit1.pas

Код

unit Unit1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, mshtml, StrUtils, ShDocVw, wininet, StdCtrls, OleCtrls, ExtCtrls; type   TForm1 = class(TForm)     Edit1: TEdit;     Edit2: TEdit;     Label1: TLabel;     Label2: TLabel;     Button1: TButton;     Panel1: TPanel;     WebBrowser1: TWebBrowser;     Button2: TButton;     procedure Button1Click(Sender: TObject);     procedure Button2Click(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end; const   HTMLLinkedFolderSuffix='.files';   PortionSize=512; var   Form1: TForm1;   ExtensionsList:TStrings; implementation {$R *.dfm} function IsFullURL(Const URL: string): boolean; begin Result := (Pos('://', URL) <> 0) or (Pos('mailto:', Lowercase(URL)) <> 0);    end; function AppearsInList(gLink:string; gList:TStrings):boolean; begin if gList.IndexOf(gLink)>-1   then result:=true   else result:=false; end;//AppearsInList {----------------Combine} function Combine(Base, APath: string): string; {combine a base and a path taking into account that overlap might exist} {needs work for cases where directories might overlap} var   I, J, K: integer; begin J := Pos('://', Base); if J > 0 then   J := Pos('/', Copy(Base, J+3, Length(Base)-(J+2)))+J+2  {third slash} else   J := Pos('/', Base); if J = 0 then   begin   Base := Base+'/';   {needs a slash}   J := Length(Base);   end else if Base[Length(Base)] <> '/' then   Base := Base + '/'; APath := Trim(APath); if (APath <> '') and (APath[1] = '/') then   {remove path from base and use host only}   Result := Copy(Base, 1, J) + Copy(APath, 2, Length(APath)-1) else Result := Base+APath; {remove any '..\'s to simply and standardize for cacheing} I := Pos('/../', Result); while I > 0 do   begin   if I > J then     begin     K := I;     while (I > 1) and (Result[I-1] <> '/') do       Dec(I);     if I <= 1 then Break;     Delete(Result, I, K-I+4);  {remove canceled directory and '/../'}     end   else     Delete(Result, I+1, 3);    {remove '../' after host name}   I := Pos('/../', Result);   end; {remove any './'s} I := Pos('/./', Result); while I > 0 do   begin   Delete(Result, I+1, 2);   I := Pos('/./', Result);   end; end; function IsURLAbsolute(gStr:string):boolean; begin if pos(':',gStr)>0   then result:=true   else result:=false; end;//IsURLAbsolute function GetURLFilenameAndExt(const URL: string): string; var   I: integer; begin Result := URL; for I := Length(URL) downto 1 do   if URL[I] = '/' then     begin     Result := Copy(URL, I+1, 255);     Break;     end; end; function ExtensionAllowed(gExt:string):boolean; begin if ExtensionsList.IndexOf(gExt)>-1   then result:=true   else result:=false; end;//ExtensionAllowed function FindFileToBring(var gStr:string;                                StartPos:integer;                                OpeningExpr:string;                                ClosingExpr:string;                                BasePath:string;                                SaveDir:string;                                ExternalLinks:TStrings):integer; //finds an occurence of external files var   StartFound:integer;   EndFound:integer;   Extracted:string;   WhereToStart:integer;   HowMany:integer;   cExt:string;   TargetLink:string; begin result:=0; StartFound:=PosEx(OpeningExpr,gStr,StartPos); if StartFound=0 then exit; WhereToStart:=StartFound+length(OpeningExpr); EndFound:=PosEx(ClosingExpr,gStr,WhereToStart); if EndFound=0 then exit; HowMany:=EndFound-WhereToStart; Extracted:=copy(gStr,WhereToStart,HowMany); cExt:=copy(ExtractFileExt(Extracted),2,24); if ExtensionAllowed(cExt) then   begin   if not IsURLAbsolute(Extracted)     then TargetLink:=Combine(BasePath,Extracted)     else TargetLink:=Extracted;   if (not AppearsInList(TargetLink,ExternalLinks)) and (not IsFullURL(Extracted)) then ExternalLinks.Add(TargetLink);   TargetLink:=SaveDir+GetURLFilenameAndExt(Extracted);   Delete(gStr,WhereToStart,HowMany);   Insert(TargetLink,gStr,WhereToStart);   end;//if filter passed result:=WhereToStart+length(TargetLink); end;//FindFileToBring procedure FindPairToBring(var gStr:string;                            OpeningExpr:string;                            ClosingExpr:string;                            BasePath:string;                            SaveDir:string;                            ExternalLinks:TStrings); var   cPos:integer; begin cPos:=1; while cPos>0 do cPos:=FindFileToBring(gStr,cPos,OpeningExpr,ClosingExpr,BasePath,SaveDir,ExternalLinks); end;//FindPairToBring {----------------GetBase} function GetBase(const URL: string): string; {Given an URL, get the base directory} var   I, J, LastSlash: integer;   S: string; begin S := Trim(URL); J := Pos('?', S);     if J > 0 then   S := Copy(S, 1, J-1);  {remove Query} J := Pos('//', S); LastSlash := 0; for I := J+2 to Length(S) do   if S[I] = '/' then LastSlash := I; if LastSlash = 0 then   Result := S+'/' else Result := Copy(S, 1, LastSlash); end; procedure PrepareHTMLToSave(gStrs:TStrings;gWB:TWebBrowser;SaveDir:string;ExternalLinks:TStrings); var   wstr:string;   BasePath:string; begin wstr:=gStrs.Text; BasePath:=GetBase(gWB.LocationURL); FindPairToBring(wstr,'url(',')',BasePath,SaveDir,ExternalLinks); FindPairToBring(wstr,' background=',' ',BasePath,SaveDir,ExternalLinks); FindPairToBring(wstr,' src="','"',BasePath,SaveDir,ExternalLinks); gStrs.Text:=wstr; end;//PrepareHTMLToSave function GetHTMLLinkedFolderName(gFN:string):string; var   cExt:string;   cName:string; begin cExt:=ExtractFileExt(gFN); cName:=ExtractFileName(gFN); result:=copy(cName,1,length(cName)-length(cExt))+HTMLLinkedFolderSuffix; end;//GetHTMLLinkedFolderName function DownloadFile(URL,FileName: string):boolean; var   MegaBuffer:array of byte;   TotalRead:cardinal;   fH:integer; function GetFile(const Url: string):boolean; var   NetHandle: HInternet;   UrlHandle: HInternet;   Buffer: array[0..PortionSize-1] of byte;   BytesRead: cardinal; begin Result:=false; NetHandle:=InternetOpen('ArbSurfer',                         INTERNET_OPEN_TYPE_PRECONFIG,                         nil, nil,0); if not Assigned(NetHandle) then exit; Application.ProcessMessages; UrlHandle:=InternetOpenUrl(NetHandle,                            PChar(Url),                            nil,0,                            INTERNET_FLAG_RELOAD,0); if not Assigned(UrlHandle) then   begin   InternetCloseHandle(NetHandle);   exit;   end; Application.ProcessMessages; TotalRead:=0; SetLength(MegaBuffer,PortionSize); repeat if not InternetReadFile(UrlHandle,@Buffer,PortionSize,BytesRead) then exit; move(Buffer,MegaBuffer[TotalRead],BytesRead); TotalRead:=TotalRead+BytesRead; FillChar(Buffer, PortionSize, 0); SetLength(MegaBuffer,TotalRead+PortionSize); Application.ProcessMessages; until BytesRead=0; InternetCloseHandle(UrlHandle); result:=true; end;//GetFile begin result:=false; if URL='' then exit; if FileName='' then exit; if URL[2]=':' then URL:='file:///'+URL; if copy(URL,1,8)='file:///' then URL:='file://'+copy(URL,9,length(URL)); if not GetFile(URL) then exit; fH:=fileCreate(FileName); if fH=-1 then exit; fileWrite(fH,MegaBuffer[0],TotalRead); fileClose(fH); result:=true; end;//DownloadFile procedure DownloadFilesByList(gFilesList:TStrings;gTargetFolder:string); var   i:integer; begin for i:=0 to gFilesList.Count-1 do   begin   Application.ProcessMessages;   DownloadFile(gFilesList[i],gTargetFolder+'\'+GetURLFilenameAndExt(gFilesList[i]));   end;//for end;//DownloadFilesByList procedure SaveWBFull(const FileName: string; WB: TWebBrowser); var   wstrs:TStrings;   LinkedFolderAbs:string;   LinkedFolderName:string;   ExternalLinks:TStrings; begin wstrs:=TStringList.Create; ExternalLinks:=TStringList.Create; LinkedFolderName:=GetHTMLLinkedFolderName(FileName); LinkedFolderAbs:=ExtractFileDir(FileName)+'\'+LinkedFolderName; try wstrs.Text:=WB.OleObject.Document.All.Tags('HTML').Item(0).OuterHTML; PrepareHTMLToSave(wstrs,WB,LinkedFolderName+'\',ExternalLinks); if ExternalLinks.Count>0 then   begin   if not DirectoryExists(LinkedFolderAbs) then     if not CreateDir(LinkedFolderAbs) then       begin       showmessage('Error creating folder '+LinkedFolderAbs);       ExternalLinks.Free;       wstrs.Free;       exit;       end;   DownloadFilesByList(ExternalLinks,LinkedFolderAbs);   end;//if there are aux. files to save wstrs.SaveToFile(FileName); except {$IFDEF DebugMode} showmessage('Error during SaveWBFull.'); {$ENDIF} end;//except ExternalLinks.Free; wstrs.Free; end; procedure TForm1.Button1Click(Sender: TObject); begin WebBrowser1.Navigate(Edit1.Text); end; procedure TForm1.Button2Click(Sender: TObject); begin SaveWBFull(Edit2.Text,WebBrowser1); showmessage('Download complete'); end; initialization ExtensionsList:=TStringList.Create; ExtensionsList.Add('gif'); ExtensionsList.Add('jpg'); ExtensionsList.Add('png'); ExtensionsList.Add('js'); ExtensionsList.Add('css'); finalization ExtensionsList.Free; end.

Unit1.dfm

Код

object Form1: TForm1   Left = 211   Top = 80   Width = 475   Height = 306   Caption = 'Form1'   Color = clBtnFace   Font.Charset = DEFAULT_CHARSET   Font.Color = clWindowText   Font.Height = -11   Font.Name = 'MS Sans Serif'   Font.Style = []   OldCreateOrder = False   PixelsPerInch = 96   TextHeight = 13   object Label1: TLabel     Left = 8     Top = 8     Width = 23     Height = 13     Caption = 'From'   end   object Label2: TLabel     Left = 8     Top = 56     Width = 13     Height = 13     Caption = 'To'   end   object Edit1: TEdit     Left = 40     Top = 0     Width = 329     Height = 21     TabOrder = 0     Text = 'http://forum.vingrad.ru/index.php?showforum=84'   end   object Edit2: TEdit     Left = 40     Top = 48     Width = 329     Height = 21     TabOrder = 1     Text = 'D:\Tmp\saved.html'   end   object Button1: TButton     Left = 376     Top = 0     Width = 89     Height = 33     Caption = 'Go get it'     TabOrder = 2     OnClick = Button1Click   end   object Panel1: TPanel     Left = 16     Top = 88     Width = 441     Height = 185     Caption = 'Panel1'     TabOrder = 3     object WebBrowser1: TWebBrowser       Left = 1       Top = 1       Width = 439       Height = 183       Align = alClient       TabOrder = 0       ControlData = {         4C0000005F2D0000EA1200000000000000000000000000000000000000000000         000000004C000000000000000000000001000000E0D057007335CF11AE690800         2B2E126208000000000000004C0000000114020000000000C000000000000046         8000000000000000000000000000000000000000000000000000000000000000         00000000000000000100000000000000000000000000000000000000}     end   end   object Button2: TButton     Left = 376     Top = 40     Width = 89     Height = 33     Caption = 'Save to disk'     TabOrder = 4     OnClick = Button2Click   end end

жалко, но здесь нет того, что я искал, зато есть то, что я не знал

этот код

Код

var   Document: IHTMLDocument2;   V: OleVariant; begin   Document := WebBrowser1.Document as IHTMLDocument2;   V := VarArrayCreate([0, 0], varVariant);   V[0] := Text;   Document.Writeln(PSafeArray(TVarData(v).VArray)); end;

может загружать только строку, при попытке загружить картинку выходит Access Violation. Похоже единственный выход - это загружать страницу через Navigate без картинок (никто не знает как это сделать? ), а затем менять адреса картинок на свои.

Кстати интересно было бы посмотреть на код Navigate'а, тогда бы решились все наши проблемы




Это сообщение отредактировал(а) Riki_tiki_tavi - 12.3.2005, 10:32