Delphi / Pascal : Intégration de page html dans les ressources d'une dll

Description

Juste un outil permettant de créer/modifier des dll de ressources dans le but de stocker des fichiers html/css/js et images(jpeg, gif, png, ...). La dll peut ensuite être utilisée dans n'importe quel programme avec un TWebBrowser ou un TembeddedWB.
Les composants suivants sont nécessaires pour compiler le programme :
- TembeddedWB : http://sourceforge.net/projects/embeddedwb/
- spTbxLib : http://www.silverpointdevelopment.com/
- VitualTreeView : http://www.soft-gems.net/
- synedit : http://sourceforge.net/projects/synedit/
Un executable est présent dans l'archive pour tester le programme.
Source / Exemple :

unit F_HTMLRes;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SpTBXItem, SpTBXSkins, SpTBXTabs, SpTBXControls,
  OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB, U_HtmlResURL,
  StdCtrls, SpTBXEditors, SpTBXDkPanels, TB2Dock, TB2Toolbar, TB2Item, Mask,
  rxToolEdit, TntDialogs, VirtualTrees, SynEdit, SynHighlighterCss,
  SynHighlighterHtml, SynEditHighlighter, SynHighlighterJScript,
  cyFlyingContainer, EIGToolBox, ActnList;

type
  pReadRES = ^TReadRES;
  TReadRES = packed record
    ResID   : integer;
    ResName : AnsiString;
    ResType : AnsiString;
  end;

  pTabReadRES = ^TTabReadRES;
  TTabReadRES = array of TReadRES;

  TFrm_HTMLRes = class(TForm)
    pgc_main: TSpTBXTabControl;
    pg_first: TSpTBXTabItem;
    pg_Proj: TSpTBXTabItem;
    SpTBXTabSheet1: TSpTBXTabSheet;
    SpTBXPanel2: TSpTBXPanel;
    page_projet: TSpTBXTabSheet;
    SpTBXPanel3: TSpTBXPanel;
    edt_DLL: TSpTBXButtonEdit;
    SpTBXLabel1: TSpTBXLabel;
    SpTBXDockablePanel1: TSpTBXDockablePanel;
    WB: TEmbeddedWB;
    OpenD: TOpenDialog;
    SpTBXPanel1: TSpTBXPanel;
    VST: TVirtualStringTree;
    SpTBXSplitter1: TSpTBXSplitter;
    pgc_read: TSpTBXTabControl;
    pg_readHTML: TSpTBXTabItem;
    pg_html: TSpTBXTabSheet;
    SpTBXPanel4: TSpTBXPanel;
    WB_read: TEmbeddedWB;
    SpTBXTabItem1: TSpTBXTabItem;
    pg_text: TSpTBXTabSheet;
    SpTBXPanel5: TSpTBXPanel;
    SynJScript: TSynJScriptSyn;
    SynHTML: TSynHTMLSyn;
    SynCss: TSynCssSyn;
    SynEditRes: TSynEdit;
    SpTBXPanel6: TSpTBXPanel;
    pg_tools1: TSpTBXTabItem;
    SpTBXTabSheet3: TSpTBXTabSheet;
    pnl_editSyn: TSpTBXDockablePanel;
    item_resName: TSpTBXItem;
    SpTBXPanel7: TSpTBXPanel;
    SynEdit_mod: TSynEdit;
    bt_valid: TSpTBXButton;
    SpTBXButton2: TSpTBXButton;
    Fly_Edit: TcyFlyingContainer;
    SpTBXToolbar1: TSpTBXToolbar;
    SpTBXItem1: TSpTBXItem;
    SpTBXItem2: TSpTBXItem;
    SpTBXItem3: TSpTBXItem;
    TBSeparatorItem1: TTBSeparatorItem;
    TBSeparatorItem2: TTBSeparatorItem;
    ActionList1: TActionList;
    act_ajouter: TAction;
    act_modifier: TAction;
    act_supprimer: TAction;
    OpenNew: TOpenDialog;
    pnl_NewRES: TSpTBXPanel;
    edt_Alias: TSpTBXEdit;
    edt_SRCNew: TSpTBXButtonEdit;
    Source: TSpTBXLabel;
    Alias: TSpTBXLabel;
    SpTBXLabel2: TSpTBXLabel;
    Lab_Alias: TSpTBXLabel;
    SpTBXLabel4: TSpTBXLabel;
    SpTBXButton1: TSpTBXButton;
    SpTBXButton3: TSpTBXButton;
    Fly_NewRES: TcyFlyingContainer;
    SpTBXButton4: TSpTBXButton;
    SaveDLL: TSaveDialog;
    procedure SpTBXButton4Click(Sender: TObject);
    procedure SpTBXButton1Click(Sender: TObject);
    procedure edt_AliasChange(Sender: TObject);
    procedure edt_AliasKeyPress(Sender: TObject; var Key: Char);
    procedure edt_SRCNewSubEditButton0Click(Sender: TObject);
    procedure SpTBXButton3Click(Sender: TObject);
    procedure act_supprimerExecute(Sender: TObject);
    procedure act_modifierExecute(Sender: TObject);
    procedure act_ajouterExecute(Sender: TObject);
    procedure bt_validClick(Sender: TObject);
    procedure SpTBXButton2Click(Sender: TObject);
    procedure VSTDblClick(Sender: TObject);
    procedure SynEditResDblClick(Sender: TObject);
    procedure VSTFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex);
    procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
    procedure VSTGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure edt_DLLSubEditButton0Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    sCopyFile : string;
    lib_DLL : THandle;
    pReads : pTabReadRES;
    SelectedNode : PVirtualNode;
    procedure readRessourcesFromFile(afile : string);
    procedure doEditSynActive;
    procedure DoUpdateRESText;
    procedure doUpdateRESBin;
    procedure doMakeAlias;
    procedure DoMakeRealAlias;
    procedure CreateNewDLL(aFileName : string);
    function  dofindRessource(aName : string) : Boolean;
  public
    constructor Create(aOwner : TComponent);override;
    destructor Destroy;override;
  end;

