利用静态数组和内存流在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;
    chkEnableAccept: TCheckBox;
    Label3: TLabel;
    edtFile: TEdit;
    OpenDlg: TOpenDialog;
    btnOpen: TButton;
    Label4: TLabel;
    edtSave: TEdit;
    btnSave: TButton;
    SaveDlg: TSaveDialog;
    procedure btnOpenQMClick(Sender: TObject);
    procedure btnCloseQMClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnSendQueueClick(Sender: TObject);
    procedure btnAcceptQueueClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
  private
    { Private declarations }
    //发送文件
    function SendFileMsg(XMLFile:String):Boolean;
    //接收文件
    function GetFileMsg(XMLFile:String):Boolean;
    //必须加，否则会出错,动态数组的循环使用问题
    procedure DoNull;
    procedure WriteToFile(XMLFile:String;iLen:Integer);
    //读取内存流
    procedure ReadStream(XMLFile:String;var iLen:int64);
    //写入内存流
    procedure WriteStream(XMLFile:String;iLen:Int64);
  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

  BufLen: MQLONG;                 // buffer length - 1 - zero terminated for strings
  MsgLen: MQLONG;                // message length received - number of bytes I want to send or I received

  QueueName          : String;
  QueueManagerName   : String;
  MessageStr         : String;
  FileBuf  :Array[0..4194304*10] of Byte;//4194304=4M
implementation

{$R *.dfm}

function GetFileSize(const FileName: String): LongInt;
var SearchRec: TSearchRec;
begin
 if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
  Result := SearchRec.Size
 else
  Result :=0;
end;

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
             + MQOO_BROWSE              // 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.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 btnCloseQM.Click;
end;

procedure TFrmMain.btnSendQueueClick(Sender: TObject);
begin

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

procedure TFrmMain.btnAcceptQueueClick(Sender: TObject);
begin
  if GetFileMsg(edtSave.Text) then
  begin
   Sb1.Panels[0].Text:='消息读取成功。';
   //memAcceptStr.Lines.LoadFromFile(edtSave.Text);
  end
  else
   Sb1.Panels[0].Text:=Format('获取消息失败，代码：[%d] 原因：[%d]', [CompCode, Reason]);
 
end;

function TFrmMain.GetFileMsg(XMLFile:String): Boolean;
begin
  Result:=False;
  try
    DoNull;
  except
  end;
  SetMQMD_DEFAULT(md);
  SetMQGMO_DEFAULT(gmo);
  /////////////////通过浏览获得长度
  gmo.Options :=MQGMO_BROWSE_FIRST;     // convert if necessary
  CompCode := MQCC_OK;
  buflen := 0;
  MsgLen:=0;
  MQGET(Hconn,              // connection handle
        Hobj,               // object handle
        md,                 // message descriptor
        gmo,                // get message options
        buflen,             // buffer length
        @FileBuf,            // message buffer
        MsgLen,            // message length
        CompCode,           // completion code
        Reason);            // reason code
  ////读消息，并删除队列
    BufLen:=MsgLen;
    //SetLength(FileBuf,BufLen);
    gmo.Options :=MQGMO_WAIT         // wait for new messages  //
               + MQGMO_CONVERT;     // convert if necessary
    CompCode := MQCC_OK;
    MQGET(Hconn,              // connection handle
          Hobj,               // object handle
          md,                 // message descriptor
          gmo,                // get message options
          buflen,             // buffer length
          @FileBuf,            // message buffer
          MsgLen,            // message length
          CompCode,           // completion code
          Reason);            // reason code
  ////检测返回值
    if (CompCode = MQCC_FAILED) then
    begin
      if (Reason = MQRC_NO_MSG_AVAILABLE) then
      begin
          Sb1.Panels[0].Text:=Format('没有消息，代码：[%d] 原因：[%d]', [CompCode, Reason]);
          exit;
      end
      else
      if (Reason <> MQRC_NONE) then //获取消息失败
      begin
        Screen.Cursor:=crDefault;
        Exit;
      end;//if
    end;//if 返回值检测
    //写入文件
    WriteStream(XMLFile,BufLen);
    Result:=True;
end;
////////////////////////// 发送文件
function TFrmMain.SendFileMsg(XMLFile: String): Boolean;
var
 iLen:Int64;
begin
  Result:=False;

  iLen:=0;
  BufLen:=0;
  try
    DoNull;
  except
  end;
  ReadStream(XMLFile,iLen);
  BufLen:=iLen;
  //SetLength(FileBuf,iLen);
  //WriteToFile('C:/1.txt',iLen);
   SetMQMD_DEFAULT(md);
  SetMQPMO_DEFAULT(pmo);
  md.Format:=MQFMT_STRING;
  //////
   MQPUT(Hconn,             // connection handle
          Hobj,              // object handle
          md,                // message descriptor
          pmo,               // default options (datagram)
          BufLen,    // message length
          @FileBuf,           // pointer to message buffer
          CompCode,          // completion code
          Reason);           // reason code
    if (Reason <> MQRC_NONE) then
    begin
      Result:=False;
      Exit;
    end;
  Result:=True;
end;

procedure TFrmMain.btnOpenClick(Sender: TObject);
begin
 if not OpenDlg.Execute then exit;
 edtFile.Text:=OpenDlg.FileName;
 //memSendStr.Lines.LoadFromFile(OpenDlg.FileName);
end;

procedure TFrmMain.btnSaveClick(Sender: TObject);
begin
 if not SaveDlg.Execute then exit;
 edtSave.Text:=SaveDlg.FileName;
end;
//必须加，否则会出错,动态数组的循环使用问题
procedure TFrmMain.DoNull;
begin
 //SetLength(FileBuf,0);
end;

procedure TFrmMain.WriteToFile(XMLFile: String;iLen:Integer);
var
 MyFile:TMemoryStream;
begin
 try
  MyFile:=TMemoryStream.Create;
  MyFile.Seek(0,soFromBeginning);
  MyFile.WriteBuffer(FileBuf[0],iLen);
  MyFile.SaveToFile(XMLFile);
 finally
  FreeAndNil(MyFile);
 end;
end;

procedure TFrmMain.ReadStream(XMLFile: String;var iLen:int64);
var
 MyFile:TMemoryStream;
begin
 try
  MyFile:=TMemoryStream.Create;
  MyFile.LoadFromFile(XMLFile);
  iLen:=MyFile.Size;
  MyFile.ReadBuffer(FileBuf[0],iLen);
 finally
  FreeAndNil(MyFile);
 end;
end;

procedure TFrmMain.WriteStream(XMLFile: String;iLen:Int64);
var
 MyFile:TMemoryStream;
begin
 try
  MyFile:=TMemoryStream.Create;
  MyFile.Seek(0,soFromBeginning);
  MyFile.WriteBuffer(FileBuf[0],iLen);
  MyFile.SaveToFile(XMLFile);
 finally
  FreeAndNil(MyFile);
 end;
end;

end.