Hi Warren,
> Also, I am retired for over 20 years.
Congratulations! But what the hell are you doing here? I *long* to be able
to repeat your statement! (But then, like you, I'm sure I'd still keep my
hand in.)
I'm backing VMS for 20 *more* years! (But then I have to :-)
> I am interested in a definition of VMS code. It looked
> a lot like Cobol to me. Oh, plus some jcl.
I'm sure there are many definitions of "VMS code" out there. What I gave you
was DCL (DEC Command Language as oposed to Job Control Language (Can't swear
to the acronyms, but close enough)) command file that you could AT (@) that
would create the COBOL source code, MACRO external definitions, SQL Module
Language (I much prefer it to EXEC SQL blah), then compile them all and link
'em all together as well as set up the TCP/IP INETd parameters so that
anyone on a Windows2000 box could CONNECT to port 303 (referencce to Breaker
Morant if anyone remembers the movie) and share in a 2PC transaction with
Rdb.
It was about the most straight forward example that I could come up with,
but please ask away if you want more.
> P.S. I see the use of pointer. I have heard that this is a tricky
> thing to use. Will you explain as it was not clear to me why that
> was true.
Other conferences are probably better for this question, but in a nut shell
a 'pointer' is an address. I find it essential for calling certain VMS
System Services and desirable for dealing with constructs like VMS String
Descriptors.
Cheers Richard.
"Warren Simmons" <wsimmons5_at_optonline.net> wrote in message
news:QRMpd.3164$FR3.1576_at_fe12.lga...
> Hi Richard,
>
> I'm a very slow learner. Also, I am retired for over 20 years.
> As a result, I am interested in a definition of VMS code. It looked
> a lot like Cobol to me. Oh, plus some jcl.
>
> Warren Simmons
>
> P.S. I see the use of pointer. I have heard that this is a tricky
> thing to use. Will you explain as it was not clear to me why that
> was true.
>
> Warren Simmons
> wsimmons5_at_optonline.net
>
> Richard Maher wrote:
>
> > Here's the DEMO code that I promised for the VMS side. It simply doesn't
get
> > any easier than this!
> >
> > Everything except the two T3$ services is *standard* VMS code.
> >
> > Enjoy!
> >
> > Cheers Richard Maher.
> >
> > $!
> > $ server_user = f$getjpi(0,"username")
> > $ home_dir = f$trnlnm("sys$login","lnm$job")
> > $ set default 'home_dir
> > $!
> > $ create demo_tip_auxs.cob
> >
> > ********
> > *
> > *
> > * COPYRIGHT (c) TIER3 SOFTWARE LTD. ALL RIGHTS RESERVED.
> > *
> > *
> > *
> > * THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
COPIED
> > ONLY *
> > * IN ACCORDANCE WITH THE TERMS AND CONDITIONS OF SUCH LICENSE AND
WITH
> > THE *
> > * THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
ANY
> > OTHER *
> > * COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
TO
> > ANY *
> > * OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS
> > HEREBY *
> > * TRANSFERRED.
> > *
> > *
> > *
> > * THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
NOTICE
> > AND *
> > * SHOULD NOT BE CONSTRUED AS A COMMITMENT BY TIER3 SOFTWARE LTD.
> > *
> > *
> > *
> >
> > ********
> > identification division.
> > program-id. demo_tip_auxs.
> > data division.
> > working-storage section.
> > 01 out_msg pointer value
external
> > out_msg.
> > 01 io$_setmode pic s9(9) comp value
external
> > io$_setmode.
> > 01 io$_writevblk pic s9(9) comp value
external
> > io$_writevblk.
> > 01 io$_readvblk pic s9(9) comp value
external
> > io$_readvblk.
> > 01 io$_deaccess pic s9(9) comp value
external
> > io$_deaccess.
> > 01 ddtm$m_nowait pic s9(9) comp value
external
> > ddtm$m_nowait.
> > 01 ddtm$_aborted pic s9(9) comp value
external
> > ddtm$_aborted.
> > 01 ss$_abort pic s9(9) comp value
external
> > ss$_abort.
> > 01 ss$_normal pic s9(9) comp value
external
> > ss$_normal.
> > 01 sys_status pic s9(9) comp.
> > *
> > 01 reply_addr pointer.
> > 01 reply_len pic 9(4) comp.
> > 01 out_len pic 9(4) comp.
> > 01 abort_msg pic x(256).
> > 01 bintim pic s9(11)v9(7) comp.
> > *
> > 01 msg_buff.
> > 03 msg_type pic x(2).
> > 03 pic x(510).
> > *
> > 01 insert_employee_msg redefines msg_buff.
> > 03 employee_msg.
> > 05 pic x(2).
> > 05 employee_detais.
> > 07 EmployeeId pic 9(10).
> > 07 LastName pic x(20).
> > 07 FirstName pic x(10).
> > 07 BirthDate pic x(23).
> > 07 Address.
> > 09 line1 pic x(30).
> > 09 line2 pic x(30).
> > 07 City pic x(15).
> > 07 Region pic x(15).
> > 07 PostalCode pic x(10).
> > 03 tip_txn_url pic x(128).
> > *
> > 01 comp_status.
> > 03 pic x(2) value
"22".
> > 03 commit_flag pic x(1).
> > *
> > 01 inet_chan pic 9(4) comp.
> > 01 iosb.
> > 03 cond_val pic 9(4) comp.
> > 03 msg_size pic 9(4) comp.
> > 03 pic x(4).
> > *
> > 01 create_socket.
> > 03 pic s9(4) comp value
external
> > ucx$c_tcp.
> > 03 pic s9(4) comp value
external
> > auxs_def.
> > *
> > 01 sqlcode pic 9(9) comp.
> > 01 rdb$message_vector external.
> > 03 rdb$lu_num_arguments pic 9(9) comp.
> > 03 rdb$lu_status pic 9(9) comp.
> > 03 rdb$alu_arguments occurs 18 times.
> > 05 rdb$lu_arguments pic 9(9) comp.
> > *
> > 01 sql_ctx.
> > 03 pic 9(9) comp value 1.
> > 03 pic 9(9) comp value 1.
> > 03 pic 9(9) comp value 16.
> > 03 db_tid pic x(16).
> > 03 pic 9(9) comp.
> > *
> > 01 tip_tid pic x(16).
> > 01 tip_bid pic x(16).
> > *
> > 01 dtm_iosb.
> > 03 dtm_iosb_status pic 9(4) comp.
> > 03 pic x(2).
> > 03 reason_code pic 9(9) comp.
> > *
> > 01 syi_item_list.
> > 03 item_nodename.
> > 05 pic s9(4) comp value 6.
> > 05 pic s9(4) comp value
external
> > syi$_nodename.
> > 05 pointer value
> > reference local_node.
> > 05 pointer value
> > reference local_node_len.
> > 03 pic s9(9) comp.
> > *
> > 01 local_node pic x(6).
> > 01 local_node_len pic 9(4) comp.
> > *
> > 01 syi_iosb.
> > 03 syi_cond pic s9(9) comp.
> > 03 pic x(4).
> > *
> > procedure division.
> > kick_off section.
> > 00.
> > call "sys$getsyiw"
> > using by value 0, 0, 0
> > by reference syi_item_list, syi_iosb
> > by value 0, 0
> > giving sys_status.
> > if sys_status = ss$_normal move syi_cond to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> >
> > perform open_socket.
> > perform read_socket.
> > perform until msg_type = "99"
> >
> > evaluate msg_type
> > when "20" perform insert_employee_push
> > when other display "Unknow message type: ",
> > msg_type
> > call "lib$stop" using by value
ss$_abort
> > end-evaluate
> >
> > perform read_socket
> >
> > end-perform.
> >
> > perform close_socket.
> >
> > stop run.
> > *
> > open_socket section.
> > 00.
> > call "sys$assign"
> > using by descriptor "sys$net:"
> > by reference inet_chan
> > by value 0, 0, 0
> > giving sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> >
> > call "sys$qiow"
> > using by value 0, inet_chan, io$_setmode
> > by reference iosb
> > by value 0, 0
> > by reference create_socket
> > by value 0, 0, 0, 0, 0
> > giving sys_status.
> > if sys_status = ss$_normal move cond_val to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> > *
> > read_socket section.
> > 00.
> > call "sys$qiow"
> > using by value 0, inet_chan, io$_readvblk
> > by reference iosb
> > by value 0, 0
> > by reference msg_buff
> > by value 512, 0, 0, 0, 0
> > giving sys_status.
> > if sys_status = ss$_normal move cond_val to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> >
> > display "Rec = *", insert_employee_msg(1:msg_size), "*".
> > *
> > write_socket section.
> > 00.
> > call "sys$qiow"
> > using by value 0, inet_chan, io$_writevblk
> > by reference iosb
> > by value 0, 0, reply_addr, reply_len, 0, 0, 0, 0
> > giving sys_status.
> > if sys_status = ss$_normal move cond_val to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> > *
> > close_socket section.
> > 00.
> > call "sys$qiow"
> > using by value 0, inet_chan, io$_deaccess
> > by reference iosb
> > by value 0, 0, 0, 0, 0, 0, 0, 0
> > giving sys_status.
> > if sys_status = ss$_normal move cond_val to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> >
> > call "sys$dassgn" using by value inet_chan giving sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> > *
> > insert_employee_push section.
> > 00.
> > move function upper-case (BirthDate) to BirthDate.
> >
> > call "sys$bintim"
> > using by descriptor BirthDate
> > by reference bintim
> > giving sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> >
> > call "t3$tip_url_to_tid"
> > using by descriptor tip_txn_url of insert_employee_msg
> > (1:(msg_size - function
> > length(employee_msg)))
> > by reference tip_tid, tip_bid
> > giving sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> >
> > call "sys$start_branchw"
> > using by value 0, 0
> > by reference dtm_iosb
> > by value 0, 0
> > by reference tip_tid
> > by descriptor local_node(1:local_node_len)
> > by reference tip_bid
> > giving sys_status.
> > if sys_status = ss$_normal move dtm_iosb_status to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> > *
> > move tip_tid to db_tid.
> > perform the_insert.
> > *
> > set reply_addr to reference comp_status.
> > move 3 to reply_len.
> > perform write_socket.
> >
> > if commit_flag = "Y"
> > perform commit_trans
> > else perform abort_trans.
> > *
> > fini.
> > *
> > the_insert section.
> > 00.
> > call "set_trans_rw" using sqlcode, sql_ctx.
> > if rdb$lu_status not = ss$_normal
> > call "sys$putmsg" using rdb$message_vector
> > call "lib$stop" using by value ss$_abort.
> >
> > call "insert_employee"
> > using sqlcode,
> > EmployeeId(6:5),
> > LastName,
> > FirstName,
> > Bintim,
> > line1,
> > line2,
> > City,
> > Region,
> > PostalCode,
> > sql_ctx.
> >
> > if rdb$lu_status not = ss$_normal
> > move "N" to commit_flag
> > call "sys$putmsg"
> > using by reference rdb$message_vector
> > by value out_msg, 0
> > by reference inet_chan
> > giving sys_status
> > if sys_status not = ss$_normal
> > call "lib$stop" using by value sys_status
> > end-if
> > else
> > move "Y" to commit_flag.
> > *
> > fini.
> > *
> > commit_trans section.
> > 00.
> > call "sys$end_branchw"
> > using by value 0, 0
> > by reference dtm_iosb
> > by value 0, 0
> > by reference tip_tid, tip_bid
> > giving sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> > *
> > if dtm_iosb_status = ss$_abort
> > display "Couldn't commit - " no advancing
> > if reason_code not = zeros
> > call "sys$getmsg"
> > using by value reason_code
> > by reference out_len
> > by descriptor abort_msg
> > by value 0,0
> > giving sys_status
> > if sys_status not = ss$_normal
> > call "lib$stop" using by value sys_status
> > end-if
> > display abort_msg (1:out_len)
> > else
> > display "and don't know why"
> > else
> > if dtm_iosb_status not = ss$_normal
> > call "lib$stop" using by value dtm_iosb_status.
> > *
> > abort_trans section.
> > 00.
> > call "sys$abort_transw"
> > using by value 0, ddtm$m_nowait
> > by reference dtm_iosb
> > by value 0, 0
> > by reference tip_tid
> > by value ddtm$_aborted
> > by reference tip_bid
> > giving sys_status.
> > if sys_status = ss$_normal move dtm_iosb_status to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> > *
> > end program demo_tip_auxs.
> > identification division.
> > program-id. out_msg.
> > data division.
> > working-storage section.
> > 01 io$_writevblk pic 9(9) comp value external
> > io$_writevblk.
> > 01 ss$_normal pic 9(9) comp value external
ss$_normal.
> > 01 sys_status pic 9(9) comp.
> > *
> > 01 iosb.
> > 03 cond_val pic s9(4) comp.
> > 03 pic x(6).
> > *
> > 01 reply_addr pointer.
> > 01 reply_len pic 9(4) comp.
> > *
> > 01 reply_hdr.
> > 03 error_id pic xx value "88".
> > 03 error_len pic 9(3).
> > *
> > linkage section.
> > *
> > 01 msg_desc.
> > 03 msg_len pic 9(4) comp.
> > 03 msg_class pic 9(4) comp.
> > 03 msg_addr pointer.
> > *
> > 01 inet_chan pic 9(4) comp.
> > *
> > procedure division
> > using msg_desc,
> > inet_chan
> > giving ss$_normal.
> > 00.
> > move function length(reply_hdr) to reply_len.
> > move msg_len to error_len.
> > set reply_addr to reference reply_hdr.
> > perform write_socket.
> >
> > move msg_len to reply_len.
> > move msg_addr to reply_addr.
> > perform write_socket.
> > *
> > fini.
> > exit program.
> > *
> > write_socket.
> > *
> > call "sys$qiow"
> > using by value 0, inet_chan, io$_writevblk
> > by reference iosb
> > by value 0, 0, reply_addr, reply_len, 0, 0, 0, 0
> > giving sys_status.
> > if sys_status = ss$_normal move cond_val to sys_status.
> > if sys_status not = ss$_normal call "lib$stop" using by value
> > sys_status.
> > *
> > end program out_msg.
> > $!
> > $ cobol/lis demo_tip_auxs.cob
> > $!
> > $ create demo_tip_auxs_def.mar
> >
> > .title DEMO_TIP_AUXS_DEF Demo example TIP external
data
> > ;+
> > ; The following command can be used to create a macro library INET in
your
> > default
> > ; area if one does not already exist:-
> > ;
> > ; $library/create/macro inet.mlb sys$library:ucx$inetdef
> > ;
> > ; .library "sys$login:inet"
> > ;
> > ; $inetsymdef GLOBAL
> > ; $siocdef GLOBAL
> > ; $inetacpfsymdef GLOBAL
> > ; $inetacpsymdef GLOBAL
> > ; $ineterrdef GLOBAL
> > ;-
> > $ddtmdef GLOBAL
> > $ddtmmsgdef GLOBAL
> >
> > ucx$c_auxs == 127
> > ucx$c_af_inet == 2
> > ucx$c_tcp == 6
> > auxs_def == <ucx$c_auxs * 256 +
ucx$c_af_inet>
> >
> > .end
> >
> > $ macro/lis demo_tip_auxs_def.mar
> > $!
> > $ create demo_tip_auxs_sql.sqlmod
> >
> > module dist_sql
> > language cobol
> > parameter colons
> >
> > declare pers alias filename mf_personnel
> >
> > procedure set_trans_rw
> > sqlcode;
> >
> > set transaction read write
> > reserving pers.employees for shared write;
> >
> > procedure insert_employee
> > sqlcode,
> > :employee_id char(5),
> > :last_name char(20),
> > :first_name char(10),
> > :birthday date vms,
> > :address_data_1 char(30),
> > :address_data_2 char(30),
> > :city char(15),
> > :state char(15),
> > :postal_code char(10)
> > ;
> >
> > insert into pers.employees
> > (
> > employee_id,
> > last_name,
> > first_name,
> > birthday,
> > address_data_1,
> > address_data_2,
> > city,
> > state,
> > postal_code,
> > middle_initial,
> > sex,
> > status_code
> > )
> > values
> > (
> > :employee_id,
> > :last_name,
> > :first_name,
> > :birthday,
> > :address_data_1,
> > :address_data_2,
> > :city,
> > :state,
> > :postal_code,
> > ' ',
> > '?',
> > 'N'
> > )
> > ;
> > $!
> > $ sqlmod:==$sql$mod
> > $ sqlmod/lis/context=(set_trans_rw,insert_employee)/const=immed
> > demo_tip_auxs_sql.sqlmod/nowarning
> > $!
> > $ define/nolog lnk$library sys$library:t3$user
> > $ link
> >
demo_tip_auxs,demo_tip_auxs_def,demo_tip_auxs_sql,sys$library:sql$user/lib
> > $!
> > $ create demo_tip_auxs_input.com
> > $ deck
> > $! define mf_personnel to_where_it_lives
> > $ run sys$login:demo_tip_auxs
> > $ exit
> > $ eod
> > $!
> > $ ucx set service tip_inetd -
> > /port = 303 -
> > /protocol = tcp -
> > /process = tip_auxs -
> > /user_name = 'server_user' -
> > /file = 'home_dir'demo_tip_auxs_input
> > $!
> > $ ucx enable service tip_inetd
> > $!
> > $ exit
> >
> >
> >
Received on Tue Nov 30 2004 - 12:38:21 CST
