Microsoft KB Archive/40869

= 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 &quot;mssupport&quot; (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$=&quot;\QUEUES\NANCYBA&quot;+CHR$(0)

QUEUETYPE=0   ' FIFO

' Create the Queue. PRINT PRINT &quot;Creating the Queue&quot; PRINT x=DosCreateQueue%(QHandle,QueueType,varseg(Qname$),sadd(Qname$)) IF (x) THEN

Print &quot;An error occurred. The number is : &quot;;x stop ELSE

Print &quot;The QUEUE &quot;;qname$;&quot; was CREATED&quot; PRINT &quot;The HANDLE is : &quot;;qhandle END IF

' Allocate memory for the Queue. PRINT PRINT &quot;Allocating Memory&quot; PRINT SIZE=1024 ALLOCFLAGS=7 x=DosAllocSeg%(size,selector,allocflags) IF (x) THEN

Print &quot;An error occurred. The number is : &quot;;x stop ELSE

Print &quot;The SEGMENT &quot;;selector;&quot; was CREATED&quot; END IF

' Place the data into memory and write the item to the Queue. PRINT PRINT &quot;Writing Data to the Queue PRINT FOR i = 0 to 5

info.segment=selector info.offset=i*10 st$=&quot;ITEM&quot;+str$(i) strlen=len(st$) IF (stringpoke%(info,st$,strlen)) THEN PRINT &quot;ERROR&quot; ELSE x=DosWriteQueue%(QHandle,i+5,strlen,info.segment,info.offset,0) IF (x) THEN Print &quot;An error occurred. The number is : &quot;;x END IF  END IF NEXT i PRINT PRINT &quot;Loop until information is in the Queue&quot; 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 &quot;Read the Information from the Queue&quot; PRINT

' If error continue or read from the Queue. IF (x) THEN

Print &quot;An Error Occurred. The number is : &quot;;x ELSE

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

IF (stringpeek(info,st$,dlen)) THEN PRINT &quot;ERROR&quot; ELSE Print &quot;The item in the QUEUE was : &quot;;st$ END IF     END IF   NEXT i END IF PRINT &quot;Hit Any Key to Continue...&quot; WHILE INKEY$=&quot;&quot; : WEND PRINT PRINT &quot;Writing More information to the Queue&quot;

' Write more information into the Queue. FOR i = 6 to 11

info.segment=selector info.offset=i*10 st$=&quot;ITEM&quot;+str$(i) strlen=len(st$) IF (stringpoke%(info,st$,strlen)) THEN PRINT &quot;ERROR&quot; ELSE x=DosWriteQueue%(QHandle,i+5,strlen,info.segment,info.offset,0) IF (x) THEN Print &quot;An error occurred. The number is : &quot;;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 &quot;Peeking in the Queue (Note: The items aren't removed)&quot; PRINT

' Look at items in the Queue, but do not remove them. IF (x) THEN

Print &quot;An Error Occurred. The number is : &quot;;x ELSE

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

' See how many items are left. x=DosQueryQueue%(Qhandle,number) IF (x) THEN

Print &quot;An error occurred. The number is : &quot;;x ELSE

PRINT &quot;There are &quot;;number;&quot; items in the QUEUE&quot; END IF

' Delete the items in the Queue. PRINT PRINT &quot;Purge the Queue&quot; PRINT x=DosPurgeQueue%(Qhandle) IF (x) THEN

Print &quot;An error occurred. The number is : &quot;;x ELSE

Print &quot;The QUEUE was PURGED&quot; END IF

' See how many items are left. x=DosQueryQueue%(Qhandle,number) IF (x) THEN

Print &quot;An error occurred. The number is : &quot;;x ELSE

PRINT &quot;There are &quot;;number;&quot; items in the QUEUE&quot; END IF PRINT PRINT &quot;Close the Queue&quot; PRINT

' Close the Queue. x=DosCloseQueue%(Qhandle) IF (x) THEN

Print &quot;An error occurred. The number is : &quot;;x ELSE

Print &quot;The QUEUE was closed.&quot; 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$ = &quot;Normal File&quot; CASE 1 FileType$ = &quot;Read-Only File&quot; CASE 2 FileType$ = &quot;Hidden File&quot; CASE 4 FileType$ = &quot;System File&quot; CASE &H10 FileType$ = &quot;Subdirectory&quot; CASE &H20 FileType$ = &quot;File Archive&quot; CASE ELSE FileType$ = &quot;Unknown Type&quot; 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$ = &quot;0&quot; + LTRIM$(STR$(mn)) ELSE mn$ = LTRIM$(STR$(mn)) END IF   dy = dl AND (&H1F) IF dy < 10 THEN dy$ = &quot;0&quot; + LTRIM$(STR$(dy)) ELSE dy$ = LTRIM$(STR$(dy)) END IF   yr$ = STR$(RightShift(dl, 9) + 1980) WDate$ = mn$ + &quot;/&quot; + dy$ + &quot;/&quot; + 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$ = &quot;0&quot; + LTRIM$(STR$(hr)) ELSE hr$ = LTRIM$(STR$(hr)) END IF  mt = (RightShift%(dl, 5) AND (&H3F)) IF mt < 10 THEN mt$ = &quot;0&quot; + LTRIM$(STR$(mt)) ELSE mt$ = LTRIM$(STR$(mt)) END IF  WTime$ = LTRIM$(hr$) + &quot;:&quot; + mt$ + STRING$(5, 32) END FUNCTION