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