Microsoft KB Archive/40869

From BetaArchive Wiki

Microsoft Knowledge Base

BC 6.00 Example of Single Process Using OS/2 Queue API CALLs

Last reviewed: September 25, 1997
Article ID: Q40869

6.00 6.00b OS/2 kbprg kbcode kbfile

The information in this article applies to:

  • Microsoft Basic Compiler for MS OS/2, versions 6.0 and 6.0b
  • Microsoft Basic Professional Development System (PDS) for MS OS/2, versions 7.0 and 7.1

SUMMARY

The information below provides an example of using MS OS/2 queues from Basic. In this example, a single Basic process (running in one OS/2 screen group) creates a queue, writes information to the queue, and reads information back from the queue. The example uses the following MS OS/2 API calls:

   DosCreateQueue
   DosReadQueue
   DosWriteQueue
   DosQueryQueue
   DosCloseQueue
   DosPeekQueue
   DosPurgeQueue
   DosAllocShrSeg
   DosGetShrSeg

This information does not apply to Microsoft QuickBasic, which only supports the MS-DOS operating system.

To download this code from the Microsoft Software Library:

Download BCOS2API.EXE, a self-extracting file, from the Microsoft Software Library (MSL) on the following services: You can find BCOS2API.EXE, a self-extracting file, on these services:

  • Microsoft's World Wide Web site on the Internet

          On the www.microsoft.com home page, click the Support icon
          Click Knowledge Base, and select the product
          Enter kbfile BCOS2API.EXE, and click GO!
          Open the article, and click the button to download the file
  • Internet (anonymous FTP)

          ftp ftp.microsoft.com
          Change to the Softlib/Mslfiles folder
          Get BCOS2API.EXE
  • The Microsoft Network

          On the Edit menu, click Go To, and then click Other Location
          Type "mssupport" (without the quotation marks)
          Double-click the MS Software Library icon
          Find the appropriate product area
          Locate and Download BCOS2API.EXE
  • Microsoft Download Service (MSDL)

          Dial (425) 936-6735 to connect to MSDL
          Download BCOS2API.EXE

For additional information about downloading, please see the following article in the Microsoft Knowledge Base:

   ARTICLE-ID: Q119591
   TITLE     : How to Obtain Microsoft Support Files from Online Services

MORE INFORMATION

The following files are listed below:

  1. Q3.BAS - A program that creates/reads a Queue
  2. QUEUE.BI - An include file used by Q3.BAS
  3. UTIL.BAS - Basic routines to read/write shared memory

The compile and LINK instructions are as follows:

  1. BC q3;
  2. BC util /x;
  3. LINK q3 util;

The following is Q3.BAS:

'===== Q3.BAS =====

REM $INCLUDE: 'queue.bi'

' Function for dealing with shared memory (UTIL.BAS).

DECLARE FUNCTION STRINGPOKE%(_

              P1  AS ADDRESS,_
              P2  AS STRING,_
              P3  AS INTEGER)

DECLARE FUNCTION STRINGPEEK%(_

              P1  AS ADDRESS,_
              P2  AS STRING,_
              P3  AS INTEGER)

DEFINT A-Z DIM info AS ADDRESS

DIM ep    AS STRING*1

' Queue name.

QNAME$="\QUEUES\NANCYBA"+CHR$(0)

QUEUETYPE=0    ' FIFO

' Create the Queue.

PRINT PRINT "Creating the Queue" PRINT x=DosCreateQueue%(QHandle,QueueType,varseg(Qname$),sadd(Qname$)) IF (x) THEN

   Print "An error occurred.  The number is : ";x
   stop

ELSE

   Print "The QUEUE ";qname$;" was CREATED"
   PRINT "The HANDLE is : ";qhandle

END IF

' Allocate memory for the Queue.

PRINT PRINT "Allocating Memory" PRINT SIZE=1024 ALLOCFLAGS=7 x=DosAllocSeg%(size,selector,allocflags) IF (x) THEN

   Print "An error occurred.  The number is : ";x
   stop

ELSE

   Print "The SEGMENT ";selector;" was CREATED"

END IF

' Place the data into memory and write the item to the Queue.

PRINT PRINT "Writing Data to the Queue PRINT FOR i = 0 to 5

   info.segment=selector
   info.offset=i*10
   st$="ITEM"+str$(i)
   strlen=len(st$)
   IF (stringpoke%(info,st$,strlen)) THEN
      PRINT "ERROR"
   ELSE
      x=DosWriteQueue%(QHandle,i+5,strlen,info.segment,info.offset,0)
      IF (x) THEN
         Print "An error occurred.  The number is : ";x
     END IF
   END IF

