mqaidemo.dpr

delphi写的IBM mq服务器

        end;
      end;
    end;
  end;
  Result := errors;
end;



function PrintBag(dataBag: MQHBAG): Integer;
var errors: Integer;
begin
  Writeln;
  errors := PrintBagContents(dataBag, 0);
  Writeln;
  Result := errors;
end;


procedure GetQEvents(hConn: MQHCONN; qName: String);
var openReason: MQLONG;    // MQOPEN reason code
    reason: MQLONG;        // reason code
    compCode: MQLONG;      // completion code
    eventQueue: MQHOBJ;    // handle to event queue
    eventBag: MQHBAG;      // event bag to receive event msg
    od: TMQOD;             // Object Descriptor
    md: TMQMD;             // Message Descriptor
    gmo: TMQGMO;           // get message options
    bQueueOK: MQLONG;      // keep reading msgs while true
begin
  (***************************************************************************)
  (* Set defaults                                                            *)
  (***************************************************************************)
  eventBag := MQHB_UNUSABLE_HBAG;
  SetMQOD_DEFAULT(od);
  SetMQMD_DEFAULT(md);
  SetMQGMO_DEFAULT(gmo);
  bQueueOK := 1;

  (***************************************************************************)
  (* Create an Event Bag in which to receive the event.                      *)
  (* Exit the function if the create fails.                                  *)
  (***************************************************************************)
  mqCreateBag(MQCBO_USER_BAG, eventBag, compCode, reason);
  CheckCallResult('Create event bag', compCode, reason);
  if (compCode <> MQCC_OK) then Exit;

  (***************************************************************************)
  (* Open the event queue chosen by the user                                 *)
  (***************************************************************************)
  StrPLCopy(od.ObjectName, qName, SizeOf(od.ObjectName));
  MQOPEN(hConn, od, MQOO_INPUT_AS_Q_DEF +
                    MQOO_FAIL_IF_QUIESCING,
         eventQueue, compCode, openReason);
  CheckCallResult('Open event queue', compCode, openReason);

  (***************************************************************************)
  (* Set the GMO options to control the action of the get message from the   *)
  (* queue.                                                                  *)
  (***************************************************************************)
  gmo.WaitInterval := 30000;               // 30 second wait for message
  gmo.Options := MQGMO_WAIT + MQGMO_FAIL_IF_QUIESCING + MQGMO_CONVERT;
  gmo.Version := MQGMO_VERSION_2;          // Avoid need to reset Message ID
  gmo.MatchOptions := MQMO_NONE;           // and Correlation ID after every
	                                          // mqGetBag

  (***************************************************************************)
  (* If open fails, we cannot access the queue and must stop the monitor.    *)
  (***************************************************************************)
  if (compCode = MQCC_OK) then bQueueOK := 0;

  (***************************************************************************)
  (* Main loop to get an event message when it arrives                       *)
  (***************************************************************************)
  while (bQueueOK = 0) do begin
    Writeln('Waiting for an event...');

    (*************************************************************************)
    (* Get the message from the event queue and convert it into the event    *)
    (* bag.                                                                  *)
    (*************************************************************************)
    mqGetBag(hConn, eventQueue, md, gmo, eventBag, compCode, reason);

    (*************************************************************************)
    (* If get fails, we cannot access the queue and must stop the monitor.   *)
    (*************************************************************************)
    if (compCode <> MQCC_OK) then begin
      bQueueOK := 0;
      (*********************************************************************)
      (* If get fails because no message available then we have timed out, *)
      (* so report this, otherwise report an error.                        *)
      (*********************************************************************)
      if (reason = MQRC_NO_MSG_AVAILABLE) then begin
        Writeln('No more messages');
      end
      else begin
        CheckCallResult('Get bag', compCode, reason);
      end;
    end

    (*************************************************************************)
    (* Event message read - Print the contents of the event bag              *)
    (*************************************************************************)
    else begin
      if ( PrintBag(eventBag) <> 0 ) then begin
        Writeln('Error found while printing bag contents');
      end;
    end;  (* end of msg found *)
  end; (* end of main loop *)

  (***************************************************************************)
  (* Close the event queue if successfully opened                            *)
  (***************************************************************************)
  if (openReason = MQRC_NONE) then begin
    MQCLOSE(hConn, eventQueue, MQCO_NONE, compCode, reason);
    CheckCallResult('Close event queue', compCode, reason);
  end;

  (***************************************************************************)
  (* Delete the event bag if successfully created.                           *)
  (***************************************************************************)
  if (eventBag <> MQHB_UNUSABLE_HBAG) then begin
    mqDeleteBag(eventBag, compCode, reason);
    CheckCallResult('Delete the event bag', compCode, reason);
  end;
end; (* end of GetQEvents *)

var hConn     : MQHCONN ;   // handle to connection
    QMName    : String;     // default QM name
    reason    : MQLONG;     // reason code
    connReason: MQLONG;     // MQCONN reason code
    compCode  : MQLONG;     // completion code
begin
  (***************************************************************************)
  (* First check the required parameters                                     *)
  (***************************************************************************)
  Writeln('Sample Event Monitor. ParamCount: ', ParamCount);
  if (ParamCount < 1) then begin
    Writeln('Required parameter missing - event queue to be monitored');
    Halt(99);
  end;

  (**************************************************************************)
  (* Connect to the queue manager                                           *)
  (**************************************************************************)
  QMName := ''; // assume default queue manager
  if (ParamCount > 1) then begin
    QMName := ParamStr(2);
  end;
  MQCONN(PChar(QMName), hConn, compCode, connReason);

  (***************************************************************************)
  (* Report the reason and stop if the connection failed                     *)
  (***************************************************************************)
  if (compCode = MQCC_FAILED) then begin
    CheckCallResult('MQCONN', compCode, connReason);
    Halt(connReason);
  end;

  (***************************************************************************)
  (* Call the routine to open the event queue and format any event messages  *)
  (* read from the queue.                                                    *)
  (***************************************************************************)
  GetQEvents(hConn, ParamStr(1));

  (***************************************************************************)
  (* Disconnect from the queue manager if not already connected              *)
  (***************************************************************************)
  if (connReason <> MQRC_ALREADY_CONNECTED) then begin
    MQDISC(hConn, compCode, reason);
    CheckCallResult('MQDISC', compCode, reason);
  end;

  Halt(0);
end.