利用静态数组在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(TmpS tr));
　　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 ITotalRow 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 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.