利用静态数组在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.