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.
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.