Added my Miranda API pascal version

Changed ShlExt to my API compilation (32 bit FPC now only)

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

1 files changed, 392 insertions, 365 deletions

diff --git a/plugins/ShlExt/shlipc.pas b/plugins/ShlExt/shlipc.pas
index 377a82f294..f2195f8060 100644
--- a/plugins/ShlExt/shlipc.pas
+++ b/plugins/ShlExt/shlipc.pas
@@ -1,369 +1,396 @@
 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.
+

+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: 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.

+  int_ptr(pipch^.DataPtr) := int_ptr(pipch) + sizeof(THeaderIPC);

+  int_ptr(pipch^.DataPtrEnd) := int_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: 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: 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

+    int_ptr(pipch^.IconsBegin) := (int_ptr(pipch^.IconsBegin) - iServerBase) + iClientBase;

+  end; // if

+  if pipch^.ContactsBegin <> nil then

+  begin

+    int_ptr(pipch^.ContactsBegin) := (int_ptr(pipch^.ContactsBegin) - iServerBase) +

+      iClientBase;

+  end; // if

+  if pipch^.GroupsBegin <> nil then

+  begin

+    int_ptr(pipch^.GroupsBegin) := (int_ptr(pipch^.GroupsBegin) - iServerBase) + iClientBase;

+  end; // if

+  if pipch^.NewIconsBegin <> nil then

+  begin

+    int_ptr(pipch^.NewIconsBegin) := (int_ptr(pipch^.NewIconsBegin) - iServerBase) +

+      iClientBase;

+  end;

+  int_ptr(pipch^.DataPtr) := (int_ptr(pipch^.DataPtr) - iServerBase) + iClientBase;

+  int_ptr(pipch^.DataPtrEnd) := (int_ptr(pipch^.DataPtrEnd) - iServerBase) + iClientBase;

+  int_ptr(pipch^.DataFramePtr) := (int_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

+      int_ptr(q^) := (int_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;

 

-
-
-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.
-
-