only add some plugins and protocols, not adapted

See please maybe not all need us

git-svn-id: http://svn.miranda-ng.org/main/trunk@678 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 369 insertions, 0 deletions

diff --git a/plugins/ShlExt/shlipc.pas b/plugins/ShlExt/shlipc.pas
new file mode 100644
index 0000000000..377a82f294
--- /dev/null
+++ b/plugins/ShlExt/shlipc.pas
@@ -0,0 +1,369 @@
+unit shlIPC;
+
+interface
+
+uses
+
+    m_globaldefs, 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: Integer): 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
+
+    {$include m_helpers.inc}
+
+    function FindGroupNode(P: PGroupNode; const Hash, Depth: Integer): 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.
+        Integer(pipch^.DataPtr) := Integer(pipch) + sizeof(THeaderIPC);
+        Integer(pipch^.DataPtrEnd) := Integer(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: int;
+    begin
+        Result := nil;
+        { nSize maybe zero, in that case there is no string section --- }
+        PSP := int( pipch^.DataFramePtr ) + sizeof(TSlotIPC) + nSize;
+        { is it past the end? }
+        If PSP >= int(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: Integer;
+        iClientBase: Integer;
+    begin
+        if pipch^.pServerBaseAddress = pipch^.pClientBaseAddress then Exit;
+        iServerBase := Integer(pipch^.pServerBaseAddress);
+        iClientBase := Integer(pipch^.pClientBaseAddress);
+        // fix up all the pointers in the header
+        if pipch^.iconsBegin <> nil then
+        begin
+            Integer(pipch^.IconsBegin) := (Integer(pipch^.IconsBegin) - iServerBase) + iClientBase;
+        end; //if
+        if pipch^.contactsBegin <> nil then
+        begin
+            Integer(pipch^.ContactsBegin) := (Integer(pipch^.ContactsBegin) - iServerBase) + iClientBase;
+        end; //if
+        if pipch^.groupsBegin <> nil then
+        begin
+            Integer(pipch^.GroupsBegin) := (Integer(pipch^.GroupsBegin) - iServerBase) + iClientBase;
+        end; //if
+		if pipch^.NewIconsBegin <> nil then
+		begin
+			Integer(pipch^.NewIconsBegin) := (Integer(pipch^.NewIconsBegin) - iServerBase) + iClientBase;
+		end;
+        Integer(pipch^.DataPtr) := (Integer(pipch^.DataPtr) - iServerBase) + iClientBase;
+        Integer(pipch^.DataPtrEnd) := (Integer(pipch^.DataPtrEnd) - iServerBase) + iClientBase;
+        Integer(pipch^.DataFramePtr) := (Integer(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
+                Integer(q^) := (Integer(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.
+
+