I recompiled the posted source and had no problem. Are you trying to run the "server" program in the IDE?
Ahh, that must be it.
No, to test the "server" separately in the IDE you would have to provide an alternate source for StdIn and StdOut.
Here's a hacked Main module allowing manual IDE testing:
Code:
Option Explicit
'
'Requires: Microsoft Scripting Runtime.
'
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private tsStdIn As Scripting.TextStream
Private tsStdOut As Scripting.TextStream
Private Function DirTree( _
ByVal DirPath As String, _
ByVal Depth As Integer, _
Optional ByVal Level As Integer = 0) As String
Dim strLevelIndent As String
Dim colFolderNames As Collection
Dim strDirItem As String
Dim varDirPathItem As Variant
Dim lngAttr As Long
Const REPARSE_POINT As Long = &H400&
strLevelIndent = Space$(4 * Level)
Set colFolderNames = New Collection
On Error Resume Next
strDirItem = Dir$(DirPath, vbReadOnly Or vbHidden Or vbDirectory)
If Err.Number Then
DirTree = Err.Description
Exit Function
End If
On Error GoTo 0
Do Until Len(strDirItem) = 0
varDirPathItem = DirPath & strDirItem
'On Error Resume Next
lngAttr = GetAttr(varDirPathItem)
If Err.Number Then
DirTree = Err.Description
Exit Function
End If
On Error GoTo 0
If (lngAttr And REPARSE_POINT) = 0 Then
If (lngAttr And vbDirectory) <> 0 Then
If strDirItem <> "." And strDirItem <> ".." Then
colFolderNames.Add varDirPathItem & "\"
End If
Else
DirTree = DirTree & strLevelIndent & varDirPathItem & vbNewLine
End If
End If
strDirItem = Dir$()
Loop
Level = Level + 1
For Each varDirPathItem In colFolderNames
DirTree = DirTree & strLevelIndent & varDirPathItem & vbNewLine
If Level <= Depth Then
DirTree = DirTree & DirTree(varDirPathItem, Depth, Level)
End If
Next
End Function
Private Sub Main()
'Inbound requests:
'
' QUIT<newline>
'
'or:
'
' <depth>|<directory path><newline>
'
'Outbound responses:
'
' QUITTING
'
'or:
'
' <response length><newline><directory tree>
'
Dim strMsg As String
Dim strParts() As String
Dim IDEMode As Boolean
On Error Resume Next
Debug.Assert CBool(1 / 0)
IDEMode = CBool(Err.Number)
On Error GoTo 0
If IDEMode Then AllocConsole
With New Scripting.FileSystemObject
Set tsStdIn = .GetStandardStream(StdIn)
Set tsStdOut = .GetStandardStream(StdOut)
End With
Do
strMsg = tsStdIn.ReadLine()
If UCase$(strMsg) = "QUIT" Then
tsStdOut.WriteLine "QUITTING"
Exit Do
Else
Sleep 1500 'Hang around pretending this is lots of work.
strParts = Split(strMsg, "|")
strMsg = DirTree(strParts(1), CInt(strParts(0) - 1))
tsStdOut.WriteLine CStr(Len(strMsg))
tsStdOut.Write strMsg
End If
Loop
If IDEMode Then FreeConsole
End Sub