putgetdemo.dpr

delphi写的IBM mq服务器

program PutGetDemo;

// **************************************************************************
// **************************************************************************
// **************************************************************************
// MQSeries IBM library test program for Delphi
// Author: Dinko Miljak
// e-mail: [e-mail]
// version 0.0.3
// **************************************************************************
// **************************************************************************
// **************************************************************************

{$APPTYPE CONSOLE}
{$A-}  // alignment settings - aviod problems between different languages

uses
  SysUtils,
  CMQPas in '..\lib\CMQPas.pas',
  CMQBPas in '..\lib\CMQBPas.pas',
  CMQCFPas in '..\lib\CMQCFPas.pas',
  CMQPSPas in '..\lib\CMQPSPas.pas',
  CMQXPas in '..\lib\CMQXPas.pas',
  CMQZPas in '..\lib\CMQZPas.pas';

procedure WriteCommonError(ErrorMsg: string; CompCode, Reason: integer);
begin
  Write(ErrorMsg);
  Write('  Completiton Code[', CompCode, ']: ', DecodeCompletionCode(CompCode));
  Writeln('  Reason Code[', Reason, ']: ', DecodeReason(Reason));
end;

var
   Hconn    : MQHCONN;   // Connection handle
   CompCode : MQLONG;    // Completion code - used by all routines
   OpenCode : MQLONG;    // Completion code - used by MQOPEN function
   Reason   : MQLONG;    // Reason code - used by all function
   CReason  : MQLONG;    // Connect Reason code qualifying CompCode
   O_options: MQLONG;    // Open connection flags
   C_options: MQLONG;    // Close connection flags
   HObj     : MQHOBJ;

   od       : TMQOD;      // Object descriptor
   gmo      : TMQGMO;     // Get message options
   md       : TMQMD;      // message descripton structure
   pmo      : TMQPMO;     // Put message options

   buffer: array[0..8191] of char;  // message buffer in which program receive messages
   buflen: MQLONG;                 // buffer length - 1 - zero terminated for strings
   messlen: MQLONG;                // message length received - number of bytes I want to send or I received

   QueueName: String;
   MessageStr: String;

