home *** CD-ROM | disk | FTP | other *** search
/ Solo Programadores 22 / SOLO_22.iso / packages / win32ada / data.z / win32-objbase.adb < prev    next >
Encoding:
Text File  |  1995-12-27  |  2.9 KB  |  86 lines
  1. -- $Source: /home/harp/1/proto/monoBANK/winnt/win32-objbase.adb,v $ 
  2. -- $Revision: 1.4 $ $Date: 95/02/07 15:12:37 $ $Author: mg $ 
  3. -------------------------------------------------------------------------------
  4. --
  5. -- THIS FILE AND ANY ASSOCIATED DOCUMENTATION IS FURNISHED "AS IS" WITHOUT 
  6. -- WARRANTY OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED 
  7. -- TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR 
  8. -- PURPOSE.  The user assumes the entire risk as to the accuracy and the 
  9. -- use of this file.
  10. --
  11. -- Copyright (c) Intermetrics, Inc. 1995
  12. -- Royalty-free, unlimited, worldwide, non-exclusive use, modification, 
  13. -- reproduction and further distribution of this file is permitted.
  14. --
  15. -------------------------------------------------------------------------------
  16.  
  17.  
  18. with Ada.Unchecked_Conversion;
  19. with Win32.Strings;
  20.  
  21. package body Win32.Objbase is
  22.  
  23.     use type Interfaces.C.Unsigned_Long;
  24.     use type Interfaces.C.Int;
  25.  
  26.     procedure LISet32(li : in out Win32.Winnt.anonymous1_t;
  27.                       v  : in Win32.DWORD) is            -- objbase.h: 245
  28.     begin
  29.         if ( v < 0) then
  30.             li.HighPart := -1;
  31.         else  
  32.             li.HighPart := 0;   
  33.         end if;
  34.         li.LowPart := v;
  35.     end LISet32;
  36.  
  37.     procedure ULISet32(li : in out Win32.Winnt.anonymous1_t;
  38.                        v  : in Win32.DWORD) is           -- objbase.h: 247
  39.     begin
  40.         li.HighPart := 0;
  41.         li.LowPart := v;
  42.     end ULISet32;
  43.  
  44.     function To_UINT is new Ada.Unchecked_Conversion(CLSCTX, Win32.UINT);
  45.  
  46.     function CLSCTX_ALL return Win32.UINT is            -- objbase.h:254
  47.     begin
  48.     return To_UINT(CLSCTX_INPROC_SERVER) or 
  49.         To_UINT(CLSCTX_INPROC_HANDLER) or To_UINT(CLSCTX_LOCAL_SERVER);
  50.  
  51.     end CLSCTX_ALL;
  52.  
  53.     function CLSCTX_INPROC return Win32.UINT is            -- objbase.h:258
  54.     begin
  55.     return To_UINT(CLSCTX_INPROC_SERVER) or To_UINT(CLSCTX_INPROC_HANDLER);
  56.     end CLSCTX_INPROC;
  57.  
  58.     function CLSCTX_SERVER return Win32.UINT is            -- objbase.h:260
  59.     begin
  60.     return To_UINT(CLSCTX_INPROC_SERVER) or To_UINT(CLSCTX_LOCAL_SERVER);
  61.     end CLSCTX_SERVER;
  62.  
  63.     function IsEqualGUID(rguid1: REFGUID;
  64.                          rguid2: REFGUID) 
  65.                          return Win32.BOOL is               -- objbase.h:8923
  66.     function To_PCVOID is new Ada.Unchecked_Conversion(REFGUID,
  67.         Win32.PCVOID);
  68.     begin
  69.         if (Win32.Strings.memcmp(To_PCVOID(rguid1), 
  70.                  To_PCVOID(rguid2), 
  71.                  Win32.Rpcdce.GUID'size) = Win32.FALSE) then
  72.         return Win32.TRUE;
  73.         end if;
  74.     return Win32.FALSE;
  75.     end IsEqualGUID;
  76.  
  77.     function IsEqualCLSID(rclsid1: REFCLSID;
  78.                           rclsid2: REFCLSID) 
  79.                           return Win32.BOOL is          -- objbase.h:953,8926  
  80.     begin
  81.         return IsEqualGUID(REFGUID(rclsid1), REFGUID(rclsid2));
  82.     end IsEqualCLSID;
  83.  
  84.  
  85. end Win32.Objbase;
  86.