Everhart, Glenn From: Rex Jolliff [Rex_Jolliff@notes.ymp.gov] Sent: Friday, May 29, 1998 10:49 AM To: Info-VAX@Mvb.Saic.Com Subject: Re: How to do COPY from a program Robin Garner wrote: > Nigel White wrote: > > > > We need to COPY a file under program control, preserving all attributes > > just like the COPY command does. > ... > > Any ideas? here is a copy routine from the infamous Carl Lydick./******************************************************************************\ * NOTLIB_COPY: A function to copy an arbitrary file in block mode * * Copyright 1992 by the Caltech Odd Hack Committee. No rights reserved * * Author: Carl J Lydick (carl@sol1.gps.caltech.edu) * * Arguments: * * inp_file * * * * VMS usage: input_filespec * * type: character-coded text string * * access: read only * * mechanism: by descriptor--fixed * * length string descriptor * * * * Name of the file to be copied. * * --------------------------------- * * out_file * * * * VMS usage: output_filespec * * type: character-coded text string * * access: read only * * mechanism: by descriptor--fixed * * length string descriptor * * * * Name of the destination file. * * --------------------------------- * * file_id * * * * VMS usage: input_file_id * * type: character-coded text string * * access: read only * * mechansim: by descriptor--fixed * * length string descriptor * * * * NAM$T_DVI, NAM$W_FID, and NAM$W_DID fields associated * * with the input file * \******************************************************************************/ long int notlib_copy(struct dsc$descriptor *inp_file, struct dsc$descriptor *out_file, struct dsc$descriptor *file_id) { struct FAB inp_fab, out_fab; struct RAB inp_rab, out_rab; struct NAM inp_nam; struct XABSUM xabsum; struct XABKEY *xabkey = 0; struct XABALL *xaball = 0; char buffer[32256]; long stat; char *ptr; int i; xabsum = cc$rms_xabsum; inp_fab = cc$rms_fab; inp_fab.fab$b_fac = FAB$M_BRO | FAB$M_GET; inp_fab.fab$l_fna = inp_file->dsc$a_pointer; inp_fab.fab$b_fns = (unsigned char) inp_file->dsc$w_length; inp_fab.fab$l_fop = FAB$M_SQO; inp_fab.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI; inp_fab.fab$l_xab = (char *)&xabsum; if (file_id != 0) { inp_nam = cc$rms_nam; ptr = (char *)&(inp_nam.nam$t_dvi); for(i = 0; i < (unsigned int)file_id->dsc$w_length; ++i) ptr[i] = file_id->dsc$a_pointer[i]; inp_fab.fab$l_fop |= FAB$M_NAM; inp_fab.fab$l_nam = &inp_nam; } if (!$VMS_STATUS_SUCCESS(stat = SYS$OPEN(&inp_fab))) { Error("sys$open failed, rc:%d", stat); return stat; } if ((unsigned int)xabsum.xab$b_nok > 0) { int i; if ((xabkey = (struct XABKEY *) malloc((unsigned int)xabsum.xab$b_nok * sizeof(struct XABKEY))) == 0) { Error("could not alloc xabkey"); return SS$_INSFMEM; } for(i = 0; i < (unsigned int)xabsum.xab$b_nok; ++i) { xabkey[i] = cc$rms_xabkey; xabkey[i].xab$l_nxt = (char *)(&xabkey[i + 1]); xabkey[i].xab$b_ref = (unsigned char) i; } xabkey[(unsigned int)xabsum.xab$b_nok-1].xab$l_nxt = 0; xabsum.xab$l_nxt = (char *)xabkey; } if ((unsigned int)xabsum.xab$b_noa > 0) { int i; if ((xaball = (struct XABALL *) malloc((unsigned int)xabsum.xab$b_noa * sizeof(struct XABALL))) == 0) { Error("Could not alloc xaball"); if (xabkey != 0) { free(xabkey); xabkey = 0; } return SS$_INSFMEM; } for (i = 0; i < (unsigned int)xabsum.xab$b_noa; ++i) { xaball[i] = cc$rms_xaball; xaball[i].xab$l_nxt = (char *)(&xaball[i + 1]); xaball[i].xab$b_aid = (unsigned char) i; } xabkey[(unsigned int)xabsum.xab$b_nok-1].xab$l_nxt = (char *)xaball; xaball[(unsigned int)xabsum.xab$b_noa-1].xab$l_nxt = 0; } if (!$VMS_STATUS_SUCCESS(stat = SYS$DISPLAY(&inp_fab))) { Error("sys$display failed, rc:%d", stat); if (xabkey != 0) { free(xabkey); xabkey = 0; } if (xaball != 0) { free(xaball); xaball = 0; } return stat; } out_fab = inp_fab; out_fab.fab$b_fac = FAB$M_BRO | FAB$M_PUT; out_fab.fab$l_fna = out_file->dsc$a_pointer; out_fab.fab$b_fns = (unsigned char) out_file->dsc$w_length; out_fab.fab$w_ifi = 0; out_fab.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI; out_fab.fab$l_fop &= ~FAB$M_NAM; out_fab.fab$l_nam = 0; if (!$VMS_STATUS_SUCCESS(stat = SYS$CREATE(&out_fab))) { Error("sys$create failed, rc:%d", stat); SYS$CLOSE(&inp_fab); if (xabkey != 0) { free(xabkey); xabkey = 0; } if (xaball != 0) { free(xaball); xaball = 0; } return stat; } inp_rab = cc$rms_rab; inp_rab.rab$l_fab = &inp_fab; inp_rab.rab$l_rop = RAB$M_BIO; out_rab = inp_rab; out_rab.rab$l_fab = &out_fab; out_rab.rab$w_isi = 0; if (!$VMS_STATUS_SUCCESS(stat = SYS$CONNECT(&inp_rab)) || !$VMS_STATUS_SUCCESS(stat = SYS$CONNECT(&out_rab))) { Error("sys$connect failed, rc:%d", stat); SYS$CLOSE(&inp_fab); SYS$CLOSE(&out_fab); if (xabkey != 0) { free(xabkey); xabkey = 0; } if (xaball != 0) { free(xaball); xaball = 0; } return stat; } inp_rab.rab$l_ubf = buffer; inp_rab.rab$w_usz = 32256; out_rab.rab$l_rbf = buffer; while (1==1) { if (!$VMS_STATUS_SUCCESS(stat = SYS$READ(&inp_rab)) && stat != RMS$_EOF) { Error("sys$read failed, rc:%d", stat); SYS$CLOSE(&inp_fab); SYS$CLOSE(&out_fab); if (xabkey != 0) { free(xabkey); xabkey = 0; } if (xaball != 0) { free(xaball); xaball = 0; } return stat; } else if(stat == RMS$_EOF) { SYS$CLOSE(&inp_fab); SYS$CLOSE(&out_fab); if (xabkey != 0) { free(xabkey); xabkey = 0; } if (xaball != 0) { free(xaball); xaball = 0; } return RMS$_NORMAL; } else { out_rab.rab$w_rsz = inp_rab.rab$w_rsz; if (!$VMS_STATUS_SUCCESS(stat = SYS$WRITE(&out_rab))) { Error("sys$write failed, rc:%d", stat); SYS$CLOSE(&inp_fab); SYS$CLOSE(&out_fab); if (xabkey != 0) { free(xabkey); xabkey = 0; } if (xaball != 0) { free(xaball); xaball = 0; } return stat; } } } return stat; } > > > Callable CONVERT, as in the following Pascal code: > > [ inherit('sys$library:pascal$conv_routines', > 'lib:utilities') ] > PROGRAM conv; > > const > conv$l_options_count = 0; > conv$l_create = 1; > conv$l_sort = 6; > > [align(vax)] > var > convert_options : array[0..19] of unsigned VALUE [otherwise 0]; > > BEGIN > convert_options[conv$l_options_count] := 19; > convert_options[conv$l_create] := 1; > check(conv$pass_files('in.dat','out.dat')); > check(conv$pass_options(convert_options)); > check(conv$convert); > END. > > -- > Robin Garner SMTP: Robin.Garner at assetservices.com-junk.au > VMS Specialist Snail: 169-171 Gladstone St. Fyshwick ACT 2609 > Asset Services -- addresses munged to avoid spam -- > +61 2 6285 7577