NEXT i PRINT PRINT "Loop until information is in the Queue" PRINT

' Loop until an error or item in the Queue.

DO

   x=DosQueryQueue%(Qhandle,number)
' Loop until error or number > 0:

LOOP WHILE ( (x <> 0) and (number <> 0) )

PRINT PRINT "Read the Information from the Queue" PRINT

' If error continue or read from the Queue.

IF (x) THEN

   Print "An Error Occurred.  The number is : ";x

ELSE

   PRINT "There are ";number;" items in the QUEUE"
   FOR i = 1 to number
      x=DosReadQueue%(Qhandle,pr&,dlen,_
                      item&,0%,1%,varseg(ep),varptr(ep),1&)
      IF (x) THEN
         Print "An error occurred.  The number is : ";x
      ELSE
         info.segment=item& \ (2^16)
         info.offset=item& mod (2^16)

         IF (stringpeek(info,st$,dlen)) THEN
            PRINT "ERROR"
         ELSE
            Print "The item in the QUEUE was : ";st$
         END IF
      END IF
   NEXT i

END IF PRINT "Hit Any Key to Continue..." WHILE INKEY$="" : WEND PRINT PRINT "Writing More information to the Queue"

' Write more information into the Queue.

FOR i = 6 to 11

   info.segment=selector
   info.offset=i*10
   st$="ITEM"+str$(i)
   strlen=len(st$)
   IF (stringpoke%(info,st$,strlen)) THEN
      PRINT "ERROR"
   ELSE
      x=DosWriteQueue%(QHandle,i+5,strlen,info.segment,info.offset,0)
      IF (x) THEN
         Print "An error occurred.  The number is : ";x
     END IF
   END IF

NEXT i

' Loop until error or number > 0.

DO

   x=DosQueryQueue%(Qhandle,number)

LOOP WHILE ( (x <> 0) and (number <> 0) ) PRINT PRINT "Peeking in the Queue (Note: The items aren't removed)" PRINT

' Look at items in the Queue, but do not remove them.

IF (x) THEN

   Print "An Error Occurred.  The number is : ";x

ELSE

   PRINT "There are ";number;" items in the QUEUE"
   FOR i = 1 to number
      x=DosPeekQueue%(Qhandle,pr&,dlen,item&,elm,1%,_
                      varseg(ep),varptr(ep),1&)
      IF (x) THEN
         Print "An error occurred.  The number is : ";x
      ELSE
         info.segment=item& \ (2^16)
         info.offset=item& mod (2^16)
         IF (stringpeek(info,st$,dlen)) THEN
            PRINT "ERROR"
         ELSE
            Print "The item in the QUEUE was : ";st$
         END IF
      END IF
   NEXT i

END IF PRINT PRINT "Peek Complete. View number of items in the Queue" PRINT

' See how many items are left.

x=DosQueryQueue%(Qhandle,number) IF (x) THEN

   Print "An error occurred.  The number is : ";x

ELSE

   PRINT "There are ";number;" items in the QUEUE"

END IF

' Delete the items in the Queue.

PRINT PRINT "Purge the Queue" PRINT x=DosPurgeQueue%(Qhandle) IF (x) THEN

   Print "An error occurred.  The number is : ";x

ELSE

   Print "The QUEUE was PURGED"

END IF

' See how many items are left.

x=DosQueryQueue%(Qhandle,number) IF (x) THEN

   Print "An error occurred.  The number is : ";x

ELSE

   PRINT "There are ";number;" items in the QUEUE"

END IF PRINT PRINT "Close the Queue" PRINT

' Close the Queue.

x=DosCloseQueue%(Qhandle) IF (x) THEN

   Print "An error occurred.  The number is : ";x

ELSE

   Print "The QUEUE was closed."

END IF END

The following is QUEUE.BI:

'===== QUEUE.BI =====
' This include file contains the routines needed for Queue usage.
' This information was taken from the BSEDOSPC.BI and BSEDOSPE.BI
' include files.

TYPE ADDRESS

     OFFSET  AS INTEGER
     SEGMENT AS INTEGER

END TYPE

DECLARE FUNCTION DOSCLOSEQUEUE%(_

        BYVAL P1 AS INTEGER)