var
  Frm_HTMLRes: TFrm_HTMLRes;

implementation

{$R *.dfm}
{$Resource DLL.res}

const
  rt_html = MakeIntResource(23);

Function _FormaterCode(Chaine : string; Upper : Boolean = true) : string;
Var	Tmp	:	String;
		Tmp2	:	String;
     P		:	Integer;
Begin
	if Upper then Tmp2 := UpperCase(trim(Chaine))
  else tmp2 := trim(Chaine);
	For p := 1 To Length(Tmp2) Do
  	Begin
			Case Tmp2[P] Of
        	'a' .. 'z', 'A' .. 'Z', '0' .. '9', '_': Tmp := Tmp + Tmp2[P];
        end;
     End;
	Result := Tmp;
End;

Function StockResourceType(restype: PChar): string;
const
  restypenames: Array [1..23] of String =
    ( 'RT_CURSOR',
      'RT_BITMAP',
      'RT_ICON',
      'RT_MENU',
      'RT_DIALOG',
      'RT_STRING',
      'RT_FONTDIR',
      'RT_FONT',
      'RT_ACCELERATOR',
      'RT_RCDATA',
      'RT_MESSAGETABLE',
      'RT_GROUP_CURSOR',
      'UNKNOWN',
      'RT_GROUP_ICON',
      'UNKNOWN',
      'RT_VERSION',
      'RT_DLGINCLUDE',
      'UNKNOWN',
      'RT_PLUGPLAY',
      'RT_VXD',
      'RT_ANICURSOR',
      'RT_ANIICON',

      'RT_HTML'        // MakeIntResource(23);
    );
var
  resid: Cardinal absolute restype;
begin
  if resid in [1..23] then
    Result := restypenames[resid]
  else
    Result := 'UNKNOWN';
end;

function enumResNamesProc(module: HMODULE; restype, resname: PChar;
  ptab : pTabReadRES): Integer; stdcall;
