pasargadnet
دوشنبه 30 آبان 1390, 17:04 عصر
با سلام خدمت اساتید
بنده یک کلاس وی بی دارم که میخواهم عینا تبدیلش کنم به سی شارپ
حالا سوالم اینه که آیا کسی هست که بتونه من رو کمک کنه تو این زمینه ؟
من خودم اصلا سوکت کار نکردم و قصدم استفاده از این کلاس هست .
کلاس رو عینا پیوست کردم به این پست .
دوستان اگر راهی هم وجود داره که از خود این کلاس بتونم استفاده کنم در سی شارپ بفرمایید لطفا .
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsNeaxConnection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Const TELCMD_IAC = 255
Const TELCMD_DONT = 254
Const TELCMD_DO = 253
Const TELCMD_WONT = 252
Const TELCMD_WILL = 251
Const TELCMD_SB = 250
Const TELCMD_NOP = 241
Const TELCMD_SE = 240
Const TELOPT_BINARY = 0
Const TELOPT_ECHO = 1
Const TELOPT_TTYPE = 24
Const TELQUAL_IS = 0
Const TELQUAL_SEND = 1
Private Enum State_Type
WaitForLogin00
WaitForPassword
WaitForRetrieve
WaitForENDOF_StopAmc
WaitForStopMSGs
WaitForENDOF_ViewDat
IsReady
WaitForENDOF_Command
End Enum
'------------------------------------------------ Class Events --------------'
Public Event IsReady()
Public Event DataReceived(strdata As String)
Public Event EndOfCommand(strCommand As String, strFileName As String, haveErr As Boolean)
'------------------------------------------------- WithEvents Var -----------'
Dim frmFORCLSCLASS_Instance As frmFORCLSCLASS
Dim WithEvents neaxChannel As MSWinsockLib.Winsock
Attribute neaxChannel.VB_VarHelpID = -1
Dim WithEvents tmReady As Timer
Attribute tmReady.VB_VarHelpID = -1
'-------------------------------------------------- Other Var ----------------'
Dim state As State_Type
Dim isLogging As Boolean
Private isClosed As Boolean
Dim waitString As String
Dim Ret As Integer
Const BUFSIZE = 30000
Dim Buf(1 To 20) As String
Dim BufNum As Byte
Dim BufCnt As Long
Dim fname_public As String
Dim Fs As FileSystemObject, Ts As TextStream
Dim debugStr As String
Dim debughWnd As Long
Private mvarPeerName As String 'local copy
Public Property Get PeerName() As String
PeerName = mvarPeerName
End Property
Public Property Get ConnectType() As String
ConnectType = "Telnet Connection"
End Property
'--------------------------------------------------- Class Initialize --------'
Private Sub Class_Initialize()
On Error Resume Next
Set frmFORCLSCLASS_Instance = New frmFORCLSCLASS
Set neaxChannel = frmFORCLSCLASS_Instance.Socket1
Set tmReady = frmFORCLSCLASS_Instance.tmReady
neaxChannel.Protocol = sckTCPProtocol
neaxChannel.LocalPort = 0
neaxChannel.RemotePort = 23
neaxChannel.RemoteHost = "192.168.0.10"
If Err <> 0 Then
MsgBox "Error (Code = " & Err.number & ") : " & Err.Description
'End
Exit Sub
End If
On Error GoTo 0
neaxChannel.Connect
Set Fs = New FileSystemObject
state = WaitForLogin00
With NIcon2
.cbSize = Len(NIcon2)
.hIcon = frmFORCLSCLASS_Instance.Icon
.hwnd = frmFORCLSCLASS_Instance.hwnd
.szTip = "Neax NEW Connection" & Chr(0)
'.uCallbackMessage = WM_MOUSEMOVE
'.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uFlags = NIF_ICON Or NIF_TIP
.uID = vbNull
End With
Shell_NotifyIcon NIM_ADD, NIcon2
isClosed = False
End Sub
'--------------------------------------------------- Class Terminate ---------'
Private Sub Class_Terminate()
Dim Counter As Long
If neaxChannel.state = sckConnected Then
neaxChannel.Close
End If
Set neaxChannel = Nothing
Set tmReady = Nothing
Set Ts = Nothing
Set Fs = Nothing
Set frmFORCLSCLASS_Instance = Nothing
Shell_NotifyIcon NIM_DELETE, NIcon2
'End
End Sub
'--------------------------------------------------- MSCOMM Events -----------'
Private Sub Analyse(UniSt As String)
'If isClosed Then Exit Sub
Static st As String
Dim ind As Long, SSS As String
If isLogging Then
'Print #1, UniSt;
'Ts.Write UniSt
BufCnt = BufCnt + Len(UniSt)
If BufCnt > BUFSIZE - 1 Then
'Ts.Write RTrim(Buf(BufNum))
BufNum = BufNum + 1
BufCnt = Len(UniSt)
Buf(BufNum) = ""
End If
Buf(BufNum) = Buf(BufNum) & UniSt
End If
st = st & UniSt
If Len(st) > 1000 Then st = Right(st, 900)
Select Case state
Case WaitForLogin00
SSS = "login:"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
SendData "swsh" & vbCrLf
state = WaitForPassword
End If
Case WaitForPassword
SSS = "Password:"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
SendData "swsh123" & vbCrLf
state = WaitForRetrieve
End If
Case WaitForRetrieve
SSS = "retrieve file initializ"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
SendData "stop amc almsg_no=all" & vbCrLf
state = WaitForENDOF_StopAmc
End If
Case WaitForENDOF_StopAmc
SSS = "...stop amc end"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
tmReady = True
state = WaitForStopMSGs
End If
Case WaitForStopMSGs
tmReady = False
tmReady = True
Case WaitForENDOF_ViewDat
SSS = "...view dat end"
ind = InStr(st, SSS)
If ind <> 0 Then
Dim ind2 As Integer
ind2 = InStr(st, "date=")
If ind2 = 0 Then
MsgBox "Can NOT adjust the time : " & st, vbCritical, "Error"
'End
Else
Dim strDat As String
strDat = Mid(st, ind2 + 5, 8)
Date = DateSerial(Mid(strDat, 7, 2), Mid(strDat, 1, 2), Mid(strDat, 4, 2))
strDat = Mid(st, ind2 + 14, 8)
Time = strDat
st = Mid(st, ind2)
RaiseEvent IsReady
state = IsReady
End If
End If
Case IsReady
'Nothing
Case WaitForENDOF_Command
SSS = waitString & " end"
ind = InStr(st, SSS)
'nic.szTip = "Neax Connection - Wait For : " & SSS & " - Index=" & CStr(ind) & Chr(0)
'Shell_NotifyIcon NIM_MODIFY, nic
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
If isLogging Then
'Close #1
Dim i
For i = 1 To BufNum
Ts.Write Buf(i)
Next i
Ts.Close
isLogging = False
RaiseEvent EndOfCommand(waitString, fname_public, False)
Else
RaiseEvent EndOfCommand(waitString, "Not Logged !", False)
End If
state = IsReady
Else
SSS = waitString & " err"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
If isLogging Then
'Close #1
'Dim i
'For i = 1 To BufCnt
' Ts.Write Buf(i)
'Next i
Ts.Write Buf(1)
Ts.Close
isLogging = False
RaiseEvent EndOfCommand(waitString, fname_public, True)
Else
RaiseEvent EndOfCommand(waitString, "Not Logged !", True)
End If
state = IsReady
End If
End If
End Select
End Sub
'--------------------------------------------------- Send Data ---------------'
Public Sub SendData(ByVal strCommand As String)
If neaxChannel.state = sckConnected Then
neaxChannel.SendData strCommand
Else
MsgBox "Error in Sending Data : It's not connected.", vbCritical, ""
'End
End If
End Sub
'--------------------------------------------------- Send Command ------------'
Public Sub SendCommand(strCommand As String, Optional logged As Boolean = False, Optional fname As String = ".\log.txt")
Dim ind1
ind1 = InStr(strCommand, " ")
If ind1 = 0 Then GoTo ERRSEG
Dim ind2
If Len(strCommand) > ind1 Then
ind2 = InStr(ind1 + 1, strCommand, " ")
End If
'If Left(strCommand, 7) = "del scd" Then debugStr = strCommand & " - " & state
If ind2 = 0 Then
waitString = strCommand
Else
waitString = Mid(strCommand, 1, ind2 - 1)
End If
isLogging = logged
If fname = ".\log.txt" Then
fname = App.Path & "\log.txt"
End If
If fname = "LogBlankPin.txtt" Then
fname = App.Path & "\LogBlankPin.txt"
End If
fname_public = fname
If isLogging Then
Set Ts = Fs.CreateTextFile(fname, True)
BufNum = 1
BufCnt = 0
Buf(BufNum) = ""
End If
state = WaitForENDOF_Command
SendData strCommand & vbCrLf
'nic.szTip = "Neax Connection - Command Sent : " & strCommand & " - State=" & CStr(state) & Chr(0)
'Shell_NotifyIcon NIM_MODIFY, nic
Exit Sub
ERRSEG:
MsgBox "Command is mistake", vbCritical, "Error"
Exit Sub
End Sub
Private Sub neaxChannel_Connect()
mvarPeerName = neaxChannel.LocalHostName
End Sub
Private Sub Read_And_Analayse()
Dim sBuffer As String, sOutput As String, sReply As String
Dim nRead As Integer, nIndex As Integer, nChar As Integer
Dim nCmd As Integer, nOpt As Integer, nQual As Integer
Call neaxChannel.GetData(sBuffer, vbString)
nRead = Len(sBuffer) 'neaxChannel.Read(sBuffer, DataLength)
nIndex = 1
While nIndex <= nRead
nChar = Asc(Mid$(sBuffer, nIndex, 1))
'
' If this is the Telnet IAC (Is A Command) character, then
' the next byte is the command
'
If nChar = TELCMD_IAC Then
nIndex = nIndex + 1: nCmd = Asc(Mid$(sBuffer, nIndex, 1))
Select Case nCmd
'
' Two IAC bytes means that this isn't really a command
'
Case TELCMD_IAC
sOutput = sOutput + Chr$(nChar)
'
' The SB (sub-option) command tells us that the server
' wants to negotiate. In this case, the only sub-option
' that we will deal with is the terminal type
'
Case TELCMD_SB
nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
nIndex = nIndex + 1: nQual = Asc(Mid$(sBuffer, nIndex, 1))
If nOpt = TELOPT_TTYPE Then
'
' Build a sub-option reply string and send it to
' the server. In this case, we're saying that we are
' a DEC VT100 terminal
'
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_SB) + Chr$(nOpt) + Chr$(TELQUAL_IS) + "DEC-VT100" + Chr$(TELCMD_IAC) + Chr$(TELCMD_SE)
neaxChannel.SendData sReply
End If
'
' The DO, DONT, WILL and WONT commands are sent by the server
' to tell us what it is capable (or not capable) of, and the
' options that it would like us to use; the next byte is the
' option code
'
Case TELCMD_DO, TELCMD_DONT, TELCMD_WILL, TELCMD_WONT
nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
Select Case nOpt
'
' The only options that we'll deal with is binary mode,
' echo and terminal type
'
Case TELOPT_BINARY, TELOPT_ECHO, TELOPT_TTYPE
If nCmd = TELCMD_DO Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WILL) + Chr$(nOpt)
neaxChannel.SendData sReply
ElseIf nCmd = TELCMD_WILL Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DO) + Chr$(nOpt)
neaxChannel.SendData sReply
End If
'
' For anything else, tell the server that we wont
' support it, or don't want the server to
'
Case Else
If nCmd = TELCMD_DO Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WONT) + Chr$(nOpt)
neaxChannel.SendData sReply
ElseIf nCmd = TELCMD_WILL Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DONT) + Chr$(nOpt)
neaxChannel.SendData sReply
End If
End Select
End Select
Else
sOutput = sOutput + Chr$(nChar)
End If
nIndex = nIndex + 1
Wend
RaiseEvent DataReceived(sOutput)
Analyse sOutput
End Sub
Private Sub neaxChannel_DataArrival(ByVal bytesTotal As Long)
Call Read_And_Analayse
End Sub
'--------------------------------------------------- Ready Timer -------------'
Private Sub tmReady_Timer()
tmReady = False
SendData "view dat" & vbCrLf
state = WaitForENDOF_ViewDat
End Sub
بنده یک کلاس وی بی دارم که میخواهم عینا تبدیلش کنم به سی شارپ
حالا سوالم اینه که آیا کسی هست که بتونه من رو کمک کنه تو این زمینه ؟
من خودم اصلا سوکت کار نکردم و قصدم استفاده از این کلاس هست .
کلاس رو عینا پیوست کردم به این پست .
دوستان اگر راهی هم وجود داره که از خود این کلاس بتونم استفاده کنم در سی شارپ بفرمایید لطفا .
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsNeaxConnection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Const TELCMD_IAC = 255
Const TELCMD_DONT = 254
Const TELCMD_DO = 253
Const TELCMD_WONT = 252
Const TELCMD_WILL = 251
Const TELCMD_SB = 250
Const TELCMD_NOP = 241
Const TELCMD_SE = 240
Const TELOPT_BINARY = 0
Const TELOPT_ECHO = 1
Const TELOPT_TTYPE = 24
Const TELQUAL_IS = 0
Const TELQUAL_SEND = 1
Private Enum State_Type
WaitForLogin00
WaitForPassword
WaitForRetrieve
WaitForENDOF_StopAmc
WaitForStopMSGs
WaitForENDOF_ViewDat
IsReady
WaitForENDOF_Command
End Enum
'------------------------------------------------ Class Events --------------'
Public Event IsReady()
Public Event DataReceived(strdata As String)
Public Event EndOfCommand(strCommand As String, strFileName As String, haveErr As Boolean)
'------------------------------------------------- WithEvents Var -----------'
Dim frmFORCLSCLASS_Instance As frmFORCLSCLASS
Dim WithEvents neaxChannel As MSWinsockLib.Winsock
Attribute neaxChannel.VB_VarHelpID = -1
Dim WithEvents tmReady As Timer
Attribute tmReady.VB_VarHelpID = -1
'-------------------------------------------------- Other Var ----------------'
Dim state As State_Type
Dim isLogging As Boolean
Private isClosed As Boolean
Dim waitString As String
Dim Ret As Integer
Const BUFSIZE = 30000
Dim Buf(1 To 20) As String
Dim BufNum As Byte
Dim BufCnt As Long
Dim fname_public As String
Dim Fs As FileSystemObject, Ts As TextStream
Dim debugStr As String
Dim debughWnd As Long
Private mvarPeerName As String 'local copy
Public Property Get PeerName() As String
PeerName = mvarPeerName
End Property
Public Property Get ConnectType() As String
ConnectType = "Telnet Connection"
End Property
'--------------------------------------------------- Class Initialize --------'
Private Sub Class_Initialize()
On Error Resume Next
Set frmFORCLSCLASS_Instance = New frmFORCLSCLASS
Set neaxChannel = frmFORCLSCLASS_Instance.Socket1
Set tmReady = frmFORCLSCLASS_Instance.tmReady
neaxChannel.Protocol = sckTCPProtocol
neaxChannel.LocalPort = 0
neaxChannel.RemotePort = 23
neaxChannel.RemoteHost = "192.168.0.10"
If Err <> 0 Then
MsgBox "Error (Code = " & Err.number & ") : " & Err.Description
'End
Exit Sub
End If
On Error GoTo 0
neaxChannel.Connect
Set Fs = New FileSystemObject
state = WaitForLogin00
With NIcon2
.cbSize = Len(NIcon2)
.hIcon = frmFORCLSCLASS_Instance.Icon
.hwnd = frmFORCLSCLASS_Instance.hwnd
.szTip = "Neax NEW Connection" & Chr(0)
'.uCallbackMessage = WM_MOUSEMOVE
'.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uFlags = NIF_ICON Or NIF_TIP
.uID = vbNull
End With
Shell_NotifyIcon NIM_ADD, NIcon2
isClosed = False
End Sub
'--------------------------------------------------- Class Terminate ---------'
Private Sub Class_Terminate()
Dim Counter As Long
If neaxChannel.state = sckConnected Then
neaxChannel.Close
End If
Set neaxChannel = Nothing
Set tmReady = Nothing
Set Ts = Nothing
Set Fs = Nothing
Set frmFORCLSCLASS_Instance = Nothing
Shell_NotifyIcon NIM_DELETE, NIcon2
'End
End Sub
'--------------------------------------------------- MSCOMM Events -----------'
Private Sub Analyse(UniSt As String)
'If isClosed Then Exit Sub
Static st As String
Dim ind As Long, SSS As String
If isLogging Then
'Print #1, UniSt;
'Ts.Write UniSt
BufCnt = BufCnt + Len(UniSt)
If BufCnt > BUFSIZE - 1 Then
'Ts.Write RTrim(Buf(BufNum))
BufNum = BufNum + 1
BufCnt = Len(UniSt)
Buf(BufNum) = ""
End If
Buf(BufNum) = Buf(BufNum) & UniSt
End If
st = st & UniSt
If Len(st) > 1000 Then st = Right(st, 900)
Select Case state
Case WaitForLogin00
SSS = "login:"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
SendData "swsh" & vbCrLf
state = WaitForPassword
End If
Case WaitForPassword
SSS = "Password:"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
SendData "swsh123" & vbCrLf
state = WaitForRetrieve
End If
Case WaitForRetrieve
SSS = "retrieve file initializ"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
SendData "stop amc almsg_no=all" & vbCrLf
state = WaitForENDOF_StopAmc
End If
Case WaitForENDOF_StopAmc
SSS = "...stop amc end"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
tmReady = True
state = WaitForStopMSGs
End If
Case WaitForStopMSGs
tmReady = False
tmReady = True
Case WaitForENDOF_ViewDat
SSS = "...view dat end"
ind = InStr(st, SSS)
If ind <> 0 Then
Dim ind2 As Integer
ind2 = InStr(st, "date=")
If ind2 = 0 Then
MsgBox "Can NOT adjust the time : " & st, vbCritical, "Error"
'End
Else
Dim strDat As String
strDat = Mid(st, ind2 + 5, 8)
Date = DateSerial(Mid(strDat, 7, 2), Mid(strDat, 1, 2), Mid(strDat, 4, 2))
strDat = Mid(st, ind2 + 14, 8)
Time = strDat
st = Mid(st, ind2)
RaiseEvent IsReady
state = IsReady
End If
End If
Case IsReady
'Nothing
Case WaitForENDOF_Command
SSS = waitString & " end"
ind = InStr(st, SSS)
'nic.szTip = "Neax Connection - Wait For : " & SSS & " - Index=" & CStr(ind) & Chr(0)
'Shell_NotifyIcon NIM_MODIFY, nic
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
If isLogging Then
'Close #1
Dim i
For i = 1 To BufNum
Ts.Write Buf(i)
Next i
Ts.Close
isLogging = False
RaiseEvent EndOfCommand(waitString, fname_public, False)
Else
RaiseEvent EndOfCommand(waitString, "Not Logged !", False)
End If
state = IsReady
Else
SSS = waitString & " err"
ind = InStr(st, SSS)
If ind <> 0 Then
st = Mid(st, ind + Len(SSS))
If isLogging Then
'Close #1
'Dim i
'For i = 1 To BufCnt
' Ts.Write Buf(i)
'Next i
Ts.Write Buf(1)
Ts.Close
isLogging = False
RaiseEvent EndOfCommand(waitString, fname_public, True)
Else
RaiseEvent EndOfCommand(waitString, "Not Logged !", True)
End If
state = IsReady
End If
End If
End Select
End Sub
'--------------------------------------------------- Send Data ---------------'
Public Sub SendData(ByVal strCommand As String)
If neaxChannel.state = sckConnected Then
neaxChannel.SendData strCommand
Else
MsgBox "Error in Sending Data : It's not connected.", vbCritical, ""
'End
End If
End Sub
'--------------------------------------------------- Send Command ------------'
Public Sub SendCommand(strCommand As String, Optional logged As Boolean = False, Optional fname As String = ".\log.txt")
Dim ind1
ind1 = InStr(strCommand, " ")
If ind1 = 0 Then GoTo ERRSEG
Dim ind2
If Len(strCommand) > ind1 Then
ind2 = InStr(ind1 + 1, strCommand, " ")
End If
'If Left(strCommand, 7) = "del scd" Then debugStr = strCommand & " - " & state
If ind2 = 0 Then
waitString = strCommand
Else
waitString = Mid(strCommand, 1, ind2 - 1)
End If
isLogging = logged
If fname = ".\log.txt" Then
fname = App.Path & "\log.txt"
End If
If fname = "LogBlankPin.txtt" Then
fname = App.Path & "\LogBlankPin.txt"
End If
fname_public = fname
If isLogging Then
Set Ts = Fs.CreateTextFile(fname, True)
BufNum = 1
BufCnt = 0
Buf(BufNum) = ""
End If
state = WaitForENDOF_Command
SendData strCommand & vbCrLf
'nic.szTip = "Neax Connection - Command Sent : " & strCommand & " - State=" & CStr(state) & Chr(0)
'Shell_NotifyIcon NIM_MODIFY, nic
Exit Sub
ERRSEG:
MsgBox "Command is mistake", vbCritical, "Error"
Exit Sub
End Sub
Private Sub neaxChannel_Connect()
mvarPeerName = neaxChannel.LocalHostName
End Sub
Private Sub Read_And_Analayse()
Dim sBuffer As String, sOutput As String, sReply As String
Dim nRead As Integer, nIndex As Integer, nChar As Integer
Dim nCmd As Integer, nOpt As Integer, nQual As Integer
Call neaxChannel.GetData(sBuffer, vbString)
nRead = Len(sBuffer) 'neaxChannel.Read(sBuffer, DataLength)
nIndex = 1
While nIndex <= nRead
nChar = Asc(Mid$(sBuffer, nIndex, 1))
'
' If this is the Telnet IAC (Is A Command) character, then
' the next byte is the command
'
If nChar = TELCMD_IAC Then
nIndex = nIndex + 1: nCmd = Asc(Mid$(sBuffer, nIndex, 1))
Select Case nCmd
'
' Two IAC bytes means that this isn't really a command
'
Case TELCMD_IAC
sOutput = sOutput + Chr$(nChar)
'
' The SB (sub-option) command tells us that the server
' wants to negotiate. In this case, the only sub-option
' that we will deal with is the terminal type
'
Case TELCMD_SB
nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
nIndex = nIndex + 1: nQual = Asc(Mid$(sBuffer, nIndex, 1))
If nOpt = TELOPT_TTYPE Then
'
' Build a sub-option reply string and send it to
' the server. In this case, we're saying that we are
' a DEC VT100 terminal
'
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_SB) + Chr$(nOpt) + Chr$(TELQUAL_IS) + "DEC-VT100" + Chr$(TELCMD_IAC) + Chr$(TELCMD_SE)
neaxChannel.SendData sReply
End If
'
' The DO, DONT, WILL and WONT commands are sent by the server
' to tell us what it is capable (or not capable) of, and the
' options that it would like us to use; the next byte is the
' option code
'
Case TELCMD_DO, TELCMD_DONT, TELCMD_WILL, TELCMD_WONT
nIndex = nIndex + 1: nOpt = Asc(Mid$(sBuffer, nIndex, 1))
Select Case nOpt
'
' The only options that we'll deal with is binary mode,
' echo and terminal type
'
Case TELOPT_BINARY, TELOPT_ECHO, TELOPT_TTYPE
If nCmd = TELCMD_DO Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WILL) + Chr$(nOpt)
neaxChannel.SendData sReply
ElseIf nCmd = TELCMD_WILL Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DO) + Chr$(nOpt)
neaxChannel.SendData sReply
End If
'
' For anything else, tell the server that we wont
' support it, or don't want the server to
'
Case Else
If nCmd = TELCMD_DO Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_WONT) + Chr$(nOpt)
neaxChannel.SendData sReply
ElseIf nCmd = TELCMD_WILL Then
sReply = Chr$(TELCMD_IAC) + Chr$(TELCMD_DONT) + Chr$(nOpt)
neaxChannel.SendData sReply
End If
End Select
End Select
Else
sOutput = sOutput + Chr$(nChar)
End If
nIndex = nIndex + 1
Wend
RaiseEvent DataReceived(sOutput)
Analyse sOutput
End Sub
Private Sub neaxChannel_DataArrival(ByVal bytesTotal As Long)
Call Read_And_Analayse
End Sub
'--------------------------------------------------- Ready Timer -------------'
Private Sub tmReady_Timer()
tmReady = False
SendData "view dat" & vbCrLf
state = WaitForENDOF_ViewDat
End Sub