DECLARE FUNCTION DOSCREATEQUEUE%(_

        SEG   P1  AS INTEGER,_
        BYVAL P2  AS INTEGER,_
        BYVAL P3s AS INTEGER,_
        BYVAL P3o AS INTEGER)

DECLARE FUNCTION DOSOPENQUEUE%(_

        SEG   P1  AS INTEGER,_
        SEG   P2  AS INTEGER,_
        BYVAL P3s AS INTEGER,_
        BYVAL P3o AS INTEGER)

DECLARE FUNCTION DOSPEEKQUEUE%(_

        BYVAL P1  AS INTEGER,_
        SEG   P2  AS LONG,_
        SEG   P3  AS INTEGER,_
        SEG   P4  AS LONG,_
        SEG   P5  AS INTEGER,_
        BYVAL P6  AS INTEGER,_
        BYVAL P7s AS INTEGER,_
        BYVAL P7o AS INTEGER,_
        BYVAL P8  AS LONG)

DECLARE FUNCTION DOSPURGEQUEUE%(_

        BYVAL P1  AS INTEGER)

DECLARE FUNCTION DOSQUERYQUEUE%(_

        BYVAL P1  AS INTEGER,_
        SEG   P2  AS INTEGER)

DECLARE FUNCTION DOSREADQUEUE%(_

        BYVAL P1  AS INTEGER,_
        SEG   P2  AS LONG,_
        SEG   P3  AS INTEGER,_
        SEG   P4  AS LONG,_
        BYVAL P5  AS INTEGER,_
        BYVAL P6  AS INTEGER,_
        BYVAL P7s AS INTEGER,_
        BYVAL P7o AS INTEGER,_
        BYVAL P8  AS LONG)

DECLARE FUNCTION DOSWRITEQUEUE%(_

        BYVAL P1  AS INTEGER,_
        BYVAL P2  AS INTEGER,_
        BYVAL P3  AS INTEGER,_
        BYVAL P4s AS INTEGER,_
        BYVAL P4o AS INTEGER,_
        BYVAL P5  AS INTEGER)

DECLARE FUNCTION DOSALLOCSEG%(_

        BYVAL P1  AS INTEGER,_
        SEG   P2  AS INTEGER,_
        BYVAL P3  AS INTEGER)

DECLARE FUNCTION DOSALLOCSHRSEG%(_

        BYVAL P1  AS INTEGER,_
        BYVAL P2s AS INTEGER,_
        BYVAL P2o AS INTEGER,_
        SEG   P3  AS INTEGER)

DECLARE FUNCTION DOSGETSHRSEG%(_

        BYVAL P1s AS INTEGER,_
        BYVAL P1o AS INTEGER,_
        SEG   P2  AS INTEGER)

The following is UTIL.BAS:

'===== UTIL.BAS =====
'=This file contains a few useful Basic routines for dealing
'=with the MS OS/2 SDK.

CONST TRUE = -1 CONST FALSE = 0 TYPE ADDRESS

     offset  AS INTEGER
     segment AS INTEGER

END TYPE DEFINT A-Z

DECLARE FUNCTION WDate$ (P1 AS INTEGER) DECLARE FUNCTION WTime$ (P1 AS INTEGER) DECLARE FUNCTION RightShift% (P1 AS LONG, P2 AS INTEGER) DECLARE FUNCTION LeftShift% (P1 AS LONG, P2 AS INTEGER) DECLARE FUNCTION FileType$ (P1 AS INTEGER) DECLARE FUNCTION Unsigned& (P1 AS INTEGER) DECLARE FUNCTION StringPeek% (P1 AS ADDRESS, _

                              P2 AS STRING, P3 AS INTEGER)

DECLARE FUNCTION IntegerPeek% (P1 AS ADDRESS, P2 AS INTEGER) DECLARE FUNCTION LongPeek% (P1 AS ADDRESS, P2 AS LONG) DECLARE FUNCTION SinglePeek% (P1 AS ADDRESS, P2 AS SINGLE) DECLARE FUNCTION DoublePeek% (P1 AS ADDRESS, P2 AS DOUBLE) DECLARE FUNCTION StringPoke% (info AS ANY, st$, strlen%)

' ERROR HANDLER.

ErrorHandler:

   status% = TRUE
   RESUME NEXT

'==========================================================
'= DoublePeek%  : Returns a Double at the given segment and offset
'= Arguments
'=      INFO    : structure containing segment and offset
'=      Number# : double to be returned
'=
'= Return
'=     TRUE    : If an error occurs
'=     FALSE   : If everything went OK

