利用静态数组在MQ中发送接收字符串

利用静态数组发送接收字符串，字符串长度超出数组大小时分割为多条消息

 unit UMQ_PutGetPas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, CMQPas, CMQBPas, CMQCFPas, CMQPSPas, CMQXPas,
  CMQZPas, ExtCtrls,XMLDoc, jpeg;

type
  TFrmMain = class(TForm)
    edtQM: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    edtQN: TEdit;
    btnOpenQM: TButton;
    Sb1: TStatusBar;
    memSendStr: TMemo;
    btnSendQueue: TButton;
    memAcceptStr: TMemo;
    btnAcceptQueue: TButton;
    btnCloseQM: TButton;
    Timer1: TTimer;
    chkEnableAccept: TCheckBox;
    btnCancelAccept: TButton;
    procedure btnOpenQMClick(Sender: TObject);
    procedure btnCloseQMClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnCancelAcceptClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSendQueueClick(Sender: TObject);
    procedure btnAcceptQueueClick(Sender: TObject);
  private
    { Private declarations }
    FCancelAccept:Boolean;
    //分解字符串，取出以回车结尾的最大长度的字符串
    function MakeStr(MsgStr: String; iLen,OldRow: Integer;var CurRow,TotalRow:Integer): String;
    //发送消息
    function SendStrMsg(MsgStr:String):Boolean;
    //接收消息
    function GetStrMsg(MsgList:TStrings):Boolean;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;
  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..1000*8] 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;
  QueueManagerName   : String;
  MessageStr         : String;
implementation

{$R *.dfm}

procedure TFrmMain.btnOpenQMClick(Sender: TObject);
begin
  if Trim(edtQN.Text)='' then
  begin
     sb1.Panels[0].Text:='队列名称出错！';
     Exit;
  end;

  // ****************************************
  // Step 1 - 连接到连接管理器
  // ****************************************
  QueueManagerName:=Trim(edtQM.Text);
  MQCONN(Pchar(QueueManagerName), // Connection manager name
         HConn,                   // Connection Handle
         CompCode,                // Completition Code
         CReason);                // Reason

  if (CompCode <> MQCC_OK) then
  begin
    sb1.Panels[0].Text:=Format('MQCONN调用失败，代码：[%d] 原因：[%d]', [CompCode, Reason]);
    Exit;
  end
  else
    sb1.Panels[0].Text:='队列管理器打开';

  // *****************************************
  // Step 2 - 打开队列
  // *****************************************
  // reset object descriptor structure to defaults
  QueueName:=Trim(edtQN.Text);
  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
  if chkEnableAccept.checked then
     O_options := 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
  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
    sb1.Panels[0].Text:=Format('MQOPEN执行结束，代码：[%d] 原因：[%d]', [OpenCode, Reason]);
    Exit;
  end;

  if (OpenCode = MQCC_FAILED) then
  begin
    sb1.Panels[0].Text:=Format('无法打开输入或输出队列，代码：[%d] 原因：[%d]', [OpenCode, Reason]);
    Exit;
  end;

  sb1.Panels[0].Text:='队列已打开';
end;

procedure TFrmMain.btnCloseQMClick(Sender: TObject);
begin
  // ***************************************
  // Step 5 - 关闭连接到队列的连接
  // ***************************************
  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
      Sb1.Panels[0].Text:=Format('MQCLOSE执行结束，代码：[%d] 原因：[%d]', [CompCode, Reason])
    else
      Sb1.Panels[0].Text:='队列已关闭';
  end;

  // ***********************************************
  // Step 6 - 关闭连接到队列管理器的连接
  // ***********************************************
  MQDISC(Hconn,                  // connection handle
         CompCode,               // completion code
         Reason);                // reason code

  if (Reason <> MQRC_NONE) then
    Sb1.Panels[0].Text:=Format('MQDISC执行结束，代码：[%d] 原因：[%d]', [CompCode, Reason])
  else
    Sb1.Panels[0].Text:='队列管理器关闭';
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
 btnAcceptQueue.Click;
end;
//取消接收
procedure TFrmMain.btnCancelAcceptClick(Sender: TObject);
begin
 FCancelAccept:=True;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 btnCloseQM.Click;
end;

//分解字符串，取出以回车结尾的最大长度的字符串
function TFrmMain.MakeStr(MsgStr: String; iLen, OldRow: Integer;
  var CurRow,TotalRow: Integer): String;
var
 StrList:TStringList;
 NewStr,TmpStr,RetStr:String;
 I:Integer;
