MODULE ComEnum;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT COM, WinApi, WinOle, ComTools;
	
	TYPE
		IEnumUnknown = POINTER TO RECORD (WinOle.IEnumUnknown)
			cur: INTEGER;
			num: INTEGER;
			data: POINTER TO ARRAY OF COM.IUnknown
		END;
		
		IEnumString = POINTER TO RECORD (WinOle.IEnumString)
			cur: INTEGER;
			num: INTEGER;
			data: POINTER TO ARRAY OF ARRAY OF CHAR
		END;
		
		IEnumFORMATETC = POINTER TO RECORD (WinOle.IEnumFORMATETC)
			cur: INTEGER;
			num: INTEGER;
			format: POINTER TO ARRAY OF INTEGER;
			aspect, tymed: POINTER TO ARRAY OF SET
		END;
		
		IEnumOLEVERB = POINTER TO RECORD (WinOle.IEnumOLEVERB)
			cur: INTEGER;
			num: INTEGER;
			verb: POINTER TO ARRAY OF INTEGER;
			name: POINTER TO ARRAY OF ARRAY OF CHAR;
			flags, attribs: POINTER TO ARRAY OF SET
		END;
		

	(* IEnumUnknown  *)
	
	PROCEDURE CreateIEnumUnknown* (num: INTEGER; IN data: ARRAY OF COM.IUnknown;
														OUT enum: WinOle.IEnumUnknown);
		VAR i, n: INTEGER; new: IEnumUnknown;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.cur := 0;
			new.num := num;
			NEW(new.data, num);
			i := 0;
			WHILE i < num DO new.data[i] := data[i]; INC(i) END;
			enum := new
		END
	END CreateIEnumUnknown;
	
	PROCEDURE (this: IEnumUnknown) Next (num: INTEGER; OUT elem: ARRAY [untagged] OF COM.IUnknown;
																								OUT [nil] fetched: INTEGER): COM.RESULT;
		VAR n: INTEGER;
	BEGIN
		n := 0;
		IF VALID(fetched) THEN fetched := 0
		ELSIF num # 1 THEN RETURN WinApi.E_POINTER
		END;
		IF this.cur < this.num THEN
			WHILE (this.cur < this.num) & (num > 0) DO
				elem[n] := this.data[this.cur];
				INC(this.cur); INC(n); DEC(num)
			END;
			IF VALID(fetched) THEN fetched := n END;
			RETURN WinApi.S_OK
		END;
		RETURN WinApi.S_FALSE
	END Next;
	
	PROCEDURE (this: IEnumUnknown) Skip (num: INTEGER): COM.RESULT;
	BEGIN
		IF this.cur + num < this.num THEN
			INC(this.cur, num); RETURN WinApi.S_OK
		ELSE RETURN WinApi.S_FALSE
		END
	END Skip;
	
	PROCEDURE (this: IEnumUnknown) Reset (): COM.RESULT;
	BEGIN
		this.cur := 0; RETURN WinApi.S_OK
	END Reset;
	
	PROCEDURE (this: IEnumUnknown) Clone (OUT enum: WinOle.IEnumUnknown): COM.RESULT;
		VAR new: IEnumUnknown;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.num := this.num;
			new.cur := this.cur;
			new.data := this.data;
			enum := new;
			RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_OUTOFMEMORY
		END
	END Clone;
	
	
	(* IEnumString  *)
	
	PROCEDURE CreateIEnumString* (num: INTEGER; IN data: ARRAY OF ARRAY OF CHAR;
															OUT enum: WinOle.IEnumString);
		VAR i, n: INTEGER; new: IEnumString;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.cur := 0;
			new.num := num;
			NEW(new.data, num, LEN(data, 1));
			i := 0;
			WHILE i < num DO new.data[i] := data[i]$; INC(i) END;
			enum := new
		END
	END CreateIEnumString;
	
	PROCEDURE (this: IEnumString) Next (num: INTEGER; OUT elem: ARRAY [untagged] OF WinApi.PtrWSTR;
																								OUT [nil] fetched: INTEGER): COM.RESULT;
		VAR n: INTEGER;
	BEGIN
		n := 0;
		IF VALID(fetched) THEN fetched := 0
		ELSIF num # 1 THEN RETURN WinApi.E_POINTER
		END;
		IF this.cur < this.num THEN
			WHILE (this.cur < this.num) & (num > 0) DO
				elem[n] := ComTools.NewString(this.data[this.cur]);
				INC(this.cur); INC(n); DEC(num)
			END;
			IF VALID(fetched) THEN fetched := n END;
			RETURN WinApi.S_OK
		END;
		RETURN WinApi.S_FALSE
	END Next;
	
	PROCEDURE (this: IEnumString) Skip (num: INTEGER): COM.RESULT;
	BEGIN
		IF this.cur + num < this.num THEN
			INC(this.cur, num); RETURN WinApi.S_OK
		ELSE RETURN WinApi.S_FALSE
		END
	END Skip;
	
	PROCEDURE (this: IEnumString) Reset (): COM.RESULT;
	BEGIN
		this.cur := 0; RETURN WinApi.S_OK
	END Reset;
	
	PROCEDURE (this: IEnumString) Clone (OUT enum: WinOle.IEnumString): COM.RESULT;
		VAR new: IEnumString;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.num := this.num;
			new.cur := this.cur;
			new.data := this.data;
			enum := new;
			RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_OUTOFMEMORY
		END
	END Clone;
	
	
	(* IEnumFORMATETC  *)
	
	PROCEDURE CreateIEnumFORMATETC* (num: INTEGER; IN format: ARRAY OF INTEGER;
														IN aspect, tymed: ARRAY OF SET;
														OUT enum: WinOle.IEnumFORMATETC);
		VAR i, n: INTEGER; new: IEnumFORMATETC;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.cur := 0;
			new.num := num;
			NEW(new.format, num);
			NEW(new.aspect, num);
			NEW(new.tymed, num);
			i := 0;
			WHILE i < num DO
				new.format[i] := format[i];
				new.aspect[i] := aspect[i];
				new.tymed[i] := tymed[i];
				INC(i)
			END;
			enum := new
		END
	END CreateIEnumFORMATETC;
	
	PROCEDURE (this: IEnumFORMATETC) Next (num: INTEGER;
																			OUT elem: ARRAY [untagged] OF WinOle.FORMATETC;
																			OUT [nil] fetched: INTEGER): COM.RESULT;
		VAR n: INTEGER;
	BEGIN
		n := 0;
		IF VALID(fetched) THEN fetched := 0
		ELSIF num # 1 THEN RETURN WinApi.E_POINTER
		END;
		IF this.cur < this.num THEN
			WHILE (this.cur < this.num) & (num > 0) DO
				ComTools.GenFormatEtc(SHORT(this.format[this.cur]), this.aspect[this.cur], this.tymed[this.cur], elem[n]);
				INC(this.cur); INC(n); DEC(num)
			END;
			IF VALID(fetched) THEN fetched := n END;
			RETURN WinApi.S_OK
		END;
		RETURN WinApi.S_FALSE
	END Next;
	
	PROCEDURE (this: IEnumFORMATETC) Skip (num: INTEGER): COM.RESULT;
	BEGIN
		IF this.cur + num < this.num THEN
			INC(this.cur, num); RETURN WinApi.S_OK
		ELSE RETURN WinApi.S_FALSE
		END
	END Skip;
	
	PROCEDURE (this: IEnumFORMATETC) Reset (): COM.RESULT;
	BEGIN
		this.cur := 0; RETURN WinApi.S_OK
	END Reset;
	
	PROCEDURE (this: IEnumFORMATETC) Clone (OUT enum: WinOle.IEnumFORMATETC): COM.RESULT;
		VAR new: IEnumFORMATETC;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.num := this.num;
			new.cur := this.cur;
			new.format := this.format;
			new.aspect := this.aspect;
			new.tymed := this.tymed;
			enum := new;
			RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_OUTOFMEMORY
		END
	END Clone;
	
	
	(* IEnumOLEVERB  *)
	
	PROCEDURE CreateIEnumOLEVERB* (num: INTEGER; IN verb: ARRAY OF INTEGER;
														IN name: ARRAY OF ARRAY OF CHAR;
														IN flags, attribs: ARRAY OF SET;
														OUT enum: WinOle.IEnumOLEVERB);
		VAR i, n: INTEGER; new: IEnumOLEVERB;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.cur := 0;
			new.num := num;
			NEW(new.verb, num);
			NEW(new.name, num, LEN(name, 1));
			NEW(new.flags, num);
			NEW(new.attribs, num);
			i := 0;
			WHILE i < num DO
				new.verb[i] := verb[i];
				new.name[i] := name[i]$;
				new.flags[i] := flags[i];
				new.attribs[i] := attribs[i];
				INC(i)
			END;
			enum := new
		END
	END CreateIEnumOLEVERB;
	
	PROCEDURE (this: IEnumOLEVERB) Next (num: INTEGER; OUT elem: ARRAY [untagged] OF WinOle.OLEVERB;
																								OUT [nil] fetched: INTEGER): COM.RESULT;
		VAR n: INTEGER;
	BEGIN
		n := 0;
		IF VALID(fetched) THEN fetched := 0
		ELSIF num # 1 THEN RETURN WinApi.E_POINTER
		END;
		IF this.cur < this.num THEN
			WHILE (this.cur < this.num) & (num > 0) DO
				elem[n].lVerb := this.verb[this.cur];
				elem[n].lpszVerbName := ComTools.NewString(this.name[this.cur]);
				elem[n].fuFlags := this.flags[this.cur];
				elem[n].grfAttribs := this.attribs[this.cur];
				INC(this.cur); INC(n); DEC(num)
			END;
			IF VALID(fetched) THEN fetched := n END;
			RETURN WinApi.S_OK
		END;
		RETURN WinApi.S_FALSE
	END Next;
	
	PROCEDURE (this: IEnumOLEVERB) Skip (num: INTEGER): COM.RESULT;
	BEGIN
		IF this.cur + num < this.num THEN
			INC(this.cur, num); RETURN WinApi.S_OK
		ELSE RETURN WinApi.S_FALSE
		END
	END Skip;
	
	PROCEDURE (this: IEnumOLEVERB) Reset (): COM.RESULT;
	BEGIN
		this.cur := 0; RETURN WinApi.S_OK
	END Reset;
	
	PROCEDURE (this: IEnumOLEVERB) Clone (OUT enum: WinOle.IEnumOLEVERB): COM.RESULT;
		VAR new: IEnumOLEVERB;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.num := this.num;
			new.cur := this.cur;
			new.verb := this.verb;
			new.name := this.name;
			new.flags := this.flags;
			new.attribs := this.attribs;
			enum := new;
			RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_OUTOFMEMORY
		END
	END Clone;
	
	
END ComEnum.

