Место общения программистов, форум разработчиков БД на Clarion
https://www.forum.clarionlife.net/
(у меня за январь 2005) хотя не совсем точно сказал это не обьект а интерфейс IShellLink сори 
Код: Выделить всё
HRESULT ResolveIt(HWND hwnd, LPCSTR lpszLinkFile, LPSTR lpszPath, int iPathBufferSize)
{
HRESULT hres;
IShellLink* psl;
char szGotPath[MAX_PATH];
char szDescription[MAX_PATH];
WIN32_FIND_DATA wfd;
*lpszPath = 0; // assume failure
// Get a pointer to the IShellLink interface.
hres = CoCreateInstance(CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
IID_IShellLink, (LPVOID*)&psl);
if (SUCCEEDED(hres))
{
IPersistFile* ppf;
// Get a pointer to the IPersistFile interface.
hres = psl->QueryInterface(IID_IPersistFile, (void**)&ppf);
if (SUCCEEDED(hres))
{
WCHAR wsz[MAX_PATH];
// Ensure that the string is Unicode.
MultiByteToWideChar(CP_ACP, 0, lpszLinkFile, -1, wsz, MAX_PATH);
// TODO: Check return value from MultiByteWideChar to ensure
success.
// Load the shortcut.
hres = ppf->Load(wsz, STGM_READ);
if (SUCCEEDED(hres))
{
// Resolve the link.
hres = psl->Resolve(hwnd, 0);
if (SUCCEEDED(hres))
{
// Get the path to the link target.
hres = psl->GetPath(szGotPath,
MAX_PATH,
(WIN32_FIND_DATA*)&wfd,
SLGP_SHORTPATH);
if (SUCCEEDED(hres))
{
// Get the description of the target.
hres = psl->GetDescription(szDescription, MAX_PATH);
if (SUCCEEDED(hres))
{
hres = StringCbCopy(lpszPath, iPathBufferSize,
szGotPath);
if (SUCCEEDED(hres))
{
// Handle success
}
else
// application-defined function
HandleErr(hres);
}
}
}
}
// Release the pointer to the IPersistFile interface.
ppf->Release();
}
// Release the pointer to the IShellLink interface.
psl->Release();
}
return hres;
}
Код: Выделить всё
PROGRAM
DWORD EQUATE(LONG)
WORD EQUATE(USHORT)
HRESULT EQUATE(LONG)
HWND EQUATE(UNSIGNED)
UINT EQUATE(UNSIGNED)
OLESTRING EQUATE(BSTRING)
!OLESTRING EQUATE(CSTRING)
! OLE Types ====================================================================
GUID GROUP,TYPE
Data1 DWORD
Data2 WORD
Data3 WORD
Data4 STRING(8)
END
IID GROUP(GUID),TYPE
END
CLSID GROUP(GUID),TYPE
END
OBJECTID GROUP(GUID),TYPE
Uniquifier ULONG
END
SHITEMID GROUP,TYPE
cb USHORT
ID BYTE,DIM(1)
END
ITEMIDLIST GROUP,TYPE
mkid LIKE(SHITEMID)
END
ITEMIZE,PRE(CLSCTX)
INPROC_SERVER EQUATE(1)
INPROC_HANDLER EQUATE(2)
LOCAL_SERVER EQUATE(4)
INPROC_SERVER16 EQUATE(8)
END
ITEMIZE,PRE(CSIDL)
DESKTOP EQUATE(0)
PROGRAMS EQUATE(2)
CONTROLS EQUATE(3)
PRINTERS EQUATE(4)
PERSONAL EQUATE(5)
STARTUP EQUATE(7)
RECENT EQUATE(8)
SENDTO EQUATE(9)
BITBUCKET EQUATE(10)
STARTMENU EQUATE(11)
DESKTOPDIRECTORY EQUATE(16)
DRIVES EQUATE(17)
NETWORK EQUATE(18)
NETHOOD EQUATE(19)
FONTS EQUATE(20)
TEMPLATES EQUATE(21)
END
ITEMIZE(0),PRE(CP)
ACP EQUATE
OEM EQUATE
MAC EQUATE
END
ITEMIZE,PRE(MB)
PRECOMPOSED EQUATE(1)
COMPOSITE EQUATE(2)
USEGLYPHCHARS EQUATE(4)
ERR_INVALID EQUATE(8)
END
! Program MAP ==================================================================
MAP
MODULE('')
CoInitialize PROCEDURE (<*LONG>),HRESULT,RAW,PROC,PASCAL
CoUninitialize PROCEDURE (),RAW,PASCAL
CoCreateInstance PROCEDURE (*CLSID rclsid, |
*IOLE UnkOuter, |
DWORD clsContext, |
*IID riid, |
*LONG ppv),HRESULT,RAW,PASCAL ! IOLE **
ShGetSpecialFolderLocation PROCEDURE ( HWND owner, |
SIGNED Folder, |
*LONG ItemIDList),HRESULT,RAW,PASCAL ! ITEMIDLIST **
ShGetPathFromIDList PROCEDURE ( LONG ItemIDList, |
*CSTRING Path),BOOL,RAW,PROC,PASCAL
MultiByteToWideChar PROCEDURE ( UINT CodePage, |
DWORD Flags, |
*CSTRING Src, |
SIGNED SrcLen, |
<*OLESTRING Dest>, |
SIGNED DestLen=0),SIGNED,RAW,PROC,PASCAL
END
END
! OLE Initialization Handler ===================================================
OLEInit CLASS,TYPE
Initialized BYTE(0)
Construct PROCEDURE()
Destruct PROCEDURE()
END
! Common OLE Interface declarations ============================================
IOLE INTERFACE,COM
QueryInterface PROCEDURE (*IID riid, |
*LONG ppvobj),HRESULT,RAW ! void**
AddRef PROCEDURE (),HRESULT,RAW
Release PROCEDURE (),HRESULT,RAW,PROC
END
! Declaration of the IShellLink Interface ======================================
FILETIME GROUP,TYPE
Low DWORD
High DWORD
END
WIN32_FINDDATA GROUP,TYPE
FileAttributes DWORD
CreationTime LIKE(FILETIME)
LastAccessTime LIKE(FILETIME)
LastWriteTime LIKE(FILETIME)
FileSizeHi DWORD
FileSizeLo DWORD
Reserved0 DWORD
Reserved1 DWORD
FileName CSTRING(FILE:MaxFilePath)
AltFileName CSTRING(14)
END
IShellLink INTERFACE(IOLE),COM
GetPath PROCEDURE (*CSTRING FileName, |
SIGNED FileNameSize, |
*WIN32_FINDDATA pfd, |
DWORD Attributes),HRESULT,RAW
GetIDList PROCEDURE (*LONG ppidl),HRESULT,RAW ! ITEMIDLIST **
SetIDList PROCEDURE (*ITEMIDLIST pidl),HRESULT,RAW
GetDescription PROCEDURE (*CSTRING Name, |
SIGNED MaxName),HRESULT,RAW
SetDescription PROCEDURE (*CSTRING Name),HRESULT,RAW
GetWorkingDir PROCEDURE (*CSTRING Dir, |
SIGNED MaxPath),HRESULT,RAW
SetWorkingDir PROCEDURE (*CSTRING Dir),HRESULT,RAW
GetArguments PROCEDURE (*CSTRING Args, |
SIGNED MaxArgs),HRESULT,RAW
SetArguments PROCEDURE (*CSTRING Args),HRESULT,RAW
GetHotKey PROCEDURE (*WORD pHotKey),HRESULT,RAW
SetHotKey PROCEDURE ( WORD HotKey),HRESULT,RAW
GetShowCmd PROCEDURE (*SIGNED pShowCmd),HRESULT,RAW
SetShowCmd PROCEDURE ( SIGNED ShowCmd),HRESULT,RAW
GetIconLocation PROCEDURE (*CSTRING IconPath, |
SIGNED IconPathMax, |
*SIGNED nIcon),HRESULT,RAW
SetIconLocation PROCEDURE (*CSTRING IconPath, |
SIGNED nIcon),HRESULT,RAW
GetRelativePath PROCEDURE (*CSTRING PathRel, |
*ITEMIDLIST pidlRel),HRESULT,RAW
Resolve PROCEDURE ( HWND hWnd, |
DWORD Flags),HRESULT,RAW
SetPath PROCEDURE (*CSTRING FilePath),HRESULT,RAW
END
! Declaration of Persist Interface =============================================
IPersist INTERFACE(IOLE),COM
GetClassID PROCEDURE (*CLSID pClassID),HRESULT,RAW
END
! Declaration of PersistFile Interface =========================================
IPersistFile INTERFACE(IPersist),COM
IsDirty PROCEDURE (),HRESULT,RAW
Load PROCEDURE ( OLESTRING FileName, |
DWORD Mode),HRESULT,RAW
Save PROCEDURE ( OLESTRING FileName, |
BOOL Remember),HRESULT,RAW
SaveCompleted PROCEDURE ( OLESTRING FileName),HRESULT,RAW
GetCurFile PROCEDURE (*OLESTRING FileName),HRESULT,RAW
END
! ==============================================================================
CLSID_ShellLink GROUP
Data1 DWORD(21401h)
Data2 WORD(0)
Data3 WORD(0)
Data4 STRING('<0C0h,000h,000h,000h,000h,000h,000h,046h>')
END
IID_IShellLink GROUP
Data1 DWORD(214EEh)
Data2 WORD(0)
Data3 WORD(0)
Data4 STRING('<0C0h,000h,000h,000h,000h,000h,000h,046h>')
END
IID_IPersistFile GROUP
Data1 DWORD(0010Bh)
Data2 WORD(0)
Data3 WORD(0)
Data4 STRING('<0C0h,000h,000h,000h,000h,000h,000h,046h>')
END
VTable &IOLE
ShellLink &IShellLink
PersistFile &IPersistFile
VTAddress LONG
IDLPtr LONG
L LONG
hr HRESULT
FilePath CSTRING(FILE:MaxFilePath)
ShortCutInfo GROUP
TargetFile CSTRING(FILE:MaxFileName)
IconName CSTRING(FILE:MaxFileName)
IconIndex SIGNED
Description CSTRING(255)
HotKey WORD
StartIn CSTRING(FILE:MaxFilePath)
ShortCut CSTRING(FILE:MaxFileName)
END
WChar BSTRING
!WChar &CSTRING
!WCharL SIGNED
InitOLE OLEInit
CODE
IF NOT InitOLE.Initialized
MESSAGE ('OLE Initialization Failed', 'Error', ICON:Hand)
RETURN
END
!!!
ShortCutInfo.TargetFile = 'W:\TESTS\_026\CALLOLE.EXE'
ShortCutInfo.IconName = 'O:\NT4\COOL.DLL'
ShortCutInfo.IconIndex = 17
ShortCutInfo.Description = 'Description for this program shortcut'
ShortCutInfo.HotKey = 0
ShortCutInfo.StartIn = 'W:\TESTS\_026\'
ShortCutInfo.ShortCut = 'This Program.LNK<0>'
!!!
VTable &= NULL
hr = CoCreateInstance (CLSID_ShellLink, VTable, CLSCTX:INPROC_SERVER, |
IID_IShellLink, VTAddress)
IF hr < 0
MESSAGE ('CoCreateInstance Failed', 'Error', ICON:Hand)
RETURN
END
ShellLink &= VTAddress + 0
!!!
hr = ShellLink.QueryInterface (IID_IPersistFile, VTAddress)
IF hr < 0
MESSAGE ('ShellLink.QueryInterface Failed', 'Error', ICON:Hand)
RETURN
END
PersistFile &= VTAddress + 0
!!!
hr = ShellLink.SetPath (ShortCutInfo.TargetFile)
hr = ShellLink.SetIconLocation (ShortCutInfo.IconName, ShortCutInfo.IconIndex)
IF ShortCutInfo.Description
hr = ShellLink.SetDescription (ShortCutInfo.Description)
END
IF ShortCutInfo.HotKey <> 0
hr = ShellLink.SetHotKey (ShortCutInfo.HotKey)
END
IF ShortCutInfo.StartIn
hr = ShellLink.SetWorkingDir (ShortCutInfo.StartIn)
END
!!!
hr = ShGetSpecialFolderLocation (0, CSIDL:DESKTOP, IDLPtr)
IF hr < 0
MESSAGE ('ShGetSpecialFolderLocation Failed', 'Error', ICON:Hand)
RETURN
END
!!!
ShGetPathFromIDList (IDLPtr, FilePath)
!!!
L = LEN (FilePath)
IF FilePath[L] <> '\'
L += 1
FilePath[L] = '\'
FilePath[L+1] = '<0>'
END
FilePath = FilePath & ShortCutInfo.ShortCut
MESSAGE (FilePath)
!!!
! WCharL = MultiByteToWideChar (CP:ACP, MB:PRECOMPOSED, FilePath, -1)
! WChar &= NEW CSTRING (WCharL * 2)
! MultiByteToWideChar (CP:ACP, MB:PRECOMPOSED, FilePath, -1, WChar, WCharL)
WChar = FilePath
!!!
hr = PersistFile.Save (WChar, TRUE)
IF hr < 0
MESSAGE ('PersistFile.Save Failed', 'Error', ICON:Hand)
RETURN
END
hr = PersistFile.SaveCompleted (WChar)
! DISPOSE (WChar)
PersistFile.Release()
ShellLink.Release()
! ==============================================================================
OLEInit.Construct PROCEDURE()
CODE
IF NOT SELF.Initialized
SELF.Initialized = CHOOSE (CoInitialize() >= 0)
END
RETURN
OLEInit.Destruct PROCEDURE()
CODE
IF SELF.Initialized
CoUninitialize()
SELF.Initialized = FALSE
END
RETURN