******************************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. RETURN_FILE_ATTRIBUTES.
* Auteur : Laurent QUIVOGNE
*
* Cette fonction permet de renvoyer les attributs d'un fichier.
*	Format : 
*		CALL "RETURN_FILE_ATTRIBUTES" USING
*			BY REFERENCE FAB
*			BY REFERENCE ITM_LIST
*			BY REFERENCE RETOUR.
* Avec : FAB : FAB du fichier sur lequel on souhaite des informations (Par
*		exemple, contexte renvoyé par LIB$FIND_FILE"
*
*	ITM_LIST : Liste des attributs que vous souhaitez récupérer (Voir
*		I/O user's guide part I, chapitre 1, lecture des attributs.
*		Les codes sont définis dans le module ATRDEF_MAC inclus
*		dans la librarie MODULE.OLB.
*		Le format de cet item_list est semblable à celle utilisée
*		dans SYS$GETDVI,... avec des codes de type ATR$...
*	NB: Les codes existent chacun en deux versions.
*	Exemple : ATR$C_CREDATE --> code de l'attribut date de création
*		  ATR$S_CREDATE --> Taille du buffer pour cette même date
*
*	RETOUR : LONGWORD dans lequel la fonction écrit le statut de retour.
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.

01  DESCR_FIB.
  02  PIC 9(9)	COMP VALUE 10.
  02  POINTER VALUE REFERENCE FIB.
01  FIB.
  02  PIC 9(9)	COMP VALUE 0.
  02  FIB_FID.
    03  PIC 9(4)	COMP OCCURS 3 TIMES.

01  IOSB.
  02  IOSB1		PIC 9(9)	COMP.
  02  IOSB2		PIC 9(9)	COMP.
01  CHANNEL		PIC 9(9)	COMP.

01  DEVICE1		PIC X(255)	VALUE SPACES.
01  DEV_LEN		PIC 9(4)	COMP.
01  DEVICE2		PIC X(255)	VALUE SPACES.

01  IO$_ACCESS		PIC 9(9)	COMP VALUE EXTERNAL IO$_ACCESS.
01  IO$_DEACCESS	PIC 9(9)	COMP VALUE EXTERNAL IO$_DEACCESS.

01  NAM_ADDRESS		PIC 9(9)	COMP VALUE 0.
01  FAB$L_NAM		PIC 9(9)	COMP VALUE EXTERNAL FAB$L_NAM.
01  NAM$T_DVI		PIC 9(9)	COMP VALUE EXTERNAL NAM$T_DVI.
01  NAM$W_FID		PIC 9(9)	COMP VALUE EXTERNAL NAM$W_FID.

01  DUMMY1		PIC 9(4)	COMP.
01  DUMMY2		PIC 9(9)	COMP.

LINKAGE SECTION.

01  FAB_ADDRESS		PIC 9(9)	COMP.
01  ITM_LIST		PIC 9(9)	COMP.
01  RETOUR		PIC 9(9)	COMP.

PROCEDURE DIVISION USING FAB_ADDRESS ITM_LIST RETOUR.
DEBUT.
* On retrouve l'adresse du NAM : @(FAB_ADDRESS + FAB$L_NAM)
	ADD FAB$L_NAM TO FAB_ADDRESS GIVING NAM_ADDRESS.
	MOVE 4 TO DUMMY1.
	CALL "LIB$MOVC3" USING DUMMY1
		BY VALUE NAM_ADDRESS
		BY REFERENCE NAM_ADDRESS.
* - A l'adresse NAM_ADDRESS + NAM$T_DVI, on trouve la counted string qui
*   contient le nom de ce device (1byte = lg de la string)
	ADD NAM$T_DVI TO NAM_ADDRESS GIVING DUMMY2.
	MOVE 1 TO DUMMY1.
	CALL "LIB$MOVC3" USING DUMMY1
		BY VALUE DUMMY2
		BY REFERENCE DEV_LEN.
	MOVE SPACES TO DEVICE1.
	ADD 1 TO DUMMY2.
	CALL "LIB$SCOPY_R_DX" USING DEV_LEN 
		BY VALUE DUMMY2
		BY DESCRIPTOR DEVICE1.
* On fait éventuellement l'assignation sur le DEVICE s'il n'a pas été fait
* auparavant (DEVICE2 contient la sauvegarde du dernier device) sur le même
* device...
	IF DEVICE1 NOT = DEVICE2 THEN
		IF CHANNEL NOT = 0 THEN	
			CALL "SYS$DASSGN" USING BY VALUE CHANNEL
		END-IF
		CALL "SYS$ASSIGN" USING 
			BY DESCRIPTOR DEVICE1(1:DEV_LEN)
			BY REFERENCE CHANNEL OMITTED OMITTED
			GIVING RETOUR
		IF RETOUR IS FAILURE THEN GO TO FIN END-IF
		MOVE DEVICE1 TO DEVICE2
	END-IF.

* On remplit la structure FIB avec le File_id du fichier
	ADD NAM$W_FID TO NAM_ADDRESS GIVING DUMMY2.
	MOVE 6 TO DUMMY1.
	CALL "LIB$MOVC3" USING DUMMY1
		BY VALUE DUMMY2
		BY REFERENCE FIB_FID.

* Accès QIO...
	CALL "SYS$QIOW" USING OMITTED
		BY VALUE CHANNEL IO$_ACCESS
		BY REFERENCE IOSB
		OMITTED OMITTED
		BY REFERENCE DESCR_FIB
		OMITTED OMITTED OMITTED ITM_LIST OMITTED
		GIVING RETOUR.
	IF RETOUR IS FAILURE THEN GO TO FIN.
	IF IOSB1 IS FAILURE THEN 
		MOVE IOSB1 TO RETOUR
	END-IF.
FIN.
	EXIT PROGRAM.
END PROGRAM RETURN_FILE_ATTRIBUTES.