(VMS Rdb COBOL example) Was: Re: Dynamic SQL

Hi,

Didn't see the original post, but I was just looking at the following code
on an old floppy of mine as I was cleaning up my office after holidays.

FWIW

Cheers Richard Maher

PS. Obviously replace all the "#" with a space and sorry about the wrapping.
(After 20 odd years in I.T. I am simply incapable of stopping that from
happening. Or can't be arsed to find out how :-)

PPS. If you want to run multiple table scrambles in parralel then you'll
have to change the BATCH UPDATE transaction. But the performance is so
blisteringly fast I honestly wouldn't bother.

identification#division.
program-id.####dyn_test.
*
data#division.
working-storage#section.
 01##rdb$_stream_eof#####################
pic#9(9)########comp####value###exte
rnal####rdb$_stream_eof.
 01##lib$_strtru#########################
pic#9(9)########comp####value###exte
rnal####lib$_strtru.
 01##ss$_abort###########################
pic#9(9)########comp####value###exte
rnal####ss$_abort.
 01##ss$_normal##########################
pic#9(9)########comp####value###exte
rnal####ss$_normal.
 01##sys_status##########################
pic#9(9)########comp.
*
 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##col_name############################
pic#x(39).
 01##col_count###########################
pic#9(9)########comp.
*
 01##cmd_string##########################
pic#x(10000).
*
01##set_trans_statement.
 ####03##################################
pic#x(39)###############value###"set
#transaction#batch#update#reserving".
 ####03##trans_table#####################
pic#x(39).
 ####03##################################
pic#x(21)###############value###"#fo
r#exclusive#write;".
*
01##select_statement.
 ####03##################################
pic#x(7)################value###"sel
ect".
####03##select_list.
 ######04##select_array##################
################occurs##256#times.
 ########05##select_col##################
pic#x(30).
 ########05##select_delim################
pic#x(1).
 ####03##################################
pic#x(5)################value###"fro
m".
 ####03##select_table####################
pic#x(39).
 ####03##################################
pic#x(1)################value###";".
*
 01##update_id###########################
pic#9(9)########comp.
01##update_statement.
 ####03##################################
pic#x(7)################value###"upd
ate".
 ####03##update_table####################
pic#x(39).
 ####03##################################
pic#x(5)################value###"#se
t".
####03##update_list.
 ######04##update_array##################
################occurs##256#times.
 ########05##update_col##################
pic#x(30).
 ########05##update_delim################
pic#x(5).
 ####03##################################
pic#x(22)###############value###"#wh
ere#current#of#sel;".
*
01##col_prefix_table.
 ####03##col_elem########################
################occurs##256#times.
 ########05##col_prefix##################
pic#x(39).
 ########05##col_prefix_len##############
pic#9(4)########comp.
*
 01##col_pfx#############################
pic#x(39).
*
 01##sqlda_char##########################
pic#9(4)########comp####value###453.
 01##sqlda_integer#######################
pic#9(4)########comp####value###497.
 01##sqlda_quadword######################
pic#9(4)########comp####value###505.
*
01##sqlda_list.
 ####03##sqldaid#########################
pic#x(8)################value###"SQL
DA".
 ####03##sqldabc#########################
pic#9(9)########comp.
 ####03##sqln############################
pic#9(4)########comp####value###256.
 ####03##sqld############################
pic#9(4)########comp.
 ####03##sqlname_rec#####################
################occurs##0#to####256#
 ########################################
################depending#on#sqln#of
#sqlda_list.
 ########05##sqltype#####################
pic#9(4)########comp.
 ########05##sqllen######################
pic#9(4)########comp.
 ########05##sqldata#####################
################pointer.
 ########05##sqlind######################
################pointer.
########05##sqlname.
 ############07##name_len################
pic#9(4)########comp.
 ############07##name_str################
pic#x(30).
*
01##sqlda_update.
 ####03##sqldaid#########################
pic#x(8)################value###"SQL
DA".
 ####03##sqldabc#########################
pic#9(9)########comp.
 ####03##sqln############################
pic#9(4)########comp####value###256.
 ####03##sqld############################
pic#9(4)########comp.
 ####03##sqlname_rec#####################
################occurs##0#to####256#
 ########################################
################depending#on#sqln#of
#sqlda_update.
 ########05##sqltype#####################
pic#9(4)########comp.
 ########05##sqllen######################
pic#9(4)########comp.
 ########05##sqldata#####################
################pointer.
 ########05##sqlind######################
################pointer.
########05##sqlname.
 ############07##name_len################
pic#9(4)########comp.
 ############07##name_str################
pic#x(30).
*
01##col_desc.
 ####03##col_len#########################
pic#9(9)########comp.
 ####03##col_addr########################
################pointer.
*
 01##scramble_eof########################
pic#x(1).
 01##unique_char#########################
pic#x(65535).
 01##unique_integer######################
pic#s9(9)#######comp.
 01##unique_quadword#####################
pic#s9(18)######comp.
 01##scramble_field######################
pic#x(65535).
01##scramble_desc.
 ####03##scramble_desc_len###############
pic#9(9)########comp.
 ####03##################################
################pointer#value###refe
rence#scramble_field.
*
 01##unique_id_string####################
pic#x(65535).
 01##unique_id_integer###################
################redefines
 ####unique_id_string####################
pic#-9(9).
 01##unique_id_quadword##################
################redefines
 ####unique_id_string####################
pic#-9(18).
 01##unique_id_len#######################
pic#9(4)########comp.
*
01##null_indicators.
 ####03##null_ind########################
pic#s9(4)#######comp
 ########################################
################occurs##256#times.
*
 01##task_id#############################
pic#x(39)###############value###"TES
T_TABLE".
 01##relation_prefix#####################
pic#x(39).
 01##relation_prefix_len#################
pic#9(4)########comp.
 01##unique_id###########################
pic#x(39).
 01##vm_bytes############################
pic#9(9)########comp.
*
procedure#division.
kick_off#section.
00.
####perform#get_setup.

 ####move#set_trans_statement#to#cmd_stri
ng.
####call#"sql_execute_immediate"#using#sqlcode,#cmd_string.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####call#"sql_prepare_select"
########using###sqlcode,
################select_statement.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####call#"sql_describe_select"
########using###sqlcode,
################sqlda_list.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####display#"Number#of#columns#in#select#list#is#",#sqld#of#sqlda_list#with#
conversion.

 ####perform#varying#sqln#of#sqlda_list#f
rom#1#by#1#until#sqln#of#sqlda_list#
=#sqld#of#sqlda_list

 ########if#sqltype#of#sqlda_list#(sqln#o
f#sqlda_list)#not#=#sqlda_char
############display#"Can#only#handle#CHAR#datatypes#",#sqltype#of#sqlda_list
#(sqln#of#sqlda_list)#with#conversion
############call#"lib$stop"#using#by#value#ss$_abort
########end-if

 ########move#sqllen#of#sqlda_list#(sqln#
of#sqlda_list)#to#vm_bytes
########call#"lib$get_vm" #using#vm_bytes,#sqldata#of#sqlda_list#(
sqln#of#sql
da_list)#giving#sys_status
########if#sys_status#not#=#ss$_normal#
############call#"lib$stop"#using#by#value#sys_status
########end-if

 ########set#sqlind#of#sqlda_list(sqln#of
