利用靜態數組和內存流在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.

利用靜態數組和內存流在MQ中發送接收文件

通過HPA+CronHPA組合應對業務複雜彈性伸縮場景

利用靜態數組和內存流在MQ中發送接收文件

https://yachay.unat.edu.pe/blog/index.php?comment_area=format_blog&comment_component=blog&comment_co

linux以太網驅動總結