Connecting to an iSeries (AS/400) dataqueue
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
cobie1 · 2015-01-15 12:57

I can connect to my iSeries and and can query files no problem, but I
need to read from and write to a dataqueue. Has anyone done this and
do they have examples.
I have searched for Cwbdq.dll but I am having the devil of a time
getting solid information on it.

----------------------------------------------------------------------
cobie1 · 2015-02-11 12:56

Sorted. There is more than one way to skin a cat! Once I had sorted
the dataqueue problem, I thought I might as well look at stored
procedures. What I wanted to do was call an iSeries CLLE program with
a user-defined workfile and two user-defined dataqueue names, one for
sending info to the iSeries program and one to receive info from it
after it has created the workfile I require. The forth parameter is to
ask the iSeries program to submit itself to batch when it would create
the workfile and the two dataqueues, send me a message that it was
ready, then sit on it's receive dataqueue waiting for a message from
me.

So I wanted to 1) start the iSeries job and 2) when it has replied
with 'READY', request it to get my data, then 3) when it has replied
with 'REFRESHED', sql the data into my DBGrid and 4) when I am
finished, request the iSeries job to end, at which stage it would
delete the workfile and dataqueues and end.

For any of this to work, you first need to include ADODB_TLB in the
'Interfaces' section of the  .lpr

Interfaces, // this includes the LCL widgetset
  Forms, Unit1, ADODB_TLB 

I've included below all the relevant relating to dataqueue and stored
procedure processing
uses
  Classes, SysUtils, odbcconn, sqldb, db, FileUtil, Forms, Controls,
Graphics,
  Dialogs, DBGrids, ExtCtrls, StdCtrls,
  variants,
  comobj,
  ADODB_TLB;
  // odbcconn for iSeries connection when opening dataqueues and sql
  // variants because OLE variants are used in the process
  // comobj because it is used for creating OLE objects
  // ADODB_TLB       

type

  { Trdtform }
                       
 ODBCConnection1: TODBCConnection;  // Required for ODBC connectio
    DataSource1: TDataSource;          // Required for query
    SQLQuery1: TSQLQuery;              // Required for query
    SQLTransaction1: TSQLTransaction;  // Required for query
    TempPFName: TEdit;                 // File name to query
    RcvFromDQ: TEdit;                // Dataqueue to receive msg from
the iSeries
    RcvDQSize: TEdit;                  // Receive DQLen
    RcvLib: TEdit;                     // Receive DQlib
    SendToDQ: TEdit;                 // Dataqueue to send message to
the iSeries
    SendDQSize: TEdit;                 // Send DQlen
    SendLib: TEdit;                    // Send DQlib
    procedure ClosebuttonClick(Sender: TObject);
    procedure EndProcessClick(Sender: TObject);
    procedure RefreshScreenClick(Sender: TObject);
    procedure SbmiSeriesJobClick(Sender: TObject);    
var
   ConnectedToiSeries: Boolean = false;
  SndQOpen: Boolean = false;
  RcvQOpen: Boolean = false;
  CN400 : _Connection;            // used when connecting to the
iSeries
  CN400SP : OLEVariant;           // Connection used to run the stored
procedure
  ConnectString : String;         // obvious
  rcds : OLEVariant;              // OLEVariant required for opening
the dataqueue and receiving replies
  DQPut : _recordset;             // the recordset you will put to the
dataqueue
  DQGet : _recordset;             // the recordset you will use to get
the reply
  SPCommand : OLEVariant;         // the command to call the stored
procedure
  SPRecordset : OLEVariant;       // The recordset you will use to run
the AS400 command
  Parms : Variant;                // the parameter array to use as
parms to the stored procedure
  DQstring : variant;             // required to format OLEVariant
  DQInData : OLEvariant;          // required to hold data received
from the dataqueue
  ParmString1 : Variant;          // Individual parameters as variants
  ParmString2 : Variant;          // for populating the parms to the
stored procedure
  ParmString3 : Variant;
  ParmString4 : Variant;

  function ConnectToiSeries : boolean;
  function OpenDataqueues   : boolean;
  function WaitOnDataQueue  : boolean;                            

  procedure Trdtform.SbmiSeriesJobClick(Sender: TObject);
begin
  //-------------------------------------------------------------
  // Call a stored procedure to submit the iSeries background job
  //-------------------------------------------------------------

  // Create the connection object
  CN400SP := CreateOLEObject('adodb.connection');

  // open the connection nwith the IP Address (Hostname doesn't work)
  if Hostname.text = 'ckserver' then
  begin
    CN400SP.Open('Provider=IBMDA400;Data Source=172.17.5.3;', '','');
    end;

  // Create the recordset and command
  SPrecordset:=CreateOLEObject('adodb.recordset');
  SPCommand:=CreateOLEObject('adodb.command');

  // prepare the stored procedure call - 4 parms (?,?,?,?) in this
