We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Course Of The Month
4 days, 5 hours left to enrollBecome a Premium Member and unlock a new, free course in leading technologies each month.
Solved
URL Monikers
Posted on 1998-06-03
Has anyone got a clue how to write an URL Moniker?
I am trying to use the Intenet Explorer to display HTML files that I pull out of a OLE2 structured storage file. Microsoft does s.th very similar in their Infoviewer 5 (comes with the MSDN): If you have the MSDN installed an type something like
mk:@ivt:activex/start.htm
IE will display the file start.htm from the knowledgebase file activex.ivt.
I already have found out that "ivt" in the above URL is registered in the registry and seems to be an URL Moniker. And from the MSDN I found out that I need to write an URL Moniker server.
Before I waste my time re-inventing the wheel: has somebody out there already written one?
Best regards,
Freter
I am trying to use the Intenet Explorer to display HTML files that I pull out of a OLE2 structured storage file. Microsoft does s.th very similar in their Infoviewer 5 (comes with the MSDN): If you have the MSDN installed an type something like
mk:@ivt:activex/start.htm
IE will display the file start.htm from the knowledgebase file activex.ivt.
I already have found out that "ivt" in the above URL is registered in the registry and seems to be an URL Moniker. And from the MSDN I found out that I need to write an URL Moniker server.
Before I waste my time re-inventing the wheel: has somebody out there already written one?
Best regards,
Freter
[X]
Welcome to Experts Exchange
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
- Help others & share knowledge
- Earn cash & points
- Learn & ask questions
-
8
-
6
-
2
- +1
17 Comments
Hm...
I have seen that before, but it doesn't help me.
I need a DLL that can be invoke by Intenet Explorer, just like the ivtmon.dll that is referenced by the string "ivt" in the URL depicted in my question.
I have seen that before, but it doesn't help me.
I need a DLL that can be invoke by Intenet Explorer, just like the ivtmon.dll that is referenced by the string "ivt" in the URL depicted in my question.
Yep, did that one some time ago. It was a pain in the ass to get all the information, because it is only well documented how to *use* monikers, but not how to *write* them.
I built a sample moniker that simply displays HTML files from a file system or an error message if the file was not found. E.g. you set the moniker root to
c:\hello
and type in IE
mk:@slashmoniker:/my/baby.
it would load c:\hello\my\baby.html
Sure you could dispatch any path to anywhere.
You'll get the moniker code for 300 points, it took me about 5 weeks to figure all the details out.
Slash/d003303
I built a sample moniker that simply displays HTML files from a file system or an error message if the file was not found. E.g. you set the moniker root to
c:\hello
and type in IE
mk:@slashmoniker:/my/baby.
it would load c:\hello\my\baby.html
Sure you could dispatch any path to anywhere.
You'll get the moniker code for 300 points, it took me about 5 weeks to figure all the details out.
Slash/d003303
Slash/d003303:
One question before I increase the points for you:
Is your moniker able to provide the embedded images of the html page out to explorer?
Freter
One question before I increase the points for you:
Is your moniker able to provide the embedded images of the html page out to explorer?
Freter
Yo,
all embedded objects (images, plug-in codbases, etc.) that have a relative path are combined to a full qualified path by IE before they are requested. E.g. if <IMG SRC="/images/help.gif"> is part of a page provided by my moniker, IE would create the full referenced path mk:@slashmoniker:/images/h
Because IE builds full referenced URLs compilant to RFC 2068, you can also prefix the moniker root like M$ does. The "mk:@slashmoniker:" identifies the protocol (equi to http:), then comes the "//(server)" part, then a directory/file path (you may omit the server part). So if the page location of the above example would be mk:@slashmoniker://MyDatab
This gives you flexibility on interpretation of the URL and organization of your database archive. E.g. you could also provide mk:@slashmoniker:MyServer/
You can do anything you like and easily run a website fromout a database.
Hope this answers your question.
Slash/d003303
all embedded objects (images, plug-in codbases, etc.) that have a relative path are combined to a full qualified path by IE before they are requested. E.g. if <IMG SRC="/images/help.gif"> is part of a page provided by my moniker, IE would create the full referenced path mk:@slashmoniker:/images/h
Because IE builds full referenced URLs compilant to RFC 2068, you can also prefix the moniker root like M$ does. The "mk:@slashmoniker:" identifies the protocol (equi to http:), then comes the "//(server)" part, then a directory/file path (you may omit the server part). So if the page location of the above example would be mk:@slashmoniker://MyDatab
This gives you flexibility on interpretation of the URL and organization of your database archive. E.g. you could also provide mk:@slashmoniker:MyServer/
You can do anything you like and easily run a website fromout a database.
Hope this answers your question.
Slash/d003303
OK, here we go. This moniker class does a simple parsing of the URL in TMyCustomMoniker.IParseDis
Here's the unit and project, below are the registry keys to set.
// BOC //
unit _MyMoniker;
interface
uses
Windows, Classes, ComObj, ActiveX;
const
CLSID_MyCustomMoniker: TGUID = (
D1:$556F12A1; D2:$DE94; D3:$11D1; D4:($B4, $EA, $00, $00, $E8, $2D, $8A, $65));
Str_CLSID_MyCustomMoniker = '{556F12A1-DE94-11D1-B4EA-
CLSID_NULL: TGUID = (D1:0; D2:0; D3:0; D4:(0, 0, 0, 0, 0, 0, 0, 0));
const
IsDebug = false;
OutStr = '<HTML>An error occured while parsing the URL<BR><B>%s</B><BR>Reques
FileSystemBase = 'c:';
type
TMyCustomMoniker = class(TComObject, IParseDisplayName, IMoniker)
private
FOutStr,
FErrorStr,
FFileName,
FRequestURL : string;
FOLEOutStr : POLEStr;
FHash : Longint;
protected
// IUnknown interface
function ObjAddRef: Integer; override; stdcall;
function ObjQueryInterface(const IID: TGUID; out Obj): Integer; override; stdcall;
function ObjRelease: Integer; override; stdcall;
// IParseDisplayName interface
function IParseDisplayName.ParseDis
function IParseDisplayNameParseDisp
out chEaten: Longint; out mkOut: IMoniker): HResult; stdcall;
// IPersist interface
function GetClassID(out classID: TCLSID): HResult; stdcall;
// IPersistStream interface
function IsDirty: HResult; stdcall;
function Load(const stm: IStream): HResult; stdcall;
function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
// IMoniker interface
function BindToObject(const bc: IBindCtx; const mkToLeft: IMoniker;
const iidResult: TIID; out vResult): HResult; stdcall;
function BindToStorage(const bc: IBindCtx; const mkToLeft: IMoniker;
const iid: TIID; out vObj): HResult; stdcall;
function Reduce(const bc: IBindCtx; dwReduceHowFar: Longint;
mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult; stdcall;
function ComposeWith(const mkRight: IMoniker; fOnlyIfNotGeneric: BOOL;
out mkComposite: IMoniker): HResult; stdcall;
function Enum(fForward: BOOL; out enumMoniker: IEnumMoniker): HResult;
stdcall;
function IsEqual(const mkOtherMoniker: IMoniker): HResult; stdcall;
function Hash(out dwHash: Longint): HResult; stdcall;
function IsRunning(const bc: IBindCtx; const mkToLeft: IMoniker;
const mkNewlyRunning: IMoniker): HResult; stdcall;
function GetTimeOfLastChange(const bc: IBindCtx; const mkToLeft: IMoniker;
out filetime: TFileTime): HResult; stdcall;
function Inverse(out mk: IMoniker): HResult; stdcall;
function CommonPrefixWith(const mkOther: IMoniker;
out mkPrefix: IMoniker): HResult; stdcall;
function RelativePathTo(const mkOther: IMoniker;
out mkRelPath: IMoniker): HResult; stdcall;
function GetDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
out pszDisplayName: POleStr): HResult; stdcall;
function ParseDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
pszDisplayName: POleStr; out chEaten: Longint;
out mkOut: IMoniker): HResult; stdcall;
function IsSystemMoniker(out dwMksys: Longint): HResult; stdcall;
end;
TMyStream = class(TComObject, IStream)
private
FTheStream : TMemoryStream;
FStatStg : TStatStg;
Fmtime,
Fctime,
Fatime : TFileTime;
protected
function Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult;
stdcall;
function Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult;
stdcall;
function Seek(dlibMove: Largeint; dwOrigin: Longint;
out libNewPosition: Largeint): HResult; stdcall;
function SetSize(libNewSize: Largeint): HResult; stdcall;
function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
out cbWritten: Largeint): HResult; stdcall;
function Commit(grfCommitFlags: Longint): HResult; stdcall;
function Revert: HResult; stdcall;
function LockRegion(libOffset: Largeint; cb: Largeint;
dwLockType: Longint): HResult; stdcall;
function UnlockRegion(libOffset: Largeint; cb: Largeint;
dwLockType: Longint): HResult; stdcall;
function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
stdcall;
function Clone(out stm: IStream): HResult; stdcall;
public
constructor Create;
destructor Destroy; override;
end;
implementation
uses ComServ, SysUtils;
const
DebugFile = 'c:\debug.txt';
var
F : Text;
procedure WriteDebug(S : string);
begin
if IsDebug then
begin
AssignFile(F, DebugFile);
Append(F);
writeln(F, FormatDateTime('dddd, mmmm d, yyyy', Date)
+ FormatDateTime(' hh:mm:ss', Time) + ': ' + S);
CloseFile(F);
end;
end;
//////////////////////////
// IUnknown interface
function TMyCustomMoniker.ObjAddRef
begin
Result := inherited ObjAddRef;
writedebug(Format('ObjAddR
end;
function TMyCustomMoniker.ObjQueryI
var StrBuf : POleStr;
begin
StringFromCLSID(IID, StrBuf);
writedebug(Format('ObjQuer
Result := inherited ObjQueryInterface(IID, Obj);
end;
function TMyCustomMoniker.ObjReleas
begin
Result := inherited ObjRelease;
writedebug(Format('ObjRele
end;
// IParseDisplayName interface
function TMyCustomMoniker.IParseDis
out chEaten: Longint; out mkOut: IMoniker): HResult;
var Index : Integer;
begin
writedebug(Format('IParseD
bc.RegisterObjectBound(Sel
mkOut := Self;
FErrorStr := '';
FFileName := '';
FRequestURL := WideCharToString(pszDispla
chEaten := Length(FRequestURL) * 2;
// interpretation
Index := Pos('/', FRequestURL);
if Index <> 0
then FFileName := FileSystemBase + Copy(FRequestURL, Index, Length(FRequestURL) - Index + 1)
else FErrorStr := 'Invalid request';
Result := S_OK;
end;
// IPersist interface
function TMyCustomMoniker.GetClassI
begin
writedebug('GetClassID');
classID := CLSID_MyCustomMoniker;
Result := S_OK;
end;
// IPersistStream interface
function TMyCustomMoniker.IsDirty: HResult;
begin
writedebug('IsDirty');
Result := S_FALSE;
end;
function TMyCustomMoniker.Load(cons
begin
writedebug('Load');
Result := E_FAIL;
end;
function TMyCustomMoniker.Save(cons
begin
writedebug('Save');
stm._AddRef;
GetMem(FOLEOutStr, Length(FOutStr) * 2);
try
StringToWideChar(FOutStr, FOLEOutStr, Length(FOutStr) * 2);
Result := stm.Write(FOLEOutStr, Length(FOutStr) * 2, nil);
finally
FreeMem(FOLEOutStr, Length(FOutStr) * 2);
stm._Release;
end;
end;
function TMyCustomMoniker.GetSizeMa
begin
writedebug('GetSizeMax');
cbSize := Length(FOutStr) * 2;
Result := S_OK;
end;
// IMoniker interface
function TMyCustomMoniker.BindToObj
const iidResult: TIID; out vResult): HResult;
var StrBuf : POleStr;
begin
StringFromCLSID(iidResult,
writedebug(Format('BindToO
IMoniker(vResult) := Self;
Result := S_OK;
end;
function TMyCustomMoniker.BindToSto
const iid: TIID; out vObj): HResult;
var StrBuf : POleStr;
TmpStream : TMemoryStream;
NewStream : TMyStream;
begin
StringFromCLSID(iid, StrBuf);
writedebug(Format('BindToS
IUnknown(vObj) := nil;
Result := MK_E_NOSTORAGE;
if mkToLeft = nil
then writedebug('mkToLef = NULL');
if IsEqualIID(iid, IStream) then
begin
NewStream := TMyStream.Create;
if FFileName <> '' then
begin
TmpStream := TMemoryStream.Create;
try
try
TmpStream.LoadFromFile(FFi
NewStream.FTheStream.LoadF
except
FErrorStr := Format('File %s not found', [FFileName]);
end;
finally
TmpStream.Free;
end;
end;
if FErrorStr <> '' then
begin
FOutStr := Format(OutStr, [FErrorStr, FRequestURL]);
NewStream.FTheStream.Write
end;
NewStream.FTheStream.Seek(
bc.RegisterObjectBound(New
IStream(vObj) := NewStream;
Result := S_OK;
end;
end;
function TMyCustomMoniker.Reduce(co
mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult;
begin
writedebug(Format('Reduce how far: %d', [dwReduceHowFar]));
mkReduced := Self;
Result := MK_S_REDUCED_TO_SELF;
end;
function TMyCustomMoniker.ComposeWi
out mkComposite: IMoniker): HResult;
begin
writedebug('ComposeWith');
Result := E_UNEXPECTED;
end;
function TMyCustomMoniker.Enum(fFor
begin
writedebug('Enum');
enumMoniker := nil;
Result := S_OK;
end;
function TMyCustomMoniker.IsEqual(c
begin
Result := S_FALSE;
if mkOtherMoniker = IMoniker(Self)
then Result := S_OK;
writedebug(Format('IsEqual
end;
function TMyCustomMoniker.Hash(out dwHash: Longint): HResult;
begin
writedebug(Format('Hash %d', [dwHash]));
FHash := dwHash;
Result := S_OK;
end;
function TMyCustomMoniker.IsRunning
const mkNewlyRunning: IMoniker): HResult;
begin
writedebug('IsRunning');
Result := S_OK;
end;
function TMyCustomMoniker.GetTimeOf
out filetime: TFileTime): HResult;
begin
writedebug('GetTimeOfLastC
filetime.dwLowDateTime := 0;
filetime.dwHighDateTime := 0;
Result := E_NOTIMPL;
end;
function TMyCustomMoniker.Inverse(o
begin
writedebug('Inverse');
Result := E_NOTIMPL;
end;
function TMyCustomMoniker.CommonPre
begin
writedebug('CommonPrefixWi
Result := S_OK;
end;
function TMyCustomMoniker.RelativeP
begin
writedebug('RelativePathTo
mkRelPath := mkOther;
Result := MK_S_HIM;
end;
function TMyCustomMoniker.GetDispla
out pszDisplayName: POleStr): HResult;
begin
writedebug('GetDisplayName
Result := E_NOTIMPL;
end;
function TMyCustomMoniker.ParseDisp
pszDisplayName: POleStr; out chEaten: Longint;
out mkOut: IMoniker): HResult;
begin
writedebug(Format('ParseDi
chEaten := Length(WideCharToString(ps
mkOut := Self;
Result := S_OK;
end;
function TMyCustomMoniker.IsSystemM
begin
writedebug('IsSystemMonike
dwMksys := MKSYS_NONE;
Result := S_FALSE;
end;
//////////////////////////
constructor TMyStream.Create;
begin
// inherited Create;
writedebug('Stream.Create'
FTheStream := TMemoryStream.Create;
GetSystemTimeAsFileTime(Fm
GetSystemTimeAsFileTime(Fc
GetSystemTimeAsFileTime(Fa
end;
destructor TMyStream.Destroy;
begin
writedebug('Stream.Destroy
FTheStream.Free;
end;
function TMyStream.Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult;
var cbRead : LongInt;
begin
writedebug('Stream.Read');
Result := S_OK;
try
cbRead := FTheStream.Read(pv^, cb);
if pcbRead <> nil
then pcbRead^ := cbRead;
if cbRead = 0
then Result := S_FALSE
else GetSystemTimeAsFileTime(Fa
except
Result := S_FALSE;
end;
end;
function TMyStream.Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult;
var cbWritten : LongInt;
begin
writedebug('Stream.Write')
Result := S_OK;
try
cbWritten := FTheStream.Write(pv^, cb);
if pcbWritten <> nil
then pcbWritten^ := cbWritten;
GetSystemTimeAsFileTime(Fa
GetSystemTimeAsFileTime(Fm
except
Result := STG_E_CANTSAVE;
end;
end;
function TMyStream.Seek(dlibMove: Largeint; dwOrigin: Longint;
out libNewPosition: Largeint): HResult;
begin
writedebug('Stream.Seek');
Result := S_OK;
try
libNewPosition := FTheStream.Seek(Trunc(Int(
except
Result := STG_E_INVALIDFUNCTION;
end;
end;
function TMyStream.SetSize(libNewSi
begin
writedebug('Stream.SetSize
Result := S_OK;
try
FTheStream.SetSize(Trunc(I
GetSystemTimeAsFileTime(Fc
except
Result := STG_E_MEDIUMFULL;
end;
end;
function TMyStream.CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
out cbWritten: Largeint): HResult;
var Buffer : PChar;
cb_Written : LargeInt;
begin
writedebug('Stream.CopyTo'
GetMem(Buffer, Trunc(Int(cb)));
Result := S_OK;
try
try
cbRead := FTheStream.Read(Buffer^, Trunc(Int(cb)));
stm.Write(Buffer, Trunc(Int(cb)), @cb_Written);
cbWritten := cb_Written;
GetSystemTimeAsFileTime(Fa
except
Result := STG_E_MEDIUMFULL;
end;
finally
FreeMem(Buffer, Trunc(Int(cb)));
end;
end;
function TMyStream.Commit(grfCommit
begin
writedebug('Stream.Commit'
Result := S_OK;
end;
function TMyStream.Revert: HResult;
begin
writedebug('Stream.Revert'
Result := S_OK;
end;
function TMyStream.LockRegion(libOf
dwLockType: Longint): HResult;
begin
writedebug('Stream.LockReg
Result := STG_E_INVALIDFUNCTION;
end;
function TMyStream.UnlockRegion(lib
dwLockType: Longint): HResult;
begin
writedebug('Stream.UnlockR
Result := STG_E_INVALIDFUNCTION;
end;
function TMyStream.Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
begin
writedebug('Stream.Stat');
with FStatStg do
begin
if grfStatFlag = STATFLAG_DEFAULT
then lstrcpyW(pwcsName, 'Test');
dwType := STGTY_LOCKBYTES;
cbSize := FTheStream.Size;
mtime := Fmtime;
ctime := Fctime;
atime := Fatime;
grfMode := 0;
grfLocksSupported := 0;
clsid := CLSID_NULL;
grfStateBits := 0;
end;
statstg := FStatStg;
Result := S_OK;
end;
function TMyStream.Clone(out stm: IStream): HResult;
begin
writedebug('Stream.Clone')
Result := STG_E_INVALIDPOINTER;
end;
//////////////////////////
initialization
begin
if IsDebug then
begin
AssignFile(F, DebugFile);
Rewrite(F);
CloseFile(F);
end;
TComObjectFactory.Create(C
end;
end.
// project source
library MyMoniker;
uses
ComServ,
_MyMoniker in '_MyMoniker.pas';
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.RES}
begin
end.
// EOC //
OK, here the registry keys. Save them in a .reg file and double-click to merge them. I assumed the project's DLL resists in D:\Program Files, change the value accordingly.
The name of the moniker, slashmoniker in this case, can be changed by changing all
HKEY_CLASSES_ROOT\SlashMon
and
HKEY_CLASSES_ROOT\SlashMon
keys and the default values of
HKEY_CLASSES_ROOT\CLSID\{5
HKEY_CLASSES_ROOT\CLSID\{5
and
HKEY_CLASSES_ROOT\SlashMon
It's not that difficult.
// BOC //
REGEDIT4
[HKEY_CLASSES_ROOT\SlashMo
@="Slash's IE Moniker"
[HKEY_CLASSES_ROOT\SlashMo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\SlashMo
@="SlashMoniker.1"
[HKEY_CLASSES_ROOT\SlashMo
@="Slash's IE Moniker V1"
[HKEY_CLASSES_ROOT\SlashMo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\CLSID\{
@="Slash's IE Moniker V1"
[HKEY_CLASSES_ROOT\CLSID\{
"ThreadingModel"="Apartmen
@="D:\\Program Files\\MyMoniker.dll"
[HKEY_CLASSES_ROOT\CLSID\{
@="SlashMoniker.1"
[HKEY_CLASSES_ROOT\CLSID\{
@="1"
[HKEY_CLASSES_ROOT\CLSID\{
@="SlashMoniker"
// EOC //
If you have any questions, just ask.
Slash/d003303
Here's the unit and project, below are the registry keys to set.
// BOC //
unit _MyMoniker;
interface
uses
Windows, Classes, ComObj, ActiveX;
const
CLSID_MyCustomMoniker: TGUID = (
D1:$556F12A1; D2:$DE94; D3:$11D1; D4:($B4, $EA, $00, $00, $E8, $2D, $8A, $65));
Str_CLSID_MyCustomMoniker = '{556F12A1-DE94-11D1-B4EA-
CLSID_NULL: TGUID = (D1:0; D2:0; D3:0; D4:(0, 0, 0, 0, 0, 0, 0, 0));
const
IsDebug = false;
OutStr = '<HTML>An error occured while parsing the URL<BR><B>%s</B><BR>Reques
FileSystemBase = 'c:';
type
TMyCustomMoniker = class(TComObject, IParseDisplayName, IMoniker)
private
FOutStr,
FErrorStr,
FFileName,
FRequestURL : string;
FOLEOutStr : POLEStr;
FHash : Longint;
protected
// IUnknown interface
function ObjAddRef: Integer; override; stdcall;
function ObjQueryInterface(const IID: TGUID; out Obj): Integer; override; stdcall;
function ObjRelease: Integer; override; stdcall;
// IParseDisplayName interface
function IParseDisplayName.ParseDis
function IParseDisplayNameParseDisp
out chEaten: Longint; out mkOut: IMoniker): HResult; stdcall;
// IPersist interface
function GetClassID(out classID: TCLSID): HResult; stdcall;
// IPersistStream interface
function IsDirty: HResult; stdcall;
function Load(const stm: IStream): HResult; stdcall;
function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
// IMoniker interface
function BindToObject(const bc: IBindCtx; const mkToLeft: IMoniker;
const iidResult: TIID; out vResult): HResult; stdcall;
function BindToStorage(const bc: IBindCtx; const mkToLeft: IMoniker;
const iid: TIID; out vObj): HResult; stdcall;
function Reduce(const bc: IBindCtx; dwReduceHowFar: Longint;
mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult; stdcall;
function ComposeWith(const mkRight: IMoniker; fOnlyIfNotGeneric: BOOL;
out mkComposite: IMoniker): HResult; stdcall;
function Enum(fForward: BOOL; out enumMoniker: IEnumMoniker): HResult;
stdcall;
function IsEqual(const mkOtherMoniker: IMoniker): HResult; stdcall;
function Hash(out dwHash: Longint): HResult; stdcall;
function IsRunning(const bc: IBindCtx; const mkToLeft: IMoniker;
const mkNewlyRunning: IMoniker): HResult; stdcall;
function GetTimeOfLastChange(const bc: IBindCtx; const mkToLeft: IMoniker;
out filetime: TFileTime): HResult; stdcall;
function Inverse(out mk: IMoniker): HResult; stdcall;
function CommonPrefixWith(const mkOther: IMoniker;
out mkPrefix: IMoniker): HResult; stdcall;
function RelativePathTo(const mkOther: IMoniker;
out mkRelPath: IMoniker): HResult; stdcall;
function GetDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
out pszDisplayName: POleStr): HResult; stdcall;
function ParseDisplayName(const bc: IBindCtx; const mkToLeft: IMoniker;
pszDisplayName: POleStr; out chEaten: Longint;
out mkOut: IMoniker): HResult; stdcall;
function IsSystemMoniker(out dwMksys: Longint): HResult; stdcall;
end;
TMyStream = class(TComObject, IStream)
private
FTheStream : TMemoryStream;
FStatStg : TStatStg;
Fmtime,
Fctime,
Fatime : TFileTime;
protected
function Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult;
stdcall;
function Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult;
stdcall;
function Seek(dlibMove: Largeint; dwOrigin: Longint;
out libNewPosition: Largeint): HResult; stdcall;
function SetSize(libNewSize: Largeint): HResult; stdcall;
function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
out cbWritten: Largeint): HResult; stdcall;
function Commit(grfCommitFlags: Longint): HResult; stdcall;
function Revert: HResult; stdcall;
function LockRegion(libOffset: Largeint; cb: Largeint;
dwLockType: Longint): HResult; stdcall;
function UnlockRegion(libOffset: Largeint; cb: Largeint;
dwLockType: Longint): HResult; stdcall;
function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
stdcall;
function Clone(out stm: IStream): HResult; stdcall;
public
constructor Create;
destructor Destroy; override;
end;
implementation
uses ComServ, SysUtils;
const
DebugFile = 'c:\debug.txt';
var
F : Text;
procedure WriteDebug(S : string);
begin
if IsDebug then
begin
AssignFile(F, DebugFile);
Append(F);
writeln(F, FormatDateTime('dddd, mmmm d, yyyy', Date)
+ FormatDateTime(' hh:mm:ss', Time) + ': ' + S);
CloseFile(F);
end;
end;
//////////////////////////
// IUnknown interface
function TMyCustomMoniker.ObjAddRef
begin
Result := inherited ObjAddRef;
writedebug(Format('ObjAddR
end;
function TMyCustomMoniker.ObjQueryI
var StrBuf : POleStr;
begin
StringFromCLSID(IID, StrBuf);
writedebug(Format('ObjQuer
Result := inherited ObjQueryInterface(IID, Obj);
end;
function TMyCustomMoniker.ObjReleas
begin
Result := inherited ObjRelease;
writedebug(Format('ObjRele
end;
// IParseDisplayName interface
function TMyCustomMoniker.IParseDis
out chEaten: Longint; out mkOut: IMoniker): HResult;
var Index : Integer;
begin
writedebug(Format('IParseD
bc.RegisterObjectBound(Sel
mkOut := Self;
FErrorStr := '';
FFileName := '';
FRequestURL := WideCharToString(pszDispla
chEaten := Length(FRequestURL) * 2;
// interpretation
Index := Pos('/', FRequestURL);
if Index <> 0
then FFileName := FileSystemBase + Copy(FRequestURL, Index, Length(FRequestURL) - Index + 1)
else FErrorStr := 'Invalid request';
Result := S_OK;
end;
// IPersist interface
function TMyCustomMoniker.GetClassI
begin
writedebug('GetClassID');
classID := CLSID_MyCustomMoniker;
Result := S_OK;
end;
// IPersistStream interface
function TMyCustomMoniker.IsDirty: HResult;
begin
writedebug('IsDirty');
Result := S_FALSE;
end;
function TMyCustomMoniker.Load(cons
begin
writedebug('Load');
Result := E_FAIL;
end;
function TMyCustomMoniker.Save(cons
begin
writedebug('Save');
stm._AddRef;
GetMem(FOLEOutStr, Length(FOutStr) * 2);
try
StringToWideChar(FOutStr, FOLEOutStr, Length(FOutStr) * 2);
Result := stm.Write(FOLEOutStr, Length(FOutStr) * 2, nil);
finally
FreeMem(FOLEOutStr, Length(FOutStr) * 2);
stm._Release;
end;
end;
function TMyCustomMoniker.GetSizeMa
begin
writedebug('GetSizeMax');
cbSize := Length(FOutStr) * 2;
Result := S_OK;
end;
// IMoniker interface
function TMyCustomMoniker.BindToObj
const iidResult: TIID; out vResult): HResult;
var StrBuf : POleStr;
begin
StringFromCLSID(iidResult,
writedebug(Format('BindToO
IMoniker(vResult) := Self;
Result := S_OK;
end;
function TMyCustomMoniker.BindToSto
const iid: TIID; out vObj): HResult;
var StrBuf : POleStr;
TmpStream : TMemoryStream;
NewStream : TMyStream;
begin
StringFromCLSID(iid, StrBuf);
writedebug(Format('BindToS
IUnknown(vObj) := nil;
Result := MK_E_NOSTORAGE;
if mkToLeft = nil
then writedebug('mkToLef = NULL');
if IsEqualIID(iid, IStream) then
begin
NewStream := TMyStream.Create;
if FFileName <> '' then
begin
TmpStream := TMemoryStream.Create;
try
try
TmpStream.LoadFromFile(FFi
NewStream.FTheStream.LoadF
except
FErrorStr := Format('File %s not found', [FFileName]);
end;
finally
TmpStream.Free;
end;
end;
if FErrorStr <> '' then
begin
FOutStr := Format(OutStr, [FErrorStr, FRequestURL]);
NewStream.FTheStream.Write
end;
NewStream.FTheStream.Seek(
bc.RegisterObjectBound(New
IStream(vObj) := NewStream;
Result := S_OK;
end;
end;
function TMyCustomMoniker.Reduce(co
mkToLeft: PIMoniker; out mkReduced: IMoniker): HResult;
begin
writedebug(Format('Reduce how far: %d', [dwReduceHowFar]));
mkReduced := Self;
Result := MK_S_REDUCED_TO_SELF;
end;
function TMyCustomMoniker.ComposeWi
out mkComposite: IMoniker): HResult;
begin
writedebug('ComposeWith');
Result := E_UNEXPECTED;
end;
function TMyCustomMoniker.Enum(fFor
begin
writedebug('Enum');
enumMoniker := nil;
Result := S_OK;
end;
function TMyCustomMoniker.IsEqual(c
begin
Result := S_FALSE;
if mkOtherMoniker = IMoniker(Self)
then Result := S_OK;
writedebug(Format('IsEqual
end;
function TMyCustomMoniker.Hash(out dwHash: Longint): HResult;
begin
writedebug(Format('Hash %d', [dwHash]));
FHash := dwHash;
Result := S_OK;
end;
function TMyCustomMoniker.IsRunning
const mkNewlyRunning: IMoniker): HResult;
begin
writedebug('IsRunning');
Result := S_OK;
end;
function TMyCustomMoniker.GetTimeOf
out filetime: TFileTime): HResult;
begin
writedebug('GetTimeOfLastC
filetime.dwLowDateTime := 0;
filetime.dwHighDateTime := 0;
Result := E_NOTIMPL;
end;
function TMyCustomMoniker.Inverse(o
begin
writedebug('Inverse');
Result := E_NOTIMPL;
end;
function TMyCustomMoniker.CommonPre
begin
writedebug('CommonPrefixWi
Result := S_OK;
end;
function TMyCustomMoniker.RelativeP
begin
writedebug('RelativePathTo
mkRelPath := mkOther;
Result := MK_S_HIM;
end;
function TMyCustomMoniker.GetDispla
out pszDisplayName: POleStr): HResult;
begin
writedebug('GetDisplayName
Result := E_NOTIMPL;
end;
function TMyCustomMoniker.ParseDisp
pszDisplayName: POleStr; out chEaten: Longint;
out mkOut: IMoniker): HResult;
begin
writedebug(Format('ParseDi
chEaten := Length(WideCharToString(ps
mkOut := Self;
Result := S_OK;
end;
function TMyCustomMoniker.IsSystemM
begin
writedebug('IsSystemMonike
dwMksys := MKSYS_NONE;
Result := S_FALSE;
end;
//////////////////////////
constructor TMyStream.Create;
begin
// inherited Create;
writedebug('Stream.Create'
FTheStream := TMemoryStream.Create;
GetSystemTimeAsFileTime(Fm
GetSystemTimeAsFileTime(Fc
GetSystemTimeAsFileTime(Fa
end;
destructor TMyStream.Destroy;
begin
writedebug('Stream.Destroy
FTheStream.Free;
end;
function TMyStream.Read(pv: Pointer; cb: Longint; pcbRead: PLongint): HResult;
var cbRead : LongInt;
begin
writedebug('Stream.Read');
Result := S_OK;
try
cbRead := FTheStream.Read(pv^, cb);
if pcbRead <> nil
then pcbRead^ := cbRead;
if cbRead = 0
then Result := S_FALSE
else GetSystemTimeAsFileTime(Fa
except
Result := S_FALSE;
end;
end;
function TMyStream.Write(pv: Pointer; cb: Longint; pcbWritten: PLongint): HResult;
var cbWritten : LongInt;
begin
writedebug('Stream.Write')
Result := S_OK;
try
cbWritten := FTheStream.Write(pv^, cb);
if pcbWritten <> nil
then pcbWritten^ := cbWritten;
GetSystemTimeAsFileTime(Fa
GetSystemTimeAsFileTime(Fm
except
Result := STG_E_CANTSAVE;
end;
end;
function TMyStream.Seek(dlibMove: Largeint; dwOrigin: Longint;
out libNewPosition: Largeint): HResult;
begin
writedebug('Stream.Seek');
Result := S_OK;
try
libNewPosition := FTheStream.Seek(Trunc(Int(
except
Result := STG_E_INVALIDFUNCTION;
end;
end;
function TMyStream.SetSize(libNewSi
begin
writedebug('Stream.SetSize
Result := S_OK;
try
FTheStream.SetSize(Trunc(I
GetSystemTimeAsFileTime(Fc
except
Result := STG_E_MEDIUMFULL;
end;
end;
function TMyStream.CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
out cbWritten: Largeint): HResult;
var Buffer : PChar;
cb_Written : LargeInt;
begin
writedebug('Stream.CopyTo'
GetMem(Buffer, Trunc(Int(cb)));
Result := S_OK;
try
try
cbRead := FTheStream.Read(Buffer^, Trunc(Int(cb)));
stm.Write(Buffer, Trunc(Int(cb)), @cb_Written);
cbWritten := cb_Written;
GetSystemTimeAsFileTime(Fa
except
Result := STG_E_MEDIUMFULL;
end;
finally
FreeMem(Buffer, Trunc(Int(cb)));
end;
end;
function TMyStream.Commit(grfCommit
begin
writedebug('Stream.Commit'
Result := S_OK;
end;
function TMyStream.Revert: HResult;
begin
writedebug('Stream.Revert'
Result := S_OK;
end;
function TMyStream.LockRegion(libOf
dwLockType: Longint): HResult;
begin
writedebug('Stream.LockReg
Result := STG_E_INVALIDFUNCTION;
end;
function TMyStream.UnlockRegion(lib
dwLockType: Longint): HResult;
begin
writedebug('Stream.UnlockR
Result := STG_E_INVALIDFUNCTION;
end;
function TMyStream.Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
begin
writedebug('Stream.Stat');
with FStatStg do
begin
if grfStatFlag = STATFLAG_DEFAULT
then lstrcpyW(pwcsName, 'Test');
dwType := STGTY_LOCKBYTES;
cbSize := FTheStream.Size;
mtime := Fmtime;
ctime := Fctime;
atime := Fatime;
grfMode := 0;
grfLocksSupported := 0;
clsid := CLSID_NULL;
grfStateBits := 0;
end;
statstg := FStatStg;
Result := S_OK;
end;
function TMyStream.Clone(out stm: IStream): HResult;
begin
writedebug('Stream.Clone')
Result := STG_E_INVALIDPOINTER;
end;
//////////////////////////
initialization
begin
if IsDebug then
begin
AssignFile(F, DebugFile);
Rewrite(F);
CloseFile(F);
end;
TComObjectFactory.Create(C
end;
end.
// project source
library MyMoniker;
uses
ComServ,
_MyMoniker in '_MyMoniker.pas';
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
{$R *.RES}
begin
end.
// EOC //
OK, here the registry keys. Save them in a .reg file and double-click to merge them. I assumed the project's DLL resists in D:\Program Files, change the value accordingly.
The name of the moniker, slashmoniker in this case, can be changed by changing all
HKEY_CLASSES_ROOT\SlashMon
and
HKEY_CLASSES_ROOT\SlashMon
keys and the default values of
HKEY_CLASSES_ROOT\CLSID\{5
HKEY_CLASSES_ROOT\CLSID\{5
and
HKEY_CLASSES_ROOT\SlashMon
It's not that difficult.
// BOC //
REGEDIT4
[HKEY_CLASSES_ROOT\SlashMo
@="Slash's IE Moniker"
[HKEY_CLASSES_ROOT\SlashMo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\SlashMo
@="SlashMoniker.1"
[HKEY_CLASSES_ROOT\SlashMo
@="Slash's IE Moniker V1"
[HKEY_CLASSES_ROOT\SlashMo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\CLSID\{
@="Slash's IE Moniker V1"
[HKEY_CLASSES_ROOT\CLSID\{
"ThreadingModel"="Apartmen
@="D:\\Program Files\\MyMoniker.dll"
[HKEY_CLASSES_ROOT\CLSID\{
@="SlashMoniker.1"
[HKEY_CLASSES_ROOT\CLSID\{
@="1"
[HKEY_CLASSES_ROOT\CLSID\{
@="SlashMoniker"
// EOC //
If you have any questions, just ask.
Slash/d003303
An example to register a moniker called by mk:@HelloWorld
// BOC //
REGEDIT4
[HKEY_CLASSES_ROOT\HelloWo
@="Hello World Moniker"
[HKEY_CLASSES_ROOT\HelloWo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\HelloWo
@="HelloWorld.1"
[HKEY_CLASSES_ROOT\HelloWo
@="Hello World Moniker V1"
[HKEY_CLASSES_ROOT\HelloWo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\CLSID\{
@="Hello World Moniker V1"
[HKEY_CLASSES_ROOT\CLSID\{
"ThreadingModel"="Apartmen
@="D:\\Program Files\\MyMoniker.dll"
[HKEY_CLASSES_ROOT\CLSID\{
@="HelloWorld.1"
[HKEY_CLASSES_ROOT\CLSID\{
@="1"
[HKEY_CLASSES_ROOT\CLSID\{
@="HelloWorld"
// EOC //
Slash/d003303
// BOC //
REGEDIT4
[HKEY_CLASSES_ROOT\HelloWo
@="Hello World Moniker"
[HKEY_CLASSES_ROOT\HelloWo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\HelloWo
@="HelloWorld.1"
[HKEY_CLASSES_ROOT\HelloWo
@="Hello World Moniker V1"
[HKEY_CLASSES_ROOT\HelloWo
@="{556F12A1-DE94-11D1-B4E
[HKEY_CLASSES_ROOT\CLSID\{
@="Hello World Moniker V1"
[HKEY_CLASSES_ROOT\CLSID\{
"ThreadingModel"="Apartmen
@="D:\\Program Files\\MyMoniker.dll"
[HKEY_CLASSES_ROOT\CLSID\{
@="HelloWorld.1"
[HKEY_CLASSES_ROOT\CLSID\{
@="1"
[HKEY_CLASSES_ROOT\CLSID\{
@="HelloWorld"
// EOC //
Slash/d003303
Thanks a lot, Slash!
This is exactly what I have been looking for. It works perfectly for me.
I had only little time this morning to look through all of the code, so maybe I will have some questions regarding the source the next few days.
This is exactly what I have been looking for. It works perfectly for me.
I had only little time this morning to look through all of the code, so maybe I will have some questions regarding the source the next few days.
Hi Slash, still listening on this thread?
I've got some probs with the Moniker. When I use it with IE 4.0, everything is just fine, but when running in IE 3 (no matter which build #), it just reports an access violation in mshtml.dll after loading the 4th unique file.
I woul be *very* glad if you could spend a minute or two helping me with this bug!
Freter
I've got some probs with the Moniker. When I use it with IE 4.0, everything is just fine, but when running in IE 3 (no matter which build #), it just reports an access violation in mshtml.dll after loading the 4th unique file.
I woul be *very* glad if you could spend a minute or two helping me with this bug!
Freter
Yo,
still listening. I just tried over and over, no problems.
So, do you still run the moniker in file-access mode or have you already bound it into the OLE structured storage ? If you are still working in a file system, could you send me an archive with these files ?
Also, take a look at the debug file and see where the moniker crashes. This is a very helpful information.
Slash/d003303
still listening. I just tried over and over, no problems.
So, do you still run the moniker in file-access mode or have you already bound it into the OLE structured storage ? If you are still working in a file system, could you send me an archive with these files ?
Also, take a look at the debug file and see where the moniker crashes. This is a very helpful information.
Slash/d003303
Hm.
I used the code you provided here. Then I put five different really plain HTML files in the root and called them via the moniker. The important thing is: the fifth unique file will cause a crash. If you try to load files that are not unique (like call only two files alternatingly), no crash will occur.
This problem arises as well with the code that reads from a file system as well as with my code that binds to OLE Structured Storage. And: it only occurs with IE3x, *not* with IE4x!
I don't have the code here today, but I can send it to you tomorrow, together with the debug.txt.
Later
Freter
I used the code you provided here. Then I put five different really plain HTML files in the root and called them via the moniker. The important thing is: the fifth unique file will cause a crash. If you try to load files that are not unique (like call only two files alternatingly), no crash will occur.
This problem arises as well with the code that reads from a file system as well as with my code that binds to OLE Structured Storage. And: it only occurs with IE3x, *not* with IE4x!
I don't have the code here today, but I can send it to you tomorrow, together with the debug.txt.
Later
Freter
Featured Post
We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Question has a verified solution.
If you are experiencing a similar issue, please ask a related question
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech.
SAPI Installation
First you need to install the SAPI type library, th…
Creating an auto free TStringList
The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list.
In such cases, you have to…
Come and listen to Percona CEO Peter Zaitsev discuss what’s new in Percona open source software, including Percona Server for MySQL (https://www.percona.com/software/mysql-database/percona-server) and MongoDB (https://www.percona.com/software/mongo-…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you!
In this Micro Tutorial, you'll learn yo…
- Microsoft Applications
- Windows 10
- Windows OS
- Fonts Typography
- Windows 7, Microsoft Word
Suggested Courses
Course of the Month4 days, 5 hours left to enroll
Earn Certification
CompTIA IT Fundamentals
$49.00$44.10
691 members asked questions and received personalized solutions in the past 7 days.
Join the community of 500,000 technology professionals and ask your questions.