var i : integer;
begin
  if HiWord(Cardinal(resname)) <> 0 then begin
    i := length(pTab^); inc(i); setLength(pTab^, i); dec(i);
    pTab^[i].ResType := StockResourceType(restype);
    pTab^[i].ResName := resname;
    pTab^[i].ResID := 1;
  end
  else begin
    i := length(pTab^); inc(i); setLength(pTab^, i); dec(i);
    pTab^[i].ResType := StockResourceType(restype);
    pTab^[i].ResName := Format('  #%d', [loword(Cardinal(resname))]);
    pTab^[i].ResID := 1;
  end;
  Result := 1;

end;

function enumResTypesProc(module: HMODULE; restype: PChar; ptab : pTabReadRES): Integer; stdcall;
begin
  if StockResourcetype(restype) = 'RT_HTML' then begin
    EnumResourceNames(module, restype, @enumResNamesProc, Integer(pTab));
  end;
  Result := 1;
end;

{ TFrm_HTMLRes }

procedure TFrm_HTMLRes.act_ajouterExecute(Sender: TObject);
begin
  if lib_Dll = 0 then
    raise exception.Create('Pas de fichier de ressource chargé');

  edt_Alias.Text := '';
  edt_SRCNew.Text := '';
  Lab_Alias.Caption := '';

  Fly_NewRES.Control := pnl_NewRES;
  Fly_NewRES.Execute(foMainCenter);
end;

procedure TFrm_HTMLRes.act_modifierExecute(Sender: TObject);
begin
//
end;

procedure TFrm_HTMLRes.act_supprimerExecute(Sender: TObject);
var N : PVirtualNode;
    p : pReadRES;

    HUpdate: THandle;
    sName : string;
    frCode : Longword;
