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:
- Q3.BAS - A program that creates/reads a Queue
- QUEUE.BI - An include file used by Q3.BAS
- UTIL.BAS - Basic routines to read/write shared memory
The compile and LINK instructions are as follows:
- BC q3;
- BC util /x;
- 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 Last reviewed: September 25, 1997 |