x_larsen_b%use.uio.uninett@TOR.NTA.NO (Bj|rn Larsen) (08/04/87)
Since there have been some discussion of FMS lately, I thought there might be some interest for this program. With FORM.EXE you can use FMS forms from DCL command routines, passing field values to and from the command routine in symbols. This posting has been packed with an old version of VMS_SHAR. If you name the two files FORM.COM01 and FORM.COM02, you will have to catenate them with the command $ copy form.com01,form.com02 form.com and then execute form.com. Read the READ.ME-file that is created as a result. There are some hints om usage in the top of FORM.MAR. In addition there is an example routine, SHOWFILE.COM Warning: Although I have been programming in MACRO-10 for several years, this is my first program in MACRO-32. It works for me. It might work for you.. Bjorn Larsen x_larsen_b%use.uio.uninett@tor.nta.no ......................... Cut between dotted lines and save ................... $!............................................................................. $! $! VAX/VMS archive file created by VMS_SHAR Version:'09-Jun-1987' $! Copyright (c) 1987, by Michael Bednarek $! To unpack, simply execute (@) the file. $! This archive was created by X_LARSEN_B $! on Friday 31-JUL-1987 16:40:55.81 $! It contains the following file(s): $! BUILD.COM FORM.CLD FORM.MAR FRMLIB.MAR GETFILE.FLG READ.ME SHOWFILE.COM $! SHOWFILE.FLG $!============================================================================== $! ATTENTION: To keep each article below 15872 bytes, this program $! has been transmitted in several parts. $! You should concatenate ALL parts to ONE file and execute (@) that file. $!============================================================================== $ Set Symbol/Scope=(NoLocal,NoGlobal) $ CR[0,8]=13 $ Pass_or_Failed="failed!,passed." $ Goto Start $Convert_File: $ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd $No_Error1:Open/Write Out 'File_is $ Open/Read In VMS_SHAR_DUMMY.DUMMY $Next_Record: Read/End_Of_File=EOF In Record $ Write Out F$Extract(1,255,Record) $ Goto Next_Record $EOF: Close Out $ Close In $ Delete VMS_SHAR_DUMMY.DUMMY;* $ Checksum 'File_is $ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR $ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd $No_Error2:Return $Start: $ File_is="BUILD.COM" $ Check_Sum_is=2083741540 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY X$! X$! This command procedure builds FORM.EXE X$! X$ libr/mac/cre frmlib frmlib X$ macro/nolist form X$ link form X$! X$! create forms for example routine X$! X$ fms/translate showfile.flg X$ fms/translate getfile.flg X$ fms/libr/cre filelib showfile X$ fms/libr filelib getfile X$! X$! Done. X$! $ GoSub Convert_File $ File_is="FORM.CLD" $ Check_Sum_is=2014992242 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY X define verb form X image sys$disk:[]form.exe X X parameter p1, label=frmnam, prompt="Form" X value(required) X parameter p2, label=libnam, prompt="Library" X value(required,type=$infile) X X qualifier DEFAULT X qualifier INPUT $ GoSub Convert_File $ File_is="FORM.MAR" $ Check_Sum_is=1985033573 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY X .title form Display FMS form, and return input in symbols. X X; X; Copyright (c) 1987 Bj|rn Larsen X; X; This program may be distributed freely, as long as the X; above copyright notice remains intact. X; X; If you make useful modifications to this program, please X; let me know about it. X; X; Bj|rn Larsen x_larsen_b%use.uio.uninett@tor.nta.no X; X; ^ X; ! X; Yes, that IS a letter. At least in Norway. And so is {}[\]. X; X X; X; Usage: X; X; $ FORM[/qualifiers] FORMNAME LIBRARYNAME X; X; where FORMNAME is the name of a FMS form in the FMS library X; LIBRARYNAME. X; X; Input will be stored in symbols named FRM$<fieldname>. X; X; If you specify /DEFAULT, then for each field the program will X; search for a symbol named DEF$<fieldname>. If the symbol exists, X; FORM will fill in the form with these default values before X; letting the user complete the form. X; X; If you specify /NOINPUT, FORM will not let the user input any data X; in the form, but just view it. The program exits as soon as X; the user presses RETURN. X; X X; X; Uses: X; This program is meant to be used from within DCL command X; procedures that wishes to present/input data using FMS. X; X; The overhead of starting the program, opening the forms library X; and retrieving the correct form is considerable. If you plan to X; design a data-entry environment I recommend that you program X; it in a traditional language instead of in DCL. X; X; For simple command procedures, the performance is reasonable. X; X X .subtitle Macros and symbols. X X .library /frmlib/ X X FDV$K_FT_NTR=0 ; snatched from FDVDEF.MAR X X X .subtitle Main program. X .psect data, noexe, wrt X X; X; Character strings used to retrieve information from the CLI. X; X Xfrm$str:.ascid /FRMNAM/ ; Form name label. Xlib$str:.ascid /LIBNAM/ ; Library name label. Xin$str: .ascid /INPUT/ ; /INPUT qualifier label. Xdef$str:.ascid /DEFAULT/ ; /DEFAULT qualifier label. X X; X; Storage for form and library name. X; Xnamlen=255 X X$descr_s frm$nam,fname,namlen Xfname: .blkb namlen X X$descr_s lib$nam,lname,namlen Xlname: .blkb namlen X X; X; Flags for qualifiers. X; X Xinput: .byte 1 ; Default is /INPUT. Xdefault: X .byte 0 ; Default is /NODEFAULT. X X$descr_d usrinp,usrbuf,namlen Xusrbuf: .blkb namlen X X X .psect code, exe, nowrt X Xretmsg: .ascid /Press RETURN to continue/ X X Xform: .word X; X; Check for presence of qualifiers. X; X pushal in$str ; Pass pointer to "INPUT". X calls #1,g^cli$present ; Is /INPUT present? X cmpl #cli$_negated,r0 ; And is it negated? X bneq 10$ ; If so, X clrl input ; indicate that. X10$: pushal def$str ; Pass pointer to "DEFAULT". X calls #1,g^cli$present ; If /DEFAULT present? X cmpl #cli$_present,r0 ; X bneq 20$ ; If so, X incl default ; indicate that. X20$: X; X; Retrieve form and library names. X; X pushal frm$nam X pushal frm$str X calls #2,g^cli$get_value ; Get form name. X cmpl #ss$_normal,r0 ; OK return value? X beql 30$ ; Give up if anything wrong. X jmp abort X30$: pushal lib$nam X pushal lib$str X calls #2,g^cli$get_value ; Get library name X cmpl #ss$_normal,r0 X beql 40$ X jmp abort X40$: X; X; Ready to go. X; X jsb fmsini ; Initialize FMS. X $fdv$lopen filspc=lib$nam,channel=#1 ; Open the library. X jsb fmschk X $fdv$spada mode=#1 X $fdv$ssigq sigmd=#0 X jsb fmschk X $fdv$load frmnam=frm$nam ; Load the form. X $fdv$disp frmnam=frm$nam ; Display it. X tstb default ; Should we default values? X beql 50$ X jsb dodef ; Yes. X50$: tstb input ; Should we input anything? X beql 60$ ; No. X jsb getinp ; Get user input. X jmp quit X X60$: $fdv$putl val=retmsg ; Ask for a RETURN. X $lib$get_input get_str=usrinp ; Get it. X; Fall thru to quit. X Xquit: jsb fmsrdn ; Rundown FMS. X movzbl #1, r0 X ret X X X .subtitle FMS initialization & rundown. X X .psect data X Xterm: .ascid /SYS$INPUT/ ; Terminal name. X Xtca: .blkl 3 ; Terminal Control Area. X tcalen=.-tca Xcwk: .blkl 3 ; Check Workspace. X cwklen=.-cwk Xwks: .blkl 3 ; Workspace. X wkslen=.-wks X X$descr_a tcadsc, tca, 4, tcalen ; Descriptor for TCA. X$descr_a cwkdsc, cwk, 4, cwklen ; Descriptor for Check Workspace. X$descr_a wksdsc, wks, 4, wkslen ; Descriptor for Workspace. X X .psect code X X; X; Assign terminal and allocate workspaces. X; Xfmsini: $fdv$aterm tca=tcadsc,size=#12,channel=#2,terminal=term,noclear=#1 X jsb fmschk X $fdv$awksp wksp=cwkdsc,size=#2000 X jsb fmschk X $fdv$awksp wksp=wksdsc,size=#2000 X jsb fmschk X rsb X Xfmsrdn: $fdv$lclos X $fdv$spada mode=#0 X $fdv$dwksp wksp=wksdsc X $fdv$dwksp wksp=cwkdsc X $fdv$dterm tca=tcadsc X rsb X X .subtitle Input from form. X X .psect data X Xfip: .blkb 132 X fiplen=.-fip X X$descr_s fipdsc, fip, fiplen X Xasterix:.ascid /*/ X Xtermin: .long 0 X Xsympfx: .ascii /FRM$/ ; Returned symbol prefix. X .psect code X Xgetinp: movl sympfx, symnam X $fdv$get fldval=fipdsc,fldtrm=termin,fldnam=asterix X $fdv$retfn fldnam=flddsc,fldidx=fldidx X10$: $fdv$retle fldlen=fipdsc+dsc$w_length,fldnam=flddsc,fldidx=fldidx X $lib$set_symbol symdsc,fipdsc X $fdv$pft termin X cmpl #fdv$k_ft_ntr,termin ; Finished? X beql 20$ X $fdv$getaf fipdsc,termin,flddsc,fldidx X jmp 10$ X X20$: rsb X X X .subtitle Default symbol handling. X X .psect data X X; X; Most of this data is also used by GETINP. X; X Xfldidx: .long 0 Xsymnam: .ascii /DEF$/ Xfldnam: .blkb namlen X fldlen=.-fldnam X symlen=.-symnam X X$descr_s flddsc, fldnam, fldlen X$descr_s symdsc, symnam, symlen X Xsymval: .blkb namlen X X$descr_s svadsc, symval, namlen X Xindex: .long 0 X X .psect code X Xdodef: incl index X $fdv$retfo index,flddsc,fldidx X cmpl #fdv$_suc, r0 ; Ok? X bneq 10$ ; No, there are no more names. X $lib$get_symbol symdsc,svadsc X cmpl #ss$_normal, r0 X bneq dodef ; (if defined) X $fdv$put svadsc,flddsc X jmp dodef ; Go for next. X; X; Here on no more names. X; X10$: rsb X X X .subtitle Error handling routines. X X; X; ABORT: - abort with last error code returned. X; Xabort: pushl r0 X calls #1,g^lib$stop ; Stop with previous error. X X X; X; FMSCHK: - abort if fdv returned error code. X; Xfmschk: cmpl #fdv$_suc,r0 X bneq abort X rsb X X X .end form $ GoSub Convert_File