MODULE ComEnum;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
changes = ""
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.