begin
 NewStr:=MsgStr;
 try
   StrList:=TStringList.Create;
   while True do
   begin
    TmpStr:='';
    I:=Pos(#13,NewStr);
    if I>0 then
    begin
     TmpStr:=Copy(NewStr,1,I);
     StrList.Add(TmpStr);
     NewStr:=Copy(NewStr,I+1,Length(NewStr)-Length(TmpStr));
    end
    else
    if NewStr<>'' then
    begin
     StrList.Add(NewStr);
     Break;
    end;//if
    if NewStr='' then
     Break;
    Application.ProcessMessages;
   end;//while
   TotalRow:=StrList.Count;
   TmpStr:='';
   RetStr:='';
   I:=0;
   while True do
   begin
    Inc(I);
    if I<OldRow+1 then
    begin
     Continue;
    end;
    if I>TotalRow then Break;
    TmpStr:=StrList.Strings[I-1];
    if Length(TmpStr)+Length(RetStr)>iLen then//-10
     Break;
    if RetStr='' then
     RetStr:=TmpStr
    else
     RetStr:=RetStr+#13+TmpStr;
    Application.ProcessMessages;
   end;//while
   CurRow:=I-OldRow-1;
 finally
   StrList.Free;
 end;
 Result:=RetStr;
end;

function TFrmMain.GetStrMsg(MsgList: TStrings): Boolean;
var
 LoopNum:Integer;
begin
  // *******************************************
  // Step 4 - 循环从队列中读取消息
  // *******************************************
  Result:=False;
  FCancelAccept:=False;

  Screen.Cursor:=crHourGlass;
  // reset Get Message Option structure to defaults
  SetMQMD_DEFAULT(md);
  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_SYNCPOINT
               + MQGMO_CONVERT;     // convert if necessary
  //gmo.WaitInterval := 15000;        // 1 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
  FillChar(buffer, SizeOf(Buffer), 0);
  buflen := SizeOf(buffer) - 1;

  // enter loop in which programm receives messages from queue
  LoopNum:=0;
  while (CompCode <> MQCC_FAILED) do
  begin
    if FCancelAccept then
    begin
      Sb1.Panels[0].Text:='用户取消接收消息';
      Screen.Cursor:=crDefault;
      exit;
    end;//if
    // 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
       Inc(LoopNum);
       MsgList.Add(Buffer);
       Sb1.Panels[1].Text:='读取次数：'+IntToStr(LoopNum);
    end
    else
    begin
      if (Reason = MQRC_NO_MSG_AVAILABLE) then begin
          Sb1.Panels[0].Text:=Format('没有消息，代码：[%d] 原因：[%d]', [CompCode, Reason]);
      end
      else
      if (Reason <> MQRC_NONE) then //获取消息失败
      begin
        Screen.Cursor:=crDefault;
        Exit;
      end;//if
    end;//if
    //重要：多次读取必须重新初始化Buffer
    FillChar(buffer, SizeOf(Buffer), 0);
    application.ProcessMessages;
  end;//while
  Screen.Cursor:=crDefault;
end;

function TFrmMain.SendStrMsg(MsgStr: String): Boolean;
var
 TotalRow,OldRow,CurRow:Integer;
 I:Integer;
 TmpStr:String;
begin
  // *****************************************
  // Step 3 - 把测试消息放入队列中
  // *****************************************
  // reset message descriptor structure to defaults
  Result:=False;
  SetMQMD_DEFAULT(md);

  // Copy my custom message string to my local buffer
  FillChar(buffer, SizeOf(Buffer), 0);
  buflen := SizeOf(buffer) - 1;
  SetMQPMO_DEFAULT(pmo);
  md.Format := MQFMT_STRING;
  //
  OldRow:=0;
  TotalRow:=1;
  while OldRow<TotalRow do
  begin
   TmpStr:=MakeStr(MsgStr,BufLen,OldRow,CurRow,TotalRow);
   OldRow:=OldRow+CurRow;
   FillChar(buffer, SizeOf(Buffer), 0);
   StrPLCopy(buffer, TmpStr,SizeOf(buffer));
   MQPUT(Hconn,             // connection handle
          Hobj,              // object handle
          md,                // message descriptor
          pmo,               // default options (datagram)
          Length(TmpStr),    // message length
          @buffer,           // pointer to message buffer
          CompCode,          // completion code
          Reason);           // reason code
    if (Reason <> MQRC_NONE) then
    begin
      Result:=False;
      Exit;
    end;
    Application.ProcessMessages;
  end;//while
  Result:=True;
end;

procedure TFrmMain.btnSendQueueClick(Sender: TObject);
begin
 Sb1.Panels[0].Text:='正在发送消息到队列...';
 if SendStrMsg(memSendStr.Text) then
   Sb1.Panels[0].Text:='消息已放入队列中'
 else
   Sb1.Panels[0].Text:=Format('MQPUT执行失败，代码：[%d] 原因：[%d]', [CompCode, Reason]);
end;

procedure TFrmMain.btnAcceptQueueClick(Sender: TObject);
begin

  Sb1.Panels[0].Text:='每隔1S读取一次队列...';
  if GetStrMsg(MemAcceptStr.Lines) then
   Sb1.Panels[0].Text:='消息读取成功。'
  else
   Sb1.Panels[0].Text:=Format('获取消息失败，代码：[%d] 原因：[%d]', [CompCode, Reason]);
end;

end.