begin
  if (ParamCount <> 2) then begin
    Writeln('Usage: ', ExtractFileName(ParamStr(0)), ' QueueName Message');
    Writeln('QueueName - existing MQSeries local queue');
    Writeln('Message - message string');
    Writeln('Example: ', ExtractFileName(ParamStr(0)), ' RIBA01 "test message"');
    Halt;
  end;

  QueueName := ParamStr(1);
  MessageStr := ParamStr(2);

  Writeln('QueueName: ', QueueName);
  Writeln('MessageStr: ', MessageStr);

  // ***********************************************************************
  // Step 1 - connect to connection manager
  // ***********************************************************************
  Writeln('Opening connection to default connection manager');
  MQCONN(Pchar(''),    // Connection manager name
         HConn,        // Connection Handle
         CompCode,     // Completition Code
         CReason);     // Reason

  if (CompCode <> MQCC_OK) then begin
    WriteCommonError('MQCONN failed with CompCode', CompCode, Reason);
    Readln; Exit;
  end
  else begin
    Writeln('Connection manager connection opened');
  end;

  // ***********************************************************************
  // Step 2 - Open Queue
  // ***********************************************************************
  // reset object descriptor structure to defaults
  SetMQOD_DEFAULT(od);

  // copy queue name string to object structure
  StrPLCopy(od.ObjectName, QueueName, SizeOf(od.ObjectName));

  // Set connection options
  O_options := MQOO_INPUT_AS_Q_DEF       // open queue for input  - read, get
             + MQOO_OUTPUT               // open queue for output - write, put
             + MQOO_FAIL_IF_QUIESCING;   // but not if Message Queue Manager is in stopping state

  // Finally open queue
  Writeln('Opening queue: "', QueueName, '"');
  MQOPEN(Hconn,            // connection handle
          od,              // object descriptor for queue
          O_options,       // open options
          Hobj,            // object handle
          OpenCode,        // completion code
          Reason);         // reason code

  // Check the results of openning action
  if (Reason <> MQRC_NONE) then begin
    WriteCommonError('MQOPEN ended with reason code ', OpenCode, Reason);
    Readln; Exit;
  end;

  if (OpenCode = MQCC_FAILED) then begin
    WriteCommonError('Unable to open queue for input or output ', OpenCode, Reason);
    Readln; Exit;
  end;

  Writeln('Queue opened');

  // ***********************************************************************
  // Step 3 - Put one test message to queue
  // ***********************************************************************

  // reset message descriptor structure to defaults
  SetMQMD_DEFAULT(md);

  // Copy my custom message string to my local buffer
  FillChar(buffer, SizeOf(Buffer), 0);
  StrPLCopy(buffer, MessageStr, SizeOf(buffer));

  // Calculate message length
  messlen := Length(MessageStr);

  // Reset Put Message Object structure to defaults
  SetMQPMO_DEFAULT(pmo);
  md.Format := MQFMT_STRING;

  Writeln('Sending test message to queue');

  // Put message to queue
  MQPUT(Hconn,             // connection handle
        Hobj,              // object handle
        md,                // message descriptor
        pmo,               // default options (datagram)
        messlen,           // message length
        @buffer,           // pointer to message buffer
        CompCode,          // completion code
        Reason);           // reason code

  //  report reason, if any
  if (Reason <> MQRC_NONE) then begin
    WriteCommonError('MQPUT failed ', CompCode, Reason);
    Readln; Exit;
  end
  else begin
    Write('Message is in the queue. Press any key to continue...');
    Readln;
  end;


  // ***********************************************************************
  // Step 4 - Read messages from queue in loop
  // ***********************************************************************
  Writeln('Receive messages in loop');
  Writeln('If programm can not read message in 15 seconds, loop is finished');

  // reset Get Message Option structure to defaults
  SetMQGMO_DEFAULT(gmo);

  //gmo.Version = MQGMO_VERSION_2;  // Avoid need to reset Message
  //gmo.MatchOptions = MQMO_NONE;   // ID and Correlation ID after
                                     // every MQGET
  gmo.Options := MQGMO_WAIT         // wait for new messages
               + MQGMO_CONVERT;     // convert if necessary
  gmo.WaitInterval := 15000;        // 15 seconds limit for waiting


  // assume that everything is OK with - see loop condition
  CompCode := MQCC_OK;

  // how much bytes my receive buffer can handle
  // note - in this application my send and receive buffers are the same
  buflen := SizeOf(buffer) - 1;

  // enter loop in which programm receives messages from queue
  while (CompCode <> MQCC_FAILED) do begin
    // before message is received you always must
    // reset this fields in Messsage Descriptor structure
    move(MQMI_NONE, md.MsgId, SizeOf(md.MsgId));
    move(MQCI_NONE, md.CorrelId, SizeOf(md.CorrelId));
    md.Encoding       := MQENC_NATIVE;
    md.CodedCharSetId := MQCCSI_Q_MGR;

    MQGET(Hconn,              // connection handle
          Hobj,               // object handle
          md,                 // message descriptor
          gmo,                // get message options
          buflen,             // buffer length
          @buffer,            // message buffer
          messlen,            // message length
          CompCode,           // completion code
          Reason);            // reason code

    if (CompCode <> MQCC_FAILED) then begin
      Writeln('Received message: ', buffer);
    end
    else begin
      if (Reason = MQRC_NO_MSG_AVAILABLE) then begin
        WriteCommonError('No more messages', CompCode, Reason);
      end
      else if (Reason <> MQRC_NONE) then begin
        WriteCommonError('Get message failed', CompCode, Reason);
        Readln; Exit;
      end;
    end;
  end;


  // ***********************************************************************
  // Step 5 - Close my connection to queue
  // ***********************************************************************
  if (OpenCode <> MQCC_FAILED) then begin
    C_options := 0;                  // no close options
    MQCLOSE(Hconn,                   // connection handle
            Hobj,                    // object handle
            C_options,               // close options
            CompCode,                // completion code
            Reason);                 // reason code

    if (Reason <> MQRC_NONE) then begin
      WriteCommonError('MQCLOSE ended with reason code ', CompCode, Reason);
    end
    else begin
      Writeln('Queue closed');
    end;
  end;

  // ***********************************************************************
  // Step 6 - Close my connection to queue manager
  // ***********************************************************************
  MQDISC(Hconn,                  // connection handle
         CompCode,               // completion code
         Reason);                // reason code

  if (Reason <> MQRC_NONE) then begin
    WriteCommonError('MQDISC ended with reason code ', CompCode, Reason);
  end
  else begin
    Writeln('Connection to Queue Manager closed');
  end;

  Write('Press any key to continue...');
  // Test finished
  Readln;
end.