From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 23-MAY-1989 12:34
To:	MRGATE::"ARISIA::EVERHART"
Subj:	undelete program part 3 of 3

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue, 23 MAY 89 07:38:49 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Tue, 23 May 89 07:19:12 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.36)
	id AA17723; Tue, 23 May 89 07:06:10 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 23 May 89 09:35:04 GMT
From: mcvax!ukc!stl!scott@uunet.uu.net  (Mike Scott)
Organization: STC Technology Limited, London Road, Harlow, Essex, UK
Subject: undelete program part 3 of 3
Message-Id: <1471@stl.stc.co.uk>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

+-+-+-+ Beginning of part 3 +-+-+-+
X`009Attributes.UCHAR.Attrib_Type`009:= ATR$C_UCHAR;
V`009Attributes.UCHAR.Attrib_Addr`009:= IADDRESS(Header`094.Header.FH$FILECHAR
X);
X   `032
X`009Attributes.UIC.Attrib_Size`009:= ATR$S_UIC;
X`009Attributes.UIC.Attrib_Type`009:= ATR$C_UIC;
V`009Attributes.UIC.Attrib_Addr`009:= IADDRESS(Header`094.Header.FH$UICMEMBER)
X;
X   `032
X`009Attributes.FPRO.Attrib_Size`009:= ATR$S_FPRO;
X`009Attributes.FPRO.Attrib_Type`009:= ATR$C_FPRO;
V`009Attributes.FPRO.Attrib_Addr`009:= IADDRESS(Header`094.Header.FH$FILEPROT)
X;
X   `032
X`009Attributes.CREDATE.Attrib_Size`009:= ATR$S_CREDATE;
X`009Attributes.CREDATE.Attrib_Type`009:= ATR$C_CREDATE;
X`009Attributes.CREDATE.Attrib_Addr`009:= IADDRESS(Ident`094.FI$CREDATE);
X   `032
X`009Attributes.BAKDATE.Attrib_Size`009:= ATR$S_BAKDATE;
X`009Attributes.BAKDATE.Attrib_Type`009:= ATR$C_BAKDATE;
X`009Attributes.BAKDATE.Attrib_Addr`009:= IADDRESS(Ident`094.FI$BAKDATE);
X   `032
X`009Attributes.EXPDATE.Attrib_Size`009:= ATR$S_EXPDATE;
X`009Attributes.EXPDATE.Attrib_Type`009:= ATR$C_EXPDATE;
X`009Attributes.EXPDATE.Attrib_Addr`009:= IADDRESS(Ident`094.FI$EXPDATE);
X   `032
X`009Attributes.Tail := 0;
X   `032
X`009REPEAT
X`009    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009`009FUNC`009:= IO$_CREATE + IO$M_CREATE + IO$M_ACCESS,
X`009`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009`009P1`009:= FIB$DESCR,
X`009`009`009`009P2`009:= IADDRESS(Name_Desc),
X`009`009`009`009P3`009:= IADDRESS(New_File.Length),
X`009`009`009`009P4`009:= IADDRESS(New_File_Desc),
X`009`009`009`009P5`009:= IADDRESS(Attributes));
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X`009    FIB`094.FIB$W_NMCTL`009:= FIB$M_NEWVER;
X`009UNTIL FIB$IOSB.Status <> SS$_DUPFILENAME;
X
X`009IF NOT ODD(FIB$IOSB.Status)`032
X`009THEN BEGIN
X`009    Created.ARG$COUNT`009`009:= 5;
X`009    Created.DEF$MESSAGE$OPT`009:= 0;
X`009    Created.MESSAGE$CODE`009:= IADDRESS(UNDELETE_WRITERR);
X`009    Created.FAO$COUNT`009`009:= 1;
X`009    Created.NEW$MESSAGE$OPT`009:= 0;
X`009    Created.FAO$1`009`009:= IADDRESS(Name_Desc);
X`009    Created.FAO$2`009`009:= FIB$IOSB.Status;
X`009    Created.FAO$3`009`009:= 0;
X`009    Status := $PUTMSG(`009MSGVEC`009:= Created);
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`009END
X`009ELSE BEGIN
X`009    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009`009FUNC`009:= IO$_WRITEVBLK,
X`009`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009`009P1`009:= Header`094.Data`094,
X`009`009`009`009P2`009:= Header`094.Data_Length,
X`009`009`009`009P3`009:= 1);
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`009    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X`009    FIB`094.FIB$W_DID_NUM`009:= 0;
X`009    FIB`094.FIB$W_EXCTL`009:= 0;
X`009    FIB`094.FIB$L_ACCTL`009:= 0;
X`009    FIB`094.FIB$W_NMCTL`009:= 0;
X
X`009    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009`009FUNC`009:= IO$_DEACCESS,
X`009`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009`009P1`009:= FIB$DESCR);
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`009    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X`009    Created.ARG$COUNT`009`009:= 6;
X`009    Created.DEF$MESSAGE$OPT`009:= 0;
X`009    Created.MESSAGE$CODE`009:= IADDRESS(UNDELETE_WRITTEN);
X`009    Created.FAO$COUNT`009`009:= 4;
X`009    Created.NEW$MESSAGE$OPT`009:= 0;
X`009    Created.FAO$1`009`009:= Name.Length;
X`009    Created.FAO$2`009`009:= IADDRESS(Name.Body);
X`009    Created.FAO$3`009`009:= New_File.Length;
X`009    Created.FAO$4`009`009:= IADDRESS(New_File.Body);
X`009    Status := $PUTMSG(`009MSGVEC`009:= Created);
X`009    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`009END;
X
X`009Header := Header`094.Link;
X    END;
X
X    DISPOSE(FIB);
X
X    Status := $DASSGN(`009CHAN`009:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
XEND;
X
V`123`012---------------------------------------------------------------------
X-----`125
X
XBEGIN
X    Filename_Desc.Length  := SIZE(Filename.Body);
X    Filename_Desc.Dtype   := DSC$K_DTYPE_VT;
X    Filename_Desc.Class   := DSC$K_CLASS_VS;
X    Filename_Desc.Address := IADDRESS(Filename);
X
X    Status := CLI$GET_VALUE('Filename', Filename_Desc);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);`032
X
X    DN := '.*;*';
X
X    NEW(NAM);
X    NAM`094.NAM$B_BID`009:= NAM$C_BID;
X    NAM`094.NAM$B_BLN`009:= NAM$C_BLN;
X    NAM`094.NAM$L_ESA`009:= IADDRESS(ES.Body);
X    NAM`094.NAM$B_ESS`009:= LENGTH(ES.Body);
X    NAM`094.NAM$L_RSA`009:= IADDRESS(RS.Body);
X    NAM`094.NAM$B_RSS`009:= LENGTH(RS.Body);
X
X    NEW(FAB);
X    FAB`094.FAB$B_BID`009:= FAB$C_BID;
X    FAB`094.FAB$B_BLN`009:= FAB$C_BLN;
X    FAB`094.FAB$L_FNA`009:= IADDRESS(Filename.Body);
X    FAB`094.FAB$B_FNS`009:= Filename.Length;
X    FAB`094.FAB$L_DNA`009:= IADDRESS(DN.Body);
X    FAB`094.FAB$B_DNS`009:= DN.Length;
X    FAB`094.FAB$L_NAM`009:= IADDRESS(NAM`094);
X
X    Status := $PARSE(FAB`094);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X    Device := SUBSTR(NAM`094.NAM$T_DVI, 2, ORD(NAM`094.NAM$T_DVI[1]));
X
X    Status := $ASSIGN(`009DEVNAM`009:= Device,
X`009`009`009CHAN`009:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X    NEW(FIB);
X    FIB`094.FIB$W_FID_NUM`009:= 1;
X    FIB`094.FIB$W_FID_SEQ`009:= 1;
X    FIB`094.FIB$L_ACCTL`009:= FIB$M_WRITE + FIB$M_NORECORD;
X
X    FIB$DESCR.Class   := 0;
X    FIB$DESCR.Dtype   := 0;
X    FIB$DESCR.Length  := SIZE(FIB`094);
X    FIB$DESCR.Address := IADDRESS(FIB`094);
X
X
X    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009FUNC`009:= IO$_ACCESS + IO$M_ACCESS,
X`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009P1`009:= FIB$DESCR);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009FUNC`009:= IO$_READVBLK,
X`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009P1`009:= Home,
X`009`009`009P2`009:= SIZE(Home),
X`009`009`009P3`009:= 2);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009FUNC`009:= IO$_READVBLK,
X`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009P1`009:= Bitmap,
X`009`009`009P2`009:= SIZE(Bitmap),
X`009`009`009P3`009:= Home.HM$IBMAPVBN);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009FUNC`009:= IO$_DEACCESS,
X`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009P1`009:= FIB$DESCR);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X    FIB`094.FIB$L_ACCTL`009:= 0;
X
X    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009FUNC`009:= IO$_ACCESS + IO$M_ACCESS,
X`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009P1`009:= FIB$DESCR);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X
X    Header_List := NIL;
X
X    IB_Index := 1;
X    Status := SS$_NORMAL;
X    REPEAT
X`009IF Bitmap[IB_Index] = FALSE
X`009THEN Status := Check_Header(IB_Index);
X
X`009IB_Index := IB_Index + 1;
X    UNTIL Status <> SS$_NORMAL;
X
X
X    Status := $QIOW(`009CHAN`009:= Channel,
X`009`009`009FUNC`009:= IO$_DEACCESS,
X`009`009`009IOSB`009:= FIB$IOSB,
X`009`009`009P1`009:= FIB$DESCR);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    IF NOT ODD(FIB$IOSB.Status) THEN LIB$SIGNAL(FIB$IOSB.Status);
X
X    Status := LIB$GETJPI(ITMCODE  := JPI$_PROCPRIV, OUTVAL := Proc_Priv);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X    IF Proc_Priv[PRV$V_SYSPRV] = FALSE
X    THEN BEGIN
X`009$SETPRV(ENBFLG`009:= 0,
X`009`009PRVADR`009:= PRV$M_SYSPRV);
X`009IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    END;
X
X    Read_Files;
X
X    Write_Files;
XEND.
$ GOSUB UNPACK_FILE
$ FILE_IS = "UNDELETE_MSG.MSG"
$ CHECKSUM_IS = 521764086
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X.TITLE`009`009UNDELETE Error and Warning  Messages
X.IDENT`009`009'VERSION 4.00'
X.FACILITY`009UNDELETE, 1`032
X.SEVERITY`009INFORMATIONAL
XLOCATED`009`009<located file !AS> /FAO_COUNT=1
X.SEVERITY`009INFORMATIONAL
XNONFOUND`009<no files found>`032
X.SEVERITY`009INFORMATIONAL
XWRITTEN`009`009<deleted file !AD written to !AD> /FAO_COUNT=4
X.SEVERITY`009ERROR
XWRITERR`009`009<error restoring deleted file !AS> /FAO_COUNT=1
X.END
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 3 +-+-+-+-+-



--
Regards.    Mike Scott       STL, London Road, Harlow, Essex  CM17 9NA, UK
scott@stl.stc.co.uk <or> ...uunet!mcvax!ukc!stl!scott <or>
PSI%234237100122::SCOTT        phone +44-279-29531 xtn 3133.

