1' BEGIN LICENSE BLOCK
2' Version: CMPL 1.1
3'
4' The contents of this file are subject to the Cisco-style Mozilla Public
5' License Version 1.1 (the "License"); you may not use this file except
6' in compliance with the License.  You may obtain a copy of the License
7' at www.eclipse-clp.org/license.
8'
9' Software distributed under the License is distributed on an "AS IS"
10' basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11' the License for the specific language governing rights and limitations
12' under the License.
13'
14' The Original Code is  The ECLiPSe Constraint Logic Programming System.
15' The Initial Developer of the Original Code is  Cisco Systems, Inc.
16' Portions created by the Initial Developer are
17' Copyright (C) 2006 Cisco Systems, Inc.  All Rights Reserved.
18'
19' Contributor(s):
20'
21' END LICENSE BLOCK
22
23VERSION 1.0 CLASS
24BEGIN
25  MultiUse = -1  'True
26END
27Attribute VB_Name = "EclipseStream"
28Attribute VB_GlobalNameSpace = False
29Attribute VB_Creatable = False
30Attribute VB_PredeclaredId = False
31Attribute VB_Exposed = False
32Attribute VB_Description = "The streams open to eclipse"
33Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
34Attribute VB_Ext_KEY = "Top_Level" ,"No"
35Option Explicit
36
37Private Declare Function ec_queue_write _
38        Lib "Eclipse.dll" _
39        (ByVal StreamNr As Long, ByVal buffer As String, ByVal length As Long) _
40        As Long
41Private Declare Function ec_queue_read _
42        Lib "Eclipse.dll" _
43        (ByVal StreamNr As Long, ByVal buffer As String, ByVal length As Long) _
44        As Long
45Private Declare Sub ec_int32_xdr _
46        Lib "Eclipse.dll" _
47        (l As Long, ByVal xdrString As String)
48Private Declare Sub ec_double_xdr _
49        Lib "Eclipse.dll" _
50        (d As Double, ByVal xdrString As String)
51Private Declare Sub ec_xdr_int32 _
52        Lib "Eclipse.dll" _
53        (ByVal xdrString As String, l As Long)
54Private Declare Sub ec_xdr_double _
55        Lib "Eclipse.dll" _
56        (ByVal xdrString As String, d As Double)
57Public Enum EclipseStreamMode
58    ToEclipse
59    FromEclipse
60End Enum
61
62Const ExdrVersion = 1
63
64'local variable(s) to hold property value(s)
65
66Private mvarMode As EclipseStreamMode 'local copy
67Private mvarStreamID As Long
68Private msPrompt As String
69Private mKey As String
70
71Event Flush()
72
73Friend Property Let Key(ByVal vData As String)
74    mKey = vData
75End Property
76Public Property Get Key() As String
77    Key = mKey
78End Property
79
80Friend Property Let Mode(ByVal vData As EclipseStreamMode)
81'used when assigning a value to the property, on the left side of an assignment.
82'Syntax: X.Mode = 5
83    mvarMode = vData
84End Property
85
86
87Public Property Get Mode() As EclipseStreamMode
88'used when retrieving value of a property, on the right side of an assignment.
89'Syntax: Debug.Print X.Mode
90    Mode = mvarMode
91End Property
92
93Public Property Let Prompt(ByVal vData As String)
94    msPrompt = vData
95End Property
96Public Property Get Prompt() As String
97    Prompt = msPrompt
98End Property
99
100Friend Property Let id(ByVal vData As Long)
101    mvarStreamID = vData
102End Property
103Friend Property Get id() As Long
104    id = mvarStreamID
105End Property
106Public Sub StreamWrite(data As String)
107    If mvarMode = FromEclipse Then
108        Err.Raise 3, TypeName(Me) & "::StreamWrite", _
109            "Writing to a FromEclipse stream" _
110            & " (" & Key & ")."
111    End If
112    ec_queue_write id, data, Len(data)
113End Sub
114
115Friend Sub Flush()
116    If Mode = ToEclipse Then Exit Sub
117    RaiseEvent Flush
118End Sub
119Public Function Read(l As Long) As String
120    Dim buffer As String
121    Dim ret As Long
122
123    If mvarMode = ToEclipse Then
124        Err.Raise 3, TypeName(Me) & "::StreamWrite", _
125            "Reading from a ToEclipse stream" _
126            & " (" & Key & ")."
127    End If
128
129    buffer = Space(l)
130    ret = ec_queue_read(mvarStreamID, buffer, l)
131    If (ret < l) Then
132        Read = Left(buffer, ret)
133    Else
134        Read = buffer
135    End If
136End Function
137Public Function NewData() As String
138    Dim buffer As String * 1000
139    Dim lenbuf As Long
140
141    lenbuf = ec_queue_read(mvarStreamID, buffer, 1000)
142    If (lenbuf = 1000) Then
143        NewData = buffer & NewData
144    ElseIf lenbuf = -192 Then
145        Err.Raise 2, TypeName(Me) & "::Flush", _
146            "Trying to read from a stream that is not a queue" _
147            & " (" & Key & ")."
148    Else
149        NewData = Left(buffer, lenbuf)
150    End If
151End Function
152
153
154
155Public Sub WriteExdr(data As Variant)
156    Dim o As String
157    o = "V" & Chr$(ExdrVersion) & Exdr(data)
158    ec_queue_write id, o, Len(o)
159End Sub
160Private Function Exdr(data As Variant) As String
161    Dim o As String
162    Dim buff As String * 8
163    Dim i As Long
164    Dim Item As Variant
165    Dim TheType As VbVarType
166
167    TheType = VarType(data)
168    Select Case TheType
169    Case Is >= vbArray
170        ec_int32_xdr UBound(data), buff
171        o = "F" & Left(buff, 4)
172        ec_int32_xdr Len(data(0)), buff
173        o = o & "S" & Left(buff, 4) & data(0)
174        For i = 1 To UBound(data)
175            o = o & Exdr(data(i))
176        Next i
177        Exdr = o
178    Case vbObject
179        If TypeName(data) = "Collection" Then
180            For Each Item In data
181                o = o & "[" & Exdr(Item)
182            Next Item
183            Exdr = o & "]"
184        Else
185            Err.Raise EC_CONVERSION_ERROR, TypeName(Me) & "::WriteExdr", _
186                "Cannot convert object of type " & TypeName(data) & "."
187        End If
188    Case vbString
189        ec_int32_xdr Len(data), buff
190        Exdr = "S" & Left(buff, 4) & data
191    Case vbDouble
192        ec_double_xdr data, buff
193        Exdr = "D" & buff
194    Case vbLong, vbInteger
195        ec_int32_xdr data, buff
196        Exdr = "I" & Left(buff, 4)
197    Case vbEmpty
198        Exdr = "_"
199    Case Else
200        Err.Raise EC_CONVERSION_ERROR, TypeName(Me) & "::WriteExdr", _
201            "Cannot convert data of type " & TypeName(data) & "."
202    End Select
203End Function
204
205Public Sub ReadExdr(vout As Variant)
206    Dim sIn As String
207    Dim iLen As Long
208
209    sIn = Space(2)
210    iLen = ec_queue_read(mvarStreamID, sIn, 2)
211    If iLen <> 2 Or sIn <> "V" & Chr$(ExdrVersion) Then
212        Err.Raise _
213            EC_CONVERSION_ERROR, TypeName(Me) & "::ReadExdr", _
214            "Bad magic or version number in exdr data"
215    End If
216    ReadSubExdr vout
217End Sub
218Private Sub ReadSubExdr(vout As Variant)
219    Dim i As Long
220    Dim sIn As String
221    Dim arity As Long
222    Dim col As Collection
223    Dim ar() As Variant
224    Dim v As Variant
225
226    sIn = Space(1)
227    ec_queue_read mvarStreamID, sIn, 1
228    Select Case sIn
229    Case "I"
230        sIn = Space(4)
231        ec_queue_read mvarStreamID, sIn, 4
232        ec_xdr_int32 sIn, i
233        vout = i
234    Case "D"
235        sIn = Space(8)
236        ec_queue_read mvarStreamID, sIn, 8
237        ec_xdr_double sIn, vout
238    Case "S"
239        sIn = Space(4)
240        ec_queue_read mvarStreamID, sIn, 4
241        ec_xdr_int32 sIn, i
242        sIn = Space(i)
243        ec_queue_read mvarStreamID, sIn, i
244        vout = sIn
245    Case "F"
246        sIn = Space(9)
247        ec_queue_read mvarStreamID, sIn, 9
248        ec_xdr_int32 Left(sIn, 4), arity
249        ReDim ar(arity)
250        ec_xdr_int32 Right(sIn, 4), i
251        sIn = Space(i)
252        ec_queue_read mvarStreamID, sIn, i
253        ar(0) = sIn
254        For i = 1 To arity
255            ReadSubExdr v
256            If TypeName(v) = "Collection" Then
257                Set ar(i) = v
258            Else
259                ar(i) = v
260            End If
261        Next i
262        vout = ar
263    Case "]"
264        Set vout = New Collection
265    Case "_"
266        vout = Empty
267    Case "["
268        Set col = New Collection
269        Do
270            ReadSubExdr v
271            col.Add v
272            sIn = Space(1)
273            ec_queue_read mvarStreamID, sIn, 1
274        Loop While sIn = "["
275        If sIn <> "]" Then Err.Raise _
276            EC_CONVERSION_ERROR, TypeName(Me) & "::ReadExdr", _
277            "Missing closing bracket for list"
278        Set vout = col
279    Case Else
280        Err.Raise EC_CONVERSION_ERROR, TypeName(Me) & "::ReadExdr", _
281            "Unrecognized exdr format (" & sIn & ")."
282    End Select
283End Sub
284