From: sysop@robot.nuceng.ufl.edu (Shawn A. Clifford)
Subject: Re: HELP undelete (UNDELETE.002-OF-003)
News-Software: VAX/VMS VNEWS 1.41    
Reply-To: sysop@robot.nuceng.ufl.edu
Organization: Nuclear Engineering Sciences - Univ. of Florida
Date: 13 Oct 1992 12:29 EST  

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X`09Proc_Priv`09: PACKED ARRAY `5B0..MAX_PRIVS`5D OF BOOLEAN;
X
X`09Pname, Ptype,`20
X`09Pver`09`09: $STRING;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XFUNCTION Decode_Map (Map : MAP$PTR; VAR Count, LBN : INTEGER) : INTEGER;
X
XCONST`09PLACEMENT`09= 0;
X`09FORMAT1`09`09= 1;
X`09FORMAT2`09`09= 2;
X`09FORMAT3`09`09= 3;
X
XBEGIN
X
X    CASE Map`5E.MAP$TYPE OF
X`09PLACEMENT`09: BEGIN
X`09`09`09`09Count := 0;
X`09`09`09`09LBN := 0;
X`09`09`09`09Decode_Map := 2;
X`09`09`09  END;
X`09FORMAT1`09`09: BEGIN
X`09`09`09`09Count := Map`5E.FIELD$1 + 1;`20
X`09`09`09`09LBN := (Map`5E.FIELD$2 * 2**16) + Map`5E.FIELD$3;
X`09`09`09`09Decode_Map := 4;
X`09`09`09  END;
X`09FORMAT2`09`09: BEGIN
X`09`09`09`09Count := (Map`5E.FIELD$2 * 2**8) +`20
X`09`09`09`09`09 Map`5E.FIELD$1 + 1;
X`09`09`09`09LBN := (Map`5E.FIELD$4 * 2**16) + Map`5E.FIELD$3;
X`09`09`09`09Decode_Map := 6;
X`09`09`09  END;
X`09FORMAT3`09`09: BEGIN
X`09`09`09`09Count := (Map`5E.FIELD$3 * 2**16) +
X`09`09`09`09`09 (Map`5E.FIELD$2 * 2**8) +`20
X`09`09`09`09`09 Map`5E.FIELD$1 + 1;
X`09`09`09`09LBN := (Map`5E.FIELD$5 * 2**16) + Map`5E.FIELD$4;
X`09`09`09`09Decode_Map := 8;
X`09`09`09  END;
X    END;
X
XEND;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XFUNCTION Check_Header (Bitmap_Index : INTEGER) : INTEGER;
X
XVAR`09Status`09`09`09: INTEGER;
X`09Header`09`09`09: FH$TYPE;
X`09H$IOSB`09`09`09: $IOSB;
X`09Chain, Extension, Tail`09: `5EVMFH$TYPE;
X`09Next_FIDNUM,`20
X`09Expected_SEGNUM `09: $UWORD;
X
XBEGIN
X    Status := $QIOW(`09CHAN`09:= Channel,
X`09`09`09FUNC`09:= IO$_READVBLK,
X`09`09`09IOSB`09:= H$IOSB,
X`09`09`09P1`09:= Header,
X`09`09`09P2`09:= SIZE(Header),
X`09`09`09P3`09:= Bitmap_Index - 1 +
X`09`09`09`09   Home.HM$IBMAPVBN +
X`09`09`09`09   Home.HM$IBMAPSIZE);
X    IF  ODD(Status)`20
X    AND ODD(H$IOSB.Status)`20
X    AND (Header.FH$SEG_NUM = 0)
X    AND (Header.FH$BK_FIDNUM = NAM`5E.NAM$W_DID_NUM)
X    THEN BEGIN
X`09NEW(Chain);
X
X`09Chain`5E.Header   := Header;
X`09Chain`5E.Exheader := NIL;
X`09Chain`5E.Data     := NIL;
X`09Chain`5E.Link     := Header_List;
X`09Header_List     := Chain;
X
X`09Expected_SEGNUM := 0;
X
X`09Tail := Chain;
X
X`09WHILE Header.FH$EX_FIDNUM <> 0 DO
X`09BEGIN
X`09    Next_FIDNUM := Header.FH$EX_FIDNUM;
X`09    Expected_SEGNUM := Expected_SEGNUM + 1;
X
X`09    Status := $QIOW(`09CHAN`09:= Channel,
X`09`09`09`09FUNC`09:= IO$_READVBLK,
X`09`09`09`09IOSB`09:= H$IOSB,
X`09`09`09`09P1`09:= Header,
X`09`09`09`09P2`09:= SIZE(Header),
X`09`09`09`09P3`09:= Next_FIDNUM - 1 +
X`09`09`09`09`09   Home.HM$IBMAPVBN +
X`09`09`09`09`09   Home.HM$IBMAPSIZE);
X`09    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`09    IF NOT ODD(H$IOSB.Status) THEN LIB$SIGNAL(H$IOSB.Status);
X
X`09    IF Header.FH$SEG_NUM = Expected_SEGNUM
X`09    THEN BEGIN
X`09`09NEW(Extension);
X`09`09Extension`5E.Header   := Header;
X`09`09Extension`5E.Exheader := NIL;
X`09`09Extension`5E.Data     := NIL;
X`09`09Extension`5E.Link     := NIL;
X`09`09Tail`5E.Exheader      := Extension;
X`09`09Tail                := Extension;
X`09    END
X`09    ELSE Header.FH$EX_FIDNUM := 0;
X`09END;
X    END;
X
X
X    IF NOT ODD(Status) THEN Check_Header := Status
X    ELSE Check_Header := H$IOSB.Status;
XEND;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XPROCEDURE Pre_Parse (VAR Wild : $STRING);
X
XVAR`09WAoff, WPoff, Woff`09: INTEGER;
X
XBEGIN
X    Woff := INDEX(Wild, '*%');
X    WHILE Woff <> 0 DO
X    BEGIN
X`09Wild`5BWoff`5D := '%';
X`09Wild`5BWoff + 1`5D := '*';
X`09Woff := INDEX(Wild, '*%')
X    END;
X
X    Woff := INDEX(Wild, '**');
X    WHILE Woff <> 0 DO
X    BEGIN
X`09Wild := SUBSTR(Wild, 1, Woff) + SUBSTR(Wild, Woff + 2,`20
X`09`09`09`09`09`09`09Wild.Length - Woff - 1);
X`09Woff := INDEX(Wild, '**')
X    END;
XEND;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XPROCEDURE Prep;
X
XTYPE`09PSTRING`09= PACKED ARRAY `5B1..MAX_NAME`5D OF CHAR;
X
XVAR`09Name`09: `5EPSTRING;
X
XBEGIN
X    Name::UNSIGNED := NAM`5E.NAM$L_NAME;
X    Pname := Name`5E;
X    Pname.Length := NAM`5E.NAM$B_NAME;
X    Pre_Parse(Pname);
X
X    Name::UNSIGNED := NAM`5E.NAM$L_TYPE + 1;
X    Ptype := Name`5E;
X    Ptype.Length := NAM`5E.NAM$B_TYPE - 1;
X    Pre_Parse(Ptype);
X
X    Name::UNSIGNED := NAM`5E.NAM$L_VER + 1;
X    Pver := Name`5E;
X    Pver.Length := NAM`5E.NAM$B_VER - 1;
XEND;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XFUNCTION Compare(Wild, Exp : $STRING) : BOOLEAN;
X
XVAR`09WAoff, WPoff, Woff`09: INTEGER;
X`09Match`09`09`09: BOOLEAN;
X`09Sub_Wild, Sub_Exp`09: $STRING;
X`09Syncoff`09`09`09: INTEGER;
X`09Sync`09`09`09: $STRING;
X
XBEGIN
X    WPoff := INDEX(Wild, '%');
X    WAoff := INDEX(Wild, '*');
X    IF ((WPoff < WAoff) AND (WPoff <> 0)) OR (WAoff = 0)
X    THEN Woff := WPoff
X    ELSE Woff := WAoff;
X
X    IF Woff = 0
X    THEN BEGIN
X`09IF Wild.Length = Exp.Length
X`09THEN BEGIN
X`09    IF Wild = Exp
X`09    THEN Match := TRUE
X`09    ELSE Match := FALSE
X`09END
X`09ELSE Match := FALSE
X    END
X    ELSE BEGIN
X`09IF Exp.Length < Woff
X`09THEN Match := FALSE
X`09ELSE BEGIN
X`09    Sub_Wild := SUBSTR(Wild, 1, Woff - 1);
X`09    Sub_Exp := SUBSTR(Exp, 1, Woff - 1);
X`09    IF Sub_Wild = Sub_Exp
X`09    THEN Match := TRUE
X`09    ELSE Match := FALSE
X`09END;
X    END;
X
X    IF (Match = TRUE) AND (Woff = 0)
X    THEN Compare := TRUE
X    ELSE IF Match = FALSE
X    THEN Compare := FALSE
X    ELSE BEGIN
X`09IF Wild`5BWoff`5D = '%'
X`09THEN BEGIN
X`09    Sub_Wild := SUBSTR(Wild, Woff + 1, Wild.Length - Woff);
X`09    Sub_Exp := SUBSTR(Exp, Woff + 1, Exp.Length - Woff);
X`09    Compare := Compare(Sub_Wild, Sub_Exp);
X`09END
X`09ELSE BEGIN
X`09    Sub_Wild := SUBSTR(Wild, Woff + 1, Wild.Length - Woff);
X`09    Sub_Exp := SUBSTR(Exp, Woff, Exp.Length - Woff + 1);
X
X`09    WPoff := INDEX(Sub_Wild, '%');
X`09    WAoff := INDEX(Sub_Wild, '*');
X`09    IF ((WPoff < WAoff) AND (WPoff <> 0)) OR (WAoff = 0)
X`09    THEN Woff := WPoff
X`09    ELSE Woff := WAoff;
X`09    IF Woff = 0
X`09    THEN Woff := Sub_Wild.Length;
X
X`09    IF Woff = 0
X`09    THEN Compare := TRUE
X`09    ELSE BEGIN
X`09`09Sync := SUBSTR(Sub_Wild, 1, Woff - 1);
X`09`09Syncoff := INDEX(Sub_Exp, Sync);
X`09`09IF Syncoff = 0
X`09`09THEN Compare := FALSE
X`09`09ELSE BEGIN
X`09`09    Sub_Exp := SUBSTR(Sub_Exp, Syncoff,
X`09`09`09`09`09`09Sub_Exp.Length - Syncoff + 1);
X`09`09    Compare := Compare(Sub_Wild, Sub_Exp);
X`09`09END;
X`09    END;
X`09END
X    END;
XEND;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XFUNCTION Selected (Full_Name : $STRING) : BOOLEAN;
X
XVAR`09Fname, Ftype, Fver`09: $STRING;
X`09Dot, Semicolon`09`09: INTEGER;
X`09Match`09`09`09: BOOLEAN;
X
XBEGIN
X    Dot := INDEX(Full_Name, '.');
X    Fname := SUBSTR(Full_Name, 1, Dot - 1);
X
X    Semicolon := INDEX(Full_Name, ';');
X    Ftype := SUBSTR(Full_Name, Dot + 1, Semicolon - Dot - 1);
X
X    Fver := SUBSTR(Full_Name, Semicolon + 1, Full_Name.Length - Semicolon);
X
X    Match := Compare(Pname, Fname);
X
X    IF Match = TRUE
X    THEN Match := Compare(Ptype, Ftype);
X
X    IF Match = TRUE
X    THEN Match := Compare(Pver, Fver);
X
X    Selected := Match;
XEND;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XPROCEDURE Read_Files;
X
XVAR`09Status`09`09: INTEGER;
X`09Header`09`09: `5EVMFH$TYPE;
X`09Map_Head`09: `5EVMFH$TYPE;
X`09Next_Header`09: `5EVMFH$TYPE;
X`09Map`09`09: `5BUNSAFE`5D `5EFM$TYPE;
X`09Ident`09`09: `5BUNSAFE`5D `5EFI$TYPE;
X`09Name`09`09: $STRING;
X`09Name_Desc`09: $DESCR;
X`09Data`09`09: `5BUNSAFE`5D `5EFILE$DATA;
X`09Block_Offset`09: INTEGER;
X`09Map_Left, I`09: INTEGER;
X`09Count, LBN`09: INTEGER;
X`09L$IOSB`09`09: $IOSB;
X`09Channel`09`09: $UWORD;
X`09HIBLK`09`09: INTEGER;
X`09Found`09`09: MESSAGE;
X
XBEGIN
X    Status := $ASSIGN(`09DEVNAM`09:= Device,
X`09`09`09CHAN`09:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X    Prep;
X
X    Header := Header_List;
X    Header_List := NIL;
X
X    WHILE Header <> NIL DO
X    BEGIN
X`09Next_Header := Header`5E.Link;
X
X`09Ident := IADDRESS(Header`5E.Header) + (Header`5E.Header.FH$IDOFFSET * 2);
X`09Name := Ident`5E.FI$FILENAME + Ident`5E.FI$FILENAMEXT;
X`09Name.Length  := INDEX(Name, ' ') - 1;
X
X`09IF Selected(Name)
X`09THEN BEGIN
X`09    Name_Desc.Length`09:= Name.Length;
X`09    Name_Desc.Dtype`09:= 0;
X`09    Name_Desc.Class`09:= 0;
X`09    Name_Desc.Address`09:= IADDRESS(Name.Body);
X
X`09    Found.ARG$COUNT`09`09:= 3;
X`09    Found.DEF$MESSAGE$OPT    `09:= 0;
X`09    Found.MESSAGE$CODE`09`09:= IADDRESS(UNDELETE_LOCATED);
X`09    Found.FAO$COUNT`09`09:= 1;
X`09    Found.NEW$MESSAGE$OPT`09:= 0;
X`09    Found.FAO$1`09`09`09:= IADDRESS(Name_Desc);
X`09    Status := $PUTMSG(`09MSGVEC`09:= Found);
X`09    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X`09    HIBLK := (Header`5E.Header.FH$RECATTR.FAT$L_HIBLK DIV 65536) +`20
X`09`09    ((Header`5E.Header.FH$RECATTR.FAT$L_HIBLK MOD 65536) * 65536);
X
X`09    Status := LIB$GET_VM(HIBLK * 512 + 1, I);
X`09    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`09    Data := I;
X
X`09    Header`5E.Data := Data;
X`09    Header`5E.Data_Length := HIBLK * 512;
X
X`09    Map_Head := Header;
X`09    Map_Left := Map_Head`5E.Header.FH$MAP_INUSE * 2;
X`09    Map      := IADDRESS(Map_Head`5E.Header) +`20
X`09`09`09(Map_Head`5E.Header.FH$MPOFFSET * 2);
X
X`09    Block_Offset := 0;
X
X`09    WHILE Map_Left > 0 DO
X`09    BEGIN
X`09`09I := Decode_Map(Map, Count, LBN);
X
X`09`09Status := $QIOW(CHAN`09:= Channel,
X`09`09`09`09FUNC`09:= IO$_READLBLK,
X`09`09`09`09IOSB`09:= L$IOSB,
X`09`09`09`09P1`09:= Data`5E`5BBlock_Offset`5D,
X`09 `09`09`09P2`09:= Count * 512,
X`09`09`09`09P3`09:= LBN);
X`09`09IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X`09`09IF NOT ODD(L$IOSB.Status) THEN LIB$SIGNAL(L$IOSB.Status);
X
X`09`09Block_Offset := Block_Offset + Count;
X
X`09`09Map := IADDRESS(Map`5E) + I;
X
X`09`09Map_Left := Map_Left - I;
X
X`09`09IF (Map_Left = 0) AND (Map_Head`5E.Exheader <> NIL)
X`09`09THEN BEGIN
X`09`09    Map_Head := Map_Head`5E.Exheader;
X`09`09    Map_Left := Map_Head`5E.Header.FH$MAP_INUSE * 2;
X`09`09    Map      := IADDRESS(Map_Head`5E.Header) +`20
X`09`09`09`09(Map_Head`5E.Header.FH$MPOFFSET * 2);
X`09`09END;
X`09    END;
X
X`09    Header`5E.Link := Header_List;
X`09    Header_List  := Header;
X`09END;
X
X`09Header := Next_Header;
X    END;
X
X    Status := $DASSGN(`09CHAN`09:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
XEND;
X
X`7B`0C----------------------------------------------------------------------
V----`7D
X
XPROCEDURE Write_Files;
X
XTYPE`09Attrib_Entry`09= PACKED RECORD
X`09`09`09`09Attrib_Size`09: $UWORD;
X`09`09`09`09Attrib_Type`09: $UWORD;
X`09`09`09`09Attrib_Addr`09: INTEGER;
X`09`09`09  END;
X
X`09Attrib_List`09= RECORD
X`09`09`09`09RECATTR`09: Attrib_Entry;
X`09`09`09`09UCHAR`09: Attrib_Entry;
X`09`09`09`09UIC`09: Attrib_Entry;
X`09`09`09`09FPRO`09: Attrib_Entry;
X`09`09`09`09CREDATE`09: Attrib_Entry;
X`09`09`09`09BAKDATE`09: Attrib_Entry;
X`09`09`09`09EXPDATE`09: Attrib_Entry;
X`09`09`09`09Tail`09: INTEGER;
X`09`09`09  END;
X
X
X
XVAR`09Status`09`09: INTEGER;
X`09Attributes`09: Attrib_List;
X`09Header`09`09: `5EVMFH$TYPE;
X`09Ident`09`09: `5BUNSAFE`5D `5EFI$TYPE;
X`09Name`09`09: $STRING;
X`09Name_Desc`09: $DESCR;
X`09FIB$IOSB`09: $IOSB;
X`09FIB$DESCR`09: $DESCR;
X`09Channel`09`09: $UWORD;
X`09HIBLK`09`09: INTEGER;
X`09New_Name`09: $STRING;
X`09New_File`09: $STRING;
X`09New_File_Desc`09: $DESCR;
X`09Created`09`09: MESSAGE;
X
XBEGIN
X    Status := $ASSIGN(`09DEVNAM`09:= Device,
X`09`09`09CHAN`09:= Channel);
X    IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X
X    NEW(FIB);
X
X    Header := Header_List;
X
X    IF Header = NIL
X    THEN BEGIN
X`09Created.ARG$COUNT`09:= 2;
X`09Created.DEF$MESSAGE$OPT`09:= 0;
X`09Created.MESSAGE$CODE`09:= IADDRESS(UNDELETE_NONFOUND);
X`09Created.FAO$COUNT`09:= 0;
X`09Created.NEW$MESSAGE$OPT`09:= 0;
X`09Status := $PUTMSG(`09MSGVEC`09:= Created);
X`09IF NOT ODD(Status) THEN LIB$SIGNAL(Status);
X    END;
X
X    WHILE Header <> NIL DO
X    BEGIN
X`09Ident := IADDRESS(Header`5E.Header) + (Header`5E.Header.FH$IDOFFSET * 2);
X`09Name := Ident`5E.FI$FILENAME + Ident`5E.FI$FILENAMEXT;
X`09Name.Length := INDEX(Name, ' ') - 1;
X
X`09New_Name := 'UNDELETED_';
X
X`09IF Name.Length + New_Name.Length <= MAX_NAME
X`09THEN New_Name := 'UNDELETED_' + Name
X`09ELSE New_Name := Name;
X
X`09Name_Desc.Length  := New_Name.Length;
X`09Name_Desc.Dtype   := 0;
X`09Name_Desc.Class   := 0;
X`09Name_Desc.Address := IADDRESS(New_Name.Body);
X   `20
X`09New_File_Desc.Length  := SIZE(New_File.Body);
X`09New_File_Desc.Dtype   := 0;
X`09New_File_Desc.Class   := 0;
X`09New_File_Desc.Address := IADDRESS(New_File.Body);
X   `20
X`09HIBLK := (Header`5E.Header.FH$RECATTR.FAT$L_HIBLK DIV 65536) +`20
X`09`09((Header`5E.Header.FH$RECATTR.FAT$L_HIBLK MOD 65536) * 65536);
X
X`09FIB`5E.FIB$W_DID_NUM`09:= Header`5E.Header.FH$BK_FIDNUM;
X`09FIB`5E.FIB$W_DID_SEQ`09:= Header`5E.Header.FH$BK_FIDSEQ;
X`09FIB`5E.FIB$W_DID_RVN`09:= Header`5E.Header.FH$BK_FIDRVN;
X
X`09FIB`5E.FIB$W_EXCTL`09:= FIB$M_EXTEND;
X`09FIB`5E.FIB$L_EXSZ`09`09:= HIBLK;
X
X`09FIB`5E.FIB$W_NMCTL`09:= 0;
X
X`09FIB`5E.FIB$L_ACCTL`09:= FIB$M_WRITE;
X   `20
X`09FIB$DESCR.Class   := 0;
X`09FIB$DESCR.Dtype   := 0;
X`09FIB$DESCR.Length  := SIZE(FIB`5E);
X`09FIB$DESCR.Address := IADDRESS(FIB`5E);
X   `20
X`09Attributes.RECATTR.Attrib_Size`09:= ATR$S_RECATTR;
X`09Attributes.RECATTR.Attrib_Type`09:= ATR$C_RECATTR;
X`09Attributes.RECATTR.Attrib_Addr`09:= IADDRESS(Header`5E.Header.FH$RECATTR)
V;
X   `20
X`09Attributes.UCHAR.Attrib_Size`09:= ATR$S_UCHAR;
X`09Attributes.UCHAR.Attrib_Type`09:= ATR$C_UCHAR;
X`09Attributes.UCHAR.Attrib_Addr`09:= IADDRESS(Header`5E.Header.FH$FILECHAR);
X   `20
X`09Attributes.UIC.Attrib_Size`09:= ATR$S_UIC;
X`09Attributes.UIC.Attrib_Type`09:= ATR$C_UIC;
X`09Attributes.UIC.Attrib_Addr`09:= IADDRESS(Header`5E.Header.FH$UICMEMBER);
X   `20
X`09Attributes.FPRO.Attrib_Size`09:= ATR$S_FPRO;
X`09Attributes.FPRO.Attrib_Type`09:= ATR$C_FPRO;
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-
Newsgroups: comp.os.vms