From 3383932a9bdee5d1166e8fdb560079da517fb568 Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Sat, 24 Aug 2013 09:14:28 +0000 Subject: - ShellExt: Delphi plugin moved to Deprecated C++ plugin added to solutions Preferences moved from 'Plugins' to 'Services' git-svn-id: http://svn.miranda-ng.org/main/trunk@5807 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/!Deprecated/ShlExt/clean.bat | 1 + plugins/!Deprecated/ShlExt/docs/HowToBuild.txt | 22 + .../ShlExt/docs/shlext release notes.txt | 344 +++ plugins/!Deprecated/ShlExt/make.bat | 25 + plugins/!Deprecated/ShlExt/resource.h | 13 + plugins/!Deprecated/ShlExt/shlc.inc | 144 ++ plugins/!Deprecated/ShlExt/shlcom.pas | 2471 ++++++++++++++++++++ plugins/!Deprecated/ShlExt/shldlgs.rc | 93 + plugins/!Deprecated/ShlExt/shldlgs.res | Bin 0 -> 2616 bytes plugins/!Deprecated/ShlExt/shlext.dpr | 379 +++ plugins/!Deprecated/ShlExt/shlicons.pas | 168 ++ plugins/!Deprecated/ShlExt/shlipc.pas | 394 ++++ plugins/ShellExt/src/options.cpp | 2 +- plugins/ShlExt/clean.bat | 1 - plugins/ShlExt/docs/HowToBuild.txt | 22 - plugins/ShlExt/docs/shlext release notes.txt | 344 --- plugins/ShlExt/make.bat | 25 - plugins/ShlExt/resource.h | 13 - plugins/ShlExt/shlc.inc | 144 -- plugins/ShlExt/shlcom.pas | 2471 -------------------- plugins/ShlExt/shldlgs.rc | 93 - plugins/ShlExt/shldlgs.res | Bin 2616 -> 0 bytes plugins/ShlExt/shlext.dpr | 379 --- plugins/ShlExt/shlicons.pas | 168 -- plugins/ShlExt/shlipc.pas | 394 ---- 25 files changed, 4055 insertions(+), 4055 deletions(-) create mode 100644 plugins/!Deprecated/ShlExt/clean.bat create mode 100644 plugins/!Deprecated/ShlExt/docs/HowToBuild.txt create mode 100644 plugins/!Deprecated/ShlExt/docs/shlext release notes.txt create mode 100644 plugins/!Deprecated/ShlExt/make.bat create mode 100644 plugins/!Deprecated/ShlExt/resource.h create mode 100644 plugins/!Deprecated/ShlExt/shlc.inc create mode 100644 plugins/!Deprecated/ShlExt/shlcom.pas create mode 100644 plugins/!Deprecated/ShlExt/shldlgs.rc create mode 100644 plugins/!Deprecated/ShlExt/shldlgs.res create mode 100644 plugins/!Deprecated/ShlExt/shlext.dpr create mode 100644 plugins/!Deprecated/ShlExt/shlicons.pas create mode 100644 plugins/!Deprecated/ShlExt/shlipc.pas delete mode 100644 plugins/ShlExt/clean.bat delete mode 100644 plugins/ShlExt/docs/HowToBuild.txt delete mode 100644 plugins/ShlExt/docs/shlext release notes.txt delete mode 100644 plugins/ShlExt/make.bat delete mode 100644 plugins/ShlExt/resource.h delete mode 100644 plugins/ShlExt/shlc.inc delete mode 100644 plugins/ShlExt/shlcom.pas delete mode 100644 plugins/ShlExt/shldlgs.rc delete mode 100644 plugins/ShlExt/shldlgs.res delete mode 100644 plugins/ShlExt/shlext.dpr delete mode 100644 plugins/ShlExt/shlicons.pas delete mode 100644 plugins/ShlExt/shlipc.pas (limited to 'plugins') diff --git a/plugins/!Deprecated/ShlExt/clean.bat b/plugins/!Deprecated/ShlExt/clean.bat new file mode 100644 index 0000000000..575eed729c --- /dev/null +++ b/plugins/!Deprecated/ShlExt/clean.bat @@ -0,0 +1 @@ +del *.o *.ppu *.dll *.a fpc-res.res *.or \ No newline at end of file diff --git a/plugins/!Deprecated/ShlExt/docs/HowToBuild.txt b/plugins/!Deprecated/ShlExt/docs/HowToBuild.txt new file mode 100644 index 0000000000..53b6738616 --- /dev/null +++ b/plugins/!Deprecated/ShlExt/docs/HowToBuild.txt @@ -0,0 +1,22 @@ +shlext 2.0.0.9 + +Info +======================= + +This source code is based on shlext 1.0.6.6 with minor changes so that it works +with FreePascal 2.2.2. + +The included headers (inc dir) are from Miranda 0.3.3.1 SDK and so if you want newer APIs +then get the API headers from the latest SVN tree. + +Note: I have included v0.8.xx API changes for GUIDs within a new file (m_v8.inc) + + +How to build +======================= + +Make sure you have installed the FreePascal compiler ( http://freepascal.org ) +the latest version is 2.2.2 at the time of writing. + +Run "make.bat" in this directory, this contains all the command line switches +for the newer version should produce shlext.dll diff --git a/plugins/!Deprecated/ShlExt/docs/shlext release notes.txt b/plugins/!Deprecated/ShlExt/docs/shlext release notes.txt new file mode 100644 index 0000000000..0e58edf9ff --- /dev/null +++ b/plugins/!Deprecated/ShlExt/docs/shlext release notes.txt @@ -0,0 +1,344 @@ +shlext 2.0.1.2 + +Contents: + + Introduction ``What is shlext?`` + Why so long? + What you need + New features + Features + Quirks + Important changes + But Miranda has drag'n'drop! + Installation + Upgrading/Removing + Translation + License + Contact/Bug reporting + Credits + + + + ---Introduction ``What is shlext?`` + + shlext is a Miranda and Explorer shell plugin, it allows you to use your + contact list under any file/directory from Windows. + + This means that you can right click on a file/folder, see "Miranda" and then + see your entire contact list! this is a feature that ICQ has built in. + + shlext is better of course. + + ---Why so long? + + A few people contacted me aeons ago about implementing a better file scanner + so that they could recreate directories whilst sending, etc, I said I would do + this as soon as I had time, that was several months ago. + + I had made several changes/bugfixes when I had time, because I'm a Miranda + dev too, I don't usually have lots of time for this plugin, however lately I needed + shlext to run again, since I was sending lots of docs/logs around with Miranda. + + So I fixed several things and improved lots of other stuff so that other users + could use shlext again (the XP bug was really annoying as soon as I got XP myself ;) + + + ---What you need + + (2008) You will need 0.7.xx or 0.8.x -- older versions will not work. + + shlext should work on all Window Explorer versions that support it, + certain features will not work on older Explorers, i.e. icons, but you will + still be able to use the main function of shlext, selection 'n' transfer. + + ---New Features (2.0.1.2) + + * shlext is now compiled with Free Pascal 2.2.4 + + * shlext now works with Windows Vista: + + 1. shlext cannot automatically register itself with Windows Explorer due to permissions issues in Vista, + therefore you will be UAC prompted if shlext detects you are running Vista and that shlext isn't registered + with Explorer. + + This is almost automatic, and you just have to press "OK". + + 2. The entire menu drawing was overhauled and now looks much better, new APIs are used so that Vista draws the menus + (with theme) but the status icons are still present. + + * added UAC button for "Remove" from the options dialog. + + * Removed GetMenuItemInfo() debug message box. + + * Note: Miranda is a 32bit application, 64bit editions of Windows require a 64bit extension DLL, this is not possible at present. + + ---New features (2.0.0.9+) + + * shlext is now compiled with Free Pascal 2.2.2 which is a newer compiler with better + optimisations so shlext should be faster. (2002 v.s. 2008) + + * shlext now works with Miranda 0.8.x UUID typing system and 0.8.xx plugin loading APIs, + 0.7.xx still works too however. + + * shlext now keeps track of recently used contacts and builds a "MRU" menu for quick + access within the menu system. This cannot be disabled, if you hate this feature, + please stick pins into a voodoo doll named "Christian", that is all. + + * The menu strings "Recently" and "Clear entries" are translate()able but MRU is not. + + ---New features (1.0.6.6+) + + * shlext will now use all your icons per protocol, **not** just the first iconset + it finds, it will also use everything properly (because it doesn't do the icon + extraction, it just asks Miranda [don't ask why it didn't do this before :P]) + + * shlext will now use a Translate()'d version of "Miranda" so that each menu + shown for a profile can be given a custom user string + + * reimplemented file/folder selection, finally! a work-as-expected version, it will + scan and add all files and folders you give it, producing a file list in the background + (scanning your drive) and then send the list to Miranda to send to your selected contact. + + * Added option for disabling status icons in menus, which means that you can use shlext + with shell variants/file managers that invoke the shlext interface, such as FAR, but + don't need/use the icons. + + * Added option about hiding offline users from the context menu, if this option is off + it will fall back onto syncing with your contact list's "hide offline users" + + * Added proper thread safety because Miranda 0.3 now has it. + + * Completely reimplemented group parsing, which means that all the old group bugs + can be expected to be gone, note that shlext will now even create menus for + subgroups of the same name, e.g. "Miranda\Miranda". + + * shlext will now not show a menu for a running Miranda fails the following checks: + + * not running shlext (duh) + * no non-offline contacts (or you have the setting 'hide offline users') + * and so on + + * shlext will now also completely ignore contacts on protocols who have no file transfer support + + + ---Features + + shlext can: + + * allow you to refer to your entire contact list from a file/folder context + menu, this includes multiple profiles! if you have Miranda running + different profiles, you'll see all your profiles as menu items as long + as you're running shlext as a Miranda plugin in that profile. + + * Group ability, see a faithful menu rendition of your group hierarchy. + This means you can go something like File->My Profile->Work->Friends->Dude... + + This feature can also be turned off, or enabled in sync with your contact + list option to "Disable groups", this is a per profile setting, i.e. setting + disable groups on one profile won't affect other profiles running shlext. + + * Multi protocol aware, shlext can send to anyone on your contact list + not just ICQ! + + * Each contact will be shown next to their status icon, as selected in your + profile(s) which means that you'll easily feel at home with the icons, + because they will be used as how they are set in each profile. + + * lots of files, shlext will now, if given a directory/folder go into that + folder and scan for files and sub directories/folders til it's added + everything. + + This means if you send c:\foobar, it will search c:\foobar\*.* for more + files to add, it will also add c:\foobar as a directory space to send. + Which means that if the other side hasn't got a 'foobar' directory, it will + be created! (Note: recreating directory trees depends on the protocol being used to send) + + + --Quirks + + * shlext displays all your users by default, if your contact list is set to + NOT show offline users, then shlext will not show them. + + * shlext doesn't use all your group settings, it will not ad here to + "hide offline users in here", however if a group has got offline users + it won't show them (per setting option!) + + + + ---Important changes + + Older versions of shlext did not go into folders more than one level, i.e. + if you added c:\foobar it would scan for c:\foobar\*.* and add all the files + but not go into each directory\folder deeper than that! + + shlext also now does background selection scanning, which means when you select + a group of files/folders/directories, it will let you get on with chating + until it's made a file list which you can send to the person you've selected. + + shlext will NOT send any file/folder/directory that is marked "hidden" + + Also, sometimes you will see "n files, 1 directory" when you say select something + e.g. c:\foobar, this is because shlext now also includes the top level directory so that the + remote side will know to create it, as well as sub directories. + + + + ---But Miranda has drag'n'drop! + + Yeah, that's okay when you can reach Miranda, but I have multiple profiles and + the "hide after NN seconds" option enabled, also I have groups! + + Miranda doesn't auto expand a group when someone is online unless you do that + yourself, which means drag 'n' drop has failed. Also, when you've selected a + large amount of files, Miranda will *freeze* completely whilst + it 1) scans all those files, 2) builds a copy of the given send list + + Whilst shlext only freezes Miranda for the latter, and that is seldom a "complete freeze". + + And of course, shlext uses Miranda 0.3's advanced threading services, which means + if you've asked shlext to build a massive send list, you can still exit Miranda safely + which you can't with drag 'n' drop! + + + + ---Installation + + If you've never installed shlext before, all you have to do is install it like + any other Miranda plugin, i.e. copy it to your plugins directory. + + That's it! you should goto Miranda->Options->Plugins->Shell Context Menus + to see if you'd like to set any of the options, however shlext works straight + out of the box and you don't really need to set anything up after that. + + If you want to use shlext with multiple profiles, you don't have to do any + special setting up either, just make sure that shlext is running with each Miranda + you want shlext to show a menu contact list for. + + Make sure ALL copies of shlext.dll are the same, i.e. 1.0.6.6, if they're not + then shlext will fail (this doesn't mean 'crash'). + + + ---Upgrading/Removing + + Upgrading shlext has always been a pain for users (and me!) this is because + shlext.dll runs in Windows and in Miranda (at the same time). + + So when you've shutdown Miranda, shlext.dll maybe kept in memory by Windows + to make things worse, clicking any file/folder will result in shlext.dll being + reloaded, so if you do shlext.dll->Delete, Windows will ask shlext.dll if + it wants to show any menus, nevermind the fact delete was selected! + + This happens also if you just press 'delete' whilst shlext.dll is selected. + + However! All is not lost, this is what you do: + + * goto M->Options->Plugins and disable shlext.dll as a Miranda plugin + * goto M->Options->Plugins->Shell context menus and click 'Remove'. + * Shutdown Miranda IM + + Advanced users only: ---------------------------------------------------- + + * Do all the above and then open a console window (Command prompt, etc) + * Make sure all applications have been shutdown + * Goto the directory where Miranda is, e.g. c:\, cd Miranda + * Goto Start->Shutdown, let the dialog come up and hold CTRL+ALT+SHIFT + and press cancel. + + This will shutdown Explorer but not Windows, you can now do: del shlext.dll + + * now run Explorer.exe usually in C:\Windows, shlext.dll will be removed. + + ---------------------------------------------------------------------------- + + The remove button will ask Windows not to load it anymore, by removing + all shlext registry entries, the button will also remove any settings from your + profile settings database that it may of made. + + You should now be able to delete shlext.dll! however if you still are unable + to, you may need to log out (if you're using XP/2000/NT) if you're using + 9x then you may have to restart Windows (pain I know, sorry!) + + You should now be free of old shlext copies and you can refer to "Installation" + above. + + If you were using shlext.dll with multiple profiles, the remove shlext + from each profile as stated above and then copy the newer shlext.dll to + your plugins folder. + + ---Translation + + I haven't been nice about translation strings in the past, but you + can pretty much translate everything shlext uses a string, even + "Miranda" which is shown in the menu. + + Note that some strings can't be translated, this is because some parts + of the plugin run within Explorer and that doesn't have access to Miranda's + langpacks, the "Miranda" string that appears in menus is a special exception + + ; + ; Translate()'able strings for shlext/2.0.0.9 + ; + + ;"Miranda" limited to 63characters! (exceed and it's chopped) + ;[Miranda] + ;[Problem, registration missing/deleted.] + ;[Successfully created shell registration.] + ;[Not Approved] + ;[Approved] + ;[Are you sure? this will remove all the settings stored in your database and all registry entries created for shlext to work with Explorer] + ;[Disable/Remove shlext] + ;[Shell context menus] + + ; new in 2.0.0.9, both these strings cannot be longer than 63 chracters + ;[Clear entries] + ;[Recently] + + ;IDD_SHLOPTS + ;[Menus] + ;[Display contacts in their assigned groups (if any)] + ;[Only if/when the contact list is using them] + ;[Display hidden, ignored or temporary contacts] + ;[Shell Status] + ;[Do not display the profile name in use] + ;[Contact Status] + ;[Show contacts that you have set privacy rules for] + ;[Remove] + ;[Do not show status icons in menus] + ;[Do not show contacts that are offline, even if my contact list does] + + + + + ---License + + Like Miranda, shlext is released under the GPL, you may find the full + FreePascal source-code on the CVS in plugins module 'shlext' + + You will need at least FreePascal/2.2.2, GNU make (if you want to use the makefile) + + Follow the CVS links from http://sf.net/projects/miranda-icq/ + + Note: All the tools used to build shlext are also under the GPL! + + + ---Contact/Bug reporting + + In the past shlext hasn't been as stable as it could be, but this was mainly + due to the problems of 0.2.0.0 and early 0.3.0.0 Miranda builds, I've taken + care to make sure things are stable as can be. + + If you have any problems/crashes, please contact me at: egodust at users.sf.net. + + Please include the following information: Windows version, service packs installed, + build version of Explorer, Miranda version, shlext version, a list of plugins + that you think maybe involved in crashes, steps to reproduce errors and so on. + + Note that shlext has been blamed for several bugs that were not shlext's fault, + for example the file xfer cancel bug was in ICQ and Miranda but not shlext ;) + + + ---Credits + + Tig-crash\d - Thanks for beta testing every version before this one ;) + Erik?, DD Of Borg - Thanks for beta testing 0.0.2.2/1.0.6.6 -- ideas and suggestions + as well what to exactly steal from ShellFileSend, heh.. \ No newline at end of file diff --git a/plugins/!Deprecated/ShlExt/make.bat b/plugins/!Deprecated/ShlExt/make.bat new file mode 100644 index 0000000000..f97c5ed9a3 --- /dev/null +++ b/plugins/!Deprecated/ShlExt/make.bat @@ -0,0 +1,25 @@ +@echo off +set p1=%1 +set p2=%2 +if "%p1%" == "" (echo "please specify target platform by adding 'fpc' or 'fpc64 parameter to command line!'"&&pause&&goto :EOF) +if "%p2%" == "" (echo "please specify target output directory by adding 10 for bin10 or 11 for bin11 to command line!'"&&pause&&goto :EOF) +if /i '%1' == 'fpc' ( + set OUTDIR="..\..\bin%2\Release\Plugins" + set FPCBIN=fpc.exe +) else if /i '%1' == 'fpc64' ( + set OUTDIR="..\..\bin%2\Release64\Plugins" + set FPCBIN=ppcrossx64.exe +) +set PROJECT=ShlExt + +if not exist %OUTDIR% mkdir %OUTDIR% +md tmp + +%FPCBIN% @..\Utils.pas\fpc.cfg %PROJECT%.dpr %3 %4 %5 %6 %7 %8 %9 +if errorlevel 1 exit /b 1 + +move .\tmp\%PROJECT%.dll %OUTDIR% +move .\tmp\%PROJECT%.map . +del /Q tmp\* +rd tmp +exit /b 0 diff --git a/plugins/!Deprecated/ShlExt/resource.h b/plugins/!Deprecated/ShlExt/resource.h new file mode 100644 index 0000000000..c89660a88d --- /dev/null +++ b/plugins/!Deprecated/ShlExt/resource.h @@ -0,0 +1,13 @@ +#define IDD_SHLOPTS 101 +#define IDC_USEGROUPS 1014 +#define IDC_CLISTGROUPS 1015 +#define IDC_SHOWFULL 1016 +#define IDC_NOPROF 1020 +#define IDC_SHOWINVISIBLES 1021 +#define IDC_HIDEOFFLINE 1022 +#define IDC_STATUS 1023 +#define IDC_CAPMENUS 1025 +#define IDC_CAPSTATUS 1026 +#define IDC_CAPSHLSTATUS 1027 +#define IDC_REMOVE 1028 +#define IDC_USEOWNERDRAW 1029 diff --git a/plugins/!Deprecated/ShlExt/shlc.inc b/plugins/!Deprecated/ShlExt/shlc.inc new file mode 100644 index 0000000000..2952de8c74 --- /dev/null +++ b/plugins/!Deprecated/ShlExt/shlc.inc @@ -0,0 +1,144 @@ +{$IFDEF SHL_IDC} + +const + IDD_SHLOPTS = 101; + IDC_USEGROUPS = 1014; + IDC_CLISTGROUPS = 1015; + // Show "HIT" + IDC_SHOWFULL = 1016; + IDC_NOPROF = 1020; + IDC_SHOWINVISIBLES = 1021; + IDC_HIDEOFFLINE = 1022; + // only in the options dialog + IDC_STATUS = 1023; + IDC_CAPMENUS = 1025; + IDC_CAPSTATUS = 1026; + IDC_CAPSHLSTATUS = 1027; + IDC_REMOVE = 1028; + IDC_USEOWNERDRAW = 1029; +{$ENDIF} +{$IFDEF SHL_KEYS} + +const + SHLExt_Name: PChar = 'shlext15'; + SHLExt_MRU: PChar = 'MRU'; + SHLExt_UseGroups: PChar = 'UseGroups'; + SHLExt_UseCListSetting: PChar = 'UseCLGroups'; + SHLExt_UseHITContacts: PChar = 'UseHITContacts'; + // HIT2 contacts will get your messages but don't know your state + SHLExt_UseHIT2Contacts: PChar = 'UseHIT2Contacts'; + SHLExt_ShowNoProfile: PChar = 'ShowNoProfile'; + SHLExt_ShowNoIcons: PChar = 'ShowNoIcons'; + SHLExt_ShowNoOffline: PChar = 'ShowNoOffline'; +{$ENDIF} +{$IFDEF SHLCOM} + +const + + S_OK = 0; + S_FALSE = 1; + + E_UNEXPECTED = $8000FFFF; + E_NOTIMPL = $80004001; + E_INVALIDARG = $80070057; + + CLASS_E_NOAGGREGATION = $80040110; + CLASS_E_CLASSNOTAVAILABLE = $80040111; + + CLSCTX_INPROC_SERVER = $1; + + { for FORMATETC } + + TYMED_HGLOBAL = 1; + DVASPECT_CONTENT = 1; + +type + + PGUID = ^TGUID; + + TGUID = record + D1: Longword; + D2: Word; + D3: Word; + D4: array [0 .. 7] of Byte; + end; + + TIID = TGUID; + TCLSID = TGUID; + + TStgMedium = record + tymed: Longint; + case Integer of + 0: (hBitmap: hBitmap; unkForRelease: Pointer { IUnknown } ); + 1: (hMetaFilePict: THandle); + 2: (hEnhMetaFile: THandle); + 3: (hGlobal: hGlobal); + 4: (lpszFileName: Pointer { POleStr } ); + 5: (stm: Pointer { IUnknown } ); + 6: (stg: Pointer { IStorage } ); + end; + + PFormatEtc = ^TFormatEtc; + + TFormatEtc = record + cfFormat: Word; { TClipFormat; } + ptd: Pointer; { PDVTargetDevice; } + dwAspect: Longint; + lindex: Longint; + tymed: Longint; + end; + +{$ENDIF} +{$IFDEF COM_STRUCTS} + +const + + IID_IUnknown: TGUID = (D1: $00000000; D2: $0000; D3: $0000; + D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); + + IID_IClassFactory: TGUID = (D1: $00000001; D2: $0000; D3: $0000; + D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); + + IID_IShellExtInit: TGUID = (D1: $000214E8; D2: $0000; D3: $0000; + D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); + + IID_IContextMenu: TGUID = (D1: $000214E4; D2: $0000; D3: $0000; + D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); + + IID_IContextMenu2: TGUID = (D1: $000214F4; D2: $0000; D3: $0000; + D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); + + IID_IContextMenu3: TGUID = (D1: $BCFCE0A0; D2: $EC17; D3: $11D0; + D4: ($8D, $10, $00, $A0, $C9, $0F, $27, $19)); + + IID_WICImagingFactory: TGUID = (D1: $EC5EC8A9; D2: $C395; D3: $4314; + D4: ($9C, $77, $54, $D7, $A9, $35, $FF, $70)); + + + // Vista+ only + + CLSID_WICImagingFactory: TGUID = (D1: $CACAF262; D2: $9370; D3: $4615; + D4: ($A1, $3B, $9F, $55, $39, $DA, $4C, $0A)); + + // anything before 0.0.1.5 was : {A321A032-7976-11d6-A310-ED893982BF28} + // changed to a new GUID to avoid older plugins + // {72013A26-A94C-11d6-8540-A5E62932711D} + // the IPC header now checks the plugin version given anyway. + + CLSID_ISHLCOM: TGUID = (D1: $72013A26; D2: $A94C; D3: $11D6; + D4: ($85, $40, $A5, $E6, $29, $32, $71, $1D);); +{$ENDIF} +{$IFDEF COMAPI} +function CoCreateInstance(const rclsid: TCLSID; pUnkOuter: Pointer; dwClsContext: DWORD; + const riid: TIID; var ppv): HResult; stdcall; external 'ole32.dll' name 'CoCreateInstance'; +procedure ReleaseStgMedium(var medium: TStgMedium); stdcall; + external 'ole32.dll' name 'ReleaseStgMedium'; +function IsEqualGUID(const guid1, guid2: TGUID): Boolean; stdcall; + external 'ole32.dll' name 'IsEqualGUID'; +function IsEqualIID(const iid1, iid2: TIID): Boolean; stdcall; + external 'ole32.dll' name 'IsEqualGUID'; +function IsEqualCLSID(const clsid1, clsid2: TCLSID): Boolean; stdcall; + external 'ole32.dll' name 'IsEqualGUID'; +function QueueUserAPC(pfnAPC: Pointer; hThread: THandle; dwData: DWORD): BOOL; stdcall; + external 'kernel32' name 'QueueUserAPC'; +{$ENDIF} diff --git a/plugins/!Deprecated/ShlExt/shlcom.pas b/plugins/!Deprecated/ShlExt/shlcom.pas new file mode 100644 index 0000000000..93a5d27695 --- /dev/null +++ b/plugins/!Deprecated/ShlExt/shlcom.pas @@ -0,0 +1,2471 @@ +unit shlcom; + +{$IFDEF FPC} +{$PACKRECORDS 4} +{$MODE Delphi} +{$ENDIF} + +interface + +uses + + Windows, m_api, shlipc, shlicons; + +{$DEFINE COM_STRUCTS} +{$DEFINE SHLCOM} +{$INCLUDE shlc.inc} +{$UNDEF SHLCOM} +{$UNDEF COM_STRUCTS} +function DllGetClassObject(const CLSID: TCLSID; const IID: TIID; var Obj): HResult; stdcall; +function DllCanUnloadNow: HResult; stdcall; + +procedure InvokeThreadServer; + +procedure CheckRegisterServer; + +procedure CheckUnregisterServer; + +function RemoveCOMRegistryEntries: HResult; + +function ExtractIcon(hInst: THandle; pszExe: PChar; nIndex: Integer): HICON; stdcall; + external 'shell32.dll' name 'ExtractIconA'; + +implementation + +var + dllpublic: record + FactoryCount: Integer; + ObjectCount: Integer; + end; + + VistaOrLater:Boolean; + +{$DEFINE COMAPI} +{$INCLUDE shlc.inc} +{$UNDEF COMAPI} + +const + + IPC_PACKET_SIZE = $1000 * 32; + // IPC_PACKET_NAME = 'm.mi.miranda.ipc'; // prior to 1.0.6.6 + // IPC_PACKET_NAME = 'mi.miranda.IPCServer'; // prior to 2.0.0.9 + IPC_PACKET_NAME = 'm.mi.miranda.ipc.server'; + +const + + { Flags returned by IContextMenu*:QueryContextMenu() } + + CMF_NORMAL = $00000000; + CMF_DEFAULTONLY = $00000001; + CMF_VERBSONLY = $00000002; + CMF_EXPLORE = $00000004; + CMF_NOVERBS = $00000008; + CMF_CANRENAME = $00000010; + CMF_NODEFAULT = $00000020; + CMF_INCLUDESTATIC = $00000040; + CMF_RESERVED = $FFFF0000; { view specific } + + { IContextMenu*:GetCommandString() uType flags } + + GCS_VERBA = $00000000; // canonical verb + GCS_HELPTEXTA = $00000001; // help text (for status bar) + GCS_VALIDATEA = $00000002; // validate command exists + GCS_VERBW = $00000004; // canonical verb (unicode) + GC_HELPTEXTW = $00000005; // help text (unicode version) + GCS_VALIDATEW = $00000006; // validate command exists (unicode) + GCS_UNICODE = $00000004; // for bit testing - Unicode string + GCS_VERB = GCS_VERBA; // + GCS_HELPTEXT = GCS_HELPTEXTA; + GCS_VALIDATE = GCS_VALIDATEA; + +type + + { this structure is returned by InvokeCommand() } + + PCMInvokeCommandInfo = ^TCMInvokeCommandInfo; + + TCMInvokeCommandInfo = packed record + cbSize: DWORD; + fMask: DWORD; + hwnd: hwnd; + lpVerb: PChar; { maybe index, type cast as Integer } + lpParams: PChar; + lpDir: PChar; + nShow: Integer; + dwHotkey: DWORD; + HICON: THandle; + end; + + { completely stolen from modules.c: 'NameHashFunction' modified slightly } + +function StrHash(const szStr: PChar): DWORD;// cdecl; +begin + result:=mir_hash(szStr,strlen(szStr)); +{ +asm + // esi content has to be preserved with basm + push esi + xor edx,edx + xor eax,eax + mov esi,szStr + mov al,[esi] + xor cl,cl +@@lph_top: // only 4 of 9 instructions in here don't use AL, so optimal pipe use is impossible + xor edx,eax + inc esi + xor eax,eax + and cl,31 + mov al,[esi] + add cl,5 + test al,al + rol eax,cl // rol is u-pipe only, but pairable + // rol doesn't touch z-flag + jnz @@lph_top // 5 clock tick loop. not bad. + xor eax,edx + pop esi +} +end; + +function CreateProcessUID(const pid: Cardinal): string; +var + pidrep: string[16]; +begin + str(pid, pidrep); + Result := Concat('mim.shlext.', pidrep, '$'); +end; + +function CreateUID: string; +var + pidrep, tidrep: string[16]; +begin + str(GetCurrentProcessId(), pidrep); + str(GetCurrentThreadId(), tidrep); + Result := Concat('mim.shlext.caller', pidrep, '$', tidrep); +end; + +// FPC doesn't support array[0..n] of Char extended syntax with Str() + +function wsprintf(lpOut, lpFmt: PChar; ArgInt: Integer): Integer; cdecl; + external 'user32.dll' name 'wsprintfA'; + +procedure str(i: Integer; S: PChar); +begin + i := wsprintf(S, '%d', i); + if i > 2 then + PChar(S)[i] := #0; +end; + +{ IShlCom } + +type + + PLResult = ^LResult; + + // bare minimum interface of IDataObject, since GetData() is only required. + + PVTable_IDataObject = ^TVTable_IDataObject; + + TVTable_IDataObject = record + { IUnknown } + QueryInterface: Pointer; + AddRef: function(Self: Pointer): Cardinal; stdcall; + Release: function(Self: Pointer): Cardinal; stdcall; + { IDataObject } + GetData: function(Self:Pointer; var formatetcIn:TFormatEtc; var medium:TStgMedium): HResult; stdcall; + GetDataHere: Pointer; + QueryGetData: Pointer; + GetCanonicalFormatEtc: Pointer; + SetData: Pointer; + EnumFormatEtc: Pointer; + DAdvise: Pointer; + DUnadvise: Pointer; + EnumDAdvise: Pointer; + end; + + PDataObject_Interface = ^TDataObject_Interface; + + TDataObject_Interface = record + ptrVTable: PVTable_IDataObject; + end; + + { TShlComRec inherits from different interfaces with different function tables + all "compiler magic" is lost in this case, but it's pretty easy to return + a different function table for each interface, IContextMenu is returned + as IContextMenu'3' since it inherits from '2' and '1' } + + PVTable_IShellExtInit = ^TVTable_IShellExtInit; + + TVTable_IShellExtInit = record + { IUnknown } + QueryInterface: Pointer; + AddRef: Pointer; + Release: Pointer; + { IShellExtInit } + Initialise: Pointer; + end; + + PShlComRec = ^TShlComRec; + PShellExtInit_Interface = ^TShellExtInit_Interface; + + TShellExtInit_Interface = record + { pointer to function table } + ptrVTable: PVTable_IShellExtInit; + { instance data } + ptrInstance: PShlComRec; + { function table itself } + vTable: TVTable_IShellExtInit; + end; + + PVTable_IContextMenu3 = ^TVTable_IContextMenu3; + + TVTable_IContextMenu3 = record + { IUnknown } + QueryInterface: Pointer; + AddRef: Pointer; + Release: Pointer; + { IContextMenu } + QueryContextMenu: Pointer; + InvokeCommand: Pointer; + GetCommandString: Pointer; + { IContextMenu2 } + HandleMenuMsg: Pointer; + { IContextMenu3 } + HandleMenuMsg2: Pointer; + end; + + PContextMenu3_Interface = ^TContextMenu3_Interface; + + TContextMenu3_Interface = record + ptrVTable: PVTable_IContextMenu3; + ptrInstance: PShlComRec; + vTable: TVTable_IContextMenu3; + end; + + PCommon_Interface = ^TCommon_Interface; + + TCommon_Interface = record + ptrVTable: Pointer; + ptrInstance: PShlComRec; + end; + + TShlComRec = record + ShellExtInit_Interface: TShellExtInit_Interface; + ContextMenu3_Interface: TContextMenu3_Interface; + { fields } + RefCount: LongInt; + // this is owned by the shell after items are added 'n' is used to + // grab menu information directly via id rather than array indexin' + hRootMenu: THandle; + idCmdFirst: Integer; + // most of the memory allocated is on this heap object so HeapDestroy() + // can do most of the cleanup, extremely lazy I know. + hDllHeap: THandle; + // This is a submenu that recently used contacts are inserted into + // the contact is inserted twice, once in its normal list (or group) and here + // Note: These variables are global data, but refered to locally by each instance + // Do not rely on these variables outside the process enumeration. + hRecentMenu: THandle; + RecentCount: Cardinal; // number of added items + // array of all the protocol icons, for every running instance! + ProtoIcons: ^TSlotProtoIconsArray; + ProtoIconsCount: Cardinal; + // maybe null, taken from IShellExtInit_Initalise() and AddRef()'d + // only used if a Miranda instance is actually running and a user + // is selected + pDataObject: PDataObject_Interface; + // DC is used for font metrics and saves on creating and destroying lots of DC handles + // during WM_MEASUREITEM + hMemDC: HDC; + end; + + { this is passed to the enumeration callback so it can process PID's with + main windows by the class name MIRANDANAME loaded with the plugin + and use the IPC stuff between enumerations -- } + + PEnumData = ^TEnumData; + + TEnumData = record + Self: PShlComRec; + // autodetected, don't hard code since shells that don't support it + // won't send WM_MEASUREITETM/WM_DRAWITEM at all. + bOwnerDrawSupported: LongBool; + // as per user setting (maybe of multiple Mirandas) + bShouldOwnerDraw: LongBool; + idCmdFirst: Integer; + ipch: PHeaderIPC; + // OpenEvent()'d handle to give each IPC server an object to set signalled + hWaitFor: THandle; + pid: DWORD; // sub-unique value used to make work object name + end; + +procedure FreeGroupTreeAndEmptyGroups(hParentMenu: THandle; pp, p: PGroupNode); +var + q: PGroupNode; +begin + while p <> nil do + begin + q := p^.Right; + if p^.Left <> nil then + begin + FreeGroupTreeAndEmptyGroups(p^.Left^.hMenu, p, p^.Left); + end; // if + if p^.dwItems = 0 then + begin + if pp <> nil then + begin + DeleteMenu(pp^.hMenu, p^.hMenuGroupID, MF_BYCOMMAND) + end + else + begin + DeleteMenu(hParentMenu, p^.hMenuGroupID, MF_BYCOMMAND); + end; // if + end + else + begin + // make sure this node's parent know's it exists + if pp <> nil then + inc(pp^.dwItems); + end; + Dispose(p); + p := q; + end; +end; + +procedure DecideMenuItemInfo(pct: PSlotIPC; pg: PGroupNode; var mii: TMenuItemInfo; lParam: PEnumData); +var + psd: PMenuDrawInfo; + hDllHeap: THandle; + c: Cardinal; + pp: ^TSlotProtoIconsArray; +begin + mii.wID := lParam^.idCmdFirst; + inc(lParam^.idCmdFirst); + // get the heap object + hDllHeap := lParam^.Self^.hDllHeap; + psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); + if pct <> nil then + begin + psd^.cch := pct^.cbStrSection - 1; // no null; + psd^.szText := HeapAlloc(hDllHeap, 0, pct^.cbStrSection); + lstrcpya(psd^.szText, PChar(uint_ptr(pct) + sizeof(TSlotIPC))); + psd^.hContact := pct^.hContact; + psd^.fTypes := [dtContact]; + // find the protocol icon array to use and which status + c := lParam^.Self^.ProtoIconsCount; + pp := lParam^.Self^.ProtoIcons; + psd^.hStatusIcon := 0; + while c > 0 do + begin + dec(c); + if (pp[c].hProto = pct^.hProto) and (pp[c].pid = lParam^.pid) then + begin + psd^.hStatusIcon := pp[c].hIcons[pct^.Status - ID_STATUS_OFFLINE]; + psd^.hStatusBitmap := pp[c].hBitmaps[pct^.Status - ID_STATUS_OFFLINE]; + break; + end; + end; // while + psd^.pid := lParam^.pid; + end + else if pg <> nil then + begin + // store the given ID + pg^.hMenuGroupID := mii.wID; + // steal the pointer from the group node it should be on the heap + psd^.cch := pg^.cchGroup; + psd^.szText := pg^.szGroup; + psd^.fTypes := [dtGroup]; + end; // if + psd^.wID := mii.wID; + psd^.szProfile := nil; + // store + mii.dwItemData := uint_ptr(psd); + + if ((lParam^.bOwnerDrawSupported) and (lParam^.bShouldOwnerDraw)) then + begin + mii.fType := MFT_OWNERDRAW; + Pointer(mii.dwTypeData) := psd; + end + else + begin + // normal menu + mii.fType := MFT_STRING; + if pct <> nil then + begin + uint_ptr(mii.dwTypeData) := uint_ptr(pct) + sizeof(TSlotIPC); + end + else + begin + mii.dwTypeData := pg^.szGroup; + end; + { For Vista + let the system draw the theme and icons, pct = contact associated data } + if VistaOrLater and (pct <> nil) and (psd <> nil) then + begin + mii.fMask := MIIM_BITMAP or MIIM_FTYPE or MIIM_ID or MIIM_DATA or MIIM_STRING; + // BuildSkinIcons() built an array of bitmaps which we can use here + mii.hBmpItem := psd^.hStatusBitmap; + end; + end; // if +end; + +// must be called after DecideMenuItemInfo() +procedure BuildMRU(pct: PSlotIPC; var mii: TMenuItemInfo; lParam: PEnumData); +begin + if pct^.MRU > 0 then + begin + inc(lParam^.Self^.RecentCount); + // lParam^.Self == pointer to object data + InsertMenuitem(lParam^.Self^.hRecentMenu, $FFFFFFFF, True, mii); + end; +end; + +procedure BuildContactTree(group: PGroupNode; lParam: PEnumData); +label + grouploop; +var + pct: PSlotIPC; + pg, px: PGroupNode; + str: TStrTokRec; + sz: PChar; + Hash: Cardinal; + Depth: Cardinal; + mii: TMenuItemInfo; +begin + // set up the menu item + mii.cbSize := sizeof(TMenuItemInfo); + mii.fMask := MIIM_ID or MIIM_TYPE or MIIM_DATA; + // set up the scanner + str.szSet := ['\']; + str.bSetTerminator := False; + // go thru all the contacts + pct := lParam^.ipch^.ContactsBegin; + while (pct <> nil) and (pct^.cbSize = sizeof(TSlotIPC)) and (pct^.fType = REQUEST_CONTACTS) do + begin + if pct^.hGroup <> 0 then + begin + // at the end of the slot header is the contact's display name + // and after a double NULL char there is the group string, which has the full path of the group + // this must be tokenised at '\' and we must walk the in memory group tree til we find our group + // this is faster than the old version since we only ever walk one or at most two levels of the tree + // per tokenised section, and it doesn't matter if two levels use the same group name (which is valid) + // as the tokens processed is equatable to depth of the tree + str.szStr := PChar(uint_ptr(pct) + sizeof(TSlotIPC) + uint_ptr(pct^.cbStrSection) + 1); + sz := StrTok(str); + // restore the root + pg := group; + Depth := 0; + while sz <> nil do + begin + Hash := StrHash(sz); + // find this node within + while pg <> nil do + begin + // does this node have the right hash and the right depth? + if (Hash = pg^.Hash) and (Depth = pg^.Depth) then + break; + // each node may have a left pointer going to a sub tree + // the path syntax doesn't know if a group is a group at the same level + // or a nested one, which means the search node can be anywhere + px := pg^.Left; + if px <> nil then + begin + // keep searching this level + while px <> nil do + begin + if (Hash = px^.Hash) and (Depth = px^.Depth) then + begin + // found the node we're looking for at the next level to pg, px is now pq for next time + pg := px; + goto grouploop; + end; // if + px := px^.Right; + end; // if + end; // if + pg := pg^.Right; + end; // while + grouploop: + inc(Depth); + // process next token + sz := StrTok(str); + end; // while + // tokenisation finished, if pg <> nil then the group is found + if pg <> nil then + begin + DecideMenuItemInfo(pct, nil, mii, lParam); + BuildMRU(pct, mii, lParam); + InsertMenuitem(pg^.hMenu, $FFFFFFFF, True, mii); + inc(pg^.dwItems); + end; + end; // if + pct := pct^.Next; + end; // while +end; + +procedure BuildMenuGroupTree(p: PGroupNode; lParam: PEnumData; hLastMenu: hMenu); +var + mii: TMenuItemInfo; +begin + mii.cbSize := sizeof(TMenuItemInfo); + mii.fMask := MIIM_ID or MIIM_DATA or MIIM_TYPE or MIIM_SUBMENU; + // go thru each group and create a menu for it adding submenus too. + while p <> nil do + begin + mii.hSubMenu := CreatePopupMenu(); + if p^.Left <> nil then + BuildMenuGroupTree(p^.Left, lParam, mii.hSubMenu); + p^.hMenu := mii.hSubMenu; + DecideMenuItemInfo(nil, p, mii, lParam); + InsertMenuitem(hLastMenu, $FFFFFFFF, True, mii); + p := p^.Right; + end; // while +end; + +{ this callback is triggered by the menu code and IPC is already taking place, + just the transfer type+data needs to be setup } +function ClearMRUIPC(pipch: PHeaderIPC; // IPC header info, already mapped + hWorkThreadEvent: THandle; // event object being waited on on miranda thread + hAckEvent: THandle; // ack event object that has been created + psd: PMenuDrawInfo // command/draw info + ): Integer; stdcall; +begin + Result := S_OK; + ipcPrepareRequests(IPC_PACKET_SIZE, pipch, REQUEST_CLEARMRU); + ipcSendRequest(hWorkThreadEvent, hAckEvent, pipch, 100); +end; + +procedure RemoveCheckmarkSpace(hMenu: hMenu); +const + MIM_STYLE = $00000010; + MNS_CHECKORBMP = $4000000; +type + TMENUINFO = record + cbSize: DWORD; + fMask: DWORD; + dwStyle: DWORD; + cyMax: LongInt; + hbrBack: THandle; + dwContextHelpID: DWORD; + dwMenuData: Pointer; + end; +var + SetMenuInfo: function(hMenu: hMenu; var mi: TMENUINFO): Boolean; stdcall; + mi: TMENUINFO; +begin + if not VistaOrLater then + Exit; + SetMenuInfo := GetProcAddress(GetModuleHandle('user32'), 'SetMenuInfo'); + if @SetMenuInfo = nil then + Exit; + mi.cbSize := sizeof(mi); + mi.fMask := MIM_STYLE; + mi.dwStyle := MNS_CHECKORBMP; + SetMenuInfo(hMenu, mi); +end; + +procedure BuildMenus(lParam: PEnumData); +{$DEFINE SHL_IDC} +{$DEFINE SHL_KEYS} +{$INCLUDE shlc.inc} +{$UNDEF SHL_KEYS} +{$UNDEF SHL_IDC} +var + hBaseMenu: hMenu; + hGroupMenu: hMenu; + pg: PSlotIPC; + mii: TMenuItemInfo; + j: TGroupNodeList; + p, q: PGroupNode; + Depth, Hash: Cardinal; + Token: PChar; + tk: TStrTokRec; + hDllHeap: THandle; + psd: PMenuDrawInfo; + c: Cardinal; + pp: ^TSlotProtoIconsArray; +begin + ZeroMemory(@mii, sizeof(mii)); + hDllHeap := lParam^.Self^.hDllHeap; + hBaseMenu := lParam^.Self^.hRootMenu; + // build an in memory tree of the groups + pg := lParam^.ipch^.GroupsBegin; + tk.szSet := ['\']; + tk.bSetTerminator := False; + j.First := nil; + j.Last := nil; + while pg <> nil do + begin + if (pg^.cbSize <> sizeof(TSlotIPC)) or (pg^.fType <> REQUEST_GROUPS) then + break; + Depth := 0; + p := j.First; // start at root again + // get the group + uint_ptr(tk.szStr) := (uint_ptr(pg) + sizeof(TSlotIPC)); + // find each word between \ and create sub groups if needed. + Token := StrTok(tk); + while Token <> nil do + begin + Hash := StrHash(Token); + // if the (sub)group doesn't exist, create it. + q := FindGroupNode(p, Hash, Depth); + if q = nil then + begin + q := AllocGroupNode(@j, p, Depth); + q^.Depth := Depth; + // this is the hash of this group node, but it can be anywhere + // i.e. Foo\Foo this is because each node has a different depth + // trouble is contacts don't come with depths! + q^.Hash := Hash; + // don't assume that pg^.hGroup's hash is valid for this token + // since it maybe Miranda\Blah\Blah and we have created the first node + // which maybe Miranda, thus giving the wrong hash + // since "Miranda" can be a group of it's own and a full path + q^.cchGroup := lstrlena(Token); + q^.szGroup := HeapAlloc(hDllHeap, 0, q^.cchGroup + 1); + lstrcpya(q^.szGroup, Token); + q^.dwItems := 0; + end; + p := q; + inc(Depth); + Token := StrTok(tk); + end; // while + pg := pg^.Next; + end; // while + // build the menus inserting into hGroupMenu which will be a submenu of + // the instance menu item. e.g. Miranda -> [Groups ->] contacts + hGroupMenu := CreatePopupMenu(); + + // allocate MRU menu, this will be associated with the higher up menu + // so doesn't need to be freed (unless theres no MRUs items attached) + // This menu is per process but the handle is stored globally (like a stack) + lParam^.Self^.hRecentMenu := CreatePopupMenu(); + lParam^.Self^.RecentCount := 0; + // create group menus only if they exist! + if lParam^.ipch^.GroupsBegin <> nil then + begin + BuildMenuGroupTree(j.First, lParam, hGroupMenu); + // add contacts that have a group somewhere + BuildContactTree(j.First, lParam); + end; + // + mii.cbSize := sizeof(TMenuItemInfo); + mii.fMask := MIIM_ID or MIIM_TYPE or MIIM_DATA; + // add all the contacts that have no group (which maybe all of them) + pg := lParam^.ipch^.ContactsBegin; + while pg <> nil do + begin + if (pg^.cbSize <> sizeof(TSlotIPC)) or (pg^.fType <> REQUEST_CONTACTS) then + break; + if pg^.hGroup = 0 then + begin + DecideMenuItemInfo(pg, nil, mii, lParam); + BuildMRU(pg, mii, lParam); + InsertMenuitem(hGroupMenu, $FFFFFFFF, True, mii); + end; // if + pg := pg^.Next; + end; // while + + // insert MRU menu as a submenu of the contact menu only if + // the MRU list has been created, the menu popup will be deleted by itself + if lParam^.Self^.RecentCount > 0 then + begin + + // insert seperator and 'clear list' menu + mii.fType := MFT_SEPARATOR; + mii.fMask := MIIM_TYPE; + InsertMenuitem(lParam^.Self^.hRecentMenu, $FFFFFFFF, True, mii); + + // insert 'clear MRU' item and setup callback + mii.fMask := MIIM_TYPE or MIIM_ID or MIIM_DATA; + mii.wID := lParam^.idCmdFirst; + inc(lParam^.idCmdFirst); + mii.fType := MFT_STRING; + mii.dwTypeData := lParam^.ipch^.ClearEntries; // "Clear entries" + // allocate menu substructure + psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); + psd^.fTypes := [dtCommand]; + psd^.MenuCommandCallback := @ClearMRUIPC; + psd^.wID := mii.wID; + // this is needed because there is a clear list command per each process. + psd^.pid := lParam^.pid; + Pointer(mii.dwItemData) := psd; + InsertMenuitem(lParam^.Self^.hRecentMenu, $FFFFFFFF, True, mii); + + // insert MRU submenu into group menu (with) ownerdraw support as needed + psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); + psd^.szProfile := 'MRU'; + psd^.fTypes := [dtGroup]; + // the IPC string pointer wont be around forever, must make a copy + psd^.cch := strlen(lParam^.ipch^.MRUMenuName); + psd^.szText := HeapAlloc(hDllHeap, 0, psd^.cch + 1); + lstrcpyn(psd^.szText, lParam^.ipch^.MRUMenuName, sizeof(lParam^.ipch^.MRUMenuName) - 1); + + pointer(mii.dwItemData) := psd; + if (lParam^.bOwnerDrawSupported) and (lParam^.bShouldOwnerDraw) then + begin + mii.fType := MFT_OWNERDRAW; + Pointer(mii.dwTypeData) := psd; + end + else + begin + mii.dwTypeData := lParam^.ipch^.MRUMenuName; // 'Recent'; + end; + mii.wID := lParam^.idCmdFirst; + inc(lParam^.idCmdFirst); + mii.fMask := MIIM_TYPE or MIIM_SUBMENU or MIIM_DATA or MIIM_ID; + mii.hSubMenu := lParam^.Self^.hRecentMenu; + InsertMenuitem(hGroupMenu, 0, True, mii); + end + else + begin + // no items were attached to the MRU, delete the MRU menu + DestroyMenu(lParam^.Self^.hRecentMenu); + lParam^.Self^.hRecentMenu := 0; + end; + + // allocate display info/memory for "Miranda" string + + mii.cbSize := sizeof(TMenuItemInfo); + mii.fMask := MIIM_ID or MIIM_DATA or MIIM_TYPE or MIIM_SUBMENU; + if VistaOrLater then + begin + mii.fMask := MIIM_ID or MIIM_DATA or MIIM_FTYPE or MIIM_SUBMENU or MIIM_STRING or + MIIM_BITMAP; + end; + mii.hSubMenu := hGroupMenu; + + // by default, the menu will have space for icons and checkmarks (on Vista+) and we don't need this + RemoveCheckmarkSpace(hGroupMenu); + + psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); + psd^.cch := strlen(lParam^.ipch^.MirandaName); + psd^.szText := HeapAlloc(hDllHeap, 0, psd^.cch + 1); + lstrcpyn(psd^.szText, lParam^.ipch^.MirandaName, sizeof(lParam^.ipch^.MirandaName) - 1); + // there may not be a profile name + pg := lParam^.ipch^.DataPtr; + psd^.szProfile := nil; + if ((pg <> nil) and (pg^.Status = STATUS_PROFILENAME)) then + begin + psd^.szProfile := HeapAlloc(hDllHeap, 0, pg^.cbStrSection); + lstrcpya(psd^.szProfile, PChar(uint_ptr(pg) + sizeof(TSlotIPC))); + end; // if + // owner draw menus need ID's + mii.wID := lParam^.idCmdFirst; + inc(lParam^.idCmdFirst); + psd^.fTypes := [dtEntry]; + psd^.wID := mii.wID; + psd^.hContact := 0; + // get Miranda's icon or bitmap + c := lParam^.Self^.ProtoIconsCount; + pp := lParam^.Self^.ProtoIcons; + while c > 0 do + begin + dec(c); + if (pp[c].pid = lParam^.pid) and (pp[c].hProto = 0) then + begin + // either of these can be 0 + psd^.hStatusIcon := pp[c].hIcons[0]; + mii.hBmpItem := pp[c].hBitmaps[0]; + break; + end; // if + end; // while + pointer(mii.dwItemData) := psd; + if ((lParam^.bOwnerDrawSupported) and (lParam^.bShouldOwnerDraw)) then + begin + mii.fType := MFT_OWNERDRAW; + Pointer(mii.dwTypeData) := psd; + end + else + begin + mii.fType := MFT_STRING; + mii.dwTypeData := lParam^.ipch^.MirandaName; + mii.cch := sizeof(lParam^.ipch^.MirandaName) - 1; + end; + // add it all + InsertMenuitem(hBaseMenu, 0, True, mii); + // free the group tree + FreeGroupTreeAndEmptyGroups(hGroupMenu, nil, j.First); +end; + +procedure BuildSkinIcons(lParam: PEnumData); +var + pct: PSlotIPC; + p, d: PSlotProtoIcons; + Self: PShlComRec; + j: Cardinal; + imageFactory: PImageFactory_Interface; +begin + pct := lParam^.ipch^.NewIconsBegin; + Self := lParam^.Self; + while (pct <> nil) do + begin + if (pct^.cbSize <> sizeof(TSlotIPC)) or (pct^.fType <> REQUEST_NEWICONS) then + break; + uint_ptr(p) := uint_ptr(pct) + sizeof(TSlotIPC); + ReAllocMem(Self^.ProtoIcons, (Self^.ProtoIconsCount + 1) * sizeof(TSlotProtoIcons)); + d := @Self^.ProtoIcons[Self^.ProtoIconsCount]; + CopyMemory(d, p, sizeof(TSlotProtoIcons)); + + { + If using Vista (or later), clone all the icons into bitmaps and keep these around, + if using anything older, just use the default code, the bitmaps (and or icons) will be freed + with the shell object. + } + + imageFactory := nil; + + for j := 0 to 9 do + begin + if imageFactory = nil then + imageFactory := ARGB_GetWorker(); + if VistaOrLater then + begin + d^.hBitmaps[j] := ARGB_BitmapFromIcon(imageFactory, Self^.hMemDC, p^.hIcons[j]); + d^.hIcons[j] := 0; + end + else + begin + d^.hBitmaps[j] := 0; + d^.hIcons[j] := CopyIcon(p^.hIcons[j]); + end; + end; + + if imageFactory <> nil then + begin + imageFactory^.ptrVTable^.Release(imageFactory); + imageFactory := nil; + end; + + inc(Self^.ProtoIconsCount); + pct := pct^.Next; + end; +end; + +function ProcessRequest(hwnd: hwnd; lParam: PEnumData): BOOL; stdcall; +var + pid: Integer; + hMirandaWorkEvent: THandle; + replyBits: Integer; + szBuf: array [0 .. MAX_PATH] of Char; +begin + Result := True; + pid := 0; + GetWindowThreadProcessId(hwnd, @pid); + If pid <> 0 then + begin + // old system would get a window's pid and the module handle that created it + // and try to OpenEvent() a event object name to it (prefixed with a string) + // this was fine for most Oses (not the best way) but now actually compares + // the class string (a bit slower) but should get rid of those bugs finally. + hMirandaWorkEvent := OpenEvent(EVENT_ALL_ACCESS, False, PChar(CreateProcessUID(pid))); + if (hMirandaWorkEvent <> 0) then + begin + GetClassName(hwnd, szBuf, sizeof(szBuf)); + if lstrcmp(szBuf, MirandaName) <> 0 then + begin + // opened but not valid. + CloseHandle(hMirandaWorkEvent); + Exit; + end; // if + end; // if + { If the event object exists, then a shlext.dll running in the instance must of created it. } + If hMirandaWorkEvent <> 0 then + begin + { prep the request } + ipcPrepareRequests(IPC_PACKET_SIZE, lParam^.ipch, REQUEST_ICONS or REQUEST_GROUPS or + REQUEST_CONTACTS or REQUEST_NEWICONS); + // slots will be in the order of icon data, groups then contacts, the first + // slot will contain the profile name + replyBits := ipcSendRequest(hMirandaWorkEvent, lParam^.hWaitFor, lParam^.ipch, 1000); + { replyBits will be REPLY_FAIL if the wait timed out, or it'll be the request + bits as sent or a series of *_NOTIMPL bits where the request bit were, if there are no + contacts to speak of, then don't bother showing this instance of Miranda } + if (replyBits <> REPLY_FAIL) and (lParam^.ipch^.ContactsBegin <> nil) then + begin + // load the address again, the server side will always overwrite it + lParam^.ipch^.pClientBaseAddress := lParam^.ipch; + // fixup all the pointers to be relative to the memory map + // the base pointer of the client side version of the mapped file + ipcFixupAddresses(False, lParam^.ipch); + // store the PID used to create the work event object + // that got replied to -- this is needed since each contact + // on the final menu maybe on a different instance and another OpenEvent() will be needed. + lParam^.pid := pid; + // check out the user options from the server + lParam^.bShouldOwnerDraw := (lParam^.ipch^.dwFlags and HIPC_NOICONS) = 0; + // process the icons + BuildSkinIcons(lParam); + // process other replies + BuildMenus(lParam); + end; + { close the work object } + CloseHandle(hMirandaWorkEvent); + end; // if + end; // if +end; + +function TShlComRec_QueryInterface(Self: PCommon_Interface; const IID: TIID; var Obj): HResult; stdcall; +begin + Pointer(Obj) := nil; + { IShellExtInit is given when the TShlRec is created } + if IsEqualIID(IID, IID_IContextMenu) or IsEqualIID(IID, IID_IContextMenu2) or + IsEqualIID(IID, IID_IContextMenu3) then + begin + with Self^.ptrInstance^ do + begin + Pointer(Obj) := @ContextMenu3_Interface; + inc(RefCount); + end; { with } + Result := S_OK; + end + else + begin + // under XP, it may ask for IShellExtInit again, this fixes the -double- click to see menus issue + // which was really just the object not being created + if IsEqualIID(IID, IID_IShellExtInit) then + begin + with Self^.ptrInstance^ do + begin + Pointer(Obj) := @ShellExtInit_Interface; + inc(RefCount); + end; // if + Result := S_OK; + end + else + begin + Result := CLASS_E_CLASSNOTAVAILABLE; + end; // if + end; // if +end; + +function TShlComRec_AddRef(Self: PCommon_Interface): LongInt; stdcall; +begin + with Self^.ptrInstance^ do + begin + inc(RefCount); + Result := RefCount; + end; { with } +end; + +function TShlComRec_Release(Self: PCommon_Interface): LongInt; stdcall; +var + j, c: Cardinal; +begin + with Self^.ptrInstance^ do + begin + dec(RefCount); + Result := RefCount; + If RefCount = 0 then + begin + // time to go byebye. + with Self^.ptrInstance^ do + begin + // Note MRU menu is associated with a window (indirectly) so windows will free it. + // free icons! + if ProtoIcons <> nil then + begin + c := ProtoIconsCount; + while c > 0 do + begin + dec(c); + for j := 0 to 9 do + begin + with ProtoIcons[c] do + begin + if hIcons[j] <> 0 then + DestroyIcon(hIcons[j]); + if hBitmaps[j] <> 0 then + DeleteObject(hBitmaps[j]); + end; + end; + end; + FreeMem(ProtoIcons); + ProtoIcons := nil; + end; // if + // free IDataObject reference if pointer exists + if pDataObject <> nil then + begin + pDataObject^.ptrVTable^.Release(pDataObject); + end; // if + pDataObject := nil; + // free the heap and any memory allocated on it + HeapDestroy(hDllHeap); + // destroy the DC + if hMemDC <> 0 then + DeleteDC(hMemDC); + end; // with + // free the instance (class record) created + Dispose(Self^.ptrInstance); + dec(dllpublic.ObjectCount); + end; { if } + end; { with } +end; + +function TShlComRec_Initialise(Self: PContextMenu3_Interface; pidLFolder: Pointer; + DObj: PDataObject_Interface; hKeyProdID: HKEY): HResult; stdcall; +begin + // DObj is a pointer to an instance of IDataObject which is a pointer itself + // it contains a pointer to a function table containing the function pointer + // address of GetData() - the instance data has to be passed explicitly since + // all compiler magic has gone. + with Self^.ptrInstance^ do + begin + if DObj <> nil then + begin + Result := S_OK; + // if an instance already exists, free it. + if pDataObject <> nil then + pDataObject^.ptrVTable^.Release(pDataObject); + // store the new one and AddRef() it + pDataObject := DObj; + pDataObject^.ptrVTable^.AddRef(pDataObject); + end + else + begin + Result := E_INVALIDARG; + end; // if + end; // if +end; + +function MAKE_HRESULT(Severity, Facility, Code: Integer): HResult; +{$IFDEF FPC} +inline; +{$ENDIF} +begin + Result := (Severity shl 31) or (Facility shl 16) or Code; +end; + +function TShlComRec_QueryContextMenu(Self: PContextMenu3_Interface; Menu: hMenu; + indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall; +type + TDllVersionInfo = record + cbSize: DWORD; + dwMajorVersion: DWORD; + dwMinorVersion: DWORD; + dwBuildNumber: DWORD; + dwPlatformID: DWORD; + end; + + TDllGetVersionProc = function(var dv: TDllVersionInfo): HResult; stdcall; +var + hShellInst: THandle; + bMF_OWNERDRAW: Boolean; + DllGetVersionProc: TDllGetVersionProc; + dvi: TDllVersionInfo; + ed: TEnumData; + hMap: THandle; + pipch: PHeaderIPC; +begin + Result := 0; + if ((LOWORD(uFlags) and CMF_VERBSONLY) <> CMF_VERBSONLY) and + ((LOWORD(uFlags) and CMF_DEFAULTONLY) <> CMF_DEFAULTONLY) then + begin + bMF_OWNERDRAW := False; + // get the shell version + hShellInst := LoadLibrary('shell32.dll'); + if hShellInst <> 0 then + begin + DllGetVersionProc := GetProcAddress(hShellInst, 'DllGetVersion'); + if @DllGetVersionProc <> nil then + begin + dvi.cbSize := sizeof(TDllVersionInfo); + if DllGetVersionProc(dvi) >= 0 then + begin + // it's at least 4.00 + bMF_OWNERDRAW := (dvi.dwMajorVersion > 4) or (dvi.dwMinorVersion >= 71); + end; // if + end; // if + FreeLibrary(hShellInst); + end; // if + + // if we're using Vista (or later), then the ownerdraw code will be disabled, because the system draws the icons. + if VistaOrLater then + bMF_OWNERDRAW := False; + + hMap := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, IPC_PACKET_SIZE, + IPC_PACKET_NAME); + If (hMap <> 0) and (GetLastError <> ERROR_ALREADY_EXISTS) then + begin + { map the memory to this address space } + pipch := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0); + If pipch <> nil then + begin + { let the callback have instance vars } + ed.Self := Self^.ptrInstance; + // not used 'ere + ed.Self^.hRootMenu := Menu; + // store the first ID to offset with index for InvokeCommand() + Self^.ptrInstance^.idCmdFirst := idCmdFirst; + // store the starting index to offset + Result := idCmdFirst; + ed.bOwnerDrawSupported := bMF_OWNERDRAW; + ed.bShouldOwnerDraw := True; + ed.idCmdFirst := idCmdFirst; + ed.ipch := pipch; + { allocate a wait object so the ST can signal us, it can't be anon + since it has to used by OpenEvent() } + lstrcpya(@pipch^.SignalEventName, PChar(CreateUID())); + { create the wait wait-for-wait object } + ed.hWaitFor := CreateEvent(nil, False, False, pipch^.SignalEventName); + If ed.hWaitFor <> 0 then + begin + { enumerate all the top level windows to find all loaded MIRANDANAME + classes -- } + EnumWindows(@ProcessRequest, lParam(@ed)); + { close the wait-for-reply object } + CloseHandle(ed.hWaitFor); + end; + { unmap the memory from this address space } + UnmapViewOfFile(pipch); + end; { if } + { close the mapping } + CloseHandle(hMap); + // use the MSDN recommended way, thou there ain't much difference + Result := MAKE_HRESULT(0, 0, (ed.idCmdFirst - Result) + 1); + end + else + begin + // the mapping file already exists, which is not good! + end; + end + else + begin + // same as giving a SEVERITY_SUCCESS, FACILITY_NULL, since that + // just clears the higher bits, which is done anyway + Result := MAKE_HRESULT(0, 0, 1); + end; // if +end; + +function TShlComRec_GetCommandString(Self: PContextMenu3_Interface; idCmd, uType: UINT; + pwReserved: PUINT; pszName: PChar; cchMax: UINT): HResult; stdcall; +begin + Result := E_NOTIMPL; +end; + +function ipcGetFiles(pipch: PHeaderIPC; pDataObject: PDataObject_Interface; const hContact: THandle): Integer; +type + TDragQueryFile = function(hDrop: THandle; fileIndex: Integer; FileName: PChar; + cbSize: Integer): Integer; stdcall; +var + fet: TFormatEtc; + stgm: TStgMedium; + pct: PSlotIPC; + iFile: Cardinal; + iFileMax: Cardinal; + hShell: THandle; + DragQueryFile: TDragQueryFile; + cbSize: Integer; + hDrop: THandle; +begin + Result := E_INVALIDARG; + hShell := LoadLibrary('shell32.dll'); + if hShell <> 0 then + begin + DragQueryFile := GetProcAddress(hShell, 'DragQueryFileA'); + if @DragQueryFile <> nil then + begin + fet.cfFormat := CF_HDROP; + fet.ptd := nil; + fet.dwAspect := DVASPECT_CONTENT; + fet.lindex := -1; + fet.tymed := TYMED_HGLOBAL; + Result := pDataObject^.ptrVTable^.GetData(pDataObject, fet, stgm); + if Result = S_OK then + begin + // FIX, actually lock the global object and get a pointer + Pointer(hDrop) := GlobalLock(stgm.hGlobal); + if hDrop <> 0 then + begin + // get the maximum number of files + iFileMax := DragQueryFile(stgm.hGlobal, $FFFFFFFF, nil, 0); + iFile := 0; + while iFile < iFileMax do + begin + // get the size of the file path + cbSize := DragQueryFile(stgm.hGlobal, iFile, nil, 0); + // get the buffer + pct := ipcAlloc(pipch, cbSize + 1); // including null term + // allocated? + if pct = nil then + break; + // store the hContact + pct^.hContact := hContact; + // copy it to the buffer + DragQueryFile(stgm.hGlobal, iFile, PChar(uint_ptr(pct) + sizeof(TSlotIPC)), pct^.cbStrSection); + // next file + inc(iFile); + end; // while + // store the number of files + pipch^.Slots := iFile; + GlobalUnlock(stgm.hGlobal); + end; // if hDrop check + // release the mediumn the lock may of failed + ReleaseStgMedium(stgm); + end; // if + end; // if + // free the dll + FreeLibrary(hShell); + end; // if +end; + +function RequestTransfer(Self: PShlComRec; idxCmd: Integer): Integer; +var + hMap: THandle; + pipch: PHeaderIPC; + mii: TMenuItemInfo; + hTransfer: THandle; + psd: PMenuDrawInfo; + hReply: THandle; + replyBits: Integer; +begin + Result := E_INVALIDARG; + // get the contact information + mii.cbSize := sizeof(TMenuItemInfo); + mii.fMask := MIIM_ID or MIIM_DATA; + if GetMenuItemInfo(Self^.hRootMenu, Self^.idCmdFirst + idxCmd, False, mii) then + begin + // get the pointer + uint_ptr(psd) := mii.dwItemData; + // the ID stored in the item pointer and the ID for the menu must match + if (psd = nil) or (psd^.wID <> mii.wID) then + begin + // MessageBox(0,'ptr assocated with menu is NULL','',MB_OK); + Exit; + end; // if + end + else + begin + // MessageBox(0,'GetMenuItemInfo failed?','',MB_OK); + // couldn't get the info, can't start the transfer + Result := E_INVALIDARG; + Exit; + end; // if + // is there an IDataObject instance? + if Self^.pDataObject <> nil then + begin + // OpenEvent() the work object to see if the instance is still around + hTransfer := OpenEvent(EVENT_ALL_ACCESS, False, PChar(CreateProcessUID(psd^.pid))); + if hTransfer <> 0 then + begin + // map the ipc file again + hMap := CreateFileMapping(INVALID_HANDLE_VALUE,nil,PAGE_READWRITE,0,IPC_PACKET_SIZE,IPC_PACKET_NAME); + if (hMap <> 0) and (GetLastError <> ERROR_ALREADY_EXISTS) then + begin + // map it to process + pipch := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0); + if pipch <> nil then + begin + // create the name of the object to be signalled by the ST + lstrcpya(pipch^.SignalEventName, PChar(CreateUID())); + // create it + hReply := CreateEvent(nil, False, False, pipch^.SignalEventName); + if hReply <> 0 then + begin + if dtCommand in psd^.fTypes then + begin + if Assigned(psd^.MenuCommandCallback) then + Result := psd^.MenuCommandCallback(pipch, hTransfer, hReply, psd); + end + else + begin + + // prepare the buffer + ipcPrepareRequests(IPC_PACKET_SIZE, pipch, REQUEST_XFRFILES); + // get all the files into the packet + if ipcGetFiles(pipch, Self^.pDataObject, psd^.hContact) = S_OK then + begin + // need to wait for the ST to open the mapping object + // since if we close it before it's opened it the data it + // has will be undefined + replyBits := ipcSendRequest(hTransfer, hReply, pipch, 200); + if replyBits <> REPLY_FAIL then + begin + // they got the files! + Result := S_OK; + end; // if + end; + + end; + // close the work object name + CloseHandle(hReply); + end; // if + // unmap it from this process + UnmapViewOfFile(pipch); + end; // if + // close the map + CloseHandle(hMap); + end; // if + // close the handle to the ST object name + CloseHandle(hTransfer); + end; // if + end // if; +end; + +function TShlComRec_InvokeCommand(Self: PContextMenu3_Interface; + var lpici: TCMInvokeCommandInfo): HResult; stdcall; +begin + Result := RequestTransfer(Self^.ptrInstance, LOWORD(uint_ptr(lpici.lpVerb))); +end; + +function TShlComRec_HandleMenuMsgs(Self: PContextMenu3_Interface; uMsg: UINT; wParam: wParam; + lParam: lParam; pResult: PLResult): HResult; +const + WM_DRAWITEM = $002B; + WM_MEASUREITEM = $002C; +var + dwi: PDrawItemStruct; + msi: PMeasureItemStruct; + psd: PMenuDrawInfo; + ncm: TNonClientMetrics; + hOldFont: THandle; + hFont: THandle; + tS: TSize; + dx: Integer; + hBr: HBRUSH; + icorc: TRect; + hMemDC: HDC; +begin + pResult^ := Integer(True); + if (uMsg = WM_DRAWITEM) and (wParam = 0) then + begin + // either a main sub menu, a group menu or a contact + dwi := PDrawItemStruct(lParam); + uint_ptr(psd) := dwi^.itemData; + // don't fill + SetBkMode(dwi^.HDC, TRANSPARENT); + // where to draw the icon? + icorc.Left := 0; + // center it + with dwi^ do + icorc.Top := rcItem.Top + ((rcItem.Bottom - rcItem.Top) div 2) - (16 div 2); + icorc.Right := icorc.Left + 16; + icorc.Bottom := icorc.Top + 16; + // draw for groups + if (dtGroup in psd^.fTypes) or (dtEntry in psd^.fTypes) then + begin + hBr := GetSysColorBrush(COLOR_MENU); + FillRect(dwi^.HDC, dwi^.rcItem, hBr); + DeleteObject(hBr); + // + if (ODS_SELECTED and dwi^.itemState = ODS_SELECTED) then + begin + // only do this for entry menu types otherwise a black mask + // is drawn under groups + hBr := GetSysColorBrush(COLOR_HIGHLIGHT); + FillRect(dwi^.HDC, dwi^.rcItem, hBr); + DeleteObject(hBr); + SetTextColor(dwi^.HDC, GetSysColor(COLOR_HIGHLIGHTTEXT)); + end; // if + // draw icon + with dwi^, icorc do + begin + if (ODS_SELECTED and dwi^.itemState) = ODS_SELECTED then + begin + hBr := GetSysColorBrush(COLOR_HIGHLIGHT); + end + else + begin + hBr := GetSysColorBrush(COLOR_MENU); + end; // if + DrawIconEx(HDC, Left + 1, Top, psd^.hStatusIcon, 16, 16, // width, height + 0, // step + hBr, // brush + DI_NORMAL); + DeleteObject(hBr); + end; // with + // draw the text + with dwi^ do + begin + inc(rcItem.Left, ((rcItem.Bottom - rcItem.Top) - 2)); + DrawText(HDC, psd^.szText, psd^.cch, rcItem, DT_NOCLIP or DT_NOPREFIX or + DT_SINGLELINE or DT_VCENTER); + // draw the name of the database text if it's there + if psd^.szProfile <> nil then + begin + GetTextExtentPoint32(dwi^.HDC, psd^.szText, psd^.cch, tS); + inc(rcItem.Left, tS.cx + 8); + SetTextColor(HDC, GetSysColor(COLOR_GRAYTEXT)); + DrawText(HDC, psd^.szProfile, lstrlena(psd^.szProfile), rcItem, + DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); + end; // if + end; // with + end + else + begin + // it's a contact! + hBr := GetSysColorBrush(COLOR_MENU); + FillRect(dwi^.HDC, dwi^.rcItem, hBr); + DeleteObject(hBr); + if ODS_SELECTED and dwi^.itemState = ODS_SELECTED then + begin + hBr := GetSysColorBrush(COLOR_HIGHLIGHT); + FillRect(dwi^.HDC, dwi^.rcItem, hBr); + DeleteObject(hBr); + SetTextColor(dwi^.HDC, GetSysColor(COLOR_HIGHLIGHTTEXT)); + end; + // draw icon + with dwi^, icorc do + begin + if (ODS_SELECTED and dwi^.itemState) = ODS_SELECTED then + begin + hBr := GetSysColorBrush(COLOR_HIGHLIGHT); + end + else + begin + hBr := GetSysColorBrush(COLOR_MENU); + end; // if + DrawIconEx(HDC, Left + 2, Top, psd^.hStatusIcon, 16, 16, // width, height + 0, // step + hBr, // brush + DI_NORMAL); + DeleteObject(hBr); + end; // with + // draw the text + with dwi^ do + begin + inc(rcItem.Left, (rcItem.Bottom - rcItem.Top) + 1); + DrawText(HDC, psd^.szText, psd^.cch, rcItem, DT_NOCLIP or DT_NOPREFIX or + DT_SINGLELINE or DT_VCENTER); + end; // with + end; // if + end + else if (uMsg = WM_MEASUREITEM) then + begin + // don't check if it's really a menu + msi := PMeasureItemStruct(lParam); + uint_ptr(psd) := msi^.itemData; + ncm.cbSize := sizeof(TNonClientMetrics); + SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @ncm, 0); + // create the font used in menus, this font should be cached somewhere really +{$IFDEF FPC} + hFont := CreateFontIndirect(@ncm.lfMenuFont); +{$ELSE} + hFont := CreateFontIndirect(ncm.lfMenuFont); +{$ENDIF} + hMemDC := Self^.ptrInstance^.hMemDC; + // select in the font + hOldFont := SelectObject(hMemDC, hFont); + // default to an icon + dx := 16; + // get the size 'n' account for the icon + GetTextExtentPoint32(hMemDC, psd^.szText, psd^.cch, tS); + inc(dx, tS.cx); + // main menu item? + if psd^.szProfile <> nil then + begin + GetTextExtentPoint32(hMemDC, psd^.szProfile, lstrlena(psd^.szProfile), tS); + inc(dx, tS.cx); + end; + // store it + msi^.itemWidth := dx + Integer(ncm.iMenuWidth); + msi^.itemHeight := Integer(ncm.iMenuHeight) + 2; + if tS.cy > msi^.itemHeight then + inc(msi^.itemHeight, tS.cy - msi^.itemHeight); + // clean up + SelectObject(hMemDC, hOldFont); + DeleteObject(hFont); + end; + Result := S_OK; +end; + +function TShlComRec_HandleMenuMsg(Self: PContextMenu3_Interface; uMsg: UINT; wParam: wParam; + lParam: lParam): HResult; stdcall; +var + Dummy: HResult; +begin + Result := TShlComRec_HandleMenuMsgs(Self, uMsg, wParam, lParam, @Dummy); +end; + +function TShlComRec_HandleMenuMsg2(Self: PContextMenu3_Interface; uMsg: UINT; wParam: wParam; + lParam: lParam; PLResult: Pointer { ^LResult } ): HResult; stdcall; +var + Dummy: HResult; +begin + // this will be null if a return value isn't needed. + if PLResult = nil then + PLResult := @Dummy; + Result := TShlComRec_HandleMenuMsgs(Self, uMsg, wParam, lParam, PLResult); +end; + +function TShlComRec_Create: PShlComRec; +var + DC: HDC; +begin + New(Result); + { build all the function tables for interfaces } + with Result^.ShellExtInit_Interface do + begin + { this is only owned by us... } + ptrVTable := @vTable; + { IUnknown } + vTable.QueryInterface := @TShlComRec_QueryInterface; + vTable.AddRef := @TShlComRec_AddRef; + vTable.Release := @TShlComRec_Release; + { IShellExtInit } + vTable.Initialise := @TShlComRec_Initialise; + { instance of a TShlComRec } + ptrInstance := Result; + end; + with Result^.ContextMenu3_Interface do + begin + ptrVTable := @vTable; + { IUnknown } + vTable.QueryInterface := @TShlComRec_QueryInterface; + vTable.AddRef := @TShlComRec_AddRef; + vTable.Release := @TShlComRec_Release; + { IContextMenu } + vTable.QueryContextMenu := @TShlComRec_QueryContextMenu; + vTable.InvokeCommand := @TShlComRec_InvokeCommand; + vTable.GetCommandString := @TShlComRec_GetCommandString; + { IContextMenu2 } + vTable.HandleMenuMsg := @TShlComRec_HandleMenuMsg; + { IContextMenu3 } + vTable.HandleMenuMsg2 := @TShlComRec_HandleMenuMsg2; + { instance data } + ptrInstance := Result; + end; + { initalise variables } + Result^.RefCount := 1; + Result^.hDllHeap := HeapCreate(0, 0, 0); + Result^.hRootMenu := 0; + Result^.hRecentMenu := 0; + Result^.RecentCount := 0; + Result^.idCmdFirst := 0; + Result^.pDataObject := nil; + Result^.ProtoIcons := nil; + Result^.ProtoIconsCount := 0; + // create an inmemory DC + DC := GetDC(0); + Result^.hMemDC := CreateCompatibleDC(DC); + ReleaseDC(0, DC); + { keep count on the number of objects } + inc(dllpublic.ObjectCount); +end; + +{ IClassFactory } + +type + + PVTable_IClassFactory = ^TVTable_IClassFactory; + + TVTable_IClassFactory = record + { IUnknown } + QueryInterface: Pointer; + AddRef: Pointer; + Release: Pointer; + { IClassFactory } + CreateInstance: Pointer; + LockServer: Pointer; + end; + + PClassFactoryRec = ^TClassFactoryRec; + + TClassFactoryRec = record + ptrVTable: PVTable_IClassFactory; + vTable: TVTable_IClassFactory; + { fields } + RefCount: LongInt; + end; + +function TClassFactoryRec_QueryInterface(Self: PClassFactoryRec; const IID: TIID; var Obj): HResult; stdcall; +begin + Pointer(Obj) := nil; + Result := E_NOTIMPL; +end; + +function TClassFactoryRec_AddRef(Self: PClassFactoryRec): LongInt; stdcall; +begin + inc(Self^.RefCount); + Result := Self^.RefCount; +end; + +function TClassFactoryRec_Release(Self: PClassFactoryRec): LongInt; stdcall; +begin + dec(Self^.RefCount); + Result := Self^.RefCount; + if Result = 0 then + begin + Dispose(Self); + dec(dllpublic.FactoryCount); + end; { if } +end; + +function TClassFactoryRec_CreateInstance(Self: PClassFactoryRec; unkOuter: Pointer; + const IID: TIID; var Obj): HResult; stdcall; +var + ShlComRec: PShlComRec; +begin + Pointer(Obj) := nil; + Result := CLASS_E_NOAGGREGATION; + if unkOuter = nil then + begin + { Before Vista, the system queried for a IShell interface then queried for a context menu, Vista now + queries for a context menu (or a shell menu) then QI()'s the other interface } + if IsEqualIID(IID, IID_IContextMenu) then + begin + Result := S_OK; + ShlComRec := TShlComRec_Create; + Pointer(Obj) := @ShlComRec^.ContextMenu3_Interface; + end; + if IsEqualIID(IID, IID_IShellExtInit) then + begin + Result := S_OK; + ShlComRec := TShlComRec_Create; + Pointer(Obj) := @ShlComRec^.ShellExtInit_Interface; + end; // if + end; // if +end; + +function TClassFactoryRec_LockServer(Self: PClassFactoryRec; fLock: BOOL): HResult; stdcall; +begin + Result := E_NOTIMPL; +end; + +function TClassFactoryRec_Create: PClassFactoryRec; +begin + New(Result); + Result^.ptrVTable := @Result^.vTable; + { IUnknown } + Result^.vTable.QueryInterface := @TClassFactoryRec_QueryInterface; + Result^.vTable.AddRef := @TClassFactoryRec_AddRef; + Result^.vTable.Release := @TClassFactoryRec_Release; + { IClassFactory } + Result^.vTable.CreateInstance := @TClassFactoryRec_CreateInstance; + Result^.vTable.LockServer := @TClassFactoryRec_LockServer; + { inital the variables } + Result^.RefCount := 1; + { count the number of factories } + inc(dllpublic.FactoryCount); +end; + +// +// IPC part +// + +type + PFileList = ^TFileList; + TFileList = array [0 .. 0] of PChar; + PAddArgList = ^TAddArgList; + + TAddArgList = record + szFile: PChar; // file being processed + cch: Cardinal; // it's length (with space for NULL char) + count: Cardinal; // number we have so far + files: PFileList; + hContact: THandle; + hEvent: THandle; + end; + +function AddToList(var args: TAddArgList): LongBool; +var + attr: Cardinal; + p: Pointer; + hFind: THandle; + fd: TWIN32FINDDATA; + szBuf: array [0 .. MAX_PATH] of Char; + szThis: PChar; + cchThis: Cardinal; +begin + Result := False; + attr := GetFileAttributes(args.szFile); + if (attr <> $FFFFFFFF) and ((attr and FILE_ATTRIBUTE_HIDDEN) = 0) then + begin + if args.count mod 10 = 5 then + begin + if CallService(MS_SYSTEM_TERMINATED, 0, 0) <> 0 then + begin + Result := True; + Exit; + end; // if + end; + if attr and FILE_ATTRIBUTE_DIRECTORY <> 0 then + begin + // add the directory + lstrcpya(szBuf, args.szFile); + ReAllocMem(args.files, (args.count + 1) * sizeof(PChar)); + GetMem(p, strlen(szBuf) + 1); + lstrcpya(p, szBuf); + args.files^[args.count] := p; + inc(args.count); + // tack on ending search token + lstrcata(szBuf, '\*'); + hFind := FindFirstFile(szBuf, fd); + while True do + begin + if fd.cFileName[0] <> '.' then + begin + lstrcpya(szBuf, args.szFile); + lstrcata(szBuf, '\'); + lstrcata(szBuf, fd.cFileName); + // keep a copy of the current thing being processed + szThis := args.szFile; + args.szFile := szBuf; + cchThis := args.cch; + args.cch := strlen(szBuf) + 1; + // recurse + Result := AddToList(args); + // restore + args.szFile := szThis; + args.cch := cchThis; + if Result then + break; + end; // if + if not FindNextFile(hFind, fd) then + break; + end; // while + FindClose(hFind); + end + else + begin + // add the file + ReAllocMem(args.files, (args.count + 1) * sizeof(PChar)); + GetMem(p, args.cch); + lstrcpya(p, args.szFile); + args.files^[args.count] := p; + inc(args.count); + end; // if + end; +end; + +procedure MainThreadIssueTransfer(p: PAddArgList); stdcall; +{$DEFINE SHL_IDC} +{$DEFINE SHL_KEYS} +{$INCLUDE shlc.inc} +{$UNDEF SHL_KEYS} +{$UNDEF SHL_IDC} +begin + DBWriteContactSettingByte(p^.hContact, SHLExt_Name, SHLExt_MRU, 1); + CallService(MS_FILE_SENDSPECIFICFILES, p^.hContact, lParam(p^.files)); + SetEvent(p^.hEvent); +end; + +procedure IssueTransferThread(pipch: PHeaderIPC); cdecl; +var + szBuf: array [0 .. MAX_PATH] of Char; + pct: PSlotIPC; + args: TAddArgList; + bQuit: LongBool; + j, c: Cardinal; + p: Pointer; + hMainThread: THandle; +begin + hMainThread := THandle(pipch^.Param); + GetCurrentDirectory(sizeof(szBuf), szBuf); + args.count := 0; + args.files := nil; + pct := pipch^.DataPtr; + bQuit := False; + while pct <> nil do + begin + if (pct^.cbSize <> sizeof(TSlotIPC)) then + break; + args.szFile := PChar(uint_ptr(pct) + sizeof(TSlotIPC)); + args.hContact := pct^.hContact; + args.cch := pct^.cbStrSection + 1; + bQuit := AddToList(args); + if bQuit then + break; + pct := pct^.Next; + end; // while + if args.files <> nil then + begin + ReAllocMem(args.files, (args.count + 1) * sizeof(PChar)); + args.files^[args.count] := nil; + inc(args.count); + if (not bQuit) then + begin + args.hEvent := CreateEvent(nil, True, False, nil); + QueueUserAPC(@MainThreadIssueTransfer, hMainThread, uint_ptr(@args)); + while True do + begin + if WaitForSingleObjectEx(args.hEvent, INFINITE, True) <> WAIT_IO_COMPLETION then + break; + end; + CloseHandle(args.hEvent); + end; // if + c := args.count - 1; + for j := 0 to c do + begin + p := args.files^[j]; + if p <> nil then + FreeMem(p); + end; + FreeMem(args.files); + end; + SetCurrentDirectory(szBuf); + FreeMem(pipch); + CloseHandle(hMainThread); +end; + +type + + PSlotInfo = ^TSlotInfo; + + TSlotInfo = record + hContact: THandle; + hProto: Cardinal; + dwStatus: Integer; // will be aligned anyway + end; + + TSlotArray = array [0 .. $FFFFFF] of TSlotInfo; + PSlotArray = ^TSlotArray; + +function SortContact(var Item1, Item2: TSlotInfo): Integer; stdcall; +begin + Result := CallService(MS_CLIST_CONTACTSCOMPARE, Item1.hContact, Item2.hContact); +end; + +// from FP FCL + +procedure QuickSort(FList: PSlotArray; L, R: LongInt); +var + i, j: LongInt; + p, q: TSlotInfo; +begin + repeat + i := L; + j := R; + p := FList^[(L + R) div 2]; + repeat + while SortContact(p, FList^[i]) > 0 do + inc(i); + while SortContact(p, FList^[j]) < 0 do + dec(j); + if i <= j then + begin + q := FList^[i]; + FList^[i] := FList^[j]; + FList^[j] := q; + inc(i); + dec(j); + end; // if + until i > j; + if L < j then + QuickSort(FList, L, j); + L := i; + until i >= R; +end; + +{$DEFINE SHL_KEYS} +{$INCLUDE shlc.inc} +{$UNDEF SHL_KEYS} + +procedure ipcGetSkinIcons(ipch: PHeaderIPC); +var + protoCount: Integer; + pp: ^PPROTOCOLDESCRIPTOR; + spi: TSlotProtoIcons; + j: Cardinal; + pct: PSlotIPC; + szTmp: array [0 .. 63] of Char; + dwCaps: Cardinal; +begin + if (CallService(MS_PROTO_ENUMACCOUNTS, wParam(@protoCount), lParam(@pp)) = 0) and + (protoCount <> 0) then + begin + spi.pid := GetCurrentProcessId(); + while protoCount > 0 do + begin + lstrcpya(szTmp, pp^.szName); + lstrcata(szTmp, PS_GETCAPS); + dwCaps := CallService(szTmp, PFLAGNUM_1, 0); + if (dwCaps and PF1_FILESEND) <> 0 then + begin + pct := ipcAlloc(ipch, sizeof(TSlotProtoIcons)); + if pct <> nil then + begin + // capture all the icons! + spi.hProto := StrHash(pp^.szName); + for j := 0 to 9 do + begin + spi.hIcons[j] := LoadSkinnedProtoIcon(pp^.szName, ID_STATUS_OFFLINE + j); + end; // for + pct^.fType := REQUEST_NEWICONS; + CopyMemory(Pointer(uint_ptr(pct) + sizeof(TSlotIPC)), @spi, sizeof(TSlotProtoIcons)); + if ipch^.NewIconsBegin = nil then + ipch^.NewIconsBegin := pct; + end; // if + end; // if + inc(pp); + dec(protoCount); + end; // while + end; // if + // add Miranda icon + pct := ipcAlloc(ipch, sizeof(TSlotProtoIcons)); + if pct <> nil then + begin + ZeroMemory(@spi.hIcons, sizeof(spi.hIcons)); + spi.hProto := 0; // no protocol + spi.hIcons[0] := LoadSkinnedIcon(SKINICON_OTHER_MIRANDA); + pct^.fType := REQUEST_NEWICONS; + CopyMemory(Pointer(uint_ptr(pct) + sizeof(TSlotIPC)), @spi, sizeof(TSlotProtoIcons)); + if ipch^.NewIconsBegin = nil then + ipch^.NewIconsBegin := pct; + end; // if +end; + +function ipcGetSortedContacts(ipch: PHeaderIPC; pSlot: pint; bGroupMode: Boolean): Boolean; +var + dwContacts: Cardinal; + pContacts: PSlotArray; + hContact: THandle; + i: Integer; + dwOnline: Cardinal; + szProto: PChar; + dwStatus: Integer; + pct: PSlotIPC; + szContact: PChar; + dbv: TDBVariant; + bHideOffline: Boolean; + szTmp: array [0 .. 63] of Char; + dwCaps: Cardinal; + szSlot: PChar; + n, rc, cch: Cardinal; +begin + Result := False; + // hide offliners? + bHideOffline := DBGetContactSettingByte(0, 'CList', 'HideOffline', 0) = 1; + // do they wanna hide the offline people anyway? + if DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoOffline, 0) = 1 then + begin + // hide offline people + bHideOffline := True; + end; + // get the number of contacts + dwContacts := CallService(MS_DB_CONTACT_GETCOUNT, 0, 0); + if dwContacts = 0 then + Exit; + // get the contacts in the array to be sorted by status, trim out anyone + // who doesn't wanna be seen. + GetMem(pContacts, (dwContacts + 2) * sizeof(TSlotInfo)); + i := 0; + dwOnline := 0; + hContact := db_find_first(); + while (hContact <> 0) do + begin + if i >= dwContacts then + break; + (* do they have a running protocol? *) + uint_ptr(szProto) := CallService(MS_PROTO_GETCONTACTBASEPROTO, hContact, 0); + if szProto <> nil then + begin + (* does it support file sends? *) + lstrcpya(szTmp, szProto); + lstrcata(szTmp, PS_GETCAPS); + dwCaps := CallService(szTmp, PFLAGNUM_1, 0); + if (dwCaps and PF1_FILESEND) = 0 then + begin + hContact := db_find_next(hContact); + continue; + end; + dwStatus := DBGetContactSettingWord(hContact, szProto, 'Status', ID_STATUS_OFFLINE); + if dwStatus <> ID_STATUS_OFFLINE then + inc(dwOnline) + else if bHideOffline then + begin + hContact := db_find_next(hContact); + continue; + end; // if + // is HIT on? + if BST_UNCHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHITContacts, + BST_UNCHECKED) then + begin + // don't show people who are "Hidden" "NotOnList" or Ignored + if (DBGetContactSettingByte(hContact, 'CList', 'Hidden', 0) = 1) or + (DBGetContactSettingByte(hContact, 'CList', 'NotOnList', 0) = 1) or + (CallService(MS_IGNORE_ISIGNORED, hContact, IGNOREEVENT_MESSAGE or + IGNOREEVENT_URL or IGNOREEVENT_FILE) <> 0) then + begin + hContact := db_find_next(hContact); + continue; + end; // if + end; // if + // is HIT2 off? + if BST_UNCHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHIT2Contacts, + BST_UNCHECKED) then + begin + if DBGetContactSettingWord(hContact, szProto, 'ApparentMode', 0) = ID_STATUS_OFFLINE + then + begin + hContact := db_find_next(hContact); + continue; + end; // if + end; // if + // store + pContacts^[i].hContact := hContact; + pContacts^[i].dwStatus := dwStatus; + pContacts^[i].hProto := StrHash(szProto); + inc(i); + end + else + begin + // contact has no protocol! + end; // if + hContact := db_find_next(hContact); + end; // while + // if no one is online and the CList isn't showing offliners, quit + if (dwOnline = 0) and (bHideOffline) then + begin + FreeMem(pContacts); + Exit; + end; // if + dwContacts := i; + i := 0; + // sort the array + QuickSort(pContacts, 0, dwContacts - 1); + // create an IPC slot for each contact and store display name, etc + while i < dwContacts do + begin + uint_ptr(szContact) := CallService(MS_CLIST_GETCONTACTDISPLAYNAME,pContacts^[i].hContact, 0); + if (szContact <> nil) then + begin + n := 0; + rc := 1; + if bGroupMode then + begin + rc := DBGetContactSetting(pContacts^[i].hContact, 'CList', 'Group', @dbv); + if rc = 0 then + begin + n := lstrlena(dbv.szVal.a) + 1; + end; + end; // if + cch := lstrlena(szContact) + 1; + pct := ipcAlloc(ipch, cch + 1 + n); + if pct = nil then + begin + DBFreeVariant(@dbv); + break; + end; + // lie about the actual size of the TSlotIPC + pct^.cbStrSection := cch; + szSlot := PChar(uint_ptr(pct) + sizeof(TSlotIPC)); + lstrcpya(szSlot, szContact); + pct^.fType := REQUEST_CONTACTS; + pct^.hContact := pContacts^[i].hContact; + pct^.Status := pContacts^[i].dwStatus; + pct^.hProto := pContacts^[i].hProto; + pct^.MRU := DBGetContactSettingByte(pct^.hContact, SHLExt_Name, SHLExt_MRU, 0); + if ipch^.ContactsBegin = nil then + ipch^.ContactsBegin := pct; + inc(szSlot, cch + 1); + if rc = 0 then + begin + pct^.hGroup := StrHash(dbv.szVal.a); + lstrcpya(szSlot, dbv.szVal.a); + DBFreeVariant(@dbv); + end + else + begin + pct^.hGroup := 0; + szSlot^ := #0; + end; + inc(pSlot^); + end; // if + inc(i); + end; // while + FreeMem(pContacts); + // + Result := True; +end; + +// worker thread to clear MRU, called by the IPC bridge +procedure ClearMRUThread(notused: Pointer); cdecl; +{$DEFINE SHL_IDC} +{$DEFINE SHL_KEYS} +{$INCLUDE shlc.inc} +{$UNDEF SHL_KEYS} +{$UNDEF SHL_IDC} +var + hContact: THandle; +begin + begin + hContact := db_find_first(); + while hContact <> 0 do + begin + if DBGetContactSettingByte(hContact, SHLExt_Name, SHLExt_MRU, 0) > 0 then + begin + DBWriteContactSettingByte(hContact, SHLExt_Name, SHLExt_MRU, 0); + end; + hContact := db_find_next(hContact); + end; + end; +end; + +// this function is called from an APC into the main thread +procedure ipcService(dwParam: DWORD); stdcall; +label + Reply; +var + hMap: THandle; + pMMT: PHeaderIPC; + hSignal: THandle; + pct: PSlotIPC; + szBuf: PChar; + iSlot: Integer; + szGroupStr: array [0 .. 31] of Char; + dbv: TDBVariant; + bits: pint; + bGroupMode: Boolean; + cloned: PHeaderIPC; + szMiranda: PChar; +begin + { try to open the file mapping object the caller must make sure no other + running instance is using this file } + hMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, IPC_PACKET_NAME); + If hMap <> 0 then + begin + { map the file to this process } + pMMT := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0); + { if it fails the caller should of had some timeout in wait } + if (pMMT <> nil) and (pMMT^.cbSize = sizeof(THeaderIPC)) and + (pMMT^.dwVersion = PLUGIN_MAKE_VERSION(2, 0, 1, 2)) then + begin + // toggle the right bits + bits := @pMMT^.fRequests; + // jump right to a worker thread for file processing? + if (bits^ and REQUEST_XFRFILES) = REQUEST_XFRFILES then + begin + GetMem(cloned, IPC_PACKET_SIZE); + // translate from client space to cloned heap memory + pMMT^.pServerBaseAddress := pMMT^.pClientBaseAddress; + pMMT^.pClientBaseAddress := cloned; + CopyMemory(cloned, pMMT, IPC_PACKET_SIZE); + ipcFixupAddresses(True, cloned); + DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), + @cloned^.Param, THREAD_SET_CONTEXT, False, 0); + mir_forkThread(@IssueTransferThread, cloned); + goto Reply; + end; + // the request was to clear the MRU entries, we have no return data + if (bits^ and REQUEST_CLEARMRU) = REQUEST_CLEARMRU then + begin + mir_forkThread(@ClearMRUThread, nil); + goto Reply; + end; + // the IPC header may have pointers that need to be translated + // in either case the supplied data area pointers has to be + // translated to this address space. + // the server base address is always removed to get an offset + // to which the client base is added, this is what ipcFixupAddresses() does + pMMT^.pServerBaseAddress := pMMT^.pClientBaseAddress; + pMMT^.pClientBaseAddress := pMMT; + // translate to the server space map + ipcFixupAddresses(True, pMMT); + // store the address map offset so the caller can retranslate + pMMT^.pServerBaseAddress := pMMT; + // return some options to the client + if DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoIcons, 0) <> 0 then + begin + pMMT^.dwFlags := HIPC_NOICONS; + end; + // see if we have a custom string for 'Miranda' + szMiranda := Translate('Miranda'); + lstrcpyn(pMMT^.MirandaName, szMiranda, sizeof(pMMT^.MirandaName) - 1); + + // for the MRU menu + szBuf := Translate('Recently'); + lstrcpyn(pMMT^.MRUMenuName, szBuf, sizeof(pMMT^.MRUMenuName) - 1); + + // and a custom string for "clear entries" + szBuf := Translate('Clear entries'); + lstrcpyn(pMMT^.ClearEntries, szBuf, sizeof(pMMT^.ClearEntries) - 1); + + // if the group mode is on, check if they want the CList setting + bGroupMode := BST_CHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseGroups, + BST_UNCHECKED); + if bGroupMode and (BST_CHECKED = DBGetContactSettingByte(0, SHLExt_Name, + SHLExt_UseCListSetting, BST_UNCHECKED)) then + begin + bGroupMode := 1 = DBGetContactSettingByte(0, 'CList', 'UseGroups', 0); + end; + iSlot := 0; + // return profile if set + if BST_UNCHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoProfile, + BST_UNCHECKED) then + begin + pct := ipcAlloc(pMMT, 50); + if pct <> nil then + begin + // will actually return with .dat if there's space for it, not what the docs say + pct^.Status := STATUS_PROFILENAME; + CallService(MS_DB_GETPROFILENAME, 49, uint_ptr(pct) + sizeof(TSlotIPC)); + end; // if + end; // if + if (bits^ and REQUEST_NEWICONS) = REQUEST_NEWICONS then + begin + ipcGetSkinIcons(pMMT); + end; + if (bits^ and REQUEST_GROUPS = REQUEST_GROUPS) then + begin + // return contact's grouping if it's present + while bGroupMode do + begin + str(iSlot, szGroupStr); + if DBGetContactSetting(0, 'CListGroups', szGroupStr, @dbv) <> 0 then + break; + pct := ipcAlloc(pMMT, lstrlena(dbv.szVal.a + 1) + 1); + // first byte has flags, need null term + if pct <> nil then + begin + if pMMT^.GroupsBegin = nil then + pMMT^.GroupsBegin := pct; + pct^.fType := REQUEST_GROUPS; + pct^.hContact := 0; + uint_ptr(szBuf) := uint_ptr(pct) + sizeof(TSlotIPC); // get the end of the slot + lstrcpya(szBuf, dbv.szVal.a + 1); + pct^.hGroup := 0; + DBFreeVariant(@dbv); // free the string + end + else + begin + // outta space + DBFreeVariant(@dbv); + break; + end; // if + inc(iSlot); + end; { while } + // if there was no space left, it'll end on null + if pct = nil then + bits^ := (bits^ or GROUPS_NOTIMPL) and not REQUEST_GROUPS; + end; { if: group request } + // SHOULD check slot space. + if (bits^ and REQUEST_CONTACTS = REQUEST_CONTACTS) then + begin + if not ipcGetSortedContacts(pMMT, @iSlot, bGroupMode) then + begin + // fail if there were no contacts AT ALL + bits^ := (bits^ or CONTACTS_NOTIMPL) and not REQUEST_CONTACTS; + end; // if + end; // if:contact request + // store the number of slots allocated + pMMT^.Slots := iSlot; + Reply: + { get the handle the caller wants to be signalled on } + hSignal := OpenEvent(EVENT_ALL_ACCESS, False, pMMT^.SignalEventName); + { did it open? } + If hSignal <> 0 then + begin + { signal and close } + SetEvent(hSignal); + CloseHandle(hSignal); + end; + { unmap the shared memory from this process } + UnmapViewOfFile(pMMT); + end; + { close the map file } + CloseHandle(hMap); + end; { if } + // +end; + +procedure ThreadServer(hMainThread: Pointer); cdecl; +var + hEvent: THandle; + retVal: Cardinal; +begin + hEvent := CreateEvent(nil, False, False, PChar(CreateProcessUID(GetCurrentProcessId()))); + while True do + begin + retVal := WaitForSingleObjectEx(hEvent, INFINITE, True); + if retVal = WAIT_OBJECT_0 then + begin + QueueUserAPC(@ipcService, THandle(hMainThread), 0); + end; // if + if CallService(MS_SYSTEM_TERMINATED, 0, 0) = 1 then + break; + end; // while + CloseHandle(hEvent); + CloseHandle(THandle(hMainThread)); +end; + +procedure InvokeThreadServer; +var + hMainThread: THandle; +begin + hMainThread := 0; + DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), @hMainThread, + THREAD_SET_CONTEXT, False, 0); + if hMainThread <> 0 then + mir_forkThread(@ThreadServer, Pointer(hMainThread)); +end; + +{ exported functions } + +function DllGetClassObject(const CLSID: TCLSID; const IID: TIID; var Obj): HResult; stdcall; +begin + Pointer(Obj) := nil; + Result := CLASS_E_CLASSNOTAVAILABLE; + if (IsEqualCLSID(CLSID, CLSID_ISHLCOM)) and (IsEqualIID(IID, IID_IClassFactory)) and + (FindWindow(MirandaName, nil) <> 0) then + begin + Pointer(Obj) := TClassFactoryRec_Create; + Result := S_OK; + end; // if +end; + +function DllCanUnloadNow: HResult; +begin + if ((dllpublic.FactoryCount = 0) and (dllpublic.ObjectCount = 0)) then + begin + Result := S_OK; + end + else + begin + Result := S_FALSE; + end; // if +end; + +{ helper functions } + +type + + PSHELLEXECUTEINFO = ^TSHELLEXECUTEINFO; + + TSHELLEXECUTEINFO = record + cbSize: DWORD; + fMask: LongInt; + hwnd: THandle; + lpVerb: PChar; + lpFile: PChar; + lpParameters: PChar; + lpDirectory: PChar; + nShow: Integer; + hInstApp: THandle; + lpIDLIst: Pointer; + lpClass: PChar; + HKEY: THandle; + dwHotkey: DWORD; + HICON: THandle; // is union + hProcess: THandle; + end; + +function ShellExecuteEx(var se: TSHELLEXECUTEINFO): Boolean; stdcall; + external 'shell32.dll' name 'ShellExecuteExA'; + +function wsprintfs(lpOut, lpFmt: PChar; args: PChar): Integer; cdecl; + external 'user32.dll' name 'wsprintfA'; + +function RemoveCOMRegistryEntries: HResult; +var + hRootKey: HKEY; +begin + if RegOpenKeyEx(HKEY_CLASSES_ROOT, 'miranda.shlext', 0, KEY_READ, hRootKey) = ERROR_SUCCESS + then + begin + (* need to delete the subkey before the parent key is deleted under NT/2000/XP *) + RegDeleteKey(hRootKey, 'CLSID'); + (* close the key *) + RegCloseKey(hRootKey); + (* delete it *) + if RegDeleteKey(HKEY_CLASSES_ROOT, 'miranda.shlext') <> ERROR_SUCCESS then + begin + MessageBox(0, + 'Unable to delete registry key for "shlext COM", this key may already be deleted or you may need admin rights.', + 'Problem', MB_ICONERROR); + end; // if + end; // if + if RegOpenKeyEx(HKEY_CLASSES_ROOT, '\*\shellex\ContextMenuHandlers', 0, KEY_ALL_ACCESS, + hRootKey) = ERROR_SUCCESS then + begin + if RegDeleteKey(hRootKey, 'miranda.shlext') <> ERROR_SUCCESS then + begin + MessageBox(0, + 'Unable to delete registry key for "File context menu handlers", this key may already be deleted or you may need admin rights.', + 'Problem', MB_ICONERROR); + end; // if + RegCloseKey(hRootKey); + end; // if + if RegOpenKeyEx(HKEY_CLASSES_ROOT, 'Directory\shellex\ContextMenuHandlers', 0, KEY_ALL_ACCESS, + hRootKey) = ERROR_SUCCESS then + begin + if RegDeleteKey(hRootKey, 'miranda.shlext') <> ERROR_SUCCESS then + begin + MessageBox(0, + 'Unable to delete registry key for "Directory context menu handlers", this key may already be deleted or you may need admin rights.', + 'Problem', MB_ICONERROR); + end; // if + RegCloseKey(hRootKey); + end; // if + if ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, + 'Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', 0, KEY_ALL_ACCESS, + hRootKey) then + begin + if RegDeleteValue(hRootKey, '{72013A26-A94C-11d6-8540-A5E62932711D}') <> ERROR_SUCCESS then + begin + MessageBox(0, + 'Unable to delete registry entry for "Approved context menu handlers", this key may already be deleted or you may need admin rights.', + 'Problem', MB_ICONERROR); + end; // if + RegCloseKey(hRootKey); + end; // if + Result := S_OK; +end; + +{ called by the options code to remove COM entries, and before that, get permission, if required. +} + +procedure CheckUnregisterServer; +var + sei: TSHELLEXECUTEINFO; + szBuf: array [0 .. MAX_PATH * 2] of Char; + szFileName: array [0 .. MAX_PATH] of Char; +begin + if not VistaOrLater then + begin + RemoveCOMRegistryEntries(); + Exit; + end; + // launches regsvr to remove the dll under admin. + GetModuleFileName(System.hInstance, szFileName, sizeof(szFileName)); + wsprintfs(szBuf, '/s /u "%s"', szFileName); + ZeroMemory(@sei, sizeof(sei)); + sei.cbSize := sizeof(sei); + sei.lpVerb := 'runas'; + sei.lpFile := 'regsvr32'; + sei.lpParameters := szBuf; + ShellExecuteEx(sei); + Sleep(1000); + RemoveCOMRegistryEntries(); +end; + +{ Wow, I can't believe there isn't a direct API for this - 'runas' will invoke the UAC and ask + for permission before installing the shell extension. note the filepath arg has to be quoted } +procedure CheckRegisterServer; +var + hRegKey: HKEY; + sei: TSHELLEXECUTEINFO; + szBuf: array [0 .. MAX_PATH * 2] of Char; + szFileName: array [0 .. MAX_PATH] of Char; +begin + if ERROR_SUCCESS = RegOpenKeyEx(HKEY_CLASSES_ROOT, 'miranda.shlext', 0, KEY_READ, hRegKey) + then + begin + RegCloseKey(hRegKey); + end + else + begin + if VistaOrLater then + begin + MessageBox(0, + 'Shell context menus requires your permission to register with Windows Explorer (one time only).', + 'Miranda IM - Shell context menus (shlext.dll)', MB_OK or MB_ICONINFORMATION); + // /s = silent + GetModuleFileName(System.hInstance, szFileName, sizeof(szFileName)); + wsprintfs(szBuf, '/s "%s"', szFileName); + ZeroMemory(@sei, sizeof(sei)); + sei.cbSize := sizeof(sei); + sei.lpVerb := 'runas'; + sei.lpFile := 'regsvr32'; + sei.lpParameters := szBuf; + ShellExecuteEx(sei); + end; + end; +end; + +initialization + +begin + FillChar(dllpublic, sizeof(dllpublic), 0); + IsMultiThread := True; + VistaOrLater := GetProcAddress(GetModuleHandle('kernel32'), 'GetProductInfo') <> nil; +end; + +end. diff --git a/plugins/!Deprecated/ShlExt/shldlgs.rc b/plugins/!Deprecated/ShlExt/shldlgs.rc new file mode 100644 index 0000000000..0e9cd82b04 --- /dev/null +++ b/plugins/!Deprecated/ShlExt/shldlgs.rc @@ -0,0 +1,93 @@ +#include "resource.h" +//#include "afxres.h" +#define WS_POPUP 0x80000000L +#define WS_CHILD 0x40000000L +#define BS_AUTOCHECKBOX 0x00000003L +#define WS_TABSTOP 0x00010000L +#define SS_ETCHEDHORZ 0x00000010L +#define WS_GROUP 0x00020000L +#ifndef IDC_STATIC +#define IDC_STATIC (-1) +#endif + +///////////////////////////////////////////////////////////////////////////// +// +// Dialog +// + +IDD_SHLOPTS DIALOG DISCARDABLE 0, 0, 312, 238 +STYLE WS_POPUP +FONT 8, "MS Shell Dlg" +BEGIN + CONTROL "Display contacts in their assigned groups (if any)", + IDC_USEGROUPS,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,15, + 35,281,8 + CONTROL "Only if/when the contact list is using them", + IDC_CLISTGROUPS,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,29, + 50,267,8 + CONTROL "Display hidden, ignored or temporary contacts", + IDC_SHOWFULL,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,65, + 281,8 + CONTROL "",IDC_STATIC,"Static",SS_ETCHEDHORZ,26,21,192,1 + LTEXT "Menus",IDC_CAPMENUS,10,17,24,8 + LTEXT "",IDC_STATIC,214,16,10,11,NOT WS_GROUP + CONTROL "",IDC_STATIC,"Static",SS_ETCHEDHORZ,34,145,183,1 + LTEXT "Shell Status",IDC_CAPSHLSTATUS,10,141,43,8 + LTEXT "",IDC_STATIC,214,111,10,11,NOT WS_GROUP + LTEXT "...",IDC_STATUS,15,154,253,12 + GROUPBOX "Shell context menus",IDC_STATIC,0,0,311,238 + CONTROL "Do not display the profile name in use",IDC_NOPROF, + "Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,80,285,8 + CONTROL "Show contacts that you have set privacy rules for", + IDC_SHOWINVISIBLES,"Button",BS_AUTOCHECKBOX | WS_TABSTOP, + 15,110,290,8 + PUSHBUTTON "Remove",IDC_REMOVE,14,173,42,14 + CONTROL "Do not show status icons in menus",IDC_USEOWNERDRAW, + "Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,95,290,8 + LTEXT "",IDC_STATIC,214,136,10,11,NOT WS_GROUP + CONTROL "Do not show contacts that are offline, even if my contact list does",IDC_HIDEOFFLINE, + "Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,125,290,8 +END + +///////////////////////////////////////////////////////////////////////////// +// +// Version +// + +VS_VERSION_INFO VERSIONINFO + FILEVERSION 1,0,6,6 + PRODUCTVERSION 1,0,6,6 + FILEFLAGSMASK 0x3fL +#ifdef _DEBUG + FILEFLAGS 0x1L +#else + FILEFLAGS 0x0L +#endif + FILEOS 0x4L + FILETYPE 0x2L + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "080904b0" + BEGIN + VALUE "Comments", "\0" + VALUE "CompanyName", "\0" + VALUE "FileDescription", "'Click ''n'' send support from Explorer/Common dialogs/Desktop, Right click on a file/folder to be presented with all your Miranda contact lists and then select the profile/contact you want to send to.\0" + VALUE "FileVersion", "1, 0, 6, 6\0" + VALUE "InternalName", "shlext\0" + VALUE "LegalCopyright", "\0" + VALUE "LegalTrademarks", "\0" + VALUE "OriginalFilename", "shlext.dll\0" + VALUE "PrivateBuild", "\0" + VALUE "ProductName", "\0" + VALUE "ProductVersion", "1, 0, 6, 6\0" + VALUE "SpecialBuild", "\0" + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x809, 1200 + END +END + diff --git a/plugins/!Deprecated/ShlExt/shldlgs.res b/plugins/!Deprecated/ShlExt/shldlgs.res new file mode 100644 index 0000000000..3de576e992 Binary files /dev/null and b/plugins/!Deprecated/ShlExt/shldlgs.res differ diff --git a/plugins/!Deprecated/ShlExt/shlext.dpr b/plugins/!Deprecated/ShlExt/shlext.dpr new file mode 100644 index 0000000000..c23ee75f93 --- /dev/null +++ b/plugins/!Deprecated/ShlExt/shlext.dpr @@ -0,0 +1,379 @@ +{$IFDEF FPC} +{$PACKRECORDS 4} +{$MODE Delphi} +{$ASMMODE intel} +{$INLINE ON} +{$MACRO ON} +{$APPTYPE GUI} +{$IMAGEBASE $49ac0000} +{$ELSE} +{$IMAGEBASE $49ac0000} // this is ignored with FPC, must be set via the command line +{$ENDIF} +library shlext; + +uses + Windows, shlcom, shlipc, m_api; + +// use the registry to store the COM information needed by the shell + +function DllRegisterServer: HResult; stdcall; +var + szData: PChar; + hRegKey: HKEY; +begin + +{$IFDEF INSTALLER_REGISTER} + Result := S_OK; +{$ELSE} + // progID + szData := 'shlext (1.0.6.6) - shell context menu support for Miranda v0.3.0.0+'; + if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, 'miranda.shlext', REG_SZ, szData, Length(szData)) then + begin + // CLSID related to ProgID + szData := '{72013A26-A94C-11d6-8540-A5E62932711D}'; + if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, 'miranda.shlext\CLSID', REG_SZ, szData, Length(szData)) then + begin + // CLSID link back to progID + szData := 'miranda.shlext'; + if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, + 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}', REG_SZ, szData, Length(szData)) then + begin + // CLSID link back to ProgID under \ProgID again? + szData := 'miranda.shlext'; + if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, + 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}\ProgID', REG_SZ, szData, Length(szData)) then + begin + GetMem(szData, MAX_PATH); + GetModuleFileName(hInstance, szData, MAX_PATH - 1); + Result := RegSetValue(HKEY_CLASSES_ROOT, + 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}\InprocServer32', REG_SZ, szData, Length(szData)); + FreeMem(szData); + if Result = ERROR_SUCCESS then + begin + // have to add threading model + szData := 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}\InprocServer32'; + Result := RegCreateKeyEx(HKEY_CLASSES_ROOT, szData, 0, nil, 0, + KEY_SET_VALUE or KEY_CREATE_SUB_KEY, nil, hRegKey, nil); + if Result = ERROR_SUCCESS then + begin + szData := 'Apartment'; + RegSetValueEx(hRegKey, 'ThreadingModel', 0, REG_SZ, PByte(szData), Length(szData) + 1); + RegCloseKey(hRegKey); + // write which file types to show under + szData := '{72013A26-A94C-11d6-8540-A5E62932711D}'; + // note that *\ should use AllFilesystemObjects for 4.71+ + if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, + '*\shellex\ContextMenuHandlers\miranda.shlext', REG_SZ, szData, Length(szData)) then + begin + // don't support directories + if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, + 'Directory\shellex\ContextMenuHandlers\miranda.shlext', REG_SZ, szData, + Length(szData)) then + begin + Result := S_OK; + // have to add to the approved list under NT/2000/XP with {CLSID}="" + szData := 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved'; + Result := RegCreateKeyEx(HKEY_LOCAL_MACHINE, szData, 0, nil, 0, + KEY_SET_VALUE or KEY_CREATE_SUB_KEY, nil, hRegKey, nil); + if Result = ERROR_SUCCESS then + begin + szData := 'shlext (1.0.6.6) - context menu support for Miranda v0.3.0.0+'; + RegSetValueEx(hRegKey, '{72013A26-A94C-11d6-8540-A5E62932711D}', 0, REG_SZ, + PByte(szData), Length(szData) + 1); + RegCloseKey(hRegKey); + end; // if + end + else + Result := E_FAIL; + end + else + Result := E_FAIL; + end + else + Result := E_FAIL; + end + else + Result := E_FAIL; + end + else + Result := E_FAIL; + end + else + Result := E_FAIL; + end + else + Result := E_FAIL; + end + else + Result := E_FAIL; + // +{$ENDIF} +end; + +function DllUnregisterServer: HResult; stdcall; +begin + Result := RemoveCOMRegistryEntries(); +end; + +// - miranda section ---- + +const + + COMREG_UNKNOWN = $00000000; + COMREG_OK = $00000001; + COMREG_APPROVED = $00000002; + +function IsCOMRegistered: Integer; +var + hRegKey: HKEY; + lpType: Integer; +begin + Result := 0; + // these arent the BEST checks in the world + if ERROR_SUCCESS = RegOpenKeyEx(HKEY_CLASSES_ROOT, 'miranda.shlext', 0, KEY_READ, hRegKey) + then + begin + Result := Result or COMREG_OK; + RegCloseKey(hRegKey); + end; // if + lpType := REG_SZ; + if ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, + 'Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', 0, KEY_READ, hRegKey) + then + begin + if ERROR_SUCCESS = RegQueryValueEx(hRegKey, '{72013A26-A94C-11d6-8540-A5E62932711D}', nil, + @lpType, nil, nil) then + begin + Result := Result or COMREG_APPROVED; + end; // if + RegCloseKey(hRegKey); + end; // if +end; + +procedure AutoSize(hwnd: THandle); +var + szBuf: array [0 .. MAX_PATH] of Char; + DC: HDC; + tS: TSize; + i: Integer; + hFont, hOldFont: THandle; +begin + DC := GetDC(hwnd); + hFont := GetStockObject(DEFAULT_GUI_FONT); + hOldFont := SelectObject(DC, hFont); + i := GetWindowText(hwnd, szBuf, MAX_PATH); + GetTextExtentPoint32(DC, szBuf, i, tS); + SelectObject(DC, hOldFont); + DeleteObject(hFont); + ReleaseDC(hwnd, DC); + SetWindowPos(hwnd, HWND_BOTTOM, 0, 0, tS.cx + 10, tS.cy, SWP_NOMOVE or SWP_FRAMECHANGED); +end; + +function OptDialogProc(hwndDlg: THandle; wMsg: Integer; wParam: wParam; lParam: lParam): BOOL; stdcall; +// don't wanna bring in CommCtrl just for a few constants +const +{$IFNDEF FPC} + WM_INITDIALOG = $0110; + WM_COMMAND = $0111; + WM_USER = $0400; + WM_NOTIFY = $004E; +{$ENDIF} + { propsheet notifications/msessages } + // PSN_APPLY = (-200) - 2; + PSM_CHANGED = WM_USER + 104; + { button styles } + BCM_SETSHIELD = ( { BCM_FIRST } $1600 + $000C); + { hotkey } + // bring in the IDC's and storage key names +{$DEFINE SHL_IDC} +{$DEFINE SHL_KEYS} +{$INCLUDE shlc.inc} +{$UNDEF SHL_KEYS} +{$UNDEF SHL_IDC} +const + COM_OKSTR: array [Boolean] of PChar = ('Problem, registration missing/deleted.', + 'Successfully created shell registration.'); + COM_APPROVEDSTR: array [Boolean] of PChar = ('Not Approved', 'Approved'); +var + comReg: Integer; + iCheck: Integer; + szBuf: array [0 .. MAX_PATH] of Char; +begin + Result := wMsg = WM_INITDIALOG; + case wMsg of + WM_NOTIFY: + begin + { * FP 2.2.2 seems to have a bug, 'Code' is supposed to be signed + but isn't signed, so when comparing -202 (=PSN_APPLY) It doesn't work + so here, -202 is converted into hex, what you are looking at is the + code == PSN_APPLY check. * } + if $FFFFFF36 = pNMHDR(lParam)^.code then + begin + DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseGroups, + IsDlgButtonChecked(hwndDlg, IDC_USEGROUPS)); + DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseCListSetting, + IsDlgButtonChecked(hwndDlg, IDC_CLISTGROUPS)); + DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoProfile, + IsDlgButtonChecked(hwndDlg, IDC_NOPROF)); + DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseHITContacts, + IsDlgButtonChecked(hwndDlg, IDC_SHOWFULL)); + DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseHIT2Contacts, + IsDlgButtonChecked(hwndDlg, IDC_SHOWINVISIBLES)); + DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoIcons, + IsDlgButtonChecked(hwndDlg, IDC_USEOWNERDRAW)); + DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoOffline, + IsDlgButtonChecked(hwndDlg, IDC_HIDEOFFLINE)); + end; // if + end; + WM_INITDIALOG: + begin + TranslateDialogDefault(hwndDlg); + comReg := IsCOMRegistered(); + FillChar(szBuf, MAX_PATH, 0); + lstrcat(szBuf, Translate(COM_OKSTR[comReg and COMREG_OK = COMREG_OK])); + lstrcat(szBuf, ' ('); + lstrcat(szBuf, Translate(COM_APPROVEDSTR[comReg and + COMREG_APPROVED = COMREG_APPROVED])); + lstrcat(szBuf, ')'); + SetWindowText(GetDlgItem(hwndDlg, IDC_STATUS), szBuf); + // auto size the static windows to fit their text + // they're rendering in a font not selected into the DC. + AutoSize(GetDlgItem(hwndDlg, IDC_CAPMENUS)); + AutoSize(GetDlgItem(hwndDlg, IDC_CAPSTATUS)); + AutoSize(GetDlgItem(hwndDlg, IDC_CAPSHLSTATUS)); + // show all the options + iCheck := DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseGroups, BST_UNCHECKED); + CheckDlgButton(hwndDlg, IDC_USEGROUPS, iCheck); + EnableWindow(GetDlgItem(hwndDlg, IDC_CLISTGROUPS), iCheck = BST_CHECKED); + CheckDlgButton(hwndDlg, IDC_CLISTGROUPS, + DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseCListSetting, BST_UNCHECKED)); + CheckDlgButton(hwndDlg, IDC_NOPROF, + DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoProfile, BST_UNCHECKED)); + CheckDlgButton(hwndDlg, IDC_SHOWFULL, + DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHITContacts, BST_UNCHECKED)); + CheckDlgButton(hwndDlg, IDC_SHOWINVISIBLES, + DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHIT2Contacts, BST_UNCHECKED)); + CheckDlgButton(hwndDlg, IDC_USEOWNERDRAW, + DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoIcons, BST_UNCHECKED)); + CheckDlgButton(hwndDlg, IDC_HIDEOFFLINE, + DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoOffline, BST_UNCHECKED)); + // give the Remove button a Vista icon + SendMessage(GetDlgItem(hwndDlg, IDC_REMOVE), BCM_SETSHIELD, 0, 1); + end; + WM_COMMAND: + begin + // don't send the changed message if remove is clicked + if LOWORD(wParam) <> IDC_REMOVE then + begin + SendMessage(GetParent(hwndDlg), PSM_CHANGED, 0, 0); + end; // if + case LOWORD(wParam) of + IDC_USEGROUPS: + begin + EnableWindow(GetDlgItem(hwndDlg, IDC_CLISTGROUPS), + BST_CHECKED = IsDlgButtonChecked(hwndDlg, IDC_USEGROUPS)); + end; // if + IDC_REMOVE: + begin + if IDYES = MessageBoxW(0, + TranslateW( + 'Are you sure? this will remove all the settings stored in your database and all registry entries created for shlext to work with Explorer'), + TranslateW('Disable/Remove shlext'), MB_YESNO or MB_ICONQUESTION) then + begin + db_unset(0, SHLExt_Name, SHLExt_UseGroups); + db_unset(0, SHLExt_Name, SHLExt_UseCListSetting); + db_unset(0, SHLExt_Name, SHLExt_UseHITContacts); + db_unset(0, SHLExt_Name, SHLExt_UseHIT2Contacts); + db_unset(0, SHLExt_Name, SHLExt_ShowNoProfile); + db_unset(0, SHLExt_Name, SHLExt_ShowNoIcons); + db_unset(0, SHLExt_Name, SHLExt_ShowNoOffline); + + (* remove from Explorer *) + // DllUnregisterServer(); + CheckUnregisterServer(); + (* show all the settings have gone... *) + SendMessage(hwndDlg, WM_INITDIALOG, 0, 0); + end; // if + end; // if + end; // case + // LOWORD(wParam) == IDC_* + end; { outercase } + end; // case +end; + +function InitialiseOptionPages(wParam: wParam; lParam: lParam): int; cdecl; +const + IDD_SHLOPTS = 101; +var + optDialog: TOPTIONSDIALOGPAGE; +begin + Result := 0; + FillChar(optDialog, sizeof(TOPTIONSDIALOGPAGE), 0); + optDialog.cbSize := sizeof(TOPTIONSDIALOGPAGE); + optDialog.flags := ODPF_BOLDGROUPS; + optDialog.groupPosition := 0; + optDialog.szGroup.a := 'Plugins'; + optDialog.position := -1066; + optDialog.szTitle.a := Translate('Shell context menus'); + optDialog.pszTemplate := MAKEINTRESOURCE(IDD_SHLOPTS); +{$IFDEF VER140} + optDialog.hInstance := hInstance; +{$ELSE} + optDialog.hInstance := System.hInstance; +{$ENDIF} + optDialog.pfnDlgProc := @OptDialogProc; + + Options_AddPage(wParam,@optDialog); +end; + +function MirandaPluginInfoEx(mirandaVersion: DWORD): PPLUGININFOEX; cdecl; +begin + Result := nil; + { fill in plugininfo } + PluginInfo.cbSize := sizeof(PluginInfo); + PluginInfo.shortName := 'Shell context menus for transfers'; + PluginInfo.version := PLUGIN_MAKE_VERSION(2, 0, 1, 2); +{$IFDEF FPC} + PluginInfo.description := + 'Click ''n'' send support from Explorer/Common dialogs/Desktop, Right click on a file/folder to be presented with all your Miranda contact lists and then select the profile/contact you want to send to.'; +{$ELSE} + PluginInfo.description := ''; +{$ENDIF} + PluginInfo.author := 'egoDust'; + PluginInfo.authorEmail := 'egodust@users.sourceforge.net'; + PluginInfo.copyright := '(c) 2009 Sam Kothari (egoDust)'; + PluginInfo.homePage := 'http://addons.miranda-im.org/details.php?action=viewfile&id=534'; + PluginInfo.flags := 0; + { This UUID is fetched twice } + CopyMemory(@PluginInfo.uuid, @CLSID_ISHLCOM, sizeof(TMUUID)); + { return info } + Result := @PluginInfo; +end; + +function Load(): int; cdecl; +begin + Result := 0; + InvokeThreadServer; + HookEvent(ME_OPT_INITIALISE, InitialiseOptionPages); + DllRegisterServer(); + CheckRegisterServer(); + // DisableThreadLibraryCalls(System.hInstance); +end; + +function Unload: int; cdecl; +begin + Result := 0; +end; + +{$R shldlgs.res} + +exports + MirandaPluginInfoEx, Load, Unload; + +exports + DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer; + +initialization + DisableThreadLibraryCalls(hInstance); + +end. diff --git a/plugins/!Deprecated/ShlExt/shlicons.pas b/plugins/!Deprecated/ShlExt/shlicons.pas new file mode 100644 index 0000000000..195033ae8d --- /dev/null +++ b/plugins/!Deprecated/ShlExt/shlicons.pas @@ -0,0 +1,168 @@ +unit shlicons; + +interface + +uses + Windows; + +type + + PVTable_IWICBitmap = ^TVTable_IWICBitmap; + + TVTable_IWICBitmap = record + { IUnknown } + QueryInterface: Pointer; + AddRef: function(Self: Pointer): Cardinal; stdcall; + Release: function(Self: Pointer): Cardinal; stdcall; + { IWICBitmapSource } + GetSize: function(Self: Pointer; var Width, Height: LongInt): HResult; stdcall; + GetPixelFormat: Pointer; + GetResolution: Pointer; + CopyPalette: Pointer; + CopyPixels: function(Self: Pointer; prc: Pointer; cbStride, cbBufferSize: LongWord; + pbBuffer: PByte): HResult; stdcall; + { IWICBitmap } + // .... not used + + end; + + PWICBitmap_Interface = ^TWICBitmap_Interface; + + TWICBitmap_Interface = record + ptrVTable: PVTable_IWICBitmap; + end; + + // bare minmum interface to ImagingFactory + + PVTable_ImagingFactory = ^TVTable_ImagingFactory; + + TVTable_ImagingFactory = record + { IUnknown } + QueryInterface: Pointer; + AddRef: function(Self: Pointer): Cardinal; stdcall; + Release: function(Self: Pointer): Cardinal; stdcall; + { ImagingFactory } + CreateDecoderFromFilename: Pointer; + CreateDecoderFromStream: Pointer; + CreateDecoderFromFileHandle: Pointer; + CreateComponentInfo: Pointer; + CreateDecoder: Pointer; + CreateEncoder: Pointer; + CreatePalette: Pointer; + CreateFormatConverter: Pointer; + CreateBitmapScaler: Pointer; + CreateBitmapClipper: Pointer; + CreateBitmapFlipRotator: Pointer; + CreateStream: Pointer; + CreateColorContext: Pointer; + CreateColorTransformer: Pointer; + CreateBitmap: Pointer; + CreateBitmapFromSource: Pointer; + CreateBitmapFromSourceRect: Pointer; + CreateBitmapFromMemory: Pointer; + CreateBitmapFromHBITMAP: Pointer; + CreateBitmapFromHICON: function(Self: Pointer; hIcon: Windows.hIcon; var foo: Pointer) + : HResult; stdcall; + { rest ommited } + end; + + PImageFactory_Interface = ^TImageFactory_Interface; + + TImageFactory_Interface = record + ptrVTable: PVTable_ImagingFactory; + end; + +function ARGB_GetWorker: PImageFactory_Interface; + +function ARGB_BitmapFromIcon(Factory: PImageFactory_Interface; hdc: Windows.hdc; hIcon: hIcon): HBitmap; + +implementation + +{$DEFINE SHLCOM} +{$DEFINE COM_STRUCTS} +{$DEFINE COMAPI} +{$INCLUDE shlc.inc} +{$UNDEF SHLCOM} +{$UNDEF COM_STRUCTS} +{$UNDEF COMAPI} +{ + The following implementation has been ported from: + + http://web.archive.org/web/20080121112802/http://shellrevealed.com/blogs/shellblog/archive/2007/02/06/Vista-Style-Menus_2C00_-Part-1-_2D00_-Adding-icons-to-standard-menus.aspx + + It uses WIC (Windows Imaging Codec) to convert the given Icon into a bitmap in ARGB format, this is required + by Windows for use as an icon (but in bitmap format), so that Windows draws everything (including theme) + so we don't have to. + + Why didn't they just do this themselves? ... +} + +{ + The object returned from this function has to be released using the QI COM interface, don't forget. + Note this function won't work on anything where WIC isn't installed (XP can have it installed, but not by default) + anything less won't work. +} +function ARGB_GetWorker: PImageFactory_Interface; +var + hr: HResult; +begin + hr := CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER, + IID_WICImagingFactory, Result); +end; + +function ARGB_BitmapFromIcon(Factory: PImageFactory_Interface; hdc: Windows.hdc; hIcon: hIcon): HBitmap; +var + bmi: BITMAPINFO; + hr: HResult; + bitmap: PWICBitmap_Interface; + cx, cy: LongInt; + pbBuffer: PByte; + hBmp: HBitmap; + cbStride, cbBuffer: LongInt; +begin + { This code gives an icon to WIC and gets a bitmap object in return, it then creates a DIB section + which is 32bits and the same H*W as the icon. It then asks the bitmap object to copy itself into the DIB } + Result := 0; + ZeroMemory(@bmi, sizeof(bmi)); + bmi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER); + bmi.bmiHeader.biPlanes := 1; + bmi.bmiHeader.biCompression := BI_RGB; + + bmi.bmiHeader.biBitCount := 32; + + hr := Factory^.ptrVTable^.CreateBitmapFromHICON(Factory, hIcon, pointer(bitmap)); + if hr = S_OK then + begin + hr := bitmap^.ptrVTable^.GetSize(bitmap, cx, cy); + if hr = S_OK then + begin + + bmi.bmiHeader.biWidth := cx; + bmi.bmiHeader.biHeight := -cy; + + hBmp := CreateDIBSection(hdc, bmi, DIB_RGB_COLORS, pointer(pbBuffer), 0, 0); + if hBmp <> 0 then + begin + cbStride := cx * sizeof(DWORD); // ARGB = DWORD + cbBuffer := cy * cbStride; + // note: the pbBuffer memory is owned by the DIB and will be freed when the bitmap is released + hr := bitmap^.ptrVTable^.CopyPixels(bitmap, nil, cbStride, cbBuffer, pbBuffer); + if hr = S_OK then + begin + Result := hBmp; + end + else + begin + // the copy failed, delete the DIB + DeleteObject(hBmp); + end; + end; + end; + // release the bitmap object now + bitmap^.ptrVTable^.Release(bitmap); + bitmap := nil; + end; + +end; + +end. diff --git a/plugins/!Deprecated/ShlExt/shlipc.pas b/plugins/!Deprecated/ShlExt/shlipc.pas new file mode 100644 index 0000000000..17ab511e52 --- /dev/null +++ b/plugins/!Deprecated/ShlExt/shlipc.pas @@ -0,0 +1,394 @@ +unit shlIPC; + +interface + +uses + + m_api, Windows; + +const + + REPLY_FAIL = $88888888; + REPLY_OK = $00000000; + + REQUEST_ICONS = 1; + REQUEST_GROUPS = (REQUEST_ICONS) shl 1; + REQUEST_CONTACTS = (REQUEST_GROUPS) shl 1; + REQUEST_XFRFILES = (REQUEST_CONTACTS) shl 1; + REQUEST_NEWICONS = (REQUEST_XFRFILES) shl 1; + REQUEST_CLEARMRU = (REQUEST_NEWICONS) shl 1; + + ICONS_NOTIMPL = $00000008; + GROUPS_NOTIMPL = $00000080; + CONTACTS_NOTIMPL = $00000800; + + STATUS_PROFILENAME = 2; + + + // there maybe more than one reason why any request type wasn't returned + +type + + { this can be a group entry, if it is, hContact = + the string contains the full group path } + + PSlotIPC = ^TSlotIPC; + + TSlotIPC = packed record + cbSize: Byte; + fType: int; // a REQUEST_* type + Next: PSlotIPC; + hContact: THandle; + hProto: Cardinal; // hash of the protocol the user is on + hGroup: Cardinal; // hash of the entire path (not defined for REQUEST_GROUPS slots) + Status: Word; + // only used for contacts -- can be STATUS_PROFILENAME -- but that is because returning the profile name is optional + MRU: Byte; // if set, contact has been recently used + cbStrSection: int; + end; + + // if the slot contains a nickname, after the NULL, there is another NULL or a group path string + + PSlotProtoIcons = ^TSlotProtoIcons; + + TSlotProtoIcons = packed record + pid: Cardinal; // pid of Miranda this protocol was on + hProto: Cardinal; // hash of the protocol + hIcons: array [0 .. 9] of HICON; // each status in order of ID_STATUS_* + hBitmaps: array [0 .. 9] of HBITMAP; // each status "icon" as a bitmap + end; + + TSlotProtoIconsArray = array [0 .. 0] of TSlotProtoIcons; + // the process space the thread is running in WILL use a different mapping + // address than the client's process space, addresses need to be adjusted + // to the client's process space.. this is done by the following means : + + // + // new_addr := (old_address - serverbase) + client base + // + // this isn't the best of solutions, the link list should be a variant array + // without random access, which would mean each element's different + // size would need to be computed each time it is accessed or read past + + PHeaderIPC = ^THeaderIPC; + + THeaderIPC = record + cbSize: Cardinal; + dwVersion: Cardinal; + pServerBaseAddress: Pointer; + pClientBaseAddress: Pointer; + fRequests: Cardinal; + dwFlags: Cardinal; + Slots: Cardinal; + Param: Cardinal; + SignalEventName: array [0 .. 63] of Char; + // Translate() won't work via Explorer + MirandaName: array [0 .. 63] of Char; + MRUMenuName: array [0 .. 63] of Char; // for the MRU menu itself + ClearEntries: array [0 .. 63] of Char; // for the "clear entries" + IconsBegin: PSlotIPC; + ContactsBegin: PSlotIPC; + GroupsBegin: PSlotIPC; + NewIconsBegin: PSlotIPC; + // start of an flat memory stack, which is referenced as a linked list + DataSize: int; + DataPtr: PSlotIPC; + DataPtrEnd: PSlotIPC; + DataFramePtr: Pointer; + end; + +const + HIPC_NOICONS = 1; + +procedure ipcPrepareRequests(ipcPacketSize: int; pipch: PHeaderIPC; fRequests: Cardinal); +function ipcSendRequest(hSignal, hWaitFor: THandle; pipch: PHeaderIPC; dwTimeoutMsecs: DWORD): Cardinal; +function ipcAlloc(pipch: PHeaderIPC; nSize: Integer): PSlotIPC; +procedure ipcFixupAddresses(FromServer: LongBool; pipch: PHeaderIPC); + +type + + TStrTokRec = record + szStr: PChar; + szSet: set of Char; + // need a delimiter after the token too?, e.g. FOO^BAR^ if FOO^BAR + // is the string then only FOO^ is returned, could cause infinite loops + // if the condition isn't accounted for thou. + bSetTerminator: Boolean; + end; + +function StrTok(var strr: TStrTokRec): PChar; + +type + + PGroupNode = ^TGroupNode; + + TGroupNode = record + Left, Right, _prev, _next: PGroupNode; + Depth: Cardinal; + Hash: Cardinal; // hash of the group name alone + szGroup: PChar; + cchGroup: Integer; + hMenu: THandle; + hMenuGroupID: Integer; + dwItems: Cardinal; + end; + + PGroupNodeList = ^TGroupNodeList; + + TGroupNodeList = record + First, Last: PGroupNode; + end; + +function AllocGroupNode(list: PGroupNodeList; Root: PGroupNode; Depth: Integer): PGroupNode; +function FindGroupNode(P: PGroupNode; const Hash, Depth: dword): PGroupNode; + +type + + // a contact can never be a submenu too. + TSlotDrawType = (dtEntry, dtGroup, dtContact, dtCommand); + TSlotDrawTypes = set of TSlotDrawType; + + PMenuDrawInfo = ^TMenuDrawInfo; + + TMenuCommandCallback = function(pipch: PHeaderIPC; // IPC header info, already mapped + hWorkThreadEvent: THandle; // event object being waited on on miranda thread + hAckEvent: THandle; // ack event object that has been created + psd: PMenuDrawInfo // command/draw info + ): Integer; stdcall; + + TMenuDrawInfo = record + szText: PChar; + szProfile: PChar; + cch: Integer; + wID: Integer; // should be the same as the menu item's ID + fTypes: TSlotDrawTypes; + hContact: THandle; + hStatusIcon: THandle; + // HICON from Self^.ProtoIcons[index].hIcons[status]; Do not DestroyIcon() + hStatusBitmap: THandle; // HBITMAP, don't free. + pid: Integer; + MenuCommandCallback: TMenuCommandCallback; // dtCommand must be set also. + end; + +implementation + +function FindGroupNode(P: PGroupNode; const Hash, Depth: dword): PGroupNode; +begin + Result := P; + while Result <> nil do + begin + if (Result^.Hash = Hash) and (Result^.Depth = Depth) then + Exit; + If Result^.Left <> nil then + begin + P := Result; + Result := FindGroupNode(Result^.Left, Hash, Depth); + If Result <> nil then + Exit; + Result := P; + end; + Result := Result^.Right; + end; // while +end; + +function AllocGroupNode(list: PGroupNodeList; Root: PGroupNode; Depth: Integer): PGroupNode; +begin + New(Result); + Result^.Left := nil; + Result^.Right := nil; + Result^.Depth := Depth; + if Depth > 0 then + begin + if Root^.Left = nil then + Root^.Left := Result + else + begin + Root := Root^.Left; + while Root^.Right <> nil do + Root := Root^.Right; + Root^.Right := Result; + end; + end + else + begin + if list^.First = nil then + list^.First := Result; + if list^.Last <> nil then + list^.Last^.Right := Result; + list^.Last := Result; + end; // if +end; + +procedure ipcPrepareRequests(ipcPacketSize: int; pipch: PHeaderIPC; fRequests: Cardinal); +begin + // some fields may already have values like the event object name to open + pipch^.cbSize := sizeof(THeaderIPC); + pipch^.dwVersion := PLUGIN_MAKE_VERSION(2, 0, 1, 2); + pipch^.dwFlags := 0; + pipch^.pServerBaseAddress := nil; + pipch^.pClientBaseAddress := pipch; + pipch^.fRequests := fRequests; + pipch^.Slots := 0; + pipch^.IconsBegin := nil; + pipch^.ContactsBegin := nil; + pipch^.GroupsBegin := nil; + pipch^.NewIconsBegin := nil; + pipch^.DataSize := ipcPacketSize - pipch^.cbSize; + // the server side will adjust these pointers as soon as it opens + // the mapped file to it's base address, these are set 'ere because ipcAlloc() + // maybe used on the client side and are translated by the server side. + // ipcAlloc() is used on the client side when transferring filenames + // to the ST thread. + uint_ptr(pipch^.DataPtr) := uint_ptr(pipch) + sizeof(THeaderIPC); + uint_ptr(pipch^.DataPtrEnd) := uint_ptr(pipch^.DataPtr) + pipch^.DataSize; + pipch^.DataFramePtr := pipch^.DataPtr; + // fill the data area + FillChar(pipch^.DataPtr^, pipch^.DataSize, 0); +end; + +function ipcSendRequest(hSignal, hWaitFor: THandle; pipch: PHeaderIPC; dwTimeoutMsecs: DWORD): Cardinal; +begin + { signal ST to work } + SetEvent(hSignal); + { wait for reply, it should open a handle to hWaitFor... } + while True do + begin + Result := WaitForSingleObjectEx(hWaitFor, dwTimeoutMsecs, True); + if Result = WAIT_OBJECT_0 then + begin + Result := pipch^.fRequests; + break; + end + else if Result = WAIT_IO_COMPLETION then + begin + (* APC call... *) + end + else + begin + Result := REPLY_FAIL; + break; + end; // if + end; // while +end; + +function ipcAlloc(pipch: PHeaderIPC; nSize: Integer): PSlotIPC; +var + PSP: uint_ptr; +begin + Result := nil; + { nSize maybe zero, in that case there is no string section --- } + PSP := uint_ptr(pipch^.DataFramePtr) + sizeof(TSlotIPC) + nSize; + { is it past the end? } + If PSP >= uint_ptr(pipch^.DataPtrEnd) then + Exit; + { return the pointer } + Result := pipch^.DataFramePtr; + { set up the item } + Result^.cbSize := sizeof(TSlotIPC); + Result^.cbStrSection := nSize; + { update the frame ptr } + pipch^.DataFramePtr := Pointer(PSP); + { let this item jump to the next yet-to-be-allocated-item which should be null anyway } + Result^.Next := Pointer(PSP); +end; + +procedure ipcFixupAddresses(FromServer: LongBool; pipch: PHeaderIPC); +var + pct: PSlotIPC; + q: ^PSlotIPC; + iServerBase: int_ptr; + iClientBase: int_ptr; +begin + if pipch^.pServerBaseAddress = pipch^.pClientBaseAddress then + Exit; + iServerBase := int_ptr(pipch^.pServerBaseAddress); + iClientBase := int_ptr(pipch^.pClientBaseAddress); + // fix up all the pointers in the header + if pipch^.IconsBegin <> nil then + begin + uint_ptr(pipch^.IconsBegin) := (uint_ptr(pipch^.IconsBegin) - iServerBase) + iClientBase; + end; // if + + if pipch^.ContactsBegin <> nil then + begin + uint_ptr(pipch^.ContactsBegin) := (uint_ptr(pipch^.ContactsBegin) - iServerBase) + iClientBase; + end; // if + + if pipch^.GroupsBegin <> nil then + begin + uint_ptr(pipch^.GroupsBegin) := (uint_ptr(pipch^.GroupsBegin) - iServerBase) + iClientBase; + end; // if + + if pipch^.NewIconsBegin <> nil then + begin + uint_ptr(pipch^.NewIconsBegin) := (uint_ptr(pipch^.NewIconsBegin) - iServerBase) + + iClientBase; + end; + uint_ptr(pipch^.DataPtr) := (uint_ptr(pipch^.DataPtr) - iServerBase) + iClientBase; + uint_ptr(pipch^.DataPtrEnd) := (uint_ptr(pipch^.DataPtrEnd) - iServerBase) + iClientBase; + uint_ptr(pipch^.DataFramePtr) := (uint_ptr(pipch^.DataFramePtr) - iServerBase) + iClientBase; + // and the link list + pct := pipch^.DataPtr; + while (pct <> nil) do + begin + // the first pointer is already fixed up, have to get a pointer + // to the next pointer and modify where it jumps to + q := @pct^.Next; + if q^ <> nil then + begin + uint_ptr(q^) := (uint_ptr(q^) - iServerBase) + iClientBase; + end; // if + pct := q^; + end; // while +end; + +function StrTok(var strr: TStrTokRec): PChar; +begin + Result := nil; + { don't allow #0's in sets or null strings } + If (strr.szStr = nil) or (#0 in strr.szSet) then + Exit; + { strip any leading delimiters } + while strr.szStr^ in strr.szSet do + Inc(strr.szStr); + { end on null? full of delimiters } + If strr.szStr^ = #0 then + begin + // wipe out the pointer + strr.szStr := nil; + Exit; + end; + { store the start of the token } + Result := strr.szStr; + { process til start of another delim } + while not(strr.szStr^ in strr.szSet) do + begin + { don't process past the real null, is a delimter required to cap the token? } + If strr.szStr^ = #0 then + break; + Inc(strr.szStr); + end; + { if we end on a null stop reprocessin' } + If strr.szStr^ = #0 then + begin + // no more tokens can be read + strr.szStr := nil; + // is a ending delimiter required? + If strr.bSetTerminator then + begin + // rollback + strr.szStr := Result; + Result := nil; + end; + // + end + else + begin + { mark the end of the token, may AV if a constant pchar is passed } + strr.szStr^ := #0; + { skip past this fake null for next time } + Inc(strr.szStr); + end; +end; + +end. diff --git a/plugins/ShellExt/src/options.cpp b/plugins/ShellExt/src/options.cpp index 1e92422fcb..ccc2d3eb6a 100644 --- a/plugins/ShellExt/src/options.cpp +++ b/plugins/ShellExt/src/options.cpp @@ -110,7 +110,7 @@ int OnOptionsInit(WPARAM wParam, LPARAM lParam) { OPTIONSDIALOGPAGE opt = { sizeof(opt) }; opt.flags = ODPF_BOLDGROUPS; - opt.pszGroup = "Plugins"; + opt.pszGroup = "Services"; opt.position = -1066; opt.pszTitle = "Shell context menus"; opt.pszTemplate = MAKEINTRESOURCEA(IDD_SHLOPTS); diff --git a/plugins/ShlExt/clean.bat b/plugins/ShlExt/clean.bat deleted file mode 100644 index 575eed729c..0000000000 --- a/plugins/ShlExt/clean.bat +++ /dev/null @@ -1 +0,0 @@ -del *.o *.ppu *.dll *.a fpc-res.res *.or \ No newline at end of file diff --git a/plugins/ShlExt/docs/HowToBuild.txt b/plugins/ShlExt/docs/HowToBuild.txt deleted file mode 100644 index 53b6738616..0000000000 --- a/plugins/ShlExt/docs/HowToBuild.txt +++ /dev/null @@ -1,22 +0,0 @@ -shlext 2.0.0.9 - -Info -======================= - -This source code is based on shlext 1.0.6.6 with minor changes so that it works -with FreePascal 2.2.2. - -The included headers (inc dir) are from Miranda 0.3.3.1 SDK and so if you want newer APIs -then get the API headers from the latest SVN tree. - -Note: I have included v0.8.xx API changes for GUIDs within a new file (m_v8.inc) - - -How to build -======================= - -Make sure you have installed the FreePascal compiler ( http://freepascal.org ) -the latest version is 2.2.2 at the time of writing. - -Run "make.bat" in this directory, this contains all the command line switches -for the newer version should produce shlext.dll diff --git a/plugins/ShlExt/docs/shlext release notes.txt b/plugins/ShlExt/docs/shlext release notes.txt deleted file mode 100644 index 0e58edf9ff..0000000000 --- a/plugins/ShlExt/docs/shlext release notes.txt +++ /dev/null @@ -1,344 +0,0 @@ -shlext 2.0.1.2 - -Contents: - - Introduction ``What is shlext?`` - Why so long? - What you need - New features - Features - Quirks - Important changes - But Miranda has drag'n'drop! - Installation - Upgrading/Removing - Translation - License - Contact/Bug reporting - Credits - - - - ---Introduction ``What is shlext?`` - - shlext is a Miranda and Explorer shell plugin, it allows you to use your - contact list under any file/directory from Windows. - - This means that you can right click on a file/folder, see "Miranda" and then - see your entire contact list! this is a feature that ICQ has built in. - - shlext is better of course. - - ---Why so long? - - A few people contacted me aeons ago about implementing a better file scanner - so that they could recreate directories whilst sending, etc, I said I would do - this as soon as I had time, that was several months ago. - - I had made several changes/bugfixes when I had time, because I'm a Miranda - dev too, I don't usually have lots of time for this plugin, however lately I needed - shlext to run again, since I was sending lots of docs/logs around with Miranda. - - So I fixed several things and improved lots of other stuff so that other users - could use shlext again (the XP bug was really annoying as soon as I got XP myself ;) - - - ---What you need - - (2008) You will need 0.7.xx or 0.8.x -- older versions will not work. - - shlext should work on all Window Explorer versions that support it, - certain features will not work on older Explorers, i.e. icons, but you will - still be able to use the main function of shlext, selection 'n' transfer. - - ---New Features (2.0.1.2) - - * shlext is now compiled with Free Pascal 2.2.4 - - * shlext now works with Windows Vista: - - 1. shlext cannot automatically register itself with Windows Explorer due to permissions issues in Vista, - therefore you will be UAC prompted if shlext detects you are running Vista and that shlext isn't registered - with Explorer. - - This is almost automatic, and you just have to press "OK". - - 2. The entire menu drawing was overhauled and now looks much better, new APIs are used so that Vista draws the menus - (with theme) but the status icons are still present. - - * added UAC button for "Remove" from the options dialog. - - * Removed GetMenuItemInfo() debug message box. - - * Note: Miranda is a 32bit application, 64bit editions of Windows require a 64bit extension DLL, this is not possible at present. - - ---New features (2.0.0.9+) - - * shlext is now compiled with Free Pascal 2.2.2 which is a newer compiler with better - optimisations so shlext should be faster. (2002 v.s. 2008) - - * shlext now works with Miranda 0.8.x UUID typing system and 0.8.xx plugin loading APIs, - 0.7.xx still works too however. - - * shlext now keeps track of recently used contacts and builds a "MRU" menu for quick - access within the menu system. This cannot be disabled, if you hate this feature, - please stick pins into a voodoo doll named "Christian", that is all. - - * The menu strings "Recently" and "Clear entries" are translate()able but MRU is not. - - ---New features (1.0.6.6+) - - * shlext will now use all your icons per protocol, **not** just the first iconset - it finds, it will also use everything properly (because it doesn't do the icon - extraction, it just asks Miranda [don't ask why it didn't do this before :P]) - - * shlext will now use a Translate()'d version of "Miranda" so that each menu - shown for a profile can be given a custom user string - - * reimplemented file/folder selection, finally! a work-as-expected version, it will - scan and add all files and folders you give it, producing a file list in the background - (scanning your drive) and then send the list to Miranda to send to your selected contact. - - * Added option for disabling status icons in menus, which means that you can use shlext - with shell variants/file managers that invoke the shlext interface, such as FAR, but - don't need/use the icons. - - * Added option about hiding offline users from the context menu, if this option is off - it will fall back onto syncing with your contact list's "hide offline users" - - * Added proper thread safety because Miranda 0.3 now has it. - - * Completely reimplemented group parsing, which means that all the old group bugs - can be expected to be gone, note that shlext will now even create menus for - subgroups of the same name, e.g. "Miranda\Miranda". - - * shlext will now not show a menu for a running Miranda fails the following checks: - - * not running shlext (duh) - * no non-offline contacts (or you have the setting 'hide offline users') - * and so on - - * shlext will now also completely ignore contacts on protocols who have no file transfer support - - - ---Features - - shlext can: - - * allow you to refer to your entire contact list from a file/folder context - menu, this includes multiple profiles! if you have Miranda running - different profiles, you'll see all your profiles as menu items as long - as you're running shlext as a Miranda plugin in that profile. - - * Group ability, see a faithful menu rendition of your group hierarchy. - This means you can go something like File->My Profile->Work->Friends->Dude... - - This feature can also be turned off, or enabled in sync with your contact - list option to "Disable groups", this is a per profile setting, i.e. setting - disable groups on one profile won't affect other profiles running shlext. - - * Multi protocol aware, shlext can send to anyone on your contact list - not just ICQ! - - * Each contact will be shown next to their status icon, as selected in your - profile(s) which means that you'll easily feel at home with the icons, - because they will be used as how they are set in each profile. - - * lots of files, shlext will now, if given a directory/folder go into that - folder and scan for files and sub directories/folders til it's added - everything. - - This means if you send c:\foobar, it will search c:\foobar\*.* for more - files to add, it will also add c:\foobar as a directory space to send. - Which means that if the other side hasn't got a 'foobar' directory, it will - be created! (Note: recreating directory trees depends on the protocol being used to send) - - - --Quirks - - * shlext displays all your users by default, if your contact list is set to - NOT show offline users, then shlext will not show them. - - * shlext doesn't use all your group settings, it will not ad here to - "hide offline users in here", however if a group has got offline users - it won't show them (per setting option!) - - - - ---Important changes - - Older versions of shlext did not go into folders more than one level, i.e. - if you added c:\foobar it would scan for c:\foobar\*.* and add all the files - but not go into each directory\folder deeper than that! - - shlext also now does background selection scanning, which means when you select - a group of files/folders/directories, it will let you get on with chating - until it's made a file list which you can send to the person you've selected. - - shlext will NOT send any file/folder/directory that is marked "hidden" - - Also, sometimes you will see "n files, 1 directory" when you say select something - e.g. c:\foobar, this is because shlext now also includes the top level directory so that the - remote side will know to create it, as well as sub directories. - - - - ---But Miranda has drag'n'drop! - - Yeah, that's okay when you can reach Miranda, but I have multiple profiles and - the "hide after NN seconds" option enabled, also I have groups! - - Miranda doesn't auto expand a group when someone is online unless you do that - yourself, which means drag 'n' drop has failed. Also, when you've selected a - large amount of files, Miranda will *freeze* completely whilst - it 1) scans all those files, 2) builds a copy of the given send list - - Whilst shlext only freezes Miranda for the latter, and that is seldom a "complete freeze". - - And of course, shlext uses Miranda 0.3's advanced threading services, which means - if you've asked shlext to build a massive send list, you can still exit Miranda safely - which you can't with drag 'n' drop! - - - - ---Installation - - If you've never installed shlext before, all you have to do is install it like - any other Miranda plugin, i.e. copy it to your plugins directory. - - That's it! you should goto Miranda->Options->Plugins->Shell Context Menus - to see if you'd like to set any of the options, however shlext works straight - out of the box and you don't really need to set anything up after that. - - If you want to use shlext with multiple profiles, you don't have to do any - special setting up either, just make sure that shlext is running with each Miranda - you want shlext to show a menu contact list for. - - Make sure ALL copies of shlext.dll are the same, i.e. 1.0.6.6, if they're not - then shlext will fail (this doesn't mean 'crash'). - - - ---Upgrading/Removing - - Upgrading shlext has always been a pain for users (and me!) this is because - shlext.dll runs in Windows and in Miranda (at the same time). - - So when you've shutdown Miranda, shlext.dll maybe kept in memory by Windows - to make things worse, clicking any file/folder will result in shlext.dll being - reloaded, so if you do shlext.dll->Delete, Windows will ask shlext.dll if - it wants to show any menus, nevermind the fact delete was selected! - - This happens also if you just press 'delete' whilst shlext.dll is selected. - - However! All is not lost, this is what you do: - - * goto M->Options->Plugins and disable shlext.dll as a Miranda plugin - * goto M->Options->Plugins->Shell context menus and click 'Remove'. - * Shutdown Miranda IM - - Advanced users only: ---------------------------------------------------- - - * Do all the above and then open a console window (Command prompt, etc) - * Make sure all applications have been shutdown - * Goto the directory where Miranda is, e.g. c:\, cd Miranda - * Goto Start->Shutdown, let the dialog come up and hold CTRL+ALT+SHIFT - and press cancel. - - This will shutdown Explorer but not Windows, you can now do: del shlext.dll - - * now run Explorer.exe usually in C:\Windows, shlext.dll will be removed. - - ---------------------------------------------------------------------------- - - The remove button will ask Windows not to load it anymore, by removing - all shlext registry entries, the button will also remove any settings from your - profile settings database that it may of made. - - You should now be able to delete shlext.dll! however if you still are unable - to, you may need to log out (if you're using XP/2000/NT) if you're using - 9x then you may have to restart Windows (pain I know, sorry!) - - You should now be free of old shlext copies and you can refer to "Installation" - above. - - If you were using shlext.dll with multiple profiles, the remove shlext - from each profile as stated above and then copy the newer shlext.dll to - your plugins folder. - - ---Translation - - I haven't been nice about translation strings in the past, but you - can pretty much translate everything shlext uses a string, even - "Miranda" which is shown in the menu. - - Note that some strings can't be translated, this is because some parts - of the plugin run within Explorer and that doesn't have access to Miranda's - langpacks, the "Miranda" string that appears in menus is a special exception - - ; - ; Translate()'able strings for shlext/2.0.0.9 - ; - - ;"Miranda" limited to 63characters! (exceed and it's chopped) - ;[Miranda] - ;[Problem, registration missing/deleted.] - ;[Successfully created shell registration.] - ;[Not Approved] - ;[Approved] - ;[Are you sure? this will remove all the settings stored in your database and all registry entries created for shlext to work with Explorer] - ;[Disable/Remove shlext] - ;[Shell context menus] - - ; new in 2.0.0.9, both these strings cannot be longer than 63 chracters - ;[Clear entries] - ;[Recently] - - ;IDD_SHLOPTS - ;[Menus] - ;[Display contacts in their assigned groups (if any)] - ;[Only if/when the contact list is using them] - ;[Display hidden, ignored or temporary contacts] - ;[Shell Status] - ;[Do not display the profile name in use] - ;[Contact Status] - ;[Show contacts that you have set privacy rules for] - ;[Remove] - ;[Do not show status icons in menus] - ;[Do not show contacts that are offline, even if my contact list does] - - - - - ---License - - Like Miranda, shlext is released under the GPL, you may find the full - FreePascal source-code on the CVS in plugins module 'shlext' - - You will need at least FreePascal/2.2.2, GNU make (if you want to use the makefile) - - Follow the CVS links from http://sf.net/projects/miranda-icq/ - - Note: All the tools used to build shlext are also under the GPL! - - - ---Contact/Bug reporting - - In the past shlext hasn't been as stable as it could be, but this was mainly - due to the problems of 0.2.0.0 and early 0.3.0.0 Miranda builds, I've taken - care to make sure things are stable as can be. - - If you have any problems/crashes, please contact me at: egodust at users.sf.net. - - Please include the following information: Windows version, service packs installed, - build version of Explorer, Miranda version, shlext version, a list of plugins - that you think maybe involved in crashes, steps to reproduce errors and so on. - - Note that shlext has been blamed for several bugs that were not shlext's fault, - for example the file xfer cancel bug was in ICQ and Miranda but not shlext ;) - - - ---Credits - - Tig-crash\d - Thanks for beta testing every version before this one ;) - Erik?, DD Of Borg - Thanks for beta testing 0.0.2.2/1.0.6.6 -- ideas and suggestions - as well what to exactly steal from ShellFileSend, heh.. \ No newline at end of file diff --git a/plugins/ShlExt/make.bat b/plugins/ShlExt/make.bat deleted file mode 100644 index f97c5ed9a3..0000000000 --- a/plugins/ShlExt/make.bat +++ /dev/null @@ -1,25 +0,0 @@ -@echo off -set p1=%1 -set p2=%2 -if "%p1%" == "" (echo "please specify target platform by adding 'fpc' or 'fpc64 parameter to command line!'"&&pause&&goto :EOF) -if "%p2%" == "" (echo "please specify target output directory by adding 10 for bin10 or 11 for bin11 to command line!'"&&pause&&goto :EOF) -if /i '%1' == 'fpc' ( - set OUTDIR="..\..\bin%2\Release\Plugins" - set FPCBIN=fpc.exe -) else if /i '%1' == 'fpc64' ( - set OUTDIR="..\..\bin%2\Release64\Plugins" - set FPCBIN=ppcrossx64.exe -) -set PROJECT=ShlExt - -if not exist %OUTDIR% mkdir %OUTDIR% -md tmp - -%FPCBIN% @..\Utils.pas\fpc.cfg %PROJECT%.dpr %3 %4 %5 %6 %7 %8 %9 -if errorlevel 1 exit /b 1 - -move .\tmp\%PROJECT%.dll %OUTDIR% -move .\tmp\%PROJECT%.map . -del /Q tmp\* -rd tmp -exit /b 0 diff --git a/plugins/ShlExt/resource.h b/plugins/ShlExt/resource.h deleted file mode 100644 index c89660a88d..0000000000 --- a/plugins/ShlExt/resource.h +++ /dev/null @@ -1,13 +0,0 @@ -#define IDD_SHLOPTS 101 -#define IDC_USEGROUPS 1014 -#define IDC_CLISTGROUPS 1015 -#define IDC_SHOWFULL 1016 -#define IDC_NOPROF 1020 -#define IDC_SHOWINVISIBLES 1021 -#define IDC_HIDEOFFLINE 1022 -#define IDC_STATUS 1023 -#define IDC_CAPMENUS 1025 -#define IDC_CAPSTATUS 1026 -#define IDC_CAPSHLSTATUS 1027 -#define IDC_REMOVE 1028 -#define IDC_USEOWNERDRAW 1029 diff --git a/plugins/ShlExt/shlc.inc b/plugins/ShlExt/shlc.inc deleted file mode 100644 index 2952de8c74..0000000000 --- a/plugins/ShlExt/shlc.inc +++ /dev/null @@ -1,144 +0,0 @@ -{$IFDEF SHL_IDC} - -const - IDD_SHLOPTS = 101; - IDC_USEGROUPS = 1014; - IDC_CLISTGROUPS = 1015; - // Show "HIT" - IDC_SHOWFULL = 1016; - IDC_NOPROF = 1020; - IDC_SHOWINVISIBLES = 1021; - IDC_HIDEOFFLINE = 1022; - // only in the options dialog - IDC_STATUS = 1023; - IDC_CAPMENUS = 1025; - IDC_CAPSTATUS = 1026; - IDC_CAPSHLSTATUS = 1027; - IDC_REMOVE = 1028; - IDC_USEOWNERDRAW = 1029; -{$ENDIF} -{$IFDEF SHL_KEYS} - -const - SHLExt_Name: PChar = 'shlext15'; - SHLExt_MRU: PChar = 'MRU'; - SHLExt_UseGroups: PChar = 'UseGroups'; - SHLExt_UseCListSetting: PChar = 'UseCLGroups'; - SHLExt_UseHITContacts: PChar = 'UseHITContacts'; - // HIT2 contacts will get your messages but don't know your state - SHLExt_UseHIT2Contacts: PChar = 'UseHIT2Contacts'; - SHLExt_ShowNoProfile: PChar = 'ShowNoProfile'; - SHLExt_ShowNoIcons: PChar = 'ShowNoIcons'; - SHLExt_ShowNoOffline: PChar = 'ShowNoOffline'; -{$ENDIF} -{$IFDEF SHLCOM} - -const - - S_OK = 0; - S_FALSE = 1; - - E_UNEXPECTED = $8000FFFF; - E_NOTIMPL = $80004001; - E_INVALIDARG = $80070057; - - CLASS_E_NOAGGREGATION = $80040110; - CLASS_E_CLASSNOTAVAILABLE = $80040111; - - CLSCTX_INPROC_SERVER = $1; - - { for FORMATETC } - - TYMED_HGLOBAL = 1; - DVASPECT_CONTENT = 1; - -type - - PGUID = ^TGUID; - - TGUID = record - D1: Longword; - D2: Word; - D3: Word; - D4: array [0 .. 7] of Byte; - end; - - TIID = TGUID; - TCLSID = TGUID; - - TStgMedium = record - tymed: Longint; - case Integer of - 0: (hBitmap: hBitmap; unkForRelease: Pointer { IUnknown } ); - 1: (hMetaFilePict: THandle); - 2: (hEnhMetaFile: THandle); - 3: (hGlobal: hGlobal); - 4: (lpszFileName: Pointer { POleStr } ); - 5: (stm: Pointer { IUnknown } ); - 6: (stg: Pointer { IStorage } ); - end; - - PFormatEtc = ^TFormatEtc; - - TFormatEtc = record - cfFormat: Word; { TClipFormat; } - ptd: Pointer; { PDVTargetDevice; } - dwAspect: Longint; - lindex: Longint; - tymed: Longint; - end; - -{$ENDIF} -{$IFDEF COM_STRUCTS} - -const - - IID_IUnknown: TGUID = (D1: $00000000; D2: $0000; D3: $0000; - D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); - - IID_IClassFactory: TGUID = (D1: $00000001; D2: $0000; D3: $0000; - D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); - - IID_IShellExtInit: TGUID = (D1: $000214E8; D2: $0000; D3: $0000; - D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); - - IID_IContextMenu: TGUID = (D1: $000214E4; D2: $0000; D3: $0000; - D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); - - IID_IContextMenu2: TGUID = (D1: $000214F4; D2: $0000; D3: $0000; - D4: ($C0, $00, $00, $00, $00, $00, $00, $46)); - - IID_IContextMenu3: TGUID = (D1: $BCFCE0A0; D2: $EC17; D3: $11D0; - D4: ($8D, $10, $00, $A0, $C9, $0F, $27, $19)); - - IID_WICImagingFactory: TGUID = (D1: $EC5EC8A9; D2: $C395; D3: $4314; - D4: ($9C, $77, $54, $D7, $A9, $35, $FF, $70)); - - - // Vista+ only - - CLSID_WICImagingFactory: TGUID = (D1: $CACAF262; D2: $9370; D3: $4615; - D4: ($A1, $3B, $9F, $55, $39, $DA, $4C, $0A)); - - // anything before 0.0.1.5 was : {A321A032-7976-11d6-A310-ED893982BF28} - // changed to a new GUID to avoid older plugins - // {72013A26-A94C-11d6-8540-A5E62932711D} - // the IPC header now checks the plugin version given anyway. - - CLSID_ISHLCOM: TGUID = (D1: $72013A26; D2: $A94C; D3: $11D6; - D4: ($85, $40, $A5, $E6, $29, $32, $71, $1D);); -{$ENDIF} -{$IFDEF COMAPI} -function CoCreateInstance(const rclsid: TCLSID; pUnkOuter: Pointer; dwClsContext: DWORD; - const riid: TIID; var ppv): HResult; stdcall; external 'ole32.dll' name 'CoCreateInstance'; -procedure ReleaseStgMedium(var medium: TStgMedium); stdcall; - external 'ole32.dll' name 'ReleaseStgMedium'; -function IsEqualGUID(const guid1, guid2: TGUID): Boolean; stdcall; - external 'ole32.dll' name 'IsEqualGUID'; -function IsEqualIID(const iid1, iid2: TIID): Boolean; stdcall; - external 'ole32.dll' name 'IsEqualGUID'; -function IsEqualCLSID(const clsid1, clsid2: TCLSID): Boolean; stdcall; - external 'ole32.dll' name 'IsEqualGUID'; -function QueueUserAPC(pfnAPC: Pointer; hThread: THandle; dwData: DWORD): BOOL; stdcall; - external 'kernel32' name 'QueueUserAPC'; -{$ENDIF} diff --git a/plugins/ShlExt/shlcom.pas b/plugins/ShlExt/shlcom.pas deleted file mode 100644 index 93a5d27695..0000000000 --- a/plugins/ShlExt/shlcom.pas +++ /dev/null @@ -1,2471 +0,0 @@ -unit shlcom; - -{$IFDEF FPC} -{$PACKRECORDS 4} -{$MODE Delphi} -{$ENDIF} - -interface - -uses - - Windows, m_api, shlipc, shlicons; - -{$DEFINE COM_STRUCTS} -{$DEFINE SHLCOM} -{$INCLUDE shlc.inc} -{$UNDEF SHLCOM} -{$UNDEF COM_STRUCTS} -function DllGetClassObject(const CLSID: TCLSID; const IID: TIID; var Obj): HResult; stdcall; -function DllCanUnloadNow: HResult; stdcall; - -procedure InvokeThreadServer; - -procedure CheckRegisterServer; - -procedure CheckUnregisterServer; - -function RemoveCOMRegistryEntries: HResult; - -function ExtractIcon(hInst: THandle; pszExe: PChar; nIndex: Integer): HICON; stdcall; - external 'shell32.dll' name 'ExtractIconA'; - -implementation - -var - dllpublic: record - FactoryCount: Integer; - ObjectCount: Integer; - end; - - VistaOrLater:Boolean; - -{$DEFINE COMAPI} -{$INCLUDE shlc.inc} -{$UNDEF COMAPI} - -const - - IPC_PACKET_SIZE = $1000 * 32; - // IPC_PACKET_NAME = 'm.mi.miranda.ipc'; // prior to 1.0.6.6 - // IPC_PACKET_NAME = 'mi.miranda.IPCServer'; // prior to 2.0.0.9 - IPC_PACKET_NAME = 'm.mi.miranda.ipc.server'; - -const - - { Flags returned by IContextMenu*:QueryContextMenu() } - - CMF_NORMAL = $00000000; - CMF_DEFAULTONLY = $00000001; - CMF_VERBSONLY = $00000002; - CMF_EXPLORE = $00000004; - CMF_NOVERBS = $00000008; - CMF_CANRENAME = $00000010; - CMF_NODEFAULT = $00000020; - CMF_INCLUDESTATIC = $00000040; - CMF_RESERVED = $FFFF0000; { view specific } - - { IContextMenu*:GetCommandString() uType flags } - - GCS_VERBA = $00000000; // canonical verb - GCS_HELPTEXTA = $00000001; // help text (for status bar) - GCS_VALIDATEA = $00000002; // validate command exists - GCS_VERBW = $00000004; // canonical verb (unicode) - GC_HELPTEXTW = $00000005; // help text (unicode version) - GCS_VALIDATEW = $00000006; // validate command exists (unicode) - GCS_UNICODE = $00000004; // for bit testing - Unicode string - GCS_VERB = GCS_VERBA; // - GCS_HELPTEXT = GCS_HELPTEXTA; - GCS_VALIDATE = GCS_VALIDATEA; - -type - - { this structure is returned by InvokeCommand() } - - PCMInvokeCommandInfo = ^TCMInvokeCommandInfo; - - TCMInvokeCommandInfo = packed record - cbSize: DWORD; - fMask: DWORD; - hwnd: hwnd; - lpVerb: PChar; { maybe index, type cast as Integer } - lpParams: PChar; - lpDir: PChar; - nShow: Integer; - dwHotkey: DWORD; - HICON: THandle; - end; - - { completely stolen from modules.c: 'NameHashFunction' modified slightly } - -function StrHash(const szStr: PChar): DWORD;// cdecl; -begin - result:=mir_hash(szStr,strlen(szStr)); -{ -asm - // esi content has to be preserved with basm - push esi - xor edx,edx - xor eax,eax - mov esi,szStr - mov al,[esi] - xor cl,cl -@@lph_top: // only 4 of 9 instructions in here don't use AL, so optimal pipe use is impossible - xor edx,eax - inc esi - xor eax,eax - and cl,31 - mov al,[esi] - add cl,5 - test al,al - rol eax,cl // rol is u-pipe only, but pairable - // rol doesn't touch z-flag - jnz @@lph_top // 5 clock tick loop. not bad. - xor eax,edx - pop esi -} -end; - -function CreateProcessUID(const pid: Cardinal): string; -var - pidrep: string[16]; -begin - str(pid, pidrep); - Result := Concat('mim.shlext.', pidrep, '$'); -end; - -function CreateUID: string; -var - pidrep, tidrep: string[16]; -begin - str(GetCurrentProcessId(), pidrep); - str(GetCurrentThreadId(), tidrep); - Result := Concat('mim.shlext.caller', pidrep, '$', tidrep); -end; - -// FPC doesn't support array[0..n] of Char extended syntax with Str() - -function wsprintf(lpOut, lpFmt: PChar; ArgInt: Integer): Integer; cdecl; - external 'user32.dll' name 'wsprintfA'; - -procedure str(i: Integer; S: PChar); -begin - i := wsprintf(S, '%d', i); - if i > 2 then - PChar(S)[i] := #0; -end; - -{ IShlCom } - -type - - PLResult = ^LResult; - - // bare minimum interface of IDataObject, since GetData() is only required. - - PVTable_IDataObject = ^TVTable_IDataObject; - - TVTable_IDataObject = record - { IUnknown } - QueryInterface: Pointer; - AddRef: function(Self: Pointer): Cardinal; stdcall; - Release: function(Self: Pointer): Cardinal; stdcall; - { IDataObject } - GetData: function(Self:Pointer; var formatetcIn:TFormatEtc; var medium:TStgMedium): HResult; stdcall; - GetDataHere: Pointer; - QueryGetData: Pointer; - GetCanonicalFormatEtc: Pointer; - SetData: Pointer; - EnumFormatEtc: Pointer; - DAdvise: Pointer; - DUnadvise: Pointer; - EnumDAdvise: Pointer; - end; - - PDataObject_Interface = ^TDataObject_Interface; - - TDataObject_Interface = record - ptrVTable: PVTable_IDataObject; - end; - - { TShlComRec inherits from different interfaces with different function tables - all "compiler magic" is lost in this case, but it's pretty easy to return - a different function table for each interface, IContextMenu is returned - as IContextMenu'3' since it inherits from '2' and '1' } - - PVTable_IShellExtInit = ^TVTable_IShellExtInit; - - TVTable_IShellExtInit = record - { IUnknown } - QueryInterface: Pointer; - AddRef: Pointer; - Release: Pointer; - { IShellExtInit } - Initialise: Pointer; - end; - - PShlComRec = ^TShlComRec; - PShellExtInit_Interface = ^TShellExtInit_Interface; - - TShellExtInit_Interface = record - { pointer to function table } - ptrVTable: PVTable_IShellExtInit; - { instance data } - ptrInstance: PShlComRec; - { function table itself } - vTable: TVTable_IShellExtInit; - end; - - PVTable_IContextMenu3 = ^TVTable_IContextMenu3; - - TVTable_IContextMenu3 = record - { IUnknown } - QueryInterface: Pointer; - AddRef: Pointer; - Release: Pointer; - { IContextMenu } - QueryContextMenu: Pointer; - InvokeCommand: Pointer; - GetCommandString: Pointer; - { IContextMenu2 } - HandleMenuMsg: Pointer; - { IContextMenu3 } - HandleMenuMsg2: Pointer; - end; - - PContextMenu3_Interface = ^TContextMenu3_Interface; - - TContextMenu3_Interface = record - ptrVTable: PVTable_IContextMenu3; - ptrInstance: PShlComRec; - vTable: TVTable_IContextMenu3; - end; - - PCommon_Interface = ^TCommon_Interface; - - TCommon_Interface = record - ptrVTable: Pointer; - ptrInstance: PShlComRec; - end; - - TShlComRec = record - ShellExtInit_Interface: TShellExtInit_Interface; - ContextMenu3_Interface: TContextMenu3_Interface; - { fields } - RefCount: LongInt; - // this is owned by the shell after items are added 'n' is used to - // grab menu information directly via id rather than array indexin' - hRootMenu: THandle; - idCmdFirst: Integer; - // most of the memory allocated is on this heap object so HeapDestroy() - // can do most of the cleanup, extremely lazy I know. - hDllHeap: THandle; - // This is a submenu that recently used contacts are inserted into - // the contact is inserted twice, once in its normal list (or group) and here - // Note: These variables are global data, but refered to locally by each instance - // Do not rely on these variables outside the process enumeration. - hRecentMenu: THandle; - RecentCount: Cardinal; // number of added items - // array of all the protocol icons, for every running instance! - ProtoIcons: ^TSlotProtoIconsArray; - ProtoIconsCount: Cardinal; - // maybe null, taken from IShellExtInit_Initalise() and AddRef()'d - // only used if a Miranda instance is actually running and a user - // is selected - pDataObject: PDataObject_Interface; - // DC is used for font metrics and saves on creating and destroying lots of DC handles - // during WM_MEASUREITEM - hMemDC: HDC; - end; - - { this is passed to the enumeration callback so it can process PID's with - main windows by the class name MIRANDANAME loaded with the plugin - and use the IPC stuff between enumerations -- } - - PEnumData = ^TEnumData; - - TEnumData = record - Self: PShlComRec; - // autodetected, don't hard code since shells that don't support it - // won't send WM_MEASUREITETM/WM_DRAWITEM at all. - bOwnerDrawSupported: LongBool; - // as per user setting (maybe of multiple Mirandas) - bShouldOwnerDraw: LongBool; - idCmdFirst: Integer; - ipch: PHeaderIPC; - // OpenEvent()'d handle to give each IPC server an object to set signalled - hWaitFor: THandle; - pid: DWORD; // sub-unique value used to make work object name - end; - -procedure FreeGroupTreeAndEmptyGroups(hParentMenu: THandle; pp, p: PGroupNode); -var - q: PGroupNode; -begin - while p <> nil do - begin - q := p^.Right; - if p^.Left <> nil then - begin - FreeGroupTreeAndEmptyGroups(p^.Left^.hMenu, p, p^.Left); - end; // if - if p^.dwItems = 0 then - begin - if pp <> nil then - begin - DeleteMenu(pp^.hMenu, p^.hMenuGroupID, MF_BYCOMMAND) - end - else - begin - DeleteMenu(hParentMenu, p^.hMenuGroupID, MF_BYCOMMAND); - end; // if - end - else - begin - // make sure this node's parent know's it exists - if pp <> nil then - inc(pp^.dwItems); - end; - Dispose(p); - p := q; - end; -end; - -procedure DecideMenuItemInfo(pct: PSlotIPC; pg: PGroupNode; var mii: TMenuItemInfo; lParam: PEnumData); -var - psd: PMenuDrawInfo; - hDllHeap: THandle; - c: Cardinal; - pp: ^TSlotProtoIconsArray; -begin - mii.wID := lParam^.idCmdFirst; - inc(lParam^.idCmdFirst); - // get the heap object - hDllHeap := lParam^.Self^.hDllHeap; - psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); - if pct <> nil then - begin - psd^.cch := pct^.cbStrSection - 1; // no null; - psd^.szText := HeapAlloc(hDllHeap, 0, pct^.cbStrSection); - lstrcpya(psd^.szText, PChar(uint_ptr(pct) + sizeof(TSlotIPC))); - psd^.hContact := pct^.hContact; - psd^.fTypes := [dtContact]; - // find the protocol icon array to use and which status - c := lParam^.Self^.ProtoIconsCount; - pp := lParam^.Self^.ProtoIcons; - psd^.hStatusIcon := 0; - while c > 0 do - begin - dec(c); - if (pp[c].hProto = pct^.hProto) and (pp[c].pid = lParam^.pid) then - begin - psd^.hStatusIcon := pp[c].hIcons[pct^.Status - ID_STATUS_OFFLINE]; - psd^.hStatusBitmap := pp[c].hBitmaps[pct^.Status - ID_STATUS_OFFLINE]; - break; - end; - end; // while - psd^.pid := lParam^.pid; - end - else if pg <> nil then - begin - // store the given ID - pg^.hMenuGroupID := mii.wID; - // steal the pointer from the group node it should be on the heap - psd^.cch := pg^.cchGroup; - psd^.szText := pg^.szGroup; - psd^.fTypes := [dtGroup]; - end; // if - psd^.wID := mii.wID; - psd^.szProfile := nil; - // store - mii.dwItemData := uint_ptr(psd); - - if ((lParam^.bOwnerDrawSupported) and (lParam^.bShouldOwnerDraw)) then - begin - mii.fType := MFT_OWNERDRAW; - Pointer(mii.dwTypeData) := psd; - end - else - begin - // normal menu - mii.fType := MFT_STRING; - if pct <> nil then - begin - uint_ptr(mii.dwTypeData) := uint_ptr(pct) + sizeof(TSlotIPC); - end - else - begin - mii.dwTypeData := pg^.szGroup; - end; - { For Vista + let the system draw the theme and icons, pct = contact associated data } - if VistaOrLater and (pct <> nil) and (psd <> nil) then - begin - mii.fMask := MIIM_BITMAP or MIIM_FTYPE or MIIM_ID or MIIM_DATA or MIIM_STRING; - // BuildSkinIcons() built an array of bitmaps which we can use here - mii.hBmpItem := psd^.hStatusBitmap; - end; - end; // if -end; - -// must be called after DecideMenuItemInfo() -procedure BuildMRU(pct: PSlotIPC; var mii: TMenuItemInfo; lParam: PEnumData); -begin - if pct^.MRU > 0 then - begin - inc(lParam^.Self^.RecentCount); - // lParam^.Self == pointer to object data - InsertMenuitem(lParam^.Self^.hRecentMenu, $FFFFFFFF, True, mii); - end; -end; - -procedure BuildContactTree(group: PGroupNode; lParam: PEnumData); -label - grouploop; -var - pct: PSlotIPC; - pg, px: PGroupNode; - str: TStrTokRec; - sz: PChar; - Hash: Cardinal; - Depth: Cardinal; - mii: TMenuItemInfo; -begin - // set up the menu item - mii.cbSize := sizeof(TMenuItemInfo); - mii.fMask := MIIM_ID or MIIM_TYPE or MIIM_DATA; - // set up the scanner - str.szSet := ['\']; - str.bSetTerminator := False; - // go thru all the contacts - pct := lParam^.ipch^.ContactsBegin; - while (pct <> nil) and (pct^.cbSize = sizeof(TSlotIPC)) and (pct^.fType = REQUEST_CONTACTS) do - begin - if pct^.hGroup <> 0 then - begin - // at the end of the slot header is the contact's display name - // and after a double NULL char there is the group string, which has the full path of the group - // this must be tokenised at '\' and we must walk the in memory group tree til we find our group - // this is faster than the old version since we only ever walk one or at most two levels of the tree - // per tokenised section, and it doesn't matter if two levels use the same group name (which is valid) - // as the tokens processed is equatable to depth of the tree - str.szStr := PChar(uint_ptr(pct) + sizeof(TSlotIPC) + uint_ptr(pct^.cbStrSection) + 1); - sz := StrTok(str); - // restore the root - pg := group; - Depth := 0; - while sz <> nil do - begin - Hash := StrHash(sz); - // find this node within - while pg <> nil do - begin - // does this node have the right hash and the right depth? - if (Hash = pg^.Hash) and (Depth = pg^.Depth) then - break; - // each node may have a left pointer going to a sub tree - // the path syntax doesn't know if a group is a group at the same level - // or a nested one, which means the search node can be anywhere - px := pg^.Left; - if px <> nil then - begin - // keep searching this level - while px <> nil do - begin - if (Hash = px^.Hash) and (Depth = px^.Depth) then - begin - // found the node we're looking for at the next level to pg, px is now pq for next time - pg := px; - goto grouploop; - end; // if - px := px^.Right; - end; // if - end; // if - pg := pg^.Right; - end; // while - grouploop: - inc(Depth); - // process next token - sz := StrTok(str); - end; // while - // tokenisation finished, if pg <> nil then the group is found - if pg <> nil then - begin - DecideMenuItemInfo(pct, nil, mii, lParam); - BuildMRU(pct, mii, lParam); - InsertMenuitem(pg^.hMenu, $FFFFFFFF, True, mii); - inc(pg^.dwItems); - end; - end; // if - pct := pct^.Next; - end; // while -end; - -procedure BuildMenuGroupTree(p: PGroupNode; lParam: PEnumData; hLastMenu: hMenu); -var - mii: TMenuItemInfo; -begin - mii.cbSize := sizeof(TMenuItemInfo); - mii.fMask := MIIM_ID or MIIM_DATA or MIIM_TYPE or MIIM_SUBMENU; - // go thru each group and create a menu for it adding submenus too. - while p <> nil do - begin - mii.hSubMenu := CreatePopupMenu(); - if p^.Left <> nil then - BuildMenuGroupTree(p^.Left, lParam, mii.hSubMenu); - p^.hMenu := mii.hSubMenu; - DecideMenuItemInfo(nil, p, mii, lParam); - InsertMenuitem(hLastMenu, $FFFFFFFF, True, mii); - p := p^.Right; - end; // while -end; - -{ this callback is triggered by the menu code and IPC is already taking place, - just the transfer type+data needs to be setup } -function ClearMRUIPC(pipch: PHeaderIPC; // IPC header info, already mapped - hWorkThreadEvent: THandle; // event object being waited on on miranda thread - hAckEvent: THandle; // ack event object that has been created - psd: PMenuDrawInfo // command/draw info - ): Integer; stdcall; -begin - Result := S_OK; - ipcPrepareRequests(IPC_PACKET_SIZE, pipch, REQUEST_CLEARMRU); - ipcSendRequest(hWorkThreadEvent, hAckEvent, pipch, 100); -end; - -procedure RemoveCheckmarkSpace(hMenu: hMenu); -const - MIM_STYLE = $00000010; - MNS_CHECKORBMP = $4000000; -type - TMENUINFO = record - cbSize: DWORD; - fMask: DWORD; - dwStyle: DWORD; - cyMax: LongInt; - hbrBack: THandle; - dwContextHelpID: DWORD; - dwMenuData: Pointer; - end; -var - SetMenuInfo: function(hMenu: hMenu; var mi: TMENUINFO): Boolean; stdcall; - mi: TMENUINFO; -begin - if not VistaOrLater then - Exit; - SetMenuInfo := GetProcAddress(GetModuleHandle('user32'), 'SetMenuInfo'); - if @SetMenuInfo = nil then - Exit; - mi.cbSize := sizeof(mi); - mi.fMask := MIM_STYLE; - mi.dwStyle := MNS_CHECKORBMP; - SetMenuInfo(hMenu, mi); -end; - -procedure BuildMenus(lParam: PEnumData); -{$DEFINE SHL_IDC} -{$DEFINE SHL_KEYS} -{$INCLUDE shlc.inc} -{$UNDEF SHL_KEYS} -{$UNDEF SHL_IDC} -var - hBaseMenu: hMenu; - hGroupMenu: hMenu; - pg: PSlotIPC; - mii: TMenuItemInfo; - j: TGroupNodeList; - p, q: PGroupNode; - Depth, Hash: Cardinal; - Token: PChar; - tk: TStrTokRec; - hDllHeap: THandle; - psd: PMenuDrawInfo; - c: Cardinal; - pp: ^TSlotProtoIconsArray; -begin - ZeroMemory(@mii, sizeof(mii)); - hDllHeap := lParam^.Self^.hDllHeap; - hBaseMenu := lParam^.Self^.hRootMenu; - // build an in memory tree of the groups - pg := lParam^.ipch^.GroupsBegin; - tk.szSet := ['\']; - tk.bSetTerminator := False; - j.First := nil; - j.Last := nil; - while pg <> nil do - begin - if (pg^.cbSize <> sizeof(TSlotIPC)) or (pg^.fType <> REQUEST_GROUPS) then - break; - Depth := 0; - p := j.First; // start at root again - // get the group - uint_ptr(tk.szStr) := (uint_ptr(pg) + sizeof(TSlotIPC)); - // find each word between \ and create sub groups if needed. - Token := StrTok(tk); - while Token <> nil do - begin - Hash := StrHash(Token); - // if the (sub)group doesn't exist, create it. - q := FindGroupNode(p, Hash, Depth); - if q = nil then - begin - q := AllocGroupNode(@j, p, Depth); - q^.Depth := Depth; - // this is the hash of this group node, but it can be anywhere - // i.e. Foo\Foo this is because each node has a different depth - // trouble is contacts don't come with depths! - q^.Hash := Hash; - // don't assume that pg^.hGroup's hash is valid for this token - // since it maybe Miranda\Blah\Blah and we have created the first node - // which maybe Miranda, thus giving the wrong hash - // since "Miranda" can be a group of it's own and a full path - q^.cchGroup := lstrlena(Token); - q^.szGroup := HeapAlloc(hDllHeap, 0, q^.cchGroup + 1); - lstrcpya(q^.szGroup, Token); - q^.dwItems := 0; - end; - p := q; - inc(Depth); - Token := StrTok(tk); - end; // while - pg := pg^.Next; - end; // while - // build the menus inserting into hGroupMenu which will be a submenu of - // the instance menu item. e.g. Miranda -> [Groups ->] contacts - hGroupMenu := CreatePopupMenu(); - - // allocate MRU menu, this will be associated with the higher up menu - // so doesn't need to be freed (unless theres no MRUs items attached) - // This menu is per process but the handle is stored globally (like a stack) - lParam^.Self^.hRecentMenu := CreatePopupMenu(); - lParam^.Self^.RecentCount := 0; - // create group menus only if they exist! - if lParam^.ipch^.GroupsBegin <> nil then - begin - BuildMenuGroupTree(j.First, lParam, hGroupMenu); - // add contacts that have a group somewhere - BuildContactTree(j.First, lParam); - end; - // - mii.cbSize := sizeof(TMenuItemInfo); - mii.fMask := MIIM_ID or MIIM_TYPE or MIIM_DATA; - // add all the contacts that have no group (which maybe all of them) - pg := lParam^.ipch^.ContactsBegin; - while pg <> nil do - begin - if (pg^.cbSize <> sizeof(TSlotIPC)) or (pg^.fType <> REQUEST_CONTACTS) then - break; - if pg^.hGroup = 0 then - begin - DecideMenuItemInfo(pg, nil, mii, lParam); - BuildMRU(pg, mii, lParam); - InsertMenuitem(hGroupMenu, $FFFFFFFF, True, mii); - end; // if - pg := pg^.Next; - end; // while - - // insert MRU menu as a submenu of the contact menu only if - // the MRU list has been created, the menu popup will be deleted by itself - if lParam^.Self^.RecentCount > 0 then - begin - - // insert seperator and 'clear list' menu - mii.fType := MFT_SEPARATOR; - mii.fMask := MIIM_TYPE; - InsertMenuitem(lParam^.Self^.hRecentMenu, $FFFFFFFF, True, mii); - - // insert 'clear MRU' item and setup callback - mii.fMask := MIIM_TYPE or MIIM_ID or MIIM_DATA; - mii.wID := lParam^.idCmdFirst; - inc(lParam^.idCmdFirst); - mii.fType := MFT_STRING; - mii.dwTypeData := lParam^.ipch^.ClearEntries; // "Clear entries" - // allocate menu substructure - psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); - psd^.fTypes := [dtCommand]; - psd^.MenuCommandCallback := @ClearMRUIPC; - psd^.wID := mii.wID; - // this is needed because there is a clear list command per each process. - psd^.pid := lParam^.pid; - Pointer(mii.dwItemData) := psd; - InsertMenuitem(lParam^.Self^.hRecentMenu, $FFFFFFFF, True, mii); - - // insert MRU submenu into group menu (with) ownerdraw support as needed - psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); - psd^.szProfile := 'MRU'; - psd^.fTypes := [dtGroup]; - // the IPC string pointer wont be around forever, must make a copy - psd^.cch := strlen(lParam^.ipch^.MRUMenuName); - psd^.szText := HeapAlloc(hDllHeap, 0, psd^.cch + 1); - lstrcpyn(psd^.szText, lParam^.ipch^.MRUMenuName, sizeof(lParam^.ipch^.MRUMenuName) - 1); - - pointer(mii.dwItemData) := psd; - if (lParam^.bOwnerDrawSupported) and (lParam^.bShouldOwnerDraw) then - begin - mii.fType := MFT_OWNERDRAW; - Pointer(mii.dwTypeData) := psd; - end - else - begin - mii.dwTypeData := lParam^.ipch^.MRUMenuName; // 'Recent'; - end; - mii.wID := lParam^.idCmdFirst; - inc(lParam^.idCmdFirst); - mii.fMask := MIIM_TYPE or MIIM_SUBMENU or MIIM_DATA or MIIM_ID; - mii.hSubMenu := lParam^.Self^.hRecentMenu; - InsertMenuitem(hGroupMenu, 0, True, mii); - end - else - begin - // no items were attached to the MRU, delete the MRU menu - DestroyMenu(lParam^.Self^.hRecentMenu); - lParam^.Self^.hRecentMenu := 0; - end; - - // allocate display info/memory for "Miranda" string - - mii.cbSize := sizeof(TMenuItemInfo); - mii.fMask := MIIM_ID or MIIM_DATA or MIIM_TYPE or MIIM_SUBMENU; - if VistaOrLater then - begin - mii.fMask := MIIM_ID or MIIM_DATA or MIIM_FTYPE or MIIM_SUBMENU or MIIM_STRING or - MIIM_BITMAP; - end; - mii.hSubMenu := hGroupMenu; - - // by default, the menu will have space for icons and checkmarks (on Vista+) and we don't need this - RemoveCheckmarkSpace(hGroupMenu); - - psd := HeapAlloc(hDllHeap, 0, sizeof(TMenuDrawInfo)); - psd^.cch := strlen(lParam^.ipch^.MirandaName); - psd^.szText := HeapAlloc(hDllHeap, 0, psd^.cch + 1); - lstrcpyn(psd^.szText, lParam^.ipch^.MirandaName, sizeof(lParam^.ipch^.MirandaName) - 1); - // there may not be a profile name - pg := lParam^.ipch^.DataPtr; - psd^.szProfile := nil; - if ((pg <> nil) and (pg^.Status = STATUS_PROFILENAME)) then - begin - psd^.szProfile := HeapAlloc(hDllHeap, 0, pg^.cbStrSection); - lstrcpya(psd^.szProfile, PChar(uint_ptr(pg) + sizeof(TSlotIPC))); - end; // if - // owner draw menus need ID's - mii.wID := lParam^.idCmdFirst; - inc(lParam^.idCmdFirst); - psd^.fTypes := [dtEntry]; - psd^.wID := mii.wID; - psd^.hContact := 0; - // get Miranda's icon or bitmap - c := lParam^.Self^.ProtoIconsCount; - pp := lParam^.Self^.ProtoIcons; - while c > 0 do - begin - dec(c); - if (pp[c].pid = lParam^.pid) and (pp[c].hProto = 0) then - begin - // either of these can be 0 - psd^.hStatusIcon := pp[c].hIcons[0]; - mii.hBmpItem := pp[c].hBitmaps[0]; - break; - end; // if - end; // while - pointer(mii.dwItemData) := psd; - if ((lParam^.bOwnerDrawSupported) and (lParam^.bShouldOwnerDraw)) then - begin - mii.fType := MFT_OWNERDRAW; - Pointer(mii.dwTypeData) := psd; - end - else - begin - mii.fType := MFT_STRING; - mii.dwTypeData := lParam^.ipch^.MirandaName; - mii.cch := sizeof(lParam^.ipch^.MirandaName) - 1; - end; - // add it all - InsertMenuitem(hBaseMenu, 0, True, mii); - // free the group tree - FreeGroupTreeAndEmptyGroups(hGroupMenu, nil, j.First); -end; - -procedure BuildSkinIcons(lParam: PEnumData); -var - pct: PSlotIPC; - p, d: PSlotProtoIcons; - Self: PShlComRec; - j: Cardinal; - imageFactory: PImageFactory_Interface; -begin - pct := lParam^.ipch^.NewIconsBegin; - Self := lParam^.Self; - while (pct <> nil) do - begin - if (pct^.cbSize <> sizeof(TSlotIPC)) or (pct^.fType <> REQUEST_NEWICONS) then - break; - uint_ptr(p) := uint_ptr(pct) + sizeof(TSlotIPC); - ReAllocMem(Self^.ProtoIcons, (Self^.ProtoIconsCount + 1) * sizeof(TSlotProtoIcons)); - d := @Self^.ProtoIcons[Self^.ProtoIconsCount]; - CopyMemory(d, p, sizeof(TSlotProtoIcons)); - - { - If using Vista (or later), clone all the icons into bitmaps and keep these around, - if using anything older, just use the default code, the bitmaps (and or icons) will be freed - with the shell object. - } - - imageFactory := nil; - - for j := 0 to 9 do - begin - if imageFactory = nil then - imageFactory := ARGB_GetWorker(); - if VistaOrLater then - begin - d^.hBitmaps[j] := ARGB_BitmapFromIcon(imageFactory, Self^.hMemDC, p^.hIcons[j]); - d^.hIcons[j] := 0; - end - else - begin - d^.hBitmaps[j] := 0; - d^.hIcons[j] := CopyIcon(p^.hIcons[j]); - end; - end; - - if imageFactory <> nil then - begin - imageFactory^.ptrVTable^.Release(imageFactory); - imageFactory := nil; - end; - - inc(Self^.ProtoIconsCount); - pct := pct^.Next; - end; -end; - -function ProcessRequest(hwnd: hwnd; lParam: PEnumData): BOOL; stdcall; -var - pid: Integer; - hMirandaWorkEvent: THandle; - replyBits: Integer; - szBuf: array [0 .. MAX_PATH] of Char; -begin - Result := True; - pid := 0; - GetWindowThreadProcessId(hwnd, @pid); - If pid <> 0 then - begin - // old system would get a window's pid and the module handle that created it - // and try to OpenEvent() a event object name to it (prefixed with a string) - // this was fine for most Oses (not the best way) but now actually compares - // the class string (a bit slower) but should get rid of those bugs finally. - hMirandaWorkEvent := OpenEvent(EVENT_ALL_ACCESS, False, PChar(CreateProcessUID(pid))); - if (hMirandaWorkEvent <> 0) then - begin - GetClassName(hwnd, szBuf, sizeof(szBuf)); - if lstrcmp(szBuf, MirandaName) <> 0 then - begin - // opened but not valid. - CloseHandle(hMirandaWorkEvent); - Exit; - end; // if - end; // if - { If the event object exists, then a shlext.dll running in the instance must of created it. } - If hMirandaWorkEvent <> 0 then - begin - { prep the request } - ipcPrepareRequests(IPC_PACKET_SIZE, lParam^.ipch, REQUEST_ICONS or REQUEST_GROUPS or - REQUEST_CONTACTS or REQUEST_NEWICONS); - // slots will be in the order of icon data, groups then contacts, the first - // slot will contain the profile name - replyBits := ipcSendRequest(hMirandaWorkEvent, lParam^.hWaitFor, lParam^.ipch, 1000); - { replyBits will be REPLY_FAIL if the wait timed out, or it'll be the request - bits as sent or a series of *_NOTIMPL bits where the request bit were, if there are no - contacts to speak of, then don't bother showing this instance of Miranda } - if (replyBits <> REPLY_FAIL) and (lParam^.ipch^.ContactsBegin <> nil) then - begin - // load the address again, the server side will always overwrite it - lParam^.ipch^.pClientBaseAddress := lParam^.ipch; - // fixup all the pointers to be relative to the memory map - // the base pointer of the client side version of the mapped file - ipcFixupAddresses(False, lParam^.ipch); - // store the PID used to create the work event object - // that got replied to -- this is needed since each contact - // on the final menu maybe on a different instance and another OpenEvent() will be needed. - lParam^.pid := pid; - // check out the user options from the server - lParam^.bShouldOwnerDraw := (lParam^.ipch^.dwFlags and HIPC_NOICONS) = 0; - // process the icons - BuildSkinIcons(lParam); - // process other replies - BuildMenus(lParam); - end; - { close the work object } - CloseHandle(hMirandaWorkEvent); - end; // if - end; // if -end; - -function TShlComRec_QueryInterface(Self: PCommon_Interface; const IID: TIID; var Obj): HResult; stdcall; -begin - Pointer(Obj) := nil; - { IShellExtInit is given when the TShlRec is created } - if IsEqualIID(IID, IID_IContextMenu) or IsEqualIID(IID, IID_IContextMenu2) or - IsEqualIID(IID, IID_IContextMenu3) then - begin - with Self^.ptrInstance^ do - begin - Pointer(Obj) := @ContextMenu3_Interface; - inc(RefCount); - end; { with } - Result := S_OK; - end - else - begin - // under XP, it may ask for IShellExtInit again, this fixes the -double- click to see menus issue - // which was really just the object not being created - if IsEqualIID(IID, IID_IShellExtInit) then - begin - with Self^.ptrInstance^ do - begin - Pointer(Obj) := @ShellExtInit_Interface; - inc(RefCount); - end; // if - Result := S_OK; - end - else - begin - Result := CLASS_E_CLASSNOTAVAILABLE; - end; // if - end; // if -end; - -function TShlComRec_AddRef(Self: PCommon_Interface): LongInt; stdcall; -begin - with Self^.ptrInstance^ do - begin - inc(RefCount); - Result := RefCount; - end; { with } -end; - -function TShlComRec_Release(Self: PCommon_Interface): LongInt; stdcall; -var - j, c: Cardinal; -begin - with Self^.ptrInstance^ do - begin - dec(RefCount); - Result := RefCount; - If RefCount = 0 then - begin - // time to go byebye. - with Self^.ptrInstance^ do - begin - // Note MRU menu is associated with a window (indirectly) so windows will free it. - // free icons! - if ProtoIcons <> nil then - begin - c := ProtoIconsCount; - while c > 0 do - begin - dec(c); - for j := 0 to 9 do - begin - with ProtoIcons[c] do - begin - if hIcons[j] <> 0 then - DestroyIcon(hIcons[j]); - if hBitmaps[j] <> 0 then - DeleteObject(hBitmaps[j]); - end; - end; - end; - FreeMem(ProtoIcons); - ProtoIcons := nil; - end; // if - // free IDataObject reference if pointer exists - if pDataObject <> nil then - begin - pDataObject^.ptrVTable^.Release(pDataObject); - end; // if - pDataObject := nil; - // free the heap and any memory allocated on it - HeapDestroy(hDllHeap); - // destroy the DC - if hMemDC <> 0 then - DeleteDC(hMemDC); - end; // with - // free the instance (class record) created - Dispose(Self^.ptrInstance); - dec(dllpublic.ObjectCount); - end; { if } - end; { with } -end; - -function TShlComRec_Initialise(Self: PContextMenu3_Interface; pidLFolder: Pointer; - DObj: PDataObject_Interface; hKeyProdID: HKEY): HResult; stdcall; -begin - // DObj is a pointer to an instance of IDataObject which is a pointer itself - // it contains a pointer to a function table containing the function pointer - // address of GetData() - the instance data has to be passed explicitly since - // all compiler magic has gone. - with Self^.ptrInstance^ do - begin - if DObj <> nil then - begin - Result := S_OK; - // if an instance already exists, free it. - if pDataObject <> nil then - pDataObject^.ptrVTable^.Release(pDataObject); - // store the new one and AddRef() it - pDataObject := DObj; - pDataObject^.ptrVTable^.AddRef(pDataObject); - end - else - begin - Result := E_INVALIDARG; - end; // if - end; // if -end; - -function MAKE_HRESULT(Severity, Facility, Code: Integer): HResult; -{$IFDEF FPC} -inline; -{$ENDIF} -begin - Result := (Severity shl 31) or (Facility shl 16) or Code; -end; - -function TShlComRec_QueryContextMenu(Self: PContextMenu3_Interface; Menu: hMenu; - indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall; -type - TDllVersionInfo = record - cbSize: DWORD; - dwMajorVersion: DWORD; - dwMinorVersion: DWORD; - dwBuildNumber: DWORD; - dwPlatformID: DWORD; - end; - - TDllGetVersionProc = function(var dv: TDllVersionInfo): HResult; stdcall; -var - hShellInst: THandle; - bMF_OWNERDRAW: Boolean; - DllGetVersionProc: TDllGetVersionProc; - dvi: TDllVersionInfo; - ed: TEnumData; - hMap: THandle; - pipch: PHeaderIPC; -begin - Result := 0; - if ((LOWORD(uFlags) and CMF_VERBSONLY) <> CMF_VERBSONLY) and - ((LOWORD(uFlags) and CMF_DEFAULTONLY) <> CMF_DEFAULTONLY) then - begin - bMF_OWNERDRAW := False; - // get the shell version - hShellInst := LoadLibrary('shell32.dll'); - if hShellInst <> 0 then - begin - DllGetVersionProc := GetProcAddress(hShellInst, 'DllGetVersion'); - if @DllGetVersionProc <> nil then - begin - dvi.cbSize := sizeof(TDllVersionInfo); - if DllGetVersionProc(dvi) >= 0 then - begin - // it's at least 4.00 - bMF_OWNERDRAW := (dvi.dwMajorVersion > 4) or (dvi.dwMinorVersion >= 71); - end; // if - end; // if - FreeLibrary(hShellInst); - end; // if - - // if we're using Vista (or later), then the ownerdraw code will be disabled, because the system draws the icons. - if VistaOrLater then - bMF_OWNERDRAW := False; - - hMap := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, IPC_PACKET_SIZE, - IPC_PACKET_NAME); - If (hMap <> 0) and (GetLastError <> ERROR_ALREADY_EXISTS) then - begin - { map the memory to this address space } - pipch := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0); - If pipch <> nil then - begin - { let the callback have instance vars } - ed.Self := Self^.ptrInstance; - // not used 'ere - ed.Self^.hRootMenu := Menu; - // store the first ID to offset with index for InvokeCommand() - Self^.ptrInstance^.idCmdFirst := idCmdFirst; - // store the starting index to offset - Result := idCmdFirst; - ed.bOwnerDrawSupported := bMF_OWNERDRAW; - ed.bShouldOwnerDraw := True; - ed.idCmdFirst := idCmdFirst; - ed.ipch := pipch; - { allocate a wait object so the ST can signal us, it can't be anon - since it has to used by OpenEvent() } - lstrcpya(@pipch^.SignalEventName, PChar(CreateUID())); - { create the wait wait-for-wait object } - ed.hWaitFor := CreateEvent(nil, False, False, pipch^.SignalEventName); - If ed.hWaitFor <> 0 then - begin - { enumerate all the top level windows to find all loaded MIRANDANAME - classes -- } - EnumWindows(@ProcessRequest, lParam(@ed)); - { close the wait-for-reply object } - CloseHandle(ed.hWaitFor); - end; - { unmap the memory from this address space } - UnmapViewOfFile(pipch); - end; { if } - { close the mapping } - CloseHandle(hMap); - // use the MSDN recommended way, thou there ain't much difference - Result := MAKE_HRESULT(0, 0, (ed.idCmdFirst - Result) + 1); - end - else - begin - // the mapping file already exists, which is not good! - end; - end - else - begin - // same as giving a SEVERITY_SUCCESS, FACILITY_NULL, since that - // just clears the higher bits, which is done anyway - Result := MAKE_HRESULT(0, 0, 1); - end; // if -end; - -function TShlComRec_GetCommandString(Self: PContextMenu3_Interface; idCmd, uType: UINT; - pwReserved: PUINT; pszName: PChar; cchMax: UINT): HResult; stdcall; -begin - Result := E_NOTIMPL; -end; - -function ipcGetFiles(pipch: PHeaderIPC; pDataObject: PDataObject_Interface; const hContact: THandle): Integer; -type - TDragQueryFile = function(hDrop: THandle; fileIndex: Integer; FileName: PChar; - cbSize: Integer): Integer; stdcall; -var - fet: TFormatEtc; - stgm: TStgMedium; - pct: PSlotIPC; - iFile: Cardinal; - iFileMax: Cardinal; - hShell: THandle; - DragQueryFile: TDragQueryFile; - cbSize: Integer; - hDrop: THandle; -begin - Result := E_INVALIDARG; - hShell := LoadLibrary('shell32.dll'); - if hShell <> 0 then - begin - DragQueryFile := GetProcAddress(hShell, 'DragQueryFileA'); - if @DragQueryFile <> nil then - begin - fet.cfFormat := CF_HDROP; - fet.ptd := nil; - fet.dwAspect := DVASPECT_CONTENT; - fet.lindex := -1; - fet.tymed := TYMED_HGLOBAL; - Result := pDataObject^.ptrVTable^.GetData(pDataObject, fet, stgm); - if Result = S_OK then - begin - // FIX, actually lock the global object and get a pointer - Pointer(hDrop) := GlobalLock(stgm.hGlobal); - if hDrop <> 0 then - begin - // get the maximum number of files - iFileMax := DragQueryFile(stgm.hGlobal, $FFFFFFFF, nil, 0); - iFile := 0; - while iFile < iFileMax do - begin - // get the size of the file path - cbSize := DragQueryFile(stgm.hGlobal, iFile, nil, 0); - // get the buffer - pct := ipcAlloc(pipch, cbSize + 1); // including null term - // allocated? - if pct = nil then - break; - // store the hContact - pct^.hContact := hContact; - // copy it to the buffer - DragQueryFile(stgm.hGlobal, iFile, PChar(uint_ptr(pct) + sizeof(TSlotIPC)), pct^.cbStrSection); - // next file - inc(iFile); - end; // while - // store the number of files - pipch^.Slots := iFile; - GlobalUnlock(stgm.hGlobal); - end; // if hDrop check - // release the mediumn the lock may of failed - ReleaseStgMedium(stgm); - end; // if - end; // if - // free the dll - FreeLibrary(hShell); - end; // if -end; - -function RequestTransfer(Self: PShlComRec; idxCmd: Integer): Integer; -var - hMap: THandle; - pipch: PHeaderIPC; - mii: TMenuItemInfo; - hTransfer: THandle; - psd: PMenuDrawInfo; - hReply: THandle; - replyBits: Integer; -begin - Result := E_INVALIDARG; - // get the contact information - mii.cbSize := sizeof(TMenuItemInfo); - mii.fMask := MIIM_ID or MIIM_DATA; - if GetMenuItemInfo(Self^.hRootMenu, Self^.idCmdFirst + idxCmd, False, mii) then - begin - // get the pointer - uint_ptr(psd) := mii.dwItemData; - // the ID stored in the item pointer and the ID for the menu must match - if (psd = nil) or (psd^.wID <> mii.wID) then - begin - // MessageBox(0,'ptr assocated with menu is NULL','',MB_OK); - Exit; - end; // if - end - else - begin - // MessageBox(0,'GetMenuItemInfo failed?','',MB_OK); - // couldn't get the info, can't start the transfer - Result := E_INVALIDARG; - Exit; - end; // if - // is there an IDataObject instance? - if Self^.pDataObject <> nil then - begin - // OpenEvent() the work object to see if the instance is still around - hTransfer := OpenEvent(EVENT_ALL_ACCESS, False, PChar(CreateProcessUID(psd^.pid))); - if hTransfer <> 0 then - begin - // map the ipc file again - hMap := CreateFileMapping(INVALID_HANDLE_VALUE,nil,PAGE_READWRITE,0,IPC_PACKET_SIZE,IPC_PACKET_NAME); - if (hMap <> 0) and (GetLastError <> ERROR_ALREADY_EXISTS) then - begin - // map it to process - pipch := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0); - if pipch <> nil then - begin - // create the name of the object to be signalled by the ST - lstrcpya(pipch^.SignalEventName, PChar(CreateUID())); - // create it - hReply := CreateEvent(nil, False, False, pipch^.SignalEventName); - if hReply <> 0 then - begin - if dtCommand in psd^.fTypes then - begin - if Assigned(psd^.MenuCommandCallback) then - Result := psd^.MenuCommandCallback(pipch, hTransfer, hReply, psd); - end - else - begin - - // prepare the buffer - ipcPrepareRequests(IPC_PACKET_SIZE, pipch, REQUEST_XFRFILES); - // get all the files into the packet - if ipcGetFiles(pipch, Self^.pDataObject, psd^.hContact) = S_OK then - begin - // need to wait for the ST to open the mapping object - // since if we close it before it's opened it the data it - // has will be undefined - replyBits := ipcSendRequest(hTransfer, hReply, pipch, 200); - if replyBits <> REPLY_FAIL then - begin - // they got the files! - Result := S_OK; - end; // if - end; - - end; - // close the work object name - CloseHandle(hReply); - end; // if - // unmap it from this process - UnmapViewOfFile(pipch); - end; // if - // close the map - CloseHandle(hMap); - end; // if - // close the handle to the ST object name - CloseHandle(hTransfer); - end; // if - end // if; -end; - -function TShlComRec_InvokeCommand(Self: PContextMenu3_Interface; - var lpici: TCMInvokeCommandInfo): HResult; stdcall; -begin - Result := RequestTransfer(Self^.ptrInstance, LOWORD(uint_ptr(lpici.lpVerb))); -end; - -function TShlComRec_HandleMenuMsgs(Self: PContextMenu3_Interface; uMsg: UINT; wParam: wParam; - lParam: lParam; pResult: PLResult): HResult; -const - WM_DRAWITEM = $002B; - WM_MEASUREITEM = $002C; -var - dwi: PDrawItemStruct; - msi: PMeasureItemStruct; - psd: PMenuDrawInfo; - ncm: TNonClientMetrics; - hOldFont: THandle; - hFont: THandle; - tS: TSize; - dx: Integer; - hBr: HBRUSH; - icorc: TRect; - hMemDC: HDC; -begin - pResult^ := Integer(True); - if (uMsg = WM_DRAWITEM) and (wParam = 0) then - begin - // either a main sub menu, a group menu or a contact - dwi := PDrawItemStruct(lParam); - uint_ptr(psd) := dwi^.itemData; - // don't fill - SetBkMode(dwi^.HDC, TRANSPARENT); - // where to draw the icon? - icorc.Left := 0; - // center it - with dwi^ do - icorc.Top := rcItem.Top + ((rcItem.Bottom - rcItem.Top) div 2) - (16 div 2); - icorc.Right := icorc.Left + 16; - icorc.Bottom := icorc.Top + 16; - // draw for groups - if (dtGroup in psd^.fTypes) or (dtEntry in psd^.fTypes) then - begin - hBr := GetSysColorBrush(COLOR_MENU); - FillRect(dwi^.HDC, dwi^.rcItem, hBr); - DeleteObject(hBr); - // - if (ODS_SELECTED and dwi^.itemState = ODS_SELECTED) then - begin - // only do this for entry menu types otherwise a black mask - // is drawn under groups - hBr := GetSysColorBrush(COLOR_HIGHLIGHT); - FillRect(dwi^.HDC, dwi^.rcItem, hBr); - DeleteObject(hBr); - SetTextColor(dwi^.HDC, GetSysColor(COLOR_HIGHLIGHTTEXT)); - end; // if - // draw icon - with dwi^, icorc do - begin - if (ODS_SELECTED and dwi^.itemState) = ODS_SELECTED then - begin - hBr := GetSysColorBrush(COLOR_HIGHLIGHT); - end - else - begin - hBr := GetSysColorBrush(COLOR_MENU); - end; // if - DrawIconEx(HDC, Left + 1, Top, psd^.hStatusIcon, 16, 16, // width, height - 0, // step - hBr, // brush - DI_NORMAL); - DeleteObject(hBr); - end; // with - // draw the text - with dwi^ do - begin - inc(rcItem.Left, ((rcItem.Bottom - rcItem.Top) - 2)); - DrawText(HDC, psd^.szText, psd^.cch, rcItem, DT_NOCLIP or DT_NOPREFIX or - DT_SINGLELINE or DT_VCENTER); - // draw the name of the database text if it's there - if psd^.szProfile <> nil then - begin - GetTextExtentPoint32(dwi^.HDC, psd^.szText, psd^.cch, tS); - inc(rcItem.Left, tS.cx + 8); - SetTextColor(HDC, GetSysColor(COLOR_GRAYTEXT)); - DrawText(HDC, psd^.szProfile, lstrlena(psd^.szProfile), rcItem, - DT_NOCLIP or DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); - end; // if - end; // with - end - else - begin - // it's a contact! - hBr := GetSysColorBrush(COLOR_MENU); - FillRect(dwi^.HDC, dwi^.rcItem, hBr); - DeleteObject(hBr); - if ODS_SELECTED and dwi^.itemState = ODS_SELECTED then - begin - hBr := GetSysColorBrush(COLOR_HIGHLIGHT); - FillRect(dwi^.HDC, dwi^.rcItem, hBr); - DeleteObject(hBr); - SetTextColor(dwi^.HDC, GetSysColor(COLOR_HIGHLIGHTTEXT)); - end; - // draw icon - with dwi^, icorc do - begin - if (ODS_SELECTED and dwi^.itemState) = ODS_SELECTED then - begin - hBr := GetSysColorBrush(COLOR_HIGHLIGHT); - end - else - begin - hBr := GetSysColorBrush(COLOR_MENU); - end; // if - DrawIconEx(HDC, Left + 2, Top, psd^.hStatusIcon, 16, 16, // width, height - 0, // step - hBr, // brush - DI_NORMAL); - DeleteObject(hBr); - end; // with - // draw the text - with dwi^ do - begin - inc(rcItem.Left, (rcItem.Bottom - rcItem.Top) + 1); - DrawText(HDC, psd^.szText, psd^.cch, rcItem, DT_NOCLIP or DT_NOPREFIX or - DT_SINGLELINE or DT_VCENTER); - end; // with - end; // if - end - else if (uMsg = WM_MEASUREITEM) then - begin - // don't check if it's really a menu - msi := PMeasureItemStruct(lParam); - uint_ptr(psd) := msi^.itemData; - ncm.cbSize := sizeof(TNonClientMetrics); - SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @ncm, 0); - // create the font used in menus, this font should be cached somewhere really -{$IFDEF FPC} - hFont := CreateFontIndirect(@ncm.lfMenuFont); -{$ELSE} - hFont := CreateFontIndirect(ncm.lfMenuFont); -{$ENDIF} - hMemDC := Self^.ptrInstance^.hMemDC; - // select in the font - hOldFont := SelectObject(hMemDC, hFont); - // default to an icon - dx := 16; - // get the size 'n' account for the icon - GetTextExtentPoint32(hMemDC, psd^.szText, psd^.cch, tS); - inc(dx, tS.cx); - // main menu item? - if psd^.szProfile <> nil then - begin - GetTextExtentPoint32(hMemDC, psd^.szProfile, lstrlena(psd^.szProfile), tS); - inc(dx, tS.cx); - end; - // store it - msi^.itemWidth := dx + Integer(ncm.iMenuWidth); - msi^.itemHeight := Integer(ncm.iMenuHeight) + 2; - if tS.cy > msi^.itemHeight then - inc(msi^.itemHeight, tS.cy - msi^.itemHeight); - // clean up - SelectObject(hMemDC, hOldFont); - DeleteObject(hFont); - end; - Result := S_OK; -end; - -function TShlComRec_HandleMenuMsg(Self: PContextMenu3_Interface; uMsg: UINT; wParam: wParam; - lParam: lParam): HResult; stdcall; -var - Dummy: HResult; -begin - Result := TShlComRec_HandleMenuMsgs(Self, uMsg, wParam, lParam, @Dummy); -end; - -function TShlComRec_HandleMenuMsg2(Self: PContextMenu3_Interface; uMsg: UINT; wParam: wParam; - lParam: lParam; PLResult: Pointer { ^LResult } ): HResult; stdcall; -var - Dummy: HResult; -begin - // this will be null if a return value isn't needed. - if PLResult = nil then - PLResult := @Dummy; - Result := TShlComRec_HandleMenuMsgs(Self, uMsg, wParam, lParam, PLResult); -end; - -function TShlComRec_Create: PShlComRec; -var - DC: HDC; -begin - New(Result); - { build all the function tables for interfaces } - with Result^.ShellExtInit_Interface do - begin - { this is only owned by us... } - ptrVTable := @vTable; - { IUnknown } - vTable.QueryInterface := @TShlComRec_QueryInterface; - vTable.AddRef := @TShlComRec_AddRef; - vTable.Release := @TShlComRec_Release; - { IShellExtInit } - vTable.Initialise := @TShlComRec_Initialise; - { instance of a TShlComRec } - ptrInstance := Result; - end; - with Result^.ContextMenu3_Interface do - begin - ptrVTable := @vTable; - { IUnknown } - vTable.QueryInterface := @TShlComRec_QueryInterface; - vTable.AddRef := @TShlComRec_AddRef; - vTable.Release := @TShlComRec_Release; - { IContextMenu } - vTable.QueryContextMenu := @TShlComRec_QueryContextMenu; - vTable.InvokeCommand := @TShlComRec_InvokeCommand; - vTable.GetCommandString := @TShlComRec_GetCommandString; - { IContextMenu2 } - vTable.HandleMenuMsg := @TShlComRec_HandleMenuMsg; - { IContextMenu3 } - vTable.HandleMenuMsg2 := @TShlComRec_HandleMenuMsg2; - { instance data } - ptrInstance := Result; - end; - { initalise variables } - Result^.RefCount := 1; - Result^.hDllHeap := HeapCreate(0, 0, 0); - Result^.hRootMenu := 0; - Result^.hRecentMenu := 0; - Result^.RecentCount := 0; - Result^.idCmdFirst := 0; - Result^.pDataObject := nil; - Result^.ProtoIcons := nil; - Result^.ProtoIconsCount := 0; - // create an inmemory DC - DC := GetDC(0); - Result^.hMemDC := CreateCompatibleDC(DC); - ReleaseDC(0, DC); - { keep count on the number of objects } - inc(dllpublic.ObjectCount); -end; - -{ IClassFactory } - -type - - PVTable_IClassFactory = ^TVTable_IClassFactory; - - TVTable_IClassFactory = record - { IUnknown } - QueryInterface: Pointer; - AddRef: Pointer; - Release: Pointer; - { IClassFactory } - CreateInstance: Pointer; - LockServer: Pointer; - end; - - PClassFactoryRec = ^TClassFactoryRec; - - TClassFactoryRec = record - ptrVTable: PVTable_IClassFactory; - vTable: TVTable_IClassFactory; - { fields } - RefCount: LongInt; - end; - -function TClassFactoryRec_QueryInterface(Self: PClassFactoryRec; const IID: TIID; var Obj): HResult; stdcall; -begin - Pointer(Obj) := nil; - Result := E_NOTIMPL; -end; - -function TClassFactoryRec_AddRef(Self: PClassFactoryRec): LongInt; stdcall; -begin - inc(Self^.RefCount); - Result := Self^.RefCount; -end; - -function TClassFactoryRec_Release(Self: PClassFactoryRec): LongInt; stdcall; -begin - dec(Self^.RefCount); - Result := Self^.RefCount; - if Result = 0 then - begin - Dispose(Self); - dec(dllpublic.FactoryCount); - end; { if } -end; - -function TClassFactoryRec_CreateInstance(Self: PClassFactoryRec; unkOuter: Pointer; - const IID: TIID; var Obj): HResult; stdcall; -var - ShlComRec: PShlComRec; -begin - Pointer(Obj) := nil; - Result := CLASS_E_NOAGGREGATION; - if unkOuter = nil then - begin - { Before Vista, the system queried for a IShell interface then queried for a context menu, Vista now - queries for a context menu (or a shell menu) then QI()'s the other interface } - if IsEqualIID(IID, IID_IContextMenu) then - begin - Result := S_OK; - ShlComRec := TShlComRec_Create; - Pointer(Obj) := @ShlComRec^.ContextMenu3_Interface; - end; - if IsEqualIID(IID, IID_IShellExtInit) then - begin - Result := S_OK; - ShlComRec := TShlComRec_Create; - Pointer(Obj) := @ShlComRec^.ShellExtInit_Interface; - end; // if - end; // if -end; - -function TClassFactoryRec_LockServer(Self: PClassFactoryRec; fLock: BOOL): HResult; stdcall; -begin - Result := E_NOTIMPL; -end; - -function TClassFactoryRec_Create: PClassFactoryRec; -begin - New(Result); - Result^.ptrVTable := @Result^.vTable; - { IUnknown } - Result^.vTable.QueryInterface := @TClassFactoryRec_QueryInterface; - Result^.vTable.AddRef := @TClassFactoryRec_AddRef; - Result^.vTable.Release := @TClassFactoryRec_Release; - { IClassFactory } - Result^.vTable.CreateInstance := @TClassFactoryRec_CreateInstance; - Result^.vTable.LockServer := @TClassFactoryRec_LockServer; - { inital the variables } - Result^.RefCount := 1; - { count the number of factories } - inc(dllpublic.FactoryCount); -end; - -// -// IPC part -// - -type - PFileList = ^TFileList; - TFileList = array [0 .. 0] of PChar; - PAddArgList = ^TAddArgList; - - TAddArgList = record - szFile: PChar; // file being processed - cch: Cardinal; // it's length (with space for NULL char) - count: Cardinal; // number we have so far - files: PFileList; - hContact: THandle; - hEvent: THandle; - end; - -function AddToList(var args: TAddArgList): LongBool; -var - attr: Cardinal; - p: Pointer; - hFind: THandle; - fd: TWIN32FINDDATA; - szBuf: array [0 .. MAX_PATH] of Char; - szThis: PChar; - cchThis: Cardinal; -begin - Result := False; - attr := GetFileAttributes(args.szFile); - if (attr <> $FFFFFFFF) and ((attr and FILE_ATTRIBUTE_HIDDEN) = 0) then - begin - if args.count mod 10 = 5 then - begin - if CallService(MS_SYSTEM_TERMINATED, 0, 0) <> 0 then - begin - Result := True; - Exit; - end; // if - end; - if attr and FILE_ATTRIBUTE_DIRECTORY <> 0 then - begin - // add the directory - lstrcpya(szBuf, args.szFile); - ReAllocMem(args.files, (args.count + 1) * sizeof(PChar)); - GetMem(p, strlen(szBuf) + 1); - lstrcpya(p, szBuf); - args.files^[args.count] := p; - inc(args.count); - // tack on ending search token - lstrcata(szBuf, '\*'); - hFind := FindFirstFile(szBuf, fd); - while True do - begin - if fd.cFileName[0] <> '.' then - begin - lstrcpya(szBuf, args.szFile); - lstrcata(szBuf, '\'); - lstrcata(szBuf, fd.cFileName); - // keep a copy of the current thing being processed - szThis := args.szFile; - args.szFile := szBuf; - cchThis := args.cch; - args.cch := strlen(szBuf) + 1; - // recurse - Result := AddToList(args); - // restore - args.szFile := szThis; - args.cch := cchThis; - if Result then - break; - end; // if - if not FindNextFile(hFind, fd) then - break; - end; // while - FindClose(hFind); - end - else - begin - // add the file - ReAllocMem(args.files, (args.count + 1) * sizeof(PChar)); - GetMem(p, args.cch); - lstrcpya(p, args.szFile); - args.files^[args.count] := p; - inc(args.count); - end; // if - end; -end; - -procedure MainThreadIssueTransfer(p: PAddArgList); stdcall; -{$DEFINE SHL_IDC} -{$DEFINE SHL_KEYS} -{$INCLUDE shlc.inc} -{$UNDEF SHL_KEYS} -{$UNDEF SHL_IDC} -begin - DBWriteContactSettingByte(p^.hContact, SHLExt_Name, SHLExt_MRU, 1); - CallService(MS_FILE_SENDSPECIFICFILES, p^.hContact, lParam(p^.files)); - SetEvent(p^.hEvent); -end; - -procedure IssueTransferThread(pipch: PHeaderIPC); cdecl; -var - szBuf: array [0 .. MAX_PATH] of Char; - pct: PSlotIPC; - args: TAddArgList; - bQuit: LongBool; - j, c: Cardinal; - p: Pointer; - hMainThread: THandle; -begin - hMainThread := THandle(pipch^.Param); - GetCurrentDirectory(sizeof(szBuf), szBuf); - args.count := 0; - args.files := nil; - pct := pipch^.DataPtr; - bQuit := False; - while pct <> nil do - begin - if (pct^.cbSize <> sizeof(TSlotIPC)) then - break; - args.szFile := PChar(uint_ptr(pct) + sizeof(TSlotIPC)); - args.hContact := pct^.hContact; - args.cch := pct^.cbStrSection + 1; - bQuit := AddToList(args); - if bQuit then - break; - pct := pct^.Next; - end; // while - if args.files <> nil then - begin - ReAllocMem(args.files, (args.count + 1) * sizeof(PChar)); - args.files^[args.count] := nil; - inc(args.count); - if (not bQuit) then - begin - args.hEvent := CreateEvent(nil, True, False, nil); - QueueUserAPC(@MainThreadIssueTransfer, hMainThread, uint_ptr(@args)); - while True do - begin - if WaitForSingleObjectEx(args.hEvent, INFINITE, True) <> WAIT_IO_COMPLETION then - break; - end; - CloseHandle(args.hEvent); - end; // if - c := args.count - 1; - for j := 0 to c do - begin - p := args.files^[j]; - if p <> nil then - FreeMem(p); - end; - FreeMem(args.files); - end; - SetCurrentDirectory(szBuf); - FreeMem(pipch); - CloseHandle(hMainThread); -end; - -type - - PSlotInfo = ^TSlotInfo; - - TSlotInfo = record - hContact: THandle; - hProto: Cardinal; - dwStatus: Integer; // will be aligned anyway - end; - - TSlotArray = array [0 .. $FFFFFF] of TSlotInfo; - PSlotArray = ^TSlotArray; - -function SortContact(var Item1, Item2: TSlotInfo): Integer; stdcall; -begin - Result := CallService(MS_CLIST_CONTACTSCOMPARE, Item1.hContact, Item2.hContact); -end; - -// from FP FCL - -procedure QuickSort(FList: PSlotArray; L, R: LongInt); -var - i, j: LongInt; - p, q: TSlotInfo; -begin - repeat - i := L; - j := R; - p := FList^[(L + R) div 2]; - repeat - while SortContact(p, FList^[i]) > 0 do - inc(i); - while SortContact(p, FList^[j]) < 0 do - dec(j); - if i <= j then - begin - q := FList^[i]; - FList^[i] := FList^[j]; - FList^[j] := q; - inc(i); - dec(j); - end; // if - until i > j; - if L < j then - QuickSort(FList, L, j); - L := i; - until i >= R; -end; - -{$DEFINE SHL_KEYS} -{$INCLUDE shlc.inc} -{$UNDEF SHL_KEYS} - -procedure ipcGetSkinIcons(ipch: PHeaderIPC); -var - protoCount: Integer; - pp: ^PPROTOCOLDESCRIPTOR; - spi: TSlotProtoIcons; - j: Cardinal; - pct: PSlotIPC; - szTmp: array [0 .. 63] of Char; - dwCaps: Cardinal; -begin - if (CallService(MS_PROTO_ENUMACCOUNTS, wParam(@protoCount), lParam(@pp)) = 0) and - (protoCount <> 0) then - begin - spi.pid := GetCurrentProcessId(); - while protoCount > 0 do - begin - lstrcpya(szTmp, pp^.szName); - lstrcata(szTmp, PS_GETCAPS); - dwCaps := CallService(szTmp, PFLAGNUM_1, 0); - if (dwCaps and PF1_FILESEND) <> 0 then - begin - pct := ipcAlloc(ipch, sizeof(TSlotProtoIcons)); - if pct <> nil then - begin - // capture all the icons! - spi.hProto := StrHash(pp^.szName); - for j := 0 to 9 do - begin - spi.hIcons[j] := LoadSkinnedProtoIcon(pp^.szName, ID_STATUS_OFFLINE + j); - end; // for - pct^.fType := REQUEST_NEWICONS; - CopyMemory(Pointer(uint_ptr(pct) + sizeof(TSlotIPC)), @spi, sizeof(TSlotProtoIcons)); - if ipch^.NewIconsBegin = nil then - ipch^.NewIconsBegin := pct; - end; // if - end; // if - inc(pp); - dec(protoCount); - end; // while - end; // if - // add Miranda icon - pct := ipcAlloc(ipch, sizeof(TSlotProtoIcons)); - if pct <> nil then - begin - ZeroMemory(@spi.hIcons, sizeof(spi.hIcons)); - spi.hProto := 0; // no protocol - spi.hIcons[0] := LoadSkinnedIcon(SKINICON_OTHER_MIRANDA); - pct^.fType := REQUEST_NEWICONS; - CopyMemory(Pointer(uint_ptr(pct) + sizeof(TSlotIPC)), @spi, sizeof(TSlotProtoIcons)); - if ipch^.NewIconsBegin = nil then - ipch^.NewIconsBegin := pct; - end; // if -end; - -function ipcGetSortedContacts(ipch: PHeaderIPC; pSlot: pint; bGroupMode: Boolean): Boolean; -var - dwContacts: Cardinal; - pContacts: PSlotArray; - hContact: THandle; - i: Integer; - dwOnline: Cardinal; - szProto: PChar; - dwStatus: Integer; - pct: PSlotIPC; - szContact: PChar; - dbv: TDBVariant; - bHideOffline: Boolean; - szTmp: array [0 .. 63] of Char; - dwCaps: Cardinal; - szSlot: PChar; - n, rc, cch: Cardinal; -begin - Result := False; - // hide offliners? - bHideOffline := DBGetContactSettingByte(0, 'CList', 'HideOffline', 0) = 1; - // do they wanna hide the offline people anyway? - if DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoOffline, 0) = 1 then - begin - // hide offline people - bHideOffline := True; - end; - // get the number of contacts - dwContacts := CallService(MS_DB_CONTACT_GETCOUNT, 0, 0); - if dwContacts = 0 then - Exit; - // get the contacts in the array to be sorted by status, trim out anyone - // who doesn't wanna be seen. - GetMem(pContacts, (dwContacts + 2) * sizeof(TSlotInfo)); - i := 0; - dwOnline := 0; - hContact := db_find_first(); - while (hContact <> 0) do - begin - if i >= dwContacts then - break; - (* do they have a running protocol? *) - uint_ptr(szProto) := CallService(MS_PROTO_GETCONTACTBASEPROTO, hContact, 0); - if szProto <> nil then - begin - (* does it support file sends? *) - lstrcpya(szTmp, szProto); - lstrcata(szTmp, PS_GETCAPS); - dwCaps := CallService(szTmp, PFLAGNUM_1, 0); - if (dwCaps and PF1_FILESEND) = 0 then - begin - hContact := db_find_next(hContact); - continue; - end; - dwStatus := DBGetContactSettingWord(hContact, szProto, 'Status', ID_STATUS_OFFLINE); - if dwStatus <> ID_STATUS_OFFLINE then - inc(dwOnline) - else if bHideOffline then - begin - hContact := db_find_next(hContact); - continue; - end; // if - // is HIT on? - if BST_UNCHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHITContacts, - BST_UNCHECKED) then - begin - // don't show people who are "Hidden" "NotOnList" or Ignored - if (DBGetContactSettingByte(hContact, 'CList', 'Hidden', 0) = 1) or - (DBGetContactSettingByte(hContact, 'CList', 'NotOnList', 0) = 1) or - (CallService(MS_IGNORE_ISIGNORED, hContact, IGNOREEVENT_MESSAGE or - IGNOREEVENT_URL or IGNOREEVENT_FILE) <> 0) then - begin - hContact := db_find_next(hContact); - continue; - end; // if - end; // if - // is HIT2 off? - if BST_UNCHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHIT2Contacts, - BST_UNCHECKED) then - begin - if DBGetContactSettingWord(hContact, szProto, 'ApparentMode', 0) = ID_STATUS_OFFLINE - then - begin - hContact := db_find_next(hContact); - continue; - end; // if - end; // if - // store - pContacts^[i].hContact := hContact; - pContacts^[i].dwStatus := dwStatus; - pContacts^[i].hProto := StrHash(szProto); - inc(i); - end - else - begin - // contact has no protocol! - end; // if - hContact := db_find_next(hContact); - end; // while - // if no one is online and the CList isn't showing offliners, quit - if (dwOnline = 0) and (bHideOffline) then - begin - FreeMem(pContacts); - Exit; - end; // if - dwContacts := i; - i := 0; - // sort the array - QuickSort(pContacts, 0, dwContacts - 1); - // create an IPC slot for each contact and store display name, etc - while i < dwContacts do - begin - uint_ptr(szContact) := CallService(MS_CLIST_GETCONTACTDISPLAYNAME,pContacts^[i].hContact, 0); - if (szContact <> nil) then - begin - n := 0; - rc := 1; - if bGroupMode then - begin - rc := DBGetContactSetting(pContacts^[i].hContact, 'CList', 'Group', @dbv); - if rc = 0 then - begin - n := lstrlena(dbv.szVal.a) + 1; - end; - end; // if - cch := lstrlena(szContact) + 1; - pct := ipcAlloc(ipch, cch + 1 + n); - if pct = nil then - begin - DBFreeVariant(@dbv); - break; - end; - // lie about the actual size of the TSlotIPC - pct^.cbStrSection := cch; - szSlot := PChar(uint_ptr(pct) + sizeof(TSlotIPC)); - lstrcpya(szSlot, szContact); - pct^.fType := REQUEST_CONTACTS; - pct^.hContact := pContacts^[i].hContact; - pct^.Status := pContacts^[i].dwStatus; - pct^.hProto := pContacts^[i].hProto; - pct^.MRU := DBGetContactSettingByte(pct^.hContact, SHLExt_Name, SHLExt_MRU, 0); - if ipch^.ContactsBegin = nil then - ipch^.ContactsBegin := pct; - inc(szSlot, cch + 1); - if rc = 0 then - begin - pct^.hGroup := StrHash(dbv.szVal.a); - lstrcpya(szSlot, dbv.szVal.a); - DBFreeVariant(@dbv); - end - else - begin - pct^.hGroup := 0; - szSlot^ := #0; - end; - inc(pSlot^); - end; // if - inc(i); - end; // while - FreeMem(pContacts); - // - Result := True; -end; - -// worker thread to clear MRU, called by the IPC bridge -procedure ClearMRUThread(notused: Pointer); cdecl; -{$DEFINE SHL_IDC} -{$DEFINE SHL_KEYS} -{$INCLUDE shlc.inc} -{$UNDEF SHL_KEYS} -{$UNDEF SHL_IDC} -var - hContact: THandle; -begin - begin - hContact := db_find_first(); - while hContact <> 0 do - begin - if DBGetContactSettingByte(hContact, SHLExt_Name, SHLExt_MRU, 0) > 0 then - begin - DBWriteContactSettingByte(hContact, SHLExt_Name, SHLExt_MRU, 0); - end; - hContact := db_find_next(hContact); - end; - end; -end; - -// this function is called from an APC into the main thread -procedure ipcService(dwParam: DWORD); stdcall; -label - Reply; -var - hMap: THandle; - pMMT: PHeaderIPC; - hSignal: THandle; - pct: PSlotIPC; - szBuf: PChar; - iSlot: Integer; - szGroupStr: array [0 .. 31] of Char; - dbv: TDBVariant; - bits: pint; - bGroupMode: Boolean; - cloned: PHeaderIPC; - szMiranda: PChar; -begin - { try to open the file mapping object the caller must make sure no other - running instance is using this file } - hMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, IPC_PACKET_NAME); - If hMap <> 0 then - begin - { map the file to this process } - pMMT := MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, 0); - { if it fails the caller should of had some timeout in wait } - if (pMMT <> nil) and (pMMT^.cbSize = sizeof(THeaderIPC)) and - (pMMT^.dwVersion = PLUGIN_MAKE_VERSION(2, 0, 1, 2)) then - begin - // toggle the right bits - bits := @pMMT^.fRequests; - // jump right to a worker thread for file processing? - if (bits^ and REQUEST_XFRFILES) = REQUEST_XFRFILES then - begin - GetMem(cloned, IPC_PACKET_SIZE); - // translate from client space to cloned heap memory - pMMT^.pServerBaseAddress := pMMT^.pClientBaseAddress; - pMMT^.pClientBaseAddress := cloned; - CopyMemory(cloned, pMMT, IPC_PACKET_SIZE); - ipcFixupAddresses(True, cloned); - DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), - @cloned^.Param, THREAD_SET_CONTEXT, False, 0); - mir_forkThread(@IssueTransferThread, cloned); - goto Reply; - end; - // the request was to clear the MRU entries, we have no return data - if (bits^ and REQUEST_CLEARMRU) = REQUEST_CLEARMRU then - begin - mir_forkThread(@ClearMRUThread, nil); - goto Reply; - end; - // the IPC header may have pointers that need to be translated - // in either case the supplied data area pointers has to be - // translated to this address space. - // the server base address is always removed to get an offset - // to which the client base is added, this is what ipcFixupAddresses() does - pMMT^.pServerBaseAddress := pMMT^.pClientBaseAddress; - pMMT^.pClientBaseAddress := pMMT; - // translate to the server space map - ipcFixupAddresses(True, pMMT); - // store the address map offset so the caller can retranslate - pMMT^.pServerBaseAddress := pMMT; - // return some options to the client - if DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoIcons, 0) <> 0 then - begin - pMMT^.dwFlags := HIPC_NOICONS; - end; - // see if we have a custom string for 'Miranda' - szMiranda := Translate('Miranda'); - lstrcpyn(pMMT^.MirandaName, szMiranda, sizeof(pMMT^.MirandaName) - 1); - - // for the MRU menu - szBuf := Translate('Recently'); - lstrcpyn(pMMT^.MRUMenuName, szBuf, sizeof(pMMT^.MRUMenuName) - 1); - - // and a custom string for "clear entries" - szBuf := Translate('Clear entries'); - lstrcpyn(pMMT^.ClearEntries, szBuf, sizeof(pMMT^.ClearEntries) - 1); - - // if the group mode is on, check if they want the CList setting - bGroupMode := BST_CHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseGroups, - BST_UNCHECKED); - if bGroupMode and (BST_CHECKED = DBGetContactSettingByte(0, SHLExt_Name, - SHLExt_UseCListSetting, BST_UNCHECKED)) then - begin - bGroupMode := 1 = DBGetContactSettingByte(0, 'CList', 'UseGroups', 0); - end; - iSlot := 0; - // return profile if set - if BST_UNCHECKED = DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoProfile, - BST_UNCHECKED) then - begin - pct := ipcAlloc(pMMT, 50); - if pct <> nil then - begin - // will actually return with .dat if there's space for it, not what the docs say - pct^.Status := STATUS_PROFILENAME; - CallService(MS_DB_GETPROFILENAME, 49, uint_ptr(pct) + sizeof(TSlotIPC)); - end; // if - end; // if - if (bits^ and REQUEST_NEWICONS) = REQUEST_NEWICONS then - begin - ipcGetSkinIcons(pMMT); - end; - if (bits^ and REQUEST_GROUPS = REQUEST_GROUPS) then - begin - // return contact's grouping if it's present - while bGroupMode do - begin - str(iSlot, szGroupStr); - if DBGetContactSetting(0, 'CListGroups', szGroupStr, @dbv) <> 0 then - break; - pct := ipcAlloc(pMMT, lstrlena(dbv.szVal.a + 1) + 1); - // first byte has flags, need null term - if pct <> nil then - begin - if pMMT^.GroupsBegin = nil then - pMMT^.GroupsBegin := pct; - pct^.fType := REQUEST_GROUPS; - pct^.hContact := 0; - uint_ptr(szBuf) := uint_ptr(pct) + sizeof(TSlotIPC); // get the end of the slot - lstrcpya(szBuf, dbv.szVal.a + 1); - pct^.hGroup := 0; - DBFreeVariant(@dbv); // free the string - end - else - begin - // outta space - DBFreeVariant(@dbv); - break; - end; // if - inc(iSlot); - end; { while } - // if there was no space left, it'll end on null - if pct = nil then - bits^ := (bits^ or GROUPS_NOTIMPL) and not REQUEST_GROUPS; - end; { if: group request } - // SHOULD check slot space. - if (bits^ and REQUEST_CONTACTS = REQUEST_CONTACTS) then - begin - if not ipcGetSortedContacts(pMMT, @iSlot, bGroupMode) then - begin - // fail if there were no contacts AT ALL - bits^ := (bits^ or CONTACTS_NOTIMPL) and not REQUEST_CONTACTS; - end; // if - end; // if:contact request - // store the number of slots allocated - pMMT^.Slots := iSlot; - Reply: - { get the handle the caller wants to be signalled on } - hSignal := OpenEvent(EVENT_ALL_ACCESS, False, pMMT^.SignalEventName); - { did it open? } - If hSignal <> 0 then - begin - { signal and close } - SetEvent(hSignal); - CloseHandle(hSignal); - end; - { unmap the shared memory from this process } - UnmapViewOfFile(pMMT); - end; - { close the map file } - CloseHandle(hMap); - end; { if } - // -end; - -procedure ThreadServer(hMainThread: Pointer); cdecl; -var - hEvent: THandle; - retVal: Cardinal; -begin - hEvent := CreateEvent(nil, False, False, PChar(CreateProcessUID(GetCurrentProcessId()))); - while True do - begin - retVal := WaitForSingleObjectEx(hEvent, INFINITE, True); - if retVal = WAIT_OBJECT_0 then - begin - QueueUserAPC(@ipcService, THandle(hMainThread), 0); - end; // if - if CallService(MS_SYSTEM_TERMINATED, 0, 0) = 1 then - break; - end; // while - CloseHandle(hEvent); - CloseHandle(THandle(hMainThread)); -end; - -procedure InvokeThreadServer; -var - hMainThread: THandle; -begin - hMainThread := 0; - DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), @hMainThread, - THREAD_SET_CONTEXT, False, 0); - if hMainThread <> 0 then - mir_forkThread(@ThreadServer, Pointer(hMainThread)); -end; - -{ exported functions } - -function DllGetClassObject(const CLSID: TCLSID; const IID: TIID; var Obj): HResult; stdcall; -begin - Pointer(Obj) := nil; - Result := CLASS_E_CLASSNOTAVAILABLE; - if (IsEqualCLSID(CLSID, CLSID_ISHLCOM)) and (IsEqualIID(IID, IID_IClassFactory)) and - (FindWindow(MirandaName, nil) <> 0) then - begin - Pointer(Obj) := TClassFactoryRec_Create; - Result := S_OK; - end; // if -end; - -function DllCanUnloadNow: HResult; -begin - if ((dllpublic.FactoryCount = 0) and (dllpublic.ObjectCount = 0)) then - begin - Result := S_OK; - end - else - begin - Result := S_FALSE; - end; // if -end; - -{ helper functions } - -type - - PSHELLEXECUTEINFO = ^TSHELLEXECUTEINFO; - - TSHELLEXECUTEINFO = record - cbSize: DWORD; - fMask: LongInt; - hwnd: THandle; - lpVerb: PChar; - lpFile: PChar; - lpParameters: PChar; - lpDirectory: PChar; - nShow: Integer; - hInstApp: THandle; - lpIDLIst: Pointer; - lpClass: PChar; - HKEY: THandle; - dwHotkey: DWORD; - HICON: THandle; // is union - hProcess: THandle; - end; - -function ShellExecuteEx(var se: TSHELLEXECUTEINFO): Boolean; stdcall; - external 'shell32.dll' name 'ShellExecuteExA'; - -function wsprintfs(lpOut, lpFmt: PChar; args: PChar): Integer; cdecl; - external 'user32.dll' name 'wsprintfA'; - -function RemoveCOMRegistryEntries: HResult; -var - hRootKey: HKEY; -begin - if RegOpenKeyEx(HKEY_CLASSES_ROOT, 'miranda.shlext', 0, KEY_READ, hRootKey) = ERROR_SUCCESS - then - begin - (* need to delete the subkey before the parent key is deleted under NT/2000/XP *) - RegDeleteKey(hRootKey, 'CLSID'); - (* close the key *) - RegCloseKey(hRootKey); - (* delete it *) - if RegDeleteKey(HKEY_CLASSES_ROOT, 'miranda.shlext') <> ERROR_SUCCESS then - begin - MessageBox(0, - 'Unable to delete registry key for "shlext COM", this key may already be deleted or you may need admin rights.', - 'Problem', MB_ICONERROR); - end; // if - end; // if - if RegOpenKeyEx(HKEY_CLASSES_ROOT, '\*\shellex\ContextMenuHandlers', 0, KEY_ALL_ACCESS, - hRootKey) = ERROR_SUCCESS then - begin - if RegDeleteKey(hRootKey, 'miranda.shlext') <> ERROR_SUCCESS then - begin - MessageBox(0, - 'Unable to delete registry key for "File context menu handlers", this key may already be deleted or you may need admin rights.', - 'Problem', MB_ICONERROR); - end; // if - RegCloseKey(hRootKey); - end; // if - if RegOpenKeyEx(HKEY_CLASSES_ROOT, 'Directory\shellex\ContextMenuHandlers', 0, KEY_ALL_ACCESS, - hRootKey) = ERROR_SUCCESS then - begin - if RegDeleteKey(hRootKey, 'miranda.shlext') <> ERROR_SUCCESS then - begin - MessageBox(0, - 'Unable to delete registry key for "Directory context menu handlers", this key may already be deleted or you may need admin rights.', - 'Problem', MB_ICONERROR); - end; // if - RegCloseKey(hRootKey); - end; // if - if ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, - 'Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', 0, KEY_ALL_ACCESS, - hRootKey) then - begin - if RegDeleteValue(hRootKey, '{72013A26-A94C-11d6-8540-A5E62932711D}') <> ERROR_SUCCESS then - begin - MessageBox(0, - 'Unable to delete registry entry for "Approved context menu handlers", this key may already be deleted or you may need admin rights.', - 'Problem', MB_ICONERROR); - end; // if - RegCloseKey(hRootKey); - end; // if - Result := S_OK; -end; - -{ called by the options code to remove COM entries, and before that, get permission, if required. -} - -procedure CheckUnregisterServer; -var - sei: TSHELLEXECUTEINFO; - szBuf: array [0 .. MAX_PATH * 2] of Char; - szFileName: array [0 .. MAX_PATH] of Char; -begin - if not VistaOrLater then - begin - RemoveCOMRegistryEntries(); - Exit; - end; - // launches regsvr to remove the dll under admin. - GetModuleFileName(System.hInstance, szFileName, sizeof(szFileName)); - wsprintfs(szBuf, '/s /u "%s"', szFileName); - ZeroMemory(@sei, sizeof(sei)); - sei.cbSize := sizeof(sei); - sei.lpVerb := 'runas'; - sei.lpFile := 'regsvr32'; - sei.lpParameters := szBuf; - ShellExecuteEx(sei); - Sleep(1000); - RemoveCOMRegistryEntries(); -end; - -{ Wow, I can't believe there isn't a direct API for this - 'runas' will invoke the UAC and ask - for permission before installing the shell extension. note the filepath arg has to be quoted } -procedure CheckRegisterServer; -var - hRegKey: HKEY; - sei: TSHELLEXECUTEINFO; - szBuf: array [0 .. MAX_PATH * 2] of Char; - szFileName: array [0 .. MAX_PATH] of Char; -begin - if ERROR_SUCCESS = RegOpenKeyEx(HKEY_CLASSES_ROOT, 'miranda.shlext', 0, KEY_READ, hRegKey) - then - begin - RegCloseKey(hRegKey); - end - else - begin - if VistaOrLater then - begin - MessageBox(0, - 'Shell context menus requires your permission to register with Windows Explorer (one time only).', - 'Miranda IM - Shell context menus (shlext.dll)', MB_OK or MB_ICONINFORMATION); - // /s = silent - GetModuleFileName(System.hInstance, szFileName, sizeof(szFileName)); - wsprintfs(szBuf, '/s "%s"', szFileName); - ZeroMemory(@sei, sizeof(sei)); - sei.cbSize := sizeof(sei); - sei.lpVerb := 'runas'; - sei.lpFile := 'regsvr32'; - sei.lpParameters := szBuf; - ShellExecuteEx(sei); - end; - end; -end; - -initialization - -begin - FillChar(dllpublic, sizeof(dllpublic), 0); - IsMultiThread := True; - VistaOrLater := GetProcAddress(GetModuleHandle('kernel32'), 'GetProductInfo') <> nil; -end; - -end. diff --git a/plugins/ShlExt/shldlgs.rc b/plugins/ShlExt/shldlgs.rc deleted file mode 100644 index 0e9cd82b04..0000000000 --- a/plugins/ShlExt/shldlgs.rc +++ /dev/null @@ -1,93 +0,0 @@ -#include "resource.h" -//#include "afxres.h" -#define WS_POPUP 0x80000000L -#define WS_CHILD 0x40000000L -#define BS_AUTOCHECKBOX 0x00000003L -#define WS_TABSTOP 0x00010000L -#define SS_ETCHEDHORZ 0x00000010L -#define WS_GROUP 0x00020000L -#ifndef IDC_STATIC -#define IDC_STATIC (-1) -#endif - -///////////////////////////////////////////////////////////////////////////// -// -// Dialog -// - -IDD_SHLOPTS DIALOG DISCARDABLE 0, 0, 312, 238 -STYLE WS_POPUP -FONT 8, "MS Shell Dlg" -BEGIN - CONTROL "Display contacts in their assigned groups (if any)", - IDC_USEGROUPS,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,15, - 35,281,8 - CONTROL "Only if/when the contact list is using them", - IDC_CLISTGROUPS,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,29, - 50,267,8 - CONTROL "Display hidden, ignored or temporary contacts", - IDC_SHOWFULL,"Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,65, - 281,8 - CONTROL "",IDC_STATIC,"Static",SS_ETCHEDHORZ,26,21,192,1 - LTEXT "Menus",IDC_CAPMENUS,10,17,24,8 - LTEXT "",IDC_STATIC,214,16,10,11,NOT WS_GROUP - CONTROL "",IDC_STATIC,"Static",SS_ETCHEDHORZ,34,145,183,1 - LTEXT "Shell Status",IDC_CAPSHLSTATUS,10,141,43,8 - LTEXT "",IDC_STATIC,214,111,10,11,NOT WS_GROUP - LTEXT "...",IDC_STATUS,15,154,253,12 - GROUPBOX "Shell context menus",IDC_STATIC,0,0,311,238 - CONTROL "Do not display the profile name in use",IDC_NOPROF, - "Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,80,285,8 - CONTROL "Show contacts that you have set privacy rules for", - IDC_SHOWINVISIBLES,"Button",BS_AUTOCHECKBOX | WS_TABSTOP, - 15,110,290,8 - PUSHBUTTON "Remove",IDC_REMOVE,14,173,42,14 - CONTROL "Do not show status icons in menus",IDC_USEOWNERDRAW, - "Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,95,290,8 - LTEXT "",IDC_STATIC,214,136,10,11,NOT WS_GROUP - CONTROL "Do not show contacts that are offline, even if my contact list does",IDC_HIDEOFFLINE, - "Button",BS_AUTOCHECKBOX | WS_TABSTOP,15,125,290,8 -END - -///////////////////////////////////////////////////////////////////////////// -// -// Version -// - -VS_VERSION_INFO VERSIONINFO - FILEVERSION 1,0,6,6 - PRODUCTVERSION 1,0,6,6 - FILEFLAGSMASK 0x3fL -#ifdef _DEBUG - FILEFLAGS 0x1L -#else - FILEFLAGS 0x0L -#endif - FILEOS 0x4L - FILETYPE 0x2L - FILESUBTYPE 0x0L -BEGIN - BLOCK "StringFileInfo" - BEGIN - BLOCK "080904b0" - BEGIN - VALUE "Comments", "\0" - VALUE "CompanyName", "\0" - VALUE "FileDescription", "'Click ''n'' send support from Explorer/Common dialogs/Desktop, Right click on a file/folder to be presented with all your Miranda contact lists and then select the profile/contact you want to send to.\0" - VALUE "FileVersion", "1, 0, 6, 6\0" - VALUE "InternalName", "shlext\0" - VALUE "LegalCopyright", "\0" - VALUE "LegalTrademarks", "\0" - VALUE "OriginalFilename", "shlext.dll\0" - VALUE "PrivateBuild", "\0" - VALUE "ProductName", "\0" - VALUE "ProductVersion", "1, 0, 6, 6\0" - VALUE "SpecialBuild", "\0" - END - END - BLOCK "VarFileInfo" - BEGIN - VALUE "Translation", 0x809, 1200 - END -END - diff --git a/plugins/ShlExt/shldlgs.res b/plugins/ShlExt/shldlgs.res deleted file mode 100644 index 3de576e992..0000000000 Binary files a/plugins/ShlExt/shldlgs.res and /dev/null differ diff --git a/plugins/ShlExt/shlext.dpr b/plugins/ShlExt/shlext.dpr deleted file mode 100644 index c23ee75f93..0000000000 --- a/plugins/ShlExt/shlext.dpr +++ /dev/null @@ -1,379 +0,0 @@ -{$IFDEF FPC} -{$PACKRECORDS 4} -{$MODE Delphi} -{$ASMMODE intel} -{$INLINE ON} -{$MACRO ON} -{$APPTYPE GUI} -{$IMAGEBASE $49ac0000} -{$ELSE} -{$IMAGEBASE $49ac0000} // this is ignored with FPC, must be set via the command line -{$ENDIF} -library shlext; - -uses - Windows, shlcom, shlipc, m_api; - -// use the registry to store the COM information needed by the shell - -function DllRegisterServer: HResult; stdcall; -var - szData: PChar; - hRegKey: HKEY; -begin - -{$IFDEF INSTALLER_REGISTER} - Result := S_OK; -{$ELSE} - // progID - szData := 'shlext (1.0.6.6) - shell context menu support for Miranda v0.3.0.0+'; - if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, 'miranda.shlext', REG_SZ, szData, Length(szData)) then - begin - // CLSID related to ProgID - szData := '{72013A26-A94C-11d6-8540-A5E62932711D}'; - if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, 'miranda.shlext\CLSID', REG_SZ, szData, Length(szData)) then - begin - // CLSID link back to progID - szData := 'miranda.shlext'; - if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, - 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}', REG_SZ, szData, Length(szData)) then - begin - // CLSID link back to ProgID under \ProgID again? - szData := 'miranda.shlext'; - if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, - 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}\ProgID', REG_SZ, szData, Length(szData)) then - begin - GetMem(szData, MAX_PATH); - GetModuleFileName(hInstance, szData, MAX_PATH - 1); - Result := RegSetValue(HKEY_CLASSES_ROOT, - 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}\InprocServer32', REG_SZ, szData, Length(szData)); - FreeMem(szData); - if Result = ERROR_SUCCESS then - begin - // have to add threading model - szData := 'CLSID\{72013A26-A94C-11d6-8540-A5E62932711D}\InprocServer32'; - Result := RegCreateKeyEx(HKEY_CLASSES_ROOT, szData, 0, nil, 0, - KEY_SET_VALUE or KEY_CREATE_SUB_KEY, nil, hRegKey, nil); - if Result = ERROR_SUCCESS then - begin - szData := 'Apartment'; - RegSetValueEx(hRegKey, 'ThreadingModel', 0, REG_SZ, PByte(szData), Length(szData) + 1); - RegCloseKey(hRegKey); - // write which file types to show under - szData := '{72013A26-A94C-11d6-8540-A5E62932711D}'; - // note that *\ should use AllFilesystemObjects for 4.71+ - if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, - '*\shellex\ContextMenuHandlers\miranda.shlext', REG_SZ, szData, Length(szData)) then - begin - // don't support directories - if ERROR_SUCCESS = RegSetValue(HKEY_CLASSES_ROOT, - 'Directory\shellex\ContextMenuHandlers\miranda.shlext', REG_SZ, szData, - Length(szData)) then - begin - Result := S_OK; - // have to add to the approved list under NT/2000/XP with {CLSID}="" - szData := 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved'; - Result := RegCreateKeyEx(HKEY_LOCAL_MACHINE, szData, 0, nil, 0, - KEY_SET_VALUE or KEY_CREATE_SUB_KEY, nil, hRegKey, nil); - if Result = ERROR_SUCCESS then - begin - szData := 'shlext (1.0.6.6) - context menu support for Miranda v0.3.0.0+'; - RegSetValueEx(hRegKey, '{72013A26-A94C-11d6-8540-A5E62932711D}', 0, REG_SZ, - PByte(szData), Length(szData) + 1); - RegCloseKey(hRegKey); - end; // if - end - else - Result := E_FAIL; - end - else - Result := E_FAIL; - end - else - Result := E_FAIL; - end - else - Result := E_FAIL; - end - else - Result := E_FAIL; - end - else - Result := E_FAIL; - end - else - Result := E_FAIL; - end - else - Result := E_FAIL; - // -{$ENDIF} -end; - -function DllUnregisterServer: HResult; stdcall; -begin - Result := RemoveCOMRegistryEntries(); -end; - -// - miranda section ---- - -const - - COMREG_UNKNOWN = $00000000; - COMREG_OK = $00000001; - COMREG_APPROVED = $00000002; - -function IsCOMRegistered: Integer; -var - hRegKey: HKEY; - lpType: Integer; -begin - Result := 0; - // these arent the BEST checks in the world - if ERROR_SUCCESS = RegOpenKeyEx(HKEY_CLASSES_ROOT, 'miranda.shlext', 0, KEY_READ, hRegKey) - then - begin - Result := Result or COMREG_OK; - RegCloseKey(hRegKey); - end; // if - lpType := REG_SZ; - if ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, - 'Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', 0, KEY_READ, hRegKey) - then - begin - if ERROR_SUCCESS = RegQueryValueEx(hRegKey, '{72013A26-A94C-11d6-8540-A5E62932711D}', nil, - @lpType, nil, nil) then - begin - Result := Result or COMREG_APPROVED; - end; // if - RegCloseKey(hRegKey); - end; // if -end; - -procedure AutoSize(hwnd: THandle); -var - szBuf: array [0 .. MAX_PATH] of Char; - DC: HDC; - tS: TSize; - i: Integer; - hFont, hOldFont: THandle; -begin - DC := GetDC(hwnd); - hFont := GetStockObject(DEFAULT_GUI_FONT); - hOldFont := SelectObject(DC, hFont); - i := GetWindowText(hwnd, szBuf, MAX_PATH); - GetTextExtentPoint32(DC, szBuf, i, tS); - SelectObject(DC, hOldFont); - DeleteObject(hFont); - ReleaseDC(hwnd, DC); - SetWindowPos(hwnd, HWND_BOTTOM, 0, 0, tS.cx + 10, tS.cy, SWP_NOMOVE or SWP_FRAMECHANGED); -end; - -function OptDialogProc(hwndDlg: THandle; wMsg: Integer; wParam: wParam; lParam: lParam): BOOL; stdcall; -// don't wanna bring in CommCtrl just for a few constants -const -{$IFNDEF FPC} - WM_INITDIALOG = $0110; - WM_COMMAND = $0111; - WM_USER = $0400; - WM_NOTIFY = $004E; -{$ENDIF} - { propsheet notifications/msessages } - // PSN_APPLY = (-200) - 2; - PSM_CHANGED = WM_USER + 104; - { button styles } - BCM_SETSHIELD = ( { BCM_FIRST } $1600 + $000C); - { hotkey } - // bring in the IDC's and storage key names -{$DEFINE SHL_IDC} -{$DEFINE SHL_KEYS} -{$INCLUDE shlc.inc} -{$UNDEF SHL_KEYS} -{$UNDEF SHL_IDC} -const - COM_OKSTR: array [Boolean] of PChar = ('Problem, registration missing/deleted.', - 'Successfully created shell registration.'); - COM_APPROVEDSTR: array [Boolean] of PChar = ('Not Approved', 'Approved'); -var - comReg: Integer; - iCheck: Integer; - szBuf: array [0 .. MAX_PATH] of Char; -begin - Result := wMsg = WM_INITDIALOG; - case wMsg of - WM_NOTIFY: - begin - { * FP 2.2.2 seems to have a bug, 'Code' is supposed to be signed - but isn't signed, so when comparing -202 (=PSN_APPLY) It doesn't work - so here, -202 is converted into hex, what you are looking at is the - code == PSN_APPLY check. * } - if $FFFFFF36 = pNMHDR(lParam)^.code then - begin - DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseGroups, - IsDlgButtonChecked(hwndDlg, IDC_USEGROUPS)); - DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseCListSetting, - IsDlgButtonChecked(hwndDlg, IDC_CLISTGROUPS)); - DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoProfile, - IsDlgButtonChecked(hwndDlg, IDC_NOPROF)); - DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseHITContacts, - IsDlgButtonChecked(hwndDlg, IDC_SHOWFULL)); - DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_UseHIT2Contacts, - IsDlgButtonChecked(hwndDlg, IDC_SHOWINVISIBLES)); - DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoIcons, - IsDlgButtonChecked(hwndDlg, IDC_USEOWNERDRAW)); - DBWriteContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoOffline, - IsDlgButtonChecked(hwndDlg, IDC_HIDEOFFLINE)); - end; // if - end; - WM_INITDIALOG: - begin - TranslateDialogDefault(hwndDlg); - comReg := IsCOMRegistered(); - FillChar(szBuf, MAX_PATH, 0); - lstrcat(szBuf, Translate(COM_OKSTR[comReg and COMREG_OK = COMREG_OK])); - lstrcat(szBuf, ' ('); - lstrcat(szBuf, Translate(COM_APPROVEDSTR[comReg and - COMREG_APPROVED = COMREG_APPROVED])); - lstrcat(szBuf, ')'); - SetWindowText(GetDlgItem(hwndDlg, IDC_STATUS), szBuf); - // auto size the static windows to fit their text - // they're rendering in a font not selected into the DC. - AutoSize(GetDlgItem(hwndDlg, IDC_CAPMENUS)); - AutoSize(GetDlgItem(hwndDlg, IDC_CAPSTATUS)); - AutoSize(GetDlgItem(hwndDlg, IDC_CAPSHLSTATUS)); - // show all the options - iCheck := DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseGroups, BST_UNCHECKED); - CheckDlgButton(hwndDlg, IDC_USEGROUPS, iCheck); - EnableWindow(GetDlgItem(hwndDlg, IDC_CLISTGROUPS), iCheck = BST_CHECKED); - CheckDlgButton(hwndDlg, IDC_CLISTGROUPS, - DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseCListSetting, BST_UNCHECKED)); - CheckDlgButton(hwndDlg, IDC_NOPROF, - DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoProfile, BST_UNCHECKED)); - CheckDlgButton(hwndDlg, IDC_SHOWFULL, - DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHITContacts, BST_UNCHECKED)); - CheckDlgButton(hwndDlg, IDC_SHOWINVISIBLES, - DBGetContactSettingByte(0, SHLExt_Name, SHLExt_UseHIT2Contacts, BST_UNCHECKED)); - CheckDlgButton(hwndDlg, IDC_USEOWNERDRAW, - DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoIcons, BST_UNCHECKED)); - CheckDlgButton(hwndDlg, IDC_HIDEOFFLINE, - DBGetContactSettingByte(0, SHLExt_Name, SHLExt_ShowNoOffline, BST_UNCHECKED)); - // give the Remove button a Vista icon - SendMessage(GetDlgItem(hwndDlg, IDC_REMOVE), BCM_SETSHIELD, 0, 1); - end; - WM_COMMAND: - begin - // don't send the changed message if remove is clicked - if LOWORD(wParam) <> IDC_REMOVE then - begin - SendMessage(GetParent(hwndDlg), PSM_CHANGED, 0, 0); - end; // if - case LOWORD(wParam) of - IDC_USEGROUPS: - begin - EnableWindow(GetDlgItem(hwndDlg, IDC_CLISTGROUPS), - BST_CHECKED = IsDlgButtonChecked(hwndDlg, IDC_USEGROUPS)); - end; // if - IDC_REMOVE: - begin - if IDYES = MessageBoxW(0, - TranslateW( - 'Are you sure? this will remove all the settings stored in your database and all registry entries created for shlext to work with Explorer'), - TranslateW('Disable/Remove shlext'), MB_YESNO or MB_ICONQUESTION) then - begin - db_unset(0, SHLExt_Name, SHLExt_UseGroups); - db_unset(0, SHLExt_Name, SHLExt_UseCListSetting); - db_unset(0, SHLExt_Name, SHLExt_UseHITContacts); - db_unset(0, SHLExt_Name, SHLExt_UseHIT2Contacts); - db_unset(0, SHLExt_Name, SHLExt_ShowNoProfile); - db_unset(0, SHLExt_Name, SHLExt_ShowNoIcons); - db_unset(0, SHLExt_Name, SHLExt_ShowNoOffline); - - (* remove from Explorer *) - // DllUnregisterServer(); - CheckUnregisterServer(); - (* show all the settings have gone... *) - SendMessage(hwndDlg, WM_INITDIALOG, 0, 0); - end; // if - end; // if - end; // case - // LOWORD(wParam) == IDC_* - end; { outercase } - end; // case -end; - -function InitialiseOptionPages(wParam: wParam; lParam: lParam): int; cdecl; -const - IDD_SHLOPTS = 101; -var - optDialog: TOPTIONSDIALOGPAGE; -begin - Result := 0; - FillChar(optDialog, sizeof(TOPTIONSDIALOGPAGE), 0); - optDialog.cbSize := sizeof(TOPTIONSDIALOGPAGE); - optDialog.flags := ODPF_BOLDGROUPS; - optDialog.groupPosition := 0; - optDialog.szGroup.a := 'Plugins'; - optDialog.position := -1066; - optDialog.szTitle.a := Translate('Shell context menus'); - optDialog.pszTemplate := MAKEINTRESOURCE(IDD_SHLOPTS); -{$IFDEF VER140} - optDialog.hInstance := hInstance; -{$ELSE} - optDialog.hInstance := System.hInstance; -{$ENDIF} - optDialog.pfnDlgProc := @OptDialogProc; - - Options_AddPage(wParam,@optDialog); -end; - -function MirandaPluginInfoEx(mirandaVersion: DWORD): PPLUGININFOEX; cdecl; -begin - Result := nil; - { fill in plugininfo } - PluginInfo.cbSize := sizeof(PluginInfo); - PluginInfo.shortName := 'Shell context menus for transfers'; - PluginInfo.version := PLUGIN_MAKE_VERSION(2, 0, 1, 2); -{$IFDEF FPC} - PluginInfo.description := - 'Click ''n'' send support from Explorer/Common dialogs/Desktop, Right click on a file/folder to be presented with all your Miranda contact lists and then select the profile/contact you want to send to.'; -{$ELSE} - PluginInfo.description := ''; -{$ENDIF} - PluginInfo.author := 'egoDust'; - PluginInfo.authorEmail := 'egodust@users.sourceforge.net'; - PluginInfo.copyright := '(c) 2009 Sam Kothari (egoDust)'; - PluginInfo.homePage := 'http://addons.miranda-im.org/details.php?action=viewfile&id=534'; - PluginInfo.flags := 0; - { This UUID is fetched twice } - CopyMemory(@PluginInfo.uuid, @CLSID_ISHLCOM, sizeof(TMUUID)); - { return info } - Result := @PluginInfo; -end; - -function Load(): int; cdecl; -begin - Result := 0; - InvokeThreadServer; - HookEvent(ME_OPT_INITIALISE, InitialiseOptionPages); - DllRegisterServer(); - CheckRegisterServer(); - // DisableThreadLibraryCalls(System.hInstance); -end; - -function Unload: int; cdecl; -begin - Result := 0; -end; - -{$R shldlgs.res} - -exports - MirandaPluginInfoEx, Load, Unload; - -exports - DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer; - -initialization - DisableThreadLibraryCalls(hInstance); - -end. diff --git a/plugins/ShlExt/shlicons.pas b/plugins/ShlExt/shlicons.pas deleted file mode 100644 index 195033ae8d..0000000000 --- a/plugins/ShlExt/shlicons.pas +++ /dev/null @@ -1,168 +0,0 @@ -unit shlicons; - -interface - -uses - Windows; - -type - - PVTable_IWICBitmap = ^TVTable_IWICBitmap; - - TVTable_IWICBitmap = record - { IUnknown } - QueryInterface: Pointer; - AddRef: function(Self: Pointer): Cardinal; stdcall; - Release: function(Self: Pointer): Cardinal; stdcall; - { IWICBitmapSource } - GetSize: function(Self: Pointer; var Width, Height: LongInt): HResult; stdcall; - GetPixelFormat: Pointer; - GetResolution: Pointer; - CopyPalette: Pointer; - CopyPixels: function(Self: Pointer; prc: Pointer; cbStride, cbBufferSize: LongWord; - pbBuffer: PByte): HResult; stdcall; - { IWICBitmap } - // .... not used - - end; - - PWICBitmap_Interface = ^TWICBitmap_Interface; - - TWICBitmap_Interface = record - ptrVTable: PVTable_IWICBitmap; - end; - - // bare minmum interface to ImagingFactory - - PVTable_ImagingFactory = ^TVTable_ImagingFactory; - - TVTable_ImagingFactory = record - { IUnknown } - QueryInterface: Pointer; - AddRef: function(Self: Pointer): Cardinal; stdcall; - Release: function(Self: Pointer): Cardinal; stdcall; - { ImagingFactory } - CreateDecoderFromFilename: Pointer; - CreateDecoderFromStream: Pointer; - CreateDecoderFromFileHandle: Pointer; - CreateComponentInfo: Pointer; - CreateDecoder: Pointer; - CreateEncoder: Pointer; - CreatePalette: Pointer; - CreateFormatConverter: Pointer; - CreateBitmapScaler: Pointer; - CreateBitmapClipper: Pointer; - CreateBitmapFlipRotator: Pointer; - CreateStream: Pointer; - CreateColorContext: Pointer; - CreateColorTransformer: Pointer; - CreateBitmap: Pointer; - CreateBitmapFromSource: Pointer; - CreateBitmapFromSourceRect: Pointer; - CreateBitmapFromMemory: Pointer; - CreateBitmapFromHBITMAP: Pointer; - CreateBitmapFromHICON: function(Self: Pointer; hIcon: Windows.hIcon; var foo: Pointer) - : HResult; stdcall; - { rest ommited } - end; - - PImageFactory_Interface = ^TImageFactory_Interface; - - TImageFactory_Interface = record - ptrVTable: PVTable_ImagingFactory; - end; - -function ARGB_GetWorker: PImageFactory_Interface; - -function ARGB_BitmapFromIcon(Factory: PImageFactory_Interface; hdc: Windows.hdc; hIcon: hIcon): HBitmap; - -implementation - -{$DEFINE SHLCOM} -{$DEFINE COM_STRUCTS} -{$DEFINE COMAPI} -{$INCLUDE shlc.inc} -{$UNDEF SHLCOM} -{$UNDEF COM_STRUCTS} -{$UNDEF COMAPI} -{ - The following implementation has been ported from: - - http://web.archive.org/web/20080121112802/http://shellrevealed.com/blogs/shellblog/archive/2007/02/06/Vista-Style-Menus_2C00_-Part-1-_2D00_-Adding-icons-to-standard-menus.aspx - - It uses WIC (Windows Imaging Codec) to convert the given Icon into a bitmap in ARGB format, this is required - by Windows for use as an icon (but in bitmap format), so that Windows draws everything (including theme) - so we don't have to. - - Why didn't they just do this themselves? ... -} - -{ - The object returned from this function has to be released using the QI COM interface, don't forget. - Note this function won't work on anything where WIC isn't installed (XP can have it installed, but not by default) - anything less won't work. -} -function ARGB_GetWorker: PImageFactory_Interface; -var - hr: HResult; -begin - hr := CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER, - IID_WICImagingFactory, Result); -end; - -function ARGB_BitmapFromIcon(Factory: PImageFactory_Interface; hdc: Windows.hdc; hIcon: hIcon): HBitmap; -var - bmi: BITMAPINFO; - hr: HResult; - bitmap: PWICBitmap_Interface; - cx, cy: LongInt; - pbBuffer: PByte; - hBmp: HBitmap; - cbStride, cbBuffer: LongInt; -begin - { This code gives an icon to WIC and gets a bitmap object in return, it then creates a DIB section - which is 32bits and the same H*W as the icon. It then asks the bitmap object to copy itself into the DIB } - Result := 0; - ZeroMemory(@bmi, sizeof(bmi)); - bmi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER); - bmi.bmiHeader.biPlanes := 1; - bmi.bmiHeader.biCompression := BI_RGB; - - bmi.bmiHeader.biBitCount := 32; - - hr := Factory^.ptrVTable^.CreateBitmapFromHICON(Factory, hIcon, pointer(bitmap)); - if hr = S_OK then - begin - hr := bitmap^.ptrVTable^.GetSize(bitmap, cx, cy); - if hr = S_OK then - begin - - bmi.bmiHeader.biWidth := cx; - bmi.bmiHeader.biHeight := -cy; - - hBmp := CreateDIBSection(hdc, bmi, DIB_RGB_COLORS, pointer(pbBuffer), 0, 0); - if hBmp <> 0 then - begin - cbStride := cx * sizeof(DWORD); // ARGB = DWORD - cbBuffer := cy * cbStride; - // note: the pbBuffer memory is owned by the DIB and will be freed when the bitmap is released - hr := bitmap^.ptrVTable^.CopyPixels(bitmap, nil, cbStride, cbBuffer, pbBuffer); - if hr = S_OK then - begin - Result := hBmp; - end - else - begin - // the copy failed, delete the DIB - DeleteObject(hBmp); - end; - end; - end; - // release the bitmap object now - bitmap^.ptrVTable^.Release(bitmap); - bitmap := nil; - end; - -end; - -end. diff --git a/plugins/ShlExt/shlipc.pas b/plugins/ShlExt/shlipc.pas deleted file mode 100644 index 17ab511e52..0000000000 --- a/plugins/ShlExt/shlipc.pas +++ /dev/null @@ -1,394 +0,0 @@ -unit shlIPC; - -interface - -uses - - m_api, Windows; - -const - - REPLY_FAIL = $88888888; - REPLY_OK = $00000000; - - REQUEST_ICONS = 1; - REQUEST_GROUPS = (REQUEST_ICONS) shl 1; - REQUEST_CONTACTS = (REQUEST_GROUPS) shl 1; - REQUEST_XFRFILES = (REQUEST_CONTACTS) shl 1; - REQUEST_NEWICONS = (REQUEST_XFRFILES) shl 1; - REQUEST_CLEARMRU = (REQUEST_NEWICONS) shl 1; - - ICONS_NOTIMPL = $00000008; - GROUPS_NOTIMPL = $00000080; - CONTACTS_NOTIMPL = $00000800; - - STATUS_PROFILENAME = 2; - - - // there maybe more than one reason why any request type wasn't returned - -type - - { this can be a group entry, if it is, hContact = - the string contains the full group path } - - PSlotIPC = ^TSlotIPC; - - TSlotIPC = packed record - cbSize: Byte; - fType: int; // a REQUEST_* type - Next: PSlotIPC; - hContact: THandle; - hProto: Cardinal; // hash of the protocol the user is on - hGroup: Cardinal; // hash of the entire path (not defined for REQUEST_GROUPS slots) - Status: Word; - // only used for contacts -- can be STATUS_PROFILENAME -- but that is because returning the profile name is optional - MRU: Byte; // if set, contact has been recently used - cbStrSection: int; - end; - - // if the slot contains a nickname, after the NULL, there is another NULL or a group path string - - PSlotProtoIcons = ^TSlotProtoIcons; - - TSlotProtoIcons = packed record - pid: Cardinal; // pid of Miranda this protocol was on - hProto: Cardinal; // hash of the protocol - hIcons: array [0 .. 9] of HICON; // each status in order of ID_STATUS_* - hBitmaps: array [0 .. 9] of HBITMAP; // each status "icon" as a bitmap - end; - - TSlotProtoIconsArray = array [0 .. 0] of TSlotProtoIcons; - // the process space the thread is running in WILL use a different mapping - // address than the client's process space, addresses need to be adjusted - // to the client's process space.. this is done by the following means : - - // - // new_addr := (old_address - serverbase) + client base - // - // this isn't the best of solutions, the link list should be a variant array - // without random access, which would mean each element's different - // size would need to be computed each time it is accessed or read past - - PHeaderIPC = ^THeaderIPC; - - THeaderIPC = record - cbSize: Cardinal; - dwVersion: Cardinal; - pServerBaseAddress: Pointer; - pClientBaseAddress: Pointer; - fRequests: Cardinal; - dwFlags: Cardinal; - Slots: Cardinal; - Param: Cardinal; - SignalEventName: array [0 .. 63] of Char; - // Translate() won't work via Explorer - MirandaName: array [0 .. 63] of Char; - MRUMenuName: array [0 .. 63] of Char; // for the MRU menu itself - ClearEntries: array [0 .. 63] of Char; // for the "clear entries" - IconsBegin: PSlotIPC; - ContactsBegin: PSlotIPC; - GroupsBegin: PSlotIPC; - NewIconsBegin: PSlotIPC; - // start of an flat memory stack, which is referenced as a linked list - DataSize: int; - DataPtr: PSlotIPC; - DataPtrEnd: PSlotIPC; - DataFramePtr: Pointer; - end; - -const - HIPC_NOICONS = 1; - -procedure ipcPrepareRequests(ipcPacketSize: int; pipch: PHeaderIPC; fRequests: Cardinal); -function ipcSendRequest(hSignal, hWaitFor: THandle; pipch: PHeaderIPC; dwTimeoutMsecs: DWORD): Cardinal; -function ipcAlloc(pipch: PHeaderIPC; nSize: Integer): PSlotIPC; -procedure ipcFixupAddresses(FromServer: LongBool; pipch: PHeaderIPC); - -type - - TStrTokRec = record - szStr: PChar; - szSet: set of Char; - // need a delimiter after the token too?, e.g. FOO^BAR^ if FOO^BAR - // is the string then only FOO^ is returned, could cause infinite loops - // if the condition isn't accounted for thou. - bSetTerminator: Boolean; - end; - -function StrTok(var strr: TStrTokRec): PChar; - -type - - PGroupNode = ^TGroupNode; - - TGroupNode = record - Left, Right, _prev, _next: PGroupNode; - Depth: Cardinal; - Hash: Cardinal; // hash of the group name alone - szGroup: PChar; - cchGroup: Integer; - hMenu: THandle; - hMenuGroupID: Integer; - dwItems: Cardinal; - end; - - PGroupNodeList = ^TGroupNodeList; - - TGroupNodeList = record - First, Last: PGroupNode; - end; - -function AllocGroupNode(list: PGroupNodeList; Root: PGroupNode; Depth: Integer): PGroupNode; -function FindGroupNode(P: PGroupNode; const Hash, Depth: dword): PGroupNode; - -type - - // a contact can never be a submenu too. - TSlotDrawType = (dtEntry, dtGroup, dtContact, dtCommand); - TSlotDrawTypes = set of TSlotDrawType; - - PMenuDrawInfo = ^TMenuDrawInfo; - - TMenuCommandCallback = function(pipch: PHeaderIPC; // IPC header info, already mapped - hWorkThreadEvent: THandle; // event object being waited on on miranda thread - hAckEvent: THandle; // ack event object that has been created - psd: PMenuDrawInfo // command/draw info - ): Integer; stdcall; - - TMenuDrawInfo = record - szText: PChar; - szProfile: PChar; - cch: Integer; - wID: Integer; // should be the same as the menu item's ID - fTypes: TSlotDrawTypes; - hContact: THandle; - hStatusIcon: THandle; - // HICON from Self^.ProtoIcons[index].hIcons[status]; Do not DestroyIcon() - hStatusBitmap: THandle; // HBITMAP, don't free. - pid: Integer; - MenuCommandCallback: TMenuCommandCallback; // dtCommand must be set also. - end; - -implementation - -function FindGroupNode(P: PGroupNode; const Hash, Depth: dword): PGroupNode; -begin - Result := P; - while Result <> nil do - begin - if (Result^.Hash = Hash) and (Result^.Depth = Depth) then - Exit; - If Result^.Left <> nil then - begin - P := Result; - Result := FindGroupNode(Result^.Left, Hash, Depth); - If Result <> nil then - Exit; - Result := P; - end; - Result := Result^.Right; - end; // while -end; - -function AllocGroupNode(list: PGroupNodeList; Root: PGroupNode; Depth: Integer): PGroupNode; -begin - New(Result); - Result^.Left := nil; - Result^.Right := nil; - Result^.Depth := Depth; - if Depth > 0 then - begin - if Root^.Left = nil then - Root^.Left := Result - else - begin - Root := Root^.Left; - while Root^.Right <> nil do - Root := Root^.Right; - Root^.Right := Result; - end; - end - else - begin - if list^.First = nil then - list^.First := Result; - if list^.Last <> nil then - list^.Last^.Right := Result; - list^.Last := Result; - end; // if -end; - -procedure ipcPrepareRequests(ipcPacketSize: int; pipch: PHeaderIPC; fRequests: Cardinal); -begin - // some fields may already have values like the event object name to open - pipch^.cbSize := sizeof(THeaderIPC); - pipch^.dwVersion := PLUGIN_MAKE_VERSION(2, 0, 1, 2); - pipch^.dwFlags := 0; - pipch^.pServerBaseAddress := nil; - pipch^.pClientBaseAddress := pipch; - pipch^.fRequests := fRequests; - pipch^.Slots := 0; - pipch^.IconsBegin := nil; - pipch^.ContactsBegin := nil; - pipch^.GroupsBegin := nil; - pipch^.NewIconsBegin := nil; - pipch^.DataSize := ipcPacketSize - pipch^.cbSize; - // the server side will adjust these pointers as soon as it opens - // the mapped file to it's base address, these are set 'ere because ipcAlloc() - // maybe used on the client side and are translated by the server side. - // ipcAlloc() is used on the client side when transferring filenames - // to the ST thread. - uint_ptr(pipch^.DataPtr) := uint_ptr(pipch) + sizeof(THeaderIPC); - uint_ptr(pipch^.DataPtrEnd) := uint_ptr(pipch^.DataPtr) + pipch^.DataSize; - pipch^.DataFramePtr := pipch^.DataPtr; - // fill the data area - FillChar(pipch^.DataPtr^, pipch^.DataSize, 0); -end; - -function ipcSendRequest(hSignal, hWaitFor: THandle; pipch: PHeaderIPC; dwTimeoutMsecs: DWORD): Cardinal; -begin - { signal ST to work } - SetEvent(hSignal); - { wait for reply, it should open a handle to hWaitFor... } - while True do - begin - Result := WaitForSingleObjectEx(hWaitFor, dwTimeoutMsecs, True); - if Result = WAIT_OBJECT_0 then - begin - Result := pipch^.fRequests; - break; - end - else if Result = WAIT_IO_COMPLETION then - begin - (* APC call... *) - end - else - begin - Result := REPLY_FAIL; - break; - end; // if - end; // while -end; - -function ipcAlloc(pipch: PHeaderIPC; nSize: Integer): PSlotIPC; -var - PSP: uint_ptr; -begin - Result := nil; - { nSize maybe zero, in that case there is no string section --- } - PSP := uint_ptr(pipch^.DataFramePtr) + sizeof(TSlotIPC) + nSize; - { is it past the end? } - If PSP >= uint_ptr(pipch^.DataPtrEnd) then - Exit; - { return the pointer } - Result := pipch^.DataFramePtr; - { set up the item } - Result^.cbSize := sizeof(TSlotIPC); - Result^.cbStrSection := nSize; - { update the frame ptr } - pipch^.DataFramePtr := Pointer(PSP); - { let this item jump to the next yet-to-be-allocated-item which should be null anyway } - Result^.Next := Pointer(PSP); -end; - -procedure ipcFixupAddresses(FromServer: LongBool; pipch: PHeaderIPC); -var - pct: PSlotIPC; - q: ^PSlotIPC; - iServerBase: int_ptr; - iClientBase: int_ptr; -begin - if pipch^.pServerBaseAddress = pipch^.pClientBaseAddress then - Exit; - iServerBase := int_ptr(pipch^.pServerBaseAddress); - iClientBase := int_ptr(pipch^.pClientBaseAddress); - // fix up all the pointers in the header - if pipch^.IconsBegin <> nil then - begin - uint_ptr(pipch^.IconsBegin) := (uint_ptr(pipch^.IconsBegin) - iServerBase) + iClientBase; - end; // if - - if pipch^.ContactsBegin <> nil then - begin - uint_ptr(pipch^.ContactsBegin) := (uint_ptr(pipch^.ContactsBegin) - iServerBase) + iClientBase; - end; // if - - if pipch^.GroupsBegin <> nil then - begin - uint_ptr(pipch^.GroupsBegin) := (uint_ptr(pipch^.GroupsBegin) - iServerBase) + iClientBase; - end; // if - - if pipch^.NewIconsBegin <> nil then - begin - uint_ptr(pipch^.NewIconsBegin) := (uint_ptr(pipch^.NewIconsBegin) - iServerBase) + - iClientBase; - end; - uint_ptr(pipch^.DataPtr) := (uint_ptr(pipch^.DataPtr) - iServerBase) + iClientBase; - uint_ptr(pipch^.DataPtrEnd) := (uint_ptr(pipch^.DataPtrEnd) - iServerBase) + iClientBase; - uint_ptr(pipch^.DataFramePtr) := (uint_ptr(pipch^.DataFramePtr) - iServerBase) + iClientBase; - // and the link list - pct := pipch^.DataPtr; - while (pct <> nil) do - begin - // the first pointer is already fixed up, have to get a pointer - // to the next pointer and modify where it jumps to - q := @pct^.Next; - if q^ <> nil then - begin - uint_ptr(q^) := (uint_ptr(q^) - iServerBase) + iClientBase; - end; // if - pct := q^; - end; // while -end; - -function StrTok(var strr: TStrTokRec): PChar; -begin - Result := nil; - { don't allow #0's in sets or null strings } - If (strr.szStr = nil) or (#0 in strr.szSet) then - Exit; - { strip any leading delimiters } - while strr.szStr^ in strr.szSet do - Inc(strr.szStr); - { end on null? full of delimiters } - If strr.szStr^ = #0 then - begin - // wipe out the pointer - strr.szStr := nil; - Exit; - end; - { store the start of the token } - Result := strr.szStr; - { process til start of another delim } - while not(strr.szStr^ in strr.szSet) do - begin - { don't process past the real null, is a delimter required to cap the token? } - If strr.szStr^ = #0 then - break; - Inc(strr.szStr); - end; - { if we end on a null stop reprocessin' } - If strr.szStr^ = #0 then - begin - // no more tokens can be read - strr.szStr := nil; - // is a ending delimiter required? - If strr.bSetTerminator then - begin - // rollback - strr.szStr := Result; - Result := nil; - end; - // - end - else - begin - { mark the end of the token, may AV if a constant pchar is passed } - strr.szStr^ := #0; - { skip past this fake null for next time } - Inc(strr.szStr); - end; -end; - -end. -- cgit v1.2.3