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