home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmPipeDest
- Caption = "Pipe Destination"
- ClientHeight = 2940
- ClientLeft = 1155
- ClientTop = 4860
- ClientWidth = 4725
- Height = 3345
- Left = 1095
- LinkTopic = "Form1"
- ScaleHeight = 2940
- ScaleWidth = 4725
- Top = 4515
- Width = 4845
- Begin VB.Timer Timer1
- Enabled = 0 'False
- Interval = 100
- Left = 4320
- Top = 0
- End
- Begin VB.TextBox txtDest
- Height = 2295
- Left = 180
- MultiLine = -1 'True
- TabIndex = 0
- Top = 480
- Width = 4335
- End
- Begin VB.Label Label1
- Caption = "Incoming Data:"
- Height = 255
- Left = 180
- TabIndex = 1
- Top = 120
- Width = 3375
- End
- Attribute VB_Name = "frmPipeDest"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- ' Copyright
- 1997 by Desaware Inc. All Rights Reserved
- Dim PipeHandle As Long
- Private Sub Form_Load()
- PipeHandle = GetStdHandle(STD_INPUT_HANDLE)
- ' MsgBox "PipeHandle: " & PipeHandle
- Timer1.Enabled = True
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- If PipeHandle <> 0 Then
- Call CloseHandle(PipeHandle)
- End If
- End Sub
- Private Sub Timer1_Timer()
- Dim res&
- Dim x&
- Dim t$
- Dim lread&, lavail&, lmessage&
- res = PeekNamedPipe(PipeHandle, ByVal 0&, 0, lread, lavail, lmessage)
- ' MsgBox res & lread & lavail & lmessage & " E: " & Hex$(GetLastError)
- If res <> 0 And lavail > 0 Then
- ReDim inbuf(lavail) As Byte
- res = ReadFile(PipeHandle, inbuf(0), lavail, lread, 0)
- ' MsgBox "read: " & lavail, lread
- ' We need to convert into Unicode here.
- t$ = inbuf()
- t$ = StrConv(t$, vbUnicode)
- txtDest = txtDest & t$
- End If
- End Sub
- Private Sub txtDest_KeyPress(KeyAscii As Integer)
- KeyAscii = 0
- End Sub
-