begin
  N := VST.FocusedNode;
  if N = nil then Exit;
  p := pReadRES(VST.GetNodeData(N)^);

  if MessageDlg('Supprimer la ressource "' + p^.ResName + '" ?', mtConfirmation, [mbYes, mbNo], 1)=mrNo then Exit; 

  frCode := (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
  sName := p^.ResName;

  FreeLibrary(lib_DLL);
  try
    HUpdate := BeginUpdateResource(pAnsiChar(sCopyFile), FALSE);
    if Hupdate = 0 then
      Raise exception.Create(Format('Impossible de mettre à jour la ressource : %8.8x', [GetLastError]));
    try
      UpdateResource(HUpdate, rt_html, pansiChar(sName), frCode, nil, 0);
    finally
      EndUpdateResource(HUpdate, FALSE);
    end;
  finally
    if FileExists(edt_DLL.Text) then
      DeleteFile(edt_DLL.Text);
    CopyFileOperation(sCopyFile, edt_DLL.Text);

    Lib_Dll := LoadLibrary(pansiChar(sCopyFile));
    VST.DeleteNode(N);
  end;
  
end;

procedure TFrm_HTMLRes.bt_validClick(Sender: TObject);
begin
  DoUpdateRESText;
  VSTFocusChanged(VST, SelectedNode, 0);
  Fly_Edit.Close(mrOk);
end;

constructor TFrm_HTMLRes.Create(aOwner: TComponent);
begin
  inherited create(aOwner);
  New(pReads);
  SetLength(pReads^, 0);

  sCopyFile := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'WorkDLL.dll';
end;

procedure TFrm_HTMLRes.CreateNewDLL(aFileName: string);
var RS : TResourceStream;
begin
  if FileExists(aFileName) then DeleteFile(aFileName);
  RS := TResourceStream.Create(HInstance, 'DLL_VIDE', RT_RCDATA);
  try
    RS.SaveToFile(aFileName);
  finally
    RS.Free;
  end;
  if FileExists(aFileName) then begin
    edt_DLL.Text := aFileName;
    readRessourcesFromFile(aFileName);
  end;
end;

destructor TFrm_HTMLRes.Destroy;
begin
  dispose(pReads);
  if lib_DLL <> 0 then FreeLibrary(lib_DLL);
  if FileExists(sCopyFile) then DeleteFile(sCopyFile);
  inherited Destroy;
end;

procedure TFrm_HTMLRes.doEditSynActive;
var pt : TPoint;
    N : PVirtualNode;
    p : pReadRES;
begin
  if Fly_Edit.Active then Exit;
  pnl_editSyn.Height := (Screen.Height div 10) * 9;
  pnl_editSyn.Width := Screen.Width - 20;

  Fly_Edit.Control := pnl_editSyn;
  SynEdit_mod.Highlighter := SynEditRes.Highlighter;
  SynEdit_mod.Lines.text := SynEditRes.Lines.Text;

  N := VST.FocusedNode;
  p := pReadRES(VST.GetNodeData(N)^);
  item_resName.Caption := p^.ResName;
  SelectedNode := N;

  pt := point(screen.MonitorFromWindow(Self.Handle).Left + 10,
              screen.MonitorFromWindow(Self.Handle).Top + 5);
  Fly_Edit.Execute(pt);
end;

function TFrm_HTMLRes.dofindRessource(aName: string): Boolean;
var N : PVirtualNode;
    p : pReadRES;
begin
  result := False;
  N := VST.GetFirst;
  while N <> nil do begin
    p := pReadRES(VST.GetNodeData(N)^);
    if p^.ResID = 1 then begin
      if UpperCase(trim(p^.ResName)) = uppercase(trim(aName)) then begin
        Result := true;
        break;
      end;
    end;
    N := VST.GetNext(N);
  end;
end;

procedure TFrm_HTMLRes.doMakeAlias;
var sExt : string;
begin
  if trim(edt_SRCNew.Text) = '' then begin
    edt_Alias.text := '';
    Lab_Alias.Caption := '';
    exit;
  end;

  sExt := ExtractFileExt(edt_SRCNew.Text);
  if trim(edt_SRCNew.Text) <> '' then begin
    edt_Alias.Text := _FormaterCode(StringReplace(ExtractFileName(edt_SRCNew.Text), sExt, '', []), true);
  end;
  DoMakeRealAlias;
end;

procedure TFrm_HTMLRes.DoMakeRealAlias;
var sExt : string;
begin
  sExt := ExtractFileExt(edt_SRCNew.Text);
  
  sExt := UpperCase(sExt);
  if sExt = '.CSS' then Lab_Alias.Caption := 'CSS_' + edt_Alias.Text
  else if sExt = '.JS'   then Lab_Alias.Caption := 'JS_'   + edt_Alias.Text
  else if sExt = '.JPEG' then Lab_Alias.Caption := 'IMG_'  + edt_Alias.Text
  else if sExt = '.JPG'  then Lab_Alias.Caption := 'IMG_'  + edt_Alias.Text
  else if sExt = '.BMP'  then Lab_Alias.Caption := 'IMG_'  + edt_Alias.Text
  else if sExt = '.GIF'  then Lab_Alias.Caption := 'IMG_'  + edt_Alias.Text
  else if sExt = '.PNG'  then Lab_Alias.Caption := 'IMG_'  + edt_Alias.Text
  else Lab_Alias.Caption := edt_Alias.Text;
end;

procedure TFrm_HTMLRes.doUpdateRESBin;
var HUpdate: THandle;
    sName : string;
    frCode : Longword;
    si : Cardinal;
    f  : file;
    p : pChar;
begin
  frCode := (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
  sName := Lab_Alias.Caption;

  AssignFile(f, edt_SRCNew.Text);
  reset(f, 1);
  FreeLibrary(lib_DLL);
  try
    HUpdate := BeginUpdateResource(pAnsiChar(sCopyFile), FALSE);
    if Hupdate = 0 then
      Raise exception.Create(Format('Impossible de mettre à jour la ressource : %8.8x', [GetLastError]));
    try
      si := FileSize(f);
      GetMem(p, si);
      BlockRead(f, p^, si);
      UpdateResource(HUpdate, rt_html, pansiChar(sName), frCode, p, si);
      FreeMem(p);
    finally
      EndUpdateResource(HUpdate, FALSE);
    end;
  finally
    CloseFile(f);
    if FileExists(edt_DLL.Text) then
      DeleteFile(edt_DLL.Text);
    CopyFileOperation(sCopyFile, edt_DLL.Text);

    Lib_Dll := LoadLibrary(pansiChar(sCopyFile));
  end;
end;

procedure TFrm_HTMLRes.DoUpdateRESText;
var HUpdate: THandle;
    sName : string;
    frCode : Longword;
    si : Cardinal;
    sValue : string;

begin
  frCode := (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
  sName := item_resName.Caption;

  FreeLibrary(lib_DLL);
  try
    HUpdate := BeginUpdateResource(pAnsiChar(sCopyFile), FALSE);
    if Hupdate = 0 then
      Raise exception.Create(Format('Impossible de mettre à jour la ressource : %8.8x', [GetLastError]));
    try
      sValue := SynEdit_mod.lines.text;
      si := length(sValue);
      UpdateResource(HUpdate, rt_html, pansiChar(sName), frCode, pChar(sValue), si);
    finally
      EndUpdateResource(HUpdate, FALSE);
    end;
  finally
    if FileExists(edt_DLL.Text) then
      DeleteFile(edt_DLL.Text);
    CopyFileOperation(sCopyFile, edt_DLL.Text);

    Lib_Dll := LoadLibrary(pansiChar(sCopyFile));
  end;
end;

procedure TFrm_HTMLRes.edt_AliasChange(Sender: TObject);
begin
  DoMakeRealAlias;
end;

procedure TFrm_HTMLRes.edt_AliasKeyPress(Sender: TObject; var Key: Char);
begin
   case Key of
     'a' .. 'z', 'A' .. 'Z', '0' .. '9', '_', #37, #39, #46, #8 : exit;
     else Key := #0;
   end;
end;

procedure TFrm_HTMLRes.edt_DLLSubEditButton0Click(Sender: TObject);
begin
  if OpenD.Execute(HInstance) then begin
    edt_DLL.Text := OpenD.FileName;
    readRessourcesFromFile(OpenD.FileName);
  end;
end;

procedure TFrm_HTMLRes.edt_SRCNewSubEditButton0Click(Sender: TObject);
begin
  if OpenNew.Execute then begin
    edt_SRCNew.Text := OpenNew.FileName;
    doMakeAlias;
  end;
end;

procedure TFrm_HTMLRes.FormShow(Sender: TObject);
begin
  if SkinManager.SkinsList.IndexOf('EIG')>=0 then
    SkinManager.SetSkin('EIG')
  else SkinManager.SetSkin('Leopard');

  pgc_main.ActivePage := page_projet;
  pgc_main.TabVisible := False;
end;

procedure TFrm_HTMLRes.readRessourcesFromFile(afile: string);
var i : integer;
    Ni, Nh, Nc, Nj : PVirtualNode;
    sBak : string;
begin
  if Not FileExists(aFile) then Exit;
  if lib_DLL <> 0 then FreeLibrary(lib_DLL);

  if FileExists(sCopyFile) then
    DeleteFile(sCopyFile);
  CopyFileOperation(aFile, sCopyFile);

  sBak := aFile + '.Bak';
  if FileExists(sBak) then DeleteFile(sBak);
  CopyFileOperation(aFile, sBak);

  lib_DLL := LoadLibrary(pansiChar(sCopyFile));

  VST.BeginUpdate;
  try
    SetLength(pReads^, 0);
    VST.clear;

    SetLength(pReads^, 4);

    if not EnumResourceTypes(lib_DLL, @enumResTypesProc, integer(pReads)) then
      MessageDlg(Format('Lecture des ressources= %8.8x', [GetLastError]), mtError, [mbok], 0)
    else begin

      pReads^[0].ResID := 0;
      pReads^[0].ResName := 'IMAGES';
      pReads^[0].ResType := 'RT_IMAG';
      Ni := VST.AddChild(nil, @pReads^[0]);
      pReads^[1].ResID := 0;
      pReads^[1].ResName := 'CSS';
      pReads^[1].ResType := 'RT_CSS';
      Nc := VST.AddChild(nil, @pReads^[1]);
      pReads^[2].ResID := 0;
      pReads^[2].ResName := 'JAVA SCRIPT';
      pReads^[2].ResType := 'RT_JS';
      Nj := VST.AddChild(nil, @pReads^[2]);
      pReads^[3].ResID := 0;
      pReads^[3].ResName := 'HTML';
      pReads^[3].ResType := 'RT_HTML';
      Nh := VST.AddChild(nil, @pReads^[3]);

      for i := low(pReads^) to High(pReads^) do begin
        if pReads^[i].ResID = 1 then begin
          if pos('IMG_', pReads^[i].ResName)=1 then
            VST.AddChild(Ni, @pReads^[i])
          else if pos('CSS_', pReads^[i].ResName)=1 then
            VST.AddChild(Nc, @pReads^[i])
          else if pos('JS_', pReads^[i].ResName)=1 then
            VST.AddChild(Nj, @pReads^[i])
          else
            VST.AddChild(Nh, @pReads^[i]);
        end;
      end;
    end;
    
  finally
    VST.EndUpdate;
  end;

end;

procedure TFrm_HTMLRes.SpTBXButton1Click(Sender: TObject);
begin
  if not FileExists(edt_SRCNew.text) then Exit;
  if trim(Lab_Alias.Caption) = '' then Exit;

  if dofindRessource(Lab_Alias.Caption) then
    raise exception.Create('Une ressource portant ce nom existe déja');

  doUpdateRESBin;
  readRessourcesFromFile(edt_DLL.Text);
  Fly_NewRES.Close;
end;

procedure TFrm_HTMLRes.SpTBXButton2Click(Sender: TObject);
begin
  Fly_Edit.Close;
end;

procedure TFrm_HTMLRes.SpTBXButton3Click(Sender: TObject);
begin
  Fly_NewRES.Close;
end;

procedure TFrm_HTMLRes.SpTBXButton4Click(Sender: TObject);
begin

  if SaveDLL.Execute then
    CreateNewDLL(SaveDLL.FileName);
end;

procedure TFrm_HTMLRes.SynEditResDblClick(Sender: TObject);
begin
  doEditSynActive;
end;

procedure TFrm_HTMLRes.VSTDblClick(Sender: TObject);
begin
  if SynEditRes.lines.Count > 0 then
    doEditSynActive;
end;

procedure TFrm_HTMLRes.VSTFocusChanged(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
var p : pReadRES;
    s, sName : string;
    m : TMemoryStream;

  procedure InitSynEditHtml;
  var HResInfo: HRSRC;
      HGlobal: THandle;
      buffer : PChar;
  begin
    HResInfo := FindResource(Lib_DLL, pChar(sName), rt_html);
    HGlobal := LoadResource(lib_dll, HResInfo);
    try
      if HGlobal <> 0 then begin
        buffer := LockResource(HGlobal);
        M.WriteBuffer(buffer[0], SizeOfResource(lib_DLL, HResInfo));
        UnlockResource(HGlobal);
        M.Seek(0, soFromBeginning);
        SynEditRes.Lines.LoadFromStream(M);
      end;
    finally
      FreeResource(HGlobal);
    end;
  end;

begin
  if node = nil then begin
    act_modifier.Enabled  := False;
    act_supprimer.Enabled := False;
    Exit;
  end;
  if lib_DLL = 0 then Exit;
  p := pReadRES(VST.GetNodeData(Node)^);
  sName := p^.ResName;

  act_modifier.Enabled  := True;
  act_supprimer.Enabled := True;

  SynEditRes.lines.Text := '';

  m := TMemoryStream.Create;
  try
    if p^.ResID = 1 then begin
      if pos('CSS_', sName)=1 then begin
        WB_read.go('about:blank');
        pgc_read.ActivePage := pg_text;
        SynEditRes.Highlighter := SynCss;
        InitSynEditHtml;
      end
      else if pos('JS_', sName)=1 then begin
        WB_read.go(MakeResourceURL(Lib_DLL, pansichar(sName), rt_html));
        pgc_read.ActivePage := pg_text;
        SynEditRes.Highlighter := SynJScript;
        SynEditRes.Lines.Text := WB_read.DocumentSource;
        InitSynEditHtml;
      end
      else if pos('IMG_', sName)=1 then begin
        SynEditRes.Highlighter := SynHTML;
        SynEditRes.lines.Text := '';
        WB_read.go(MakeResourceURL(Lib_DLL, pansichar(sName), rt_html));
        pgc_read.ActivePage := pg_html;
      end
      else begin
        s := MakeResourceURL(Lib_DLL, pansichar(sName), rt_html);
        WB_read.go(s);
        pgc_read.ActivePage := pg_html;
        SynEditRes.Highlighter := SynHTML;
        SynEditRes.Lines.Text := WB_read.DocumentSource;
        InitSynEditHtml;
      end
    end
    else begin
      WB_read.go('about:blank');
      pgc_read.ActivePage := pg_html;
    end;
  finally
    m.free;
  end;

end;

procedure TFrm_HTMLRes.VSTGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := 4;
end;

procedure TFrm_HTMLRes.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
var p : pReadRES;
begin
  p := pReadRES(VST.GetNodeData(Node)^);

  Celltext := p^.ResName;
end;

end.

//---------------------------------------------------------------------------------------------------------

unit U_HtmlResURL;

interface
uses 
  SysUtils,
  Classes,
  Windows;

  function URLEncode(const S: string): string;
  function FormatResNameOrType(ResID: PChar): string;
  function MakeResourceURL(const ModuleName: string; const ResName: PChar;
                           const ResType: PChar = nil): string; overload;
  function MakeResourceURL(const Module: HMODULE; const ResName: PChar;
                           const ResType: PChar = nil): string; overload;
  function MakeResourceHTML(const Module: HMODULE; const ResName: PChar): string; 

implementation
var _Lib_HTML : THandle;

function URLEncode(const S: string): string;
var
  Idx: Integer;
begin
  Result := '';
  for Idx := 1 to Length(S) do
  begin
    {$IFDEF UNICODE}
    if CharInSet(S[Idx], ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.']) then
    {$ELSE}
    if S[Idx] in ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.'] then
    {$ENDIF}
      Result := Result + S[Idx]
    else
      Result := Result + '%' + IntToHex(Ord(S[Idx]), 2);
  end;
end;

function FormatResNameOrType(ResID: PChar): string;
begin
  if HiWord(LongWord(ResID)) = 0 then
    // high word = 0 => numeric resource id
    // numeric value is stored in low word
    Result := Format('#%d', [LoWord(LongWord(ResID))])
  else
    // high word <> 0 => string value
    // PChar is implicitly converted to string
    Result := ResID;
end;

function MakeResourceURL(const ModuleName: string; const ResName: PChar;
  const ResType: PChar = nil): string; overload;
begin
  Assert(ModuleName <> '');
  Assert(Assigned(ResName));
  Result := 'res://' + URLEncode(ModuleName);
  if Assigned(ResType) then
    Result := Result + '/' + URLEncode(FormatResNameOrType(ResType));
  Result := Result + '/' + URLEncode(FormatResNameOrType(ResName));
end;

function MakeResourceURL(const Module: HMODULE; const ResName: PChar;
  const ResType: PChar = nil): string; overload;
begin
  Result := MakeResourceURL(GetModuleName(Module), ResName, ResType);
end;

function MakeResourceHTML(const Module: HMODULE; const ResName: PChar): string;
const
  RT_HTML = MakeIntResource(23);
begin
  Result := MakeResourceURL(GetModuleName(Module), ResName, RT_HTML);
end;

end.
Télécharger le projet
Codes Sources

A voir également

Delphi getlasterror
Delphi embeddedwb - Meilleures réponses
Getlasterror delphi - Meilleures réponses
Integration d'un fichier a une page html - Codes sources - Visual Basic / VB.NET (Sécurité)
GTKMM - Affichage/Intégration d'une page HTML ✓ - Forum - C++ & C++ .NET
Appeler un fichier javascript dans une page html - Conseils pratiques - Javascript
Créer une page html avec python - Forum - Python
Python : Créer une page html (avec interface graphique) - CodeS SourceS - Guide
Ajouter un commentaire
S'inscrire maintenant
Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.
Source / Exemple :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
