diff options
Diffstat (limited to 'plugins/!NotAdopted/ShlExt')
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/clean.bat | 1 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/docs/HowToBuild.txt | 22 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/docs/shlext release notes.txt | 344 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/make.bat | 9 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/resource.h | 13 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/shlc.inc | 144 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/shlcom.pas | 2502 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/shldlgs.rc | 93 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/shldlgs.res | bin | 0 -> 2616 bytes | |||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/shlext.dpr | 397 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/shlicons.pas | 168 | ||||
| -rw-r--r-- | plugins/!NotAdopted/ShlExt/shlipc.pas | 394 |
12 files changed, 4087 insertions, 0 deletions
diff --git a/plugins/!NotAdopted/ShlExt/clean.bat b/plugins/!NotAdopted/ShlExt/clean.bat new file mode 100644 index 0000000000..575eed729c --- /dev/null +++ b/plugins/!NotAdopted/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/!NotAdopted/ShlExt/docs/HowToBuild.txt b/plugins/!NotAdopted/ShlExt/docs/HowToBuild.txt new file mode 100644 index 0000000000..53b6738616 --- /dev/null +++ b/plugins/!NotAdopted/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/!NotAdopted/ShlExt/docs/shlext release notes.txt b/plugins/!NotAdopted/ShlExt/docs/shlext release notes.txt new file mode 100644 index 0000000000..0e58edf9ff --- /dev/null +++ b/plugins/!NotAdopted/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/!NotAdopted/ShlExt/make.bat b/plugins/!NotAdopted/ShlExt/make.bat new file mode 100644 index 0000000000..40131550cf --- /dev/null +++ b/plugins/!NotAdopted/ShlExt/make.bat @@ -0,0 +1,9 @@ +@echo off
+REM -Fi/u are for include/unit dirs
+REM -Mdelphi is delphi mode
+REM -WG - graphical app
+REM -v0 turn off warnings
+REM -O2 -Os // optimise
+REM -Rintel (intel style asm)
+REM -WB (relocatable) -WR (relocate)
+fpc shlext.dpr -Fiinc -Fuinc -Mdelphi -WG -O2 -Os -Rintel -WR -WB49ac0000 -v0
\ No newline at end of file diff --git a/plugins/!NotAdopted/ShlExt/resource.h b/plugins/!NotAdopted/ShlExt/resource.h new file mode 100644 index 0000000000..c89660a88d --- /dev/null +++ b/plugins/!NotAdopted/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/!NotAdopted/ShlExt/shlc.inc b/plugins/!NotAdopted/ShlExt/shlc.inc new file mode 100644 index 0000000000..2952de8c74 --- /dev/null +++ b/plugins/!NotAdopted/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/!NotAdopted/ShlExt/shlcom.pas b/plugins/!NotAdopted/ShlExt/shlcom.pas new file mode 100644 index 0000000000..d3377d9cda --- /dev/null +++ b/plugins/!NotAdopted/ShlExt/shlcom.pas @@ -0,0 +1,2502 @@ +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;
+
+function IssueTransferThread(pipch: PHeaderIPC): Cardinal; stdcall;
+var
+ szBuf: array [0 .. MAX_PATH] of Char;
+ pct: PSlotIPC;
+ args: TAddArgList;
+ bQuit: LongBool;
+ j, c: Cardinal;
+ p: Pointer;
+ hMainThread: THandle;
+begin
+ result:=0;
+ Thread_Push(0,nil);
+ 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);
+ Thread_Pop();
+ ExitThread(0);
+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_ENUMPROTOCOLS, wParam(@protoCount), lParam(@pp)) = 0) and
+ (protoCount <> 0) then
+ begin
+ spi.pid := GetCurrentProcessId();
+ while protoCount > 0 do
+ begin
+ if (pp^._type = PROTOTYPE_PROTOCOL) then
+ 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
+ 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 := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
+ 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 := CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
+ continue;
+ end;
+ dwStatus := DBGetContactSettingWord(hContact, szProto, 'Status', ID_STATUS_OFFLINE);
+ if dwStatus <> ID_STATUS_OFFLINE then
+ inc(dwOnline)
+ else if bHideOffline then
+ begin
+ hContact := CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
+ 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 := CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
+ 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 := CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
+ 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 := CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
+ 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
+function ClearMRUThread(notused: Pointer): Cardinal; stdcall;
+{$DEFINE SHL_IDC}
+{$DEFINE SHL_KEYS}
+{$INCLUDE shlc.inc}
+{$UNDEF SHL_KEYS}
+{$UNDEF SHL_IDC}
+var
+ hContact: THandle;
+begin
+ result:=0;
+ Thread_Push(0,nil);
+
+ begin
+ hContact := CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
+ 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 := CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
+ end;
+ end;
+ Thread_Pop();
+ ExitThread(0);
+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;
+ tid: Cardinal;
+ 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);
+ CloseHandle(CreateThread(nil, 0, @IssueTransferThread, cloned, 0, tid));
+ 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
+ CloseHandle(CreateThread(nil, 0, @ClearMRUThread, nil, 0, tid));
+ 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;
+
+function ThreadServer(hMainThread: Pointer): Cardinal;
+{$IFDEF FPC}
+stdcall;
+{$ENDIF}
+var
+ hEvent: THandle;
+begin
+ result:=0;
+ Thread_Push(0,nil);
+ hEvent := CreateEvent(nil, False, False, PChar(CreateProcessUID(GetCurrentProcessId())));
+ while True do
+ begin
+ Result := WaitForSingleObjectEx(hEvent, INFINITE, True);
+ if Result = 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));
+ Thread_Pop();
+ ExitThread(0);
+end;
+
+procedure InvokeThreadServer;
+var
+{$IFDEF FPC}
+ tid: LongWord;
+{$ELSE}
+ tid: Cardinal;
+{$ENDIF}
+var
+ hMainThread: THandle;
+begin
+ hMainThread := 0;
+ DuplicateHandle(GetCurrentProcess(), GetCurrentThread(), GetCurrentProcess(), @hMainThread,
+ THREAD_SET_CONTEXT, False, 0);
+ if hMainThread <> 0 then
+ begin
+{$IFDEF FPC}
+ CloseHandle(CreateThread(nil, 0, @ThreadServer, Pointer(hMainThread), 0, tid));
+{$ELSE}
+ CloseHandle(BeginThread(nil, 0, @ThreadServer, Pointer(hMainThread), 0, tid));
+{$ENDIF}
+ end; // if
+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/!NotAdopted/ShlExt/shldlgs.rc b/plugins/!NotAdopted/ShlExt/shldlgs.rc new file mode 100644 index 0000000000..0e9cd82b04 --- /dev/null +++ b/plugins/!NotAdopted/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/!NotAdopted/ShlExt/shldlgs.res b/plugins/!NotAdopted/ShlExt/shldlgs.res Binary files differnew file mode 100644 index 0000000000..3de576e992 --- /dev/null +++ b/plugins/!NotAdopted/ShlExt/shldlgs.res diff --git a/plugins/!NotAdopted/ShlExt/shlext.dpr b/plugins/!NotAdopted/ShlExt/shlext.dpr new file mode 100644 index 0000000000..d8745532f2 --- /dev/null +++ b/plugins/!NotAdopted/ShlExt/shlext.dpr @@ -0,0 +1,397 @@ +{$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}="<description>"
+ 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;
+ cgs: TDBCONTACTGETSETTING;
+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
+ cgs.szModule := SHLExt_Name;
+
+ cgs.szSetting := SHLExt_UseGroups;
+ CallService(MS_DB_CONTACT_DELETESETTING, 0, TLPARAM(@cgs));
+
+ cgs.szSetting := SHLExt_UseCListSetting;
+ CallService(MS_DB_CONTACT_DELETESETTING, 0, TLPARAM(@cgs));
+
+ cgs.szSetting := SHLExt_UseHITContacts;
+ CallService(MS_DB_CONTACT_DELETESETTING, 0, TLPARAM(@cgs));
+
+ cgs.szSetting := SHLExt_UseHIT2Contacts;
+ CallService(MS_DB_CONTACT_DELETESETTING, 0, TLPARAM(@cgs));
+
+ cgs.szSetting := SHLExt_ShowNoProfile;
+ CallService(MS_DB_CONTACT_DELETESETTING, 0, TLPARAM(@cgs));
+
+ cgs.szSetting := SHLExt_ShowNoIcons;
+ CallService(MS_DB_CONTACT_DELETESETTING, 0, TLPARAM(@cgs));
+
+ cgs.szSetting := SHLExt_ShowNoOffline;
+ CallService(MS_DB_CONTACT_DELETESETTING, 0, TLPARAM(@cgs));
+
+ (* 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. Built on ' +
+ {$I %DATE%} +' at ' + {$I %TIME%} +' with FPC ' + {$I %FPCVERSION%};
+{$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;
+
+begin
+
+end. diff --git a/plugins/!NotAdopted/ShlExt/shlicons.pas b/plugins/!NotAdopted/ShlExt/shlicons.pas new file mode 100644 index 0000000000..195033ae8d --- /dev/null +++ b/plugins/!NotAdopted/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/!NotAdopted/ShlExt/shlipc.pas b/plugins/!NotAdopted/ShlExt/shlipc.pas new file mode 100644 index 0000000000..17ab511e52 --- /dev/null +++ b/plugins/!NotAdopted/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 = <index>
+ 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. |