case
  SPCommand.ActiveConnection:='Provider=IBMDA400;Data
Source=172.17.5.3';
  SPCommand.CommandText := '{CALL DVNCO.RDT12AEXTC(?,?,?,?)}';
  SPCommand.Prepared := true;
 
  // Set the direction of the parms (1=IN, 2=OUT, 3=INOUT, 4=Returned
value
  SPCommand.Parameters .direction:=1;
  SPCommand.Parameters [1].direction:=1;
  SPCommand.Parameters [2].direction:=1;
  SPCommand.Parameters [3].direction:=3;

  // Set Parms = Variant array for as many parms as you have defined
  parms:=VarArrayCreate([0, 3], varvariant);
 
  // and populate parms with the actual data
  Parms :=TempPFname.text;
  Parms [1]:=SendToDQ.text;
  Parms [2]:=RcvFromDQ.text;
  Parms [3]:='Y';
 
  // We are now ready to call the stored procedure which will return a
recordset
  // (even though in this instance we don't want a record set)
  SPrecordset := SPcommand.execute(rcds, parms, 0);
 
  // the execute command has called iSeries program, which has
submitted itself
  // as a background job. The background job has created the send and
receive
  // dataqueues and sent a message to this program's receive queue
stating
  // 'Ready'. We can now close the stored procedure connection and
open the
  // Dataqueue connection.
  CN400SP.Close;

  //---------------------------------------------------------
  // Ensure both dataqueues can be accessed before continuing
  //---------------------------------------------------------
  ConnectToiSeries;
  Opendataqueues;

  //------------------------------------------------------------------
---
  // Wait on the 'Receive' data queue for the 'Ready' message
  //------------------------------------------------------------------
---
   If RcvDQStatus.caption = 'Opened' then
   begin
    result:=WaitOnDataqueue;
   end;

   // Now we have the Ready' message, we can enable the 'Get Date'
   // and 'End iSeries job' buttons
   // and disable the 'Start' button
   if DQGetString = 'READY' then
   begin
   RefreshScreen.Visible := true;
   EndProcess.Visible:=true;
   SbmiSeriesJob.Visible:=false;
   SbmiSeriesJob.Enabled:=false;
   end;

end;                                                   

procedure Trdtform.RefreshScreenClick(Sender: TObject);
begin
  // Refresh the DBGrid by:-
  // Message to the 'Send' dataqueue requesting a refresh,
  // Wait for response on the 'Receive' data queue
  // then call the sql to refresh the DBGrid

  // Only process if both 'Put' and 'Get' Dataqueues are open
  if SndQOpen=true  and RcvQOpen=true then
  begin
  // Inform the iSeries background program to refresh the data
  result:=false;
  DQString:='REFRESH' + TempPFName.text; // The recordset has to hold
your message to the Dataqueue
  DQPut.AddNew('Data', DQString); //'.Addnew identifies a 'PUT' 'Data'
                                  // Identifies a single-field put.

  // The iSeries background program will send a message to our receive
queue
  // stating 'Refreshed' so wait on this message
  WaitonDataqueue;
  if rdtform.RcvDQStatus.caption = 'REFRESHED' then
    begin
    Try
       ODBCConnection1.Connected:= False;
    finally
    end;
      datasource1.DataSet := SQLQuery1;
      DBGrid1.DataSource := DataSource1;
      ODBCConnection1.Transaction := SQLTransaction1;
      SQLQuery1.Database := ODBCConnection1;
      SQLTransaction1.DataBase := ODBCConnection1;;
      ODBCConnection1.DatabaseName:='ckserver';    // IP Address
      ODBCConnection1.UserName:=UserId.Text;
      ODBCConnection1.Password:=UserPwd.Text;
      ODBCConnection1.Connected := True;
      DataSource1.Enabled:= True;

      SQLQuery1.UsePrimaryKeyAsKey:= False; // use 'Select' instead

      SQLTransaction1.Active:=False;
      SQLQuery1.Active := False;
      SQLQuery1.InsertSQL.Clear;
      SQLQuery1.SQL.Clear;
      SQLQuery1.SQL.add(trim('select * from dvnco.rdt12a001')); //
hardwired in rdt12a001 rather than user-defined file
      SQLTransaction1.Active:=True;
      SQLQuery1.Active:=True;

      end
      else
      begin
      RcvDQStatus.caption:='No Data Returned';
      end;
    end;

end;

procedure Trdtform.EndProcessClick(Sender: TObject);
begin
  // Send a message to the iSeries background program to cease and
desist
  // The background program will then delete the dataqueues and the
temporary
  // file before ending
  result:=false;
  SQLQuery1.Close;  // Close the SQL connection to enable iSeries file
deletion
  DQString:='STOP'; // The recordset has to hold your message to the
Dataqueue
  DQPut.AddNew('Data', DQString); //'.Addnew identifies a 'PUT' 'Data'
                                  // Identifies a single-field put.

  // The iseries background program will now have deleted the two
