<% 'NOTE: You must replace the session variables with system name, userid and password dim FailedTest dim UniqueKey Dim DQData() Dim NumWrites Dim S Dim I Dim SysObj Dim dq Dim dqa Dim stringCvtr 'Create objects 'On Error Resume Next Set SysObj = Server.CreateObject("cwbx.AS400System") Set dq = Server.CreateObject("cwbx.DataQueue") Set dqa = Server.CreateObject("cwbx.DataQueueAttributes") Set stringCvtr = Server.CreateObject("cwbx.StringConverter") 'Verify objects created 'Set up some data to write NumWrites = 4 ReDim DQData(NumWrites - 1) For I = 0 To NumWrites - 1 DQData(I) = "String " & I Next S = "" 'Logon setting noprompt to Never (NOTE: Either define cwbcoPromptNever or use the value 2. ' Not using Option Explicit can define an incorrect value for cwbcoPromptNever SysObj.Define Session("DataConn_RuntimeSystem") SysObj.UserID = Session("DataConn_RuntimeUserName") SysObj.PassWord = Session("DataConn_RuntimePassword") SysObj.PromptMode = 2 'cwbcoPromptNever SysObj.Connect 6 'cwbcoServiceDataQueues Set dq.System = SysObj ' Set the LibraryName property. Note: This library needs to exist ' before attempting to create the data queue on the AS/400. If the ' library does not exist, the query of the Exists property will fail ' with a cwbdqLibraryNotFound error (The Command object can be used ' to create the library) dq.LibraryName = "QGPL" ' Set the QueueName property dq.QueueName = "JANET2" 'Check to see if the data queue already exists on the AS/400 If (dq.Exists = False) Then ' Set properties in the DataQueueAttributes object to override ' some of the default values dqa.Description = "Express DQ 3-tier test" dqa.MaxRecordLength = 100 'dqa.RetrievalOrder = 0 'cwbdqSeqLifo 'dqa.SenderInfoSaved = True ' Create the data queue on the AS/400, using the attributes set ' in the DataQueueAttributes object. If a DataQueueAttributes ' was not passed, the default attribute values would have been ' used dq.Create dqa response.write "Created DQ " & dq.LibraryName & "/" & dq.QueueName & "
" End If 'Write the specified number of entries For I = 0 To NumWrites - 1 dq.Write stringCvtr.ToBytes(DQData(I)) Response.write "Wrote record " & (I + 1) & ": " & DQData(I) & "
" Next ' Set the MaximumRetrievalLength property, since we know none of ' the records on the queue are very long. This saves memory dq.MaximumRetrievalLength = 25 ' Peek the first string. This does not remove the record from the ' queue. The StringConverter object is used to convert the string ' from a byte array to a string Dim tmp tmp = stringCvtr.FromBytes(dq.Peek) If InStr(1, tmp, DQData(0), vbTextCompare) = 0 Then S = S & "Peek1 returned incorrect data" else Response.write "Peek record 1: " & tmp & "
" End If For I = 0 To NumWrites - 1 ' Read the string. This removes the record from the queue. tmp = stringCvtr.FromBytes(dq.Read) If InStr(1, tmp, DQData(I), vbTextCompare) = 0 Then S = S & "Read number " & Str(I) & " returned incorrect data: " & _ stringCvtr.FromBytes(dq.Read) & vbCrLf else Response.write "Read record " & (I + 1) & ": " & tmp & "
" End If Next If FailedTest then S = GetErrors(SysObj) 'response.write S response.write Str(GetCurrentProcessId()) & ":" & Str(App.ThreadID) & vbTab & S response.write Str(GetCurrentProcessId()) & ":" & Str(App.ThreadID) & "***Exit DQ1" response.write " Test failed!
" Err.Raise 64999, "ADO3TRPGM1.ASP", "DPC Test returned incorrect data!" 'Raise an overflow error for wcat to fail! Response.Status = "500 Janet1 failed" 'must enable the URI Query option of the Extended Logging Properties sheet for the site whose activity you wish to log. Response.AppendToLog "Janet2 Test returned incorrect data!" else response.write S & "
" response.write " Test passed!
" end if ' Cleanup On Error Resume Next Set stringCvtr = Nothing Set dqa = Nothing Set dq = Nothing Set SysObj = Nothing Response.End %>