#sqlda_list)#to#reference#null_ind(s
qln#of#sqlda_list)

####end-perform.

 ####evaluate####sqltype#of#sqlda_list(sq
ln#of#sqlda_list)
 ########when####sqlda_char######set#sqld
ata#of#sqlda_list(sqln#of#sqlda_list
)#to#reference#unique_char
 ########when####sqlda_integer###set#sqld
ata#of#sqlda_list(sqln#of#sqlda_list
)#to#reference#unique_integer
 ########when####sqlda_quadword##set#sqld
ata#of#sqlda_list(sqln#of#sqlda_list
)#to#reference#unique_quadword
########when####other###########call#"lib$stop"#using#by#value#sys_status
####end-evaluate.

####move#sqlda_list#to#sqlda_update.
 ####subtract#1#from#####sqln#of#sqlda_up
date,
 ########################sqld#of#sqlda_up
date.

####call#"sql_prepare_update"
########using###sqlcode,
################update_id,
################update_statement.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####call#"sql_open_sel"#using#sqlcode.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####move#"N"#to#scramble_eof
####call#"sql_fetch_sel"#using#sqlcode,#sqlda_list.
####evaluate####rdb$lu_status
########when####rdb$_stream_eof#move#"Y"#to#scramble_eof
 ########when####ss$_normal######continue

########when####other###########call#"sys$putmsg"#using#rdb$message_vector#g
iving#sys_status
################################call#"lib$stop"#using#by#value#ss$_abort
####end-evaluate.

 ####perform#scramble_data#until#scramble
