home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD58465162000.psc / server / Form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2000-05-16  |  3.8 KB  |  113 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "www.planet-source-code.com"
  4.    ClientHeight    =   1965
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   3915
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   1965
  10.    ScaleWidth      =   3915
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.CommandButton listenBtn 
  13.       Caption         =   "Listen"
  14.       Height          =   375
  15.       Left            =   1320
  16.       TabIndex        =   3
  17.       Top             =   1560
  18.       Width           =   1095
  19.    End
  20.    Begin VB.TextBox Text1 
  21.       Height          =   1455
  22.       Left            =   0
  23.       MultiLine       =   -1  'True
  24.       TabIndex        =   2
  25.       Top             =   0
  26.       Width           =   3855
  27.    End
  28.    Begin VB.CommandButton Databtn 
  29.       Caption         =   "DataBtn"
  30.       Height          =   255
  31.       Left            =   120
  32.       TabIndex        =   1
  33.       Top             =   1560
  34.       Visible         =   0   'False
  35.       Width           =   1095
  36.    End
  37.    Begin VB.CommandButton Reqbtn 
  38.       Caption         =   "reqbtn"
  39.       Height          =   255
  40.       Left            =   2520
  41.       TabIndex        =   0
  42.       Top             =   1560
  43.       Visible         =   0   'False
  44.       Width           =   1215
  45.    End
  46. Attribute VB_Name = "Form1"
  47. Attribute VB_GlobalNameSpace = False
  48. Attribute VB_Creatable = False
  49. Attribute VB_PredeclaredId = True
  50. Attribute VB_Exposed = False
  51. '//////////////////////////////////////////
  52. '// This is a basic telnet server useing winsock API.
  53. '// I put this to gether because of the lack of Socket
  54. '// code for VB.
  55. '// This is only the Server. Next isue, The client
  56. '//////
  57. Dim Start_up_Data As WSADataType
  58. Dim Socket_Number As Long
  59. Dim Read_Sock As Long
  60. Dim Socket_Buffer As sockaddr
  61. Dim Read_Sock_Buffer As sockaddr
  62. Dim Read_Buffer As String * 1024
  63. Private Sub Form_Load()
  64.     RC = WSACleanup()
  65.     RC = WSAStartup(&H101, Start_up_Data)
  66.     If RC = SOCKET_ERROR Then Exit Sub
  67. End Sub
  68. Private Sub Form_Unload(Cancel As Integer)
  69.     RC = WSACleanup()
  70. End Sub
  71. Private Sub listenBtn_Click()
  72.     Socket_Number = socket(AF_INET, SOCK_STREAM, 0)
  73.     If Socket_Number < 1 Then
  74.         Exit Sub
  75.     End If
  76.     Socket_Buffer.sin_family = AF_INET
  77.     Socket_Buffer.sin_port = htons(23)      '// Port 23 is telnet.
  78.     Socket_Buffer.sin_addr = 0
  79.     Socket_Buffer.sin_zero = String$(8, 0)
  80.     X = bind(Socket_Number, Socket_Buffer, sockaddr_size)
  81.     If X <> 0 Then
  82.         X = WSACleanup()
  83.         Exit Sub
  84.     End If
  85.     X = listen(Socket_Number, 1)
  86.     X = WSAAsyncSelect(Socket_Number, Databtn.hWnd, &H202, FD_CONNECT Or FD_ACCEPT)
  87.     Text1.Text = "Socket opend = " & Socket_Number & vbCrLf
  88. End Sub
  89. '///////////////////
  90. '// Controlers::MouseUp
  91. '/////
  92. Private Sub Reqbtn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  93. On Error Resume Next    '// This alows for the Socket Stay open
  94.     Bytes = recv(Read_Sock, Read_Buffer, 1024, 0)
  95.     If Bytes <> 0 Then
  96.         Text1.Text = Text1.Text + Left$(Read_Buffer, Bytes)
  97.             
  98.     '/////////////////////////////
  99.     '// This is where you would put your code.
  100.     '//
  101.     '// if Left$(Read_Buffer, Bytes) = vbCrLf then
  102.     '//     doSomething(comandSent$)
  103.     '// end if
  104.     '/////////
  105.       
  106.     End If
  107. End Sub
  108. Private Sub Databtn_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  109.     Read_Sock = accept(Socket_Number, Read_Sock_Buffer, Len(Read_Sock_Buffer))
  110.     X = WSAAsyncSelect(Read_Sock, Reqbtn.hWnd, ByVal &H202, ByVal FD_READ Or FD_CLOSE)
  111.     Text1.Text = Text1.Text & "Connected" & vbCrLf
  112. End Sub
  113.