FUNCTION DoublePeek% (info AS ADDRESS, number#) SHARED status% ON ERROR GOTO ErrorHandler status% = FALSE

  DEF SEG = info.segment
  i = 0
  WHILE (NOT status%) AND (i < 8)
      hold$ = hold$ + CHR$(PEEK(info.offset + i))
      PRINT PEEK(info.offset + i);
      i = i + 1
  WEND
  DEF SEG
  number# = CVD(hold$)
  DoublePeek% = status%

END FUNCTION

'==========================================================
'= FileType$ : Determine the type of file by its attributes
'= Arguments
'=      attr : Attribute Number
'=
'= Return
'=      String containing the file type

FUNCTION FileType$ (attr)

  SELECT CASE attr
     CASE 0
        FileType$ = "Normal File"
     CASE 1
        FileType$ = "Read-Only File"
     CASE 2
        FileType$ = "Hidden File"
     CASE 4
        FileType$ = "System File"
     CASE &H10
        FileType$ = "Subdirectory"
     CASE &H20
        FileType$ = "File Archive"
     CASE ELSE
        FileType$ = "Unknown Type"
  END SELECT

END FUNCTION

'==========================================================
'= IntegerPeek% : Finds an integer at a given segment and
'=                offset
'= Arguments
'=      INFO    : structure containing segment and offset
'=      Number% : integer to be returned
'=
'= Return
'=      TRUE    : If an error occurs
'=      FALSE   : If everything went OK

FUNCTION IntegerPeek% (info AS ADDRESS, number%) SHARED status% ON ERROR GOTO ErrorHandler status% = FALSE

  DEF SEG = info.segment
  i = 0
  WHILE (NOT status%) AND (i < 2)
      hold$ = hold$ + CHR$(PEEK(info.offset + i))
      i = i + 1
  WEND
  DEF SEG
  number% = CVI(hold$)
  interpeek% = status%

END FUNCTION

'==========================================================
'= LeftShift% : Shift Bits to the left ====================
'= Arguments
'=      Number : Long to be shifted (unsigned integer)
'=      Amount : Amount to be shifted
'=
'= Return
'=      The shifted SIGNED integer

FUNCTION LeftShift% (number&, amount)

  LeftShift = number& * (2 ^ amount)

END FUNCTION

'==========================================================
'= LongPeek% : Finds a long at a given segment and offset
'= Arguments
'=      INFO    : structure containing segment and offset
'=      Number& : long to be returned
'=
'= Return
'=     TRUE    : If an error occurs
'=     FALSE   : If everything went OK

FUNCTION LongPeek% (info AS ADDRESS, number&) SHARED status% ON ERROR GOTO ErrorHandler status% = FALSE

  DEF SEG = info.segment
  i = 0
  WHILE (NOT status%) AND (i < 4)
      PRINT PEEK(info.offset + i)
      hold$ = hold$ + CHR$(PEEK(info.offset + i))
      i = i + 1
  WEND
  DEF SEG
  number& = CVL(hold$)
  LongPeek% = status%

END FUNCTION

'==========================================================
'= RightShift% : Shift bits to the right ==================
'= Arguments
'=      Number : Long to be shifted (unsigned integer)
'=      Amount : Amount to be shifted
'=
'= Return
'=      The shifted SIGNED integer

FUNCTION RightShift% (number&, amount)

   RightShift = number& \ 2 ^ amount

END FUNCTION

'============================================================
'= SinglePeek! : Finds a single at a given segment and offset
'= Arguments
'=      INFO    : structure containing segment and offset
'=      Number! : single to be returned
'=
'= Return
'=     TRUE    : If an error occurs
'=     FALSE   : If everything went OK

FUNCTION SinglePeek% (info AS ADDRESS, number!) SHARED status% ON ERROR GOTO ErrorHandler status% = FALSE

  DEF SEG = info.segment
  i = 0
  WHILE (NOT status%) AND (i < 4)
      hold$ = hold$ + CHR$(PEEK(info.offset + i))
      PRINT PEEK(info.offset + i);
      i = i + 1
  WEND
  DEF SEG
  number! = CVS(hold$)
  SinglePeek% = status%
  PRINT

END FUNCTION

'==========================================================
'= StringPeek% : Given segment and offset create a string
'=               with length STRLEN
'= Arguments
'=      INFO   : structure containing segment and offset
'=      ST$    : String to be returned
'=      STRLEN : Length max length of the string
'=               If the a NULL is found before the counter
'=               is greater than max length, the new length
'=               of the string is returned in STRLEN.
'= Return
'=     TRUE    : If an error occurs
'=     FALSE   : If everything went OK

FUNCTION StringPeek% (info AS ADDRESS, st$, strlen) DIM null AS STRING * 1 SHARED status% ON ERROR GOTO ErrorHandler

   null = CHR$(0)
   incr = 0
   st$ = null
   status% = FALSE
   DEF SEG = info.segment
   DO
     c$ = CHR$(PEEK(info.offset + incr))
     st$ = st$ + c$
     incr = incr + 1
   LOOP WHILE ((c$ <> null) AND (incr < strlen) AND (NOT status%))
   strlen = incr
   StringPeek% = status%

END FUNCTION

'==========================================================
'= StringPoke% : Poke a given string into the segment and
'=               offset provided
'= Arguments
'=      INFO   : structure containing the segment and offset
'=      ST$    : the string
'=      Strlen : length of the string
'=
'= Return
'=     TRUE    : If an error occurs
'=     FALSE   : If everything went OK
'=
'= Notes
'=    This function can also be used for placing numbers into
'=    memory. MKx$ can be used to convert the number to a
'=    string.  This string can be passed to the routine.

FUNCTION StringPoke% (info AS ADDRESS, st$, strlen) DIM null AS STRING * 1 SHARED status% ON ERROR GOTO ErrorHandler

   incr = 0
   status% = FALSE
   DEF SEG = info.segment
   DO
     POKE info.offset + incr, ASC(MID$(st$, incr + 1, incr + 1))
     incr = incr + 1
   LOOP WHILE ((incr < strlen) AND (NOT status%))
  strlen = incr
  DEF SEG
  StringPoke% = status%

END FUNCTION

'==========================================================
'= Unsigned& : Convert signed integer to unsigned long ====
'= Arguments
'=      NUM% : Signed integer to be converted to unsigned
'=             long
'= Return
'=      Long which is the unsigned integer

FUNCTION Unsigned& (num)

   IF num >= 0 THEN
      Unsigned& = num
   ELSE
      Unsigned& = 65536 + num
   END IF

END FUNCTION

'==========================================================
'= WDate$ : FUNCTION to print file date returned by FindNext
'= Arguments
'=      d%  : Number to be printed as the date
'=
'= Return
'=      String containing the date

FUNCTION WDate$ (d%) STATIC DIM dl AS LONG

    dl = Unsigned&(d%)
    mn = (RightShift%(dl, 5)) AND (&HF)
    IF mn < 10 THEN
       mn$ = "0" + LTRIM$(STR$(mn))
    ELSE
       mn$ = LTRIM$(STR$(mn))
    END IF
    dy = dl AND (&H1F)
    IF dy < 10 THEN
       dy$ = "0" + LTRIM$(STR$(dy))
    ELSE
       dy$ = LTRIM$(STR$(dy))
    END IF
    yr$ = STR$(RightShift(dl, 9) + 1980)
    WDate$ = mn$ + "/" + dy$ + "/" + LTRIM$(yr$)

END FUNCTION

'==========================================================
'= WTime$ : FUNCTION to print file time returned by FindNext
'= Arguments
'=      d%  : Number to be printed as the time
'=
'= Return
'=      String containing the time

FUNCTION WTime$ (d%) DIM dl AS LONG

   dl = Unsigned&(d%)
   hr = RightShift%(dl, 11) AND (&H1F)
   IF hr < 10 THEN
      hr$ = "0" + LTRIM$(STR$(hr))
   ELSE
      hr$ = LTRIM$(STR$(hr))
   END IF
   mt = (RightShift%(dl, 5) AND (&H3F))
   IF mt < 10 THEN
      mt$ = "0" + LTRIM$(STR$(mt))
   ELSE
      mt$ = LTRIM$(STR$(mt))
   END IF
   WTime$ = LTRIM$(hr$) + ":" + mt$ + STRING$(5, 32)

END FUNCTION


Additional reference words: BasicCom 6.00 6.00b 7.00 7.10 softlib BCOS2API

KBCategory: kbprg kbcode kbfile
KBSubcategory:
Keywords : kbcode kbfile kbprg
Version : 6.00 6.00b
Platform : OS/2


THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY.

Last reviewed: September 25, 1997
©1997 Microsoft Corporation. All rights reserved. Legal Notices.