_eof#=#"Y".

####call#"sql_close_sel"#using#sqlcode.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####call#"sql_commit_db"#using#sqlcode.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.
*
*
fini.
####stop#run.
*
get_setup#section.
00.
####call#"sql_task_tran"#using#sqlcode.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####move#task_id#to#####trans_table,
########################select_table,
########################update_table.

####call#"sql_get_scramble"
########using###sqlcode,
################relation_prefix,
################unique_id,
################task_id.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####call#"str$trim"
 ########using###by#descriptor###relation
_prefix,#relation_prefix
 ################by#reference####relation
_prefix_len
########giving##sys_status.
 ####if#sys_status#not#=#ss$_normal#call#
"lib$stop"#using#by#value#sys_status
.

####call#"sql_open_enigma"#
########using###sqlcode,
################task_id.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####move#spaces#to######select_list,
########################update_list.
####move#zeros#to#col_count.

####call#"sql_fetch_enigma"
########using###sqlcode,
################col_name,
################col_pfx.

 ####perform#until#rdb$lu_status#not#=#ss
$_normal

########add#1#to#col_count

 ########move#col_pfx##to########col_pref
ix(col_count)
 ########move#col_name#to########select_c
ol(col_count)
 ################################update_c
ol(col_count)

########call#"str$trim"
 ############using##by#descriptor#col_pre
fix(col_count),#col_prefix(col_count
)
 ###################by#reference##col_pre
fix_len(col_count)
############giving#sys_status
########if#sys_status#not#=#ss$_normal#
############call#"lib$stop"#using#by#value#sys_status
########end-if

########move#","#to#select_delim(col_count)

########move#"#=#?,"#to#update_delim(col_count)

########call#"sql_fetch_enigma"
############using#######sqlcode,
########################col_name,
########################col_pfx
####end-perform.
 ####if#rdb$lu_status#not#=#rdb$_stream_e
of
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####if#col_count#=#zeros
########display#"No#columns#to#update#for#",#task_id
########call#"lib$stop"#using#by#value#ss$_abort.

 ####move#space#to#update_delim(col_count
)(5:1).

####add#1#to#col_count.
 ####move#unique_id#to#select_col(col_cou
nt).

####call#"sql_close_enigma"#using#sqlcode.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.

####call#"sql_commit_db"#using#sqlcode.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.
*
scramble_data#section.
00.

####move#spaces#to#unique_id_string.
 ####evaluate####sqltype#of#sqlda_list(sq
ln#of#sqlda_list)
########when####sqlda_char######call#"str$trim"
 ####################################usin
g#######by#descriptor###unique_char,
#unique_id_string
 ########################################
########by#reference####unique_id_le
n
 ####################################givi
ng######sys_status
 ################################if#sys_s
tatus#not#=#ss$_normal#
 ####################################call
#"lib$stop"#using#by#value#sys_statu
s
################################end-if
 ########when####sqlda_integer###move#uni
que_integer#to#unique_id_integer
 ################################move#10#
to#unique_id_len
 ########when####sqlda_quadword##move#uni
que_quadword#to#unique_id_quadword
 ################################move#19#
to#unique_id_len
####end-evaluate.

 ####perform#varying#sqln#of#sqlda_update
#from#1#by#1#until#sqln#of#sqlda_upd
ate#>#sqld#of#sqlda_update

########move#spaces#to#scramble_field

 ########string##relation_prefix(1:relati
on_prefix_len),
 ################col_prefix(sqln#of#sqlda
_update)(1:col_prefix_len(sqln#of#sq
lda_update)),
 ################unique_id_string(1:uniqu
e_id_len)
################delimited#by#size
########into####scramble_field

########add#####relation_prefix_len,
 ################col_prefix_len(sqln#of#s
qlda_update),
################unique_id_len
########giving##scramble_desc_len

 ########move#sqllen##of#sqlda_update#(sq
ln#of#sqlda_update)#to#col_len
 ########move#sqldata#of#sqlda_update#(sq
ln#of#sqlda_update)#to#col_addr

########call#"lib$scopy_dxdx" #using#scramble_desc,#col_desc#giving#sy
s_statu
s
 ########if#sys_status#not#=#ss$_normal#a
nd#lib$_strtru
############call#"lib$stop"#using#by#value#sys_status
########end-if