dataqueues
  // and the workfile. We can now enable the 'Start iSeries Server
Job' button
  // and disable the 'Refresh' and 'Stop' buttons
   RefreshScreen.Visible := false;
   EndProcess.Visible:=false;
   SbmiSeriesJob.Visible:=true;
   SbmiSeriesJob.Enabled:=true;

end;

procedure Trdtform.ClosebuttonClick(Sender: TObject);
begin
  close;
end;

function ConnectToiSeries: boolean;
begin
  //-----------------------------------------------------
  // Connect to the iSeries box if not already connected
  //-----------------------------------------------------
  if ConnectedToiSeries = false then
  begin
  CN400 := coConnection.Create;
  ConnectString := Concat('Provider=IBMDA400;Data Source=',
rdtform.HostIPAddress.text);
  ConnectString := Concat(connectstring, ';');
  Try
  If CN400.State = adStateClosed then
  begin
 
CN400.Open(ConnectString,rdtform.UserID.text,rdtform.UserPwd.text,-1);
  end;
  except
  exit; // open failed
  end;
  ConnectedToiSeries:=true;
  end;
end;


// Open Dataqueues function
Function OpenDataqueues: Boolean;
Begin
  result:=false;
  // Check we can send using Tedits 'SndToDQ', 'DQSndLib' and
'DQSndSize'
  if SndQOpen = false then
  begin
  DQPut:=corecordset.create; // create the record set
  DQLength:=rdtform.SendDQSize.Text;
  // create the 'Open' dialogue for the dataqueue
  OpenSndString := 'OPEN DATAQUEUE /QSYS.LIB/' + rdtform.Sendlib.text
+ '.LIB/' +
  rdtform.SendToDq.text + '.DTAQ' +  '(Data CHARACTER(' + DQLength + 
')) FOR SEND';
 
  count:=0;
  repeat
  count:= count + 1;
  Try // attempt to open the Dataqueue for SEND
  DQPut := Cn400.Execute(OpenSndString, Rcds, 1);
  Except
  if count = 10 then
    begin
    MessageDlg('Connection to ' + rdtform.SendToDQ.text + ' for Send
Failed',mterror,[mbok],0);
    exit;
    end
    else
    begin
    sleep(2000); // delay for 2 seconds and retry (gives the iSeries
job time to create dataqueue
    end;
  end;
  SndQOpen:=true;
   until count = 10;

  end;

  // Check we can receive using Tedits 'RcvFromToDQ', 'DQRcvLib' and
'DQRcvSize'
  if RcvQOpen=false then
  begin
  DQGet:=corecordset.create;  // create the record set
  DQLength:=rdtform.RcvDQSize.Text;
  // create the 'Open' dialogue for the dataqueue
  OpenRcvString := 'OPEN DATAQUEUE /QSYS.LIB/' + rdtform.RcvLib.text +
'.LIB/' +
  rdtform.RcvFromDQ.text + '.DTAQ' +  '(Data CHARACTER(' +
  DQLength +  ')) FOR RECEIVE';
   Try // Attempt to open the dataqueue for RECEIVE
  DQGet := Cn400.Execute(OpenRcvString, Rcds, 1);
  Except
  MessageDlg('Connection to ' + rdtform.RcvFromDQ.text + ' for Receive
Failed',mterror,[mbok],0);
  exit;
  end;
  RcvQOpen:=true;
  end;

  // inform if either one or both queues not opened
  Case SndQOpen of
    true: rdtform.SndDQStatus.caption:='Opened';
    false: rdtform.SndDQStatus.caption:='Not Opened';
  end;
  Case RcvQOpen of
    true: rdtform.RcvDQStatus.caption:='Opened';
    false: rdtform.RcvDQStatus.caption:='Not Opened';
  end;
end;

// QRCVDTAQ function
Function WaitOnDataqueue: Boolean;
Begin
  result:=false;
  DQGetString:= '';
  count:=0;
  repeat; // until a message arrives
  begin

  Try // Wait on the dataQueue for a response
  count:= count + 1;
  DQGet := Cn400.Execute(OpenRcvString, Rcds, 1);
  Except
  MessageDlg('Connection to ' + rdtform.RcvFromDQ.text + ' for Receive
Failed',mterror,[mbok],0);
  exit;
  end;
  IF not DQGet.EOF then
  Begin
  DQString := DQGet.fields[0].value; // get first field in the
dataqueue
  DQGetString:= DQString;
  rdtform.RcvDQStatus.caption:=DQGetstring;
  result:=true;
  count:=10;
  end
  else
  begin
  sleep(5000) // delay for 5 seconds
  end;
  //
  end;
  until count=10;

  // If DQString is equal to '' then failed
  if result=false then
  begin
  rdtform.RcvDQStatus.caption:='Failed';
  end;
end;