####end-perform.
 ####move#sqld#of#sqlda_update#to#sqln#of
#sqlda_update.

####call#"sql_execute_stmt"
########using###sqlcode,
################sqlda_update,
################update_id.
####if#rdb$lu_status#not#=#ss$_normal
########call#"sys$putmsg" #using#rdb$message_vector#giving#sys_sta
tus
########call#"lib$stop"#using#by#value#ss$_abort.
*
fini.
####call#"sql_fetch_sel"#using#sqlcode,#sqlda_list.
####evaluate####rdb$lu_status
########when####rdb$_stream_eof#move#"Y"#to#scramble_eof
 ########when####ss$_normal######continue

########when####other###########call#"sys$putmsg"#using#rdb$message_vector#g
iving#sys_status
################################call#"lib$stop"#using#by#value#ss$_abort
####end-evaluate.
*
end#program#dyn_test.

module####dyn_sql
language##cobol
authorization#scram_db
parameter#colons

 declare#external#scram_db#alias#filename
#scram_db

declare#sel#cursor#for#sel_stmt

declare#enigma#cursor#for
########select#
################a.field_name,
################a.field_prefix
########from
 ################scramble_relation_fields
#a
########where
################a.relation_name#=#:task_id

procedure#sql_task_tran
########sqlcode
########;

 ########set#transaction#read#write#reser
ving
 ################scramble_relation#######
########for#shared#write,
 ################scramble_relation_fields
########for#shared#read;

procedure#sql_get_scramble
########sqlcode,
 ########:relation_prefix########char(39)
,
 ########:unique_id##############char(39)
,
 ########:task_id################char(39)

########;

########select
################a.relation_prefix,
################a.unique_id
########into
################:relation_prefix,
################:unique_id
########from#
################scramble_relation#a
########where
################a.relation_name#=#:task_id
########;

procedure#sql_open_enigma
########sqlcode,
 ########:task_id################char(39)

########;

########open#enigma;

procedure#sql_fetch_enigma
########sqlcode,
 ########:field_name#############char(39)
,
 ########:field_prefix###########char(39)

########;

########fetch
################enigma
########into
################:field_name,
################:field_prefix
########;

procedure#sql_close_enigma
########sqlcode
########;

########close#enigma;

procedure#sql_prepare_select
########sqlcode,
 ########:stmt###################char(798
8)
########;

########prepare#sel_stmt#from#:stmt;

procedure#sql_describe_select
########sqlca,
########sqlda;

 ########describe#sel_stmt#select#list#in
to#sqlda;

procedure#sql_open_sel
########sqlca;

########open#sel;

procedure#sql_fetch_sel
########sqlca,
########sqlda;

 ########fetch#sel#using#descriptor#sqlda
;

procedure#sql_close_sel
########sqlca;

########close#sel;

procedure#sql_release_stmt
########sqlca;

########release#sel_stmt;#

procedure#sql_prepare_update
########sqlcode,
 ########:update_id##############integer,

 ########:stmt###################char(903
3)
########;

########prepare#:update_id#from#:stmt;

procedure#sql_execute_stmt
########sqlcode,
########:sqlda##################sqlda,
########:dyn_stmt_id############integer
########;

 ########execute#:dyn_stmt_id#using#descr
iptor#:sqlda;

procedure#sql_commit_db
########sqlcode;

########commit;

procedure#sql_execute_immediate
########sqlcode,
 ########:cmd_string#############char(100
00)
########;

########execute#immediate#:cmd_string;


"William M. Klein" <wmklein@nospam.netcom.com> wrote in message
news:aqV8e.317613$za2.50898@news.easynews.com...
> the E-level message says that "WS-SQL" is not of "type" VARCHAR.
>
> See:
>
http://publibz.boulder.ibm.com/cgi-...snaph13/2.4.3.7
>
> for how to define a VARCHAR host variable (in COBOL - at least for IBM
> mainframes and DB2), e.g.
>
>    01 VAR-NAME.
>       49 VAR-LEN PIC S9(4) USAGE BINARY.
>       49 VAR-TEXT PIC X(n).
>
> Use of level "49" is required (as I recall) and you MUST have a binary
field
> followed by the actual "data" portion.
>
> --
> Bill Klein
>  wmklein <at> ix.netcom.com
> "kathie" <kktbva@yahoo.com> wrote in message
> news:1113852104.333988.160920@f14g2000cwb.googlegroups.com... 
>
>