如何在vb 中用api函数代替winsock控件建立网络连接?

给出示例代码如下:

sendemail.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   5250
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5865
   LinkTopic       =   "Form1"
   ScaleHeight     =   5250
   ScaleWidth      =   5865
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text5
      Height          =   2055
      Left            =   480
      MultiLine       =   -1  'True
      TabIndex        =   8
      Top             =   2880
      Width           =   4815
   End
   Begin VB.TextBox Text2
      Height          =   375
      Left            =   2040
      TabIndex        =   7
      Top             =   720
      Width           =   2535
   End
   Begin VB.CommandButton Command1
      Caption         =   "send"
      Height          =   375
      Left            =   3600
      TabIndex        =   6
      Top             =   2160
      Width           =   975
   End
   Begin VB.TextBox Text4
      Height          =   375
      Left            =   1440
      TabIndex        =   5
      Text            =   "qaymuic@wocall.com"
      Top             =   2160
      Width           =   2055
   End
   Begin VB.TextBox Text3
      Height          =   735
      Left            =   360
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   1320
      Width           =   4215
   End
   Begin VB.TextBox Text1
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   120
      Width           =   2655
   End
   Begin VB.Label Label3
      Caption         =   "from"
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   2160
      Width           =   975
   End
   Begin VB.Label Label2
      Caption         =   "to:"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   720
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "smtp server"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocal As Long) As Long
Private Const AF_INET = 2
Private Const SOCK_STREAM = 1
Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wversion As Long, lpwsadata As wsadata) As Long
Private Type wsadata
wversion As Integer
whighversion As Integer
szdescription(0 To 256) As Byte
szsystemstatus(0 To 128) As Byte
imaxsockets As Integer
imaxudpdg As Integer
lpvendorinfo As Long
End Type
Dim sendok As Boolean
Dim rcptok As Boolean
Private Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wmsg As Long, ByVal levent As Long) As Long
Private Const FD_READ = &H1
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Dim mailok As Boolean
Private Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Private Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Private Type hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Dim sll As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function send Lib "wsock32.dll" (ByVal s As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Private Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As Long
Private Sub Command1_Click()

Dim rc As Long
Dim xxz As wsadata
Dim sck As sockaddr
mailok = False
rcptok = False
sendok = False
Text5.Text = ""
sll = 0
sck.sin_family = AF_INET
sck.sin_addr = getipaddress(Text1.Text)
sck.sin_port = htons(25)
sck.sin_zero = String(8, 0)
rc = WSAStartup(&H101, xxz)
sll = socket(AF_INET, SOCK_STREAM, 0)
rc = connect(sll, sck, Len(sck))
WSAAsyncSelect sll, Text5.hwnd, &H100, FD_READ

End Sub
Private Function getipaddress(host As String) As Long
Dim he As Long
Dim hedesthost As hostent
Dim addrlist As Long
Dim rc As Long
he = gethostbyname(host)
If he = 0 Then
MsgBox "主机名错误或网络错误!"
rc = 0
Exit Function
End If
CopyMemory hedesthost, ByVal he, Len(hedesthost)
CopyMemory addrlist, ByVal hedesthost.h_addr_list, 4
CopyMemory rc, ByVal addrlist, hedesthost.h_length
getipaddress = rc
End Function

 

Private Sub Text5_KeyDown(KeyCode As Integer, Shift As Integer)
Dim datareceived As String
Dim datasend As String
datareceived = String$(255, Chr(0))
rc = recv(sll, datareceived, 255, 0)
If rc <= 0 Then Exit Sub
Text5.Text = Text5.Text & Left(datareceived, rc)
If Left(datareceived, 3) = "220" Then datasend = "helo " & Text4.Text & vbCrLf
If Left(datareceived, 3) = "250" And mailok = False Then
datasend = "mail from:" & Text4.Text & vbCrLf
mailok = True
ElseIf Left(datareceived, 3) = "250" And mailok = True And rcptok = False Then
datasend = "rcpt to:" & Text2.Text & vbCrLf
rcptok = True
ElseIf Left(datareceived, 3) = "250" And rcptok = True And sendok = False Then
datasend = "data" & vbCrLf
sendok = True
ElseIf Left(datareceived, 3) = "250" And sendok = True Then
Text5.Text = Text5.Text & "邮件发送成功!"
closesocket sll
WSACleanup
Exit Sub
End If
If Left(datareceived, 3) = "354" Then datasend = Text3.Text & vbCrLf & "." & vbCrLf
If Left(datareceived, 1) = "5" Then
Text5.Text = Text5.Text & "邮件发送失败!"
closesocket sll
WSACleanup
End If
rc = send(sll, ByVal datasend, Len(datasend), 0)

End Sub

 

 

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
发现网上关于vbrichclient的教程比较少,但这个实在是好东西,实用性,稳定性都比VB自带的winsock好的多,多客户端不用winsock控件数组。 也不用在各窗体上放winsock,直接在模块中就能实现收发 下面直接上代码,窗体和文本钮、按钮大家自行拖放。要用到VB自带隐藏函数varptr()取内存指针(VbMsdn中没有这个函数,实际上很简单^^)。 VbRichClient5.0.38中包含sqlite3.9支持 上面共享中也包含VbRichClient5.0.38支持库 VbRichClient代替winsock 主要使用 cTCPServer cTCPClient cUDP '--------------------------------------------------------------------- '服务器端,代码最简化,要实现多客户端只要用数组存hsocket就可以 Option Explicit Dim WithEvents sv As cTCPServer Dim WithEvents udp1 As cUDP Dim cHsocket& Private Sub Form_Load() Set sv = New cTCPServer sv.Listen sv.GetHost("127.0.0.1"), 35912 Debug.Print sv.GetHost("") Set udp1 = New cUDP udp1.Bind "127.0.0.1", 5616 End Sub Private Sub sv_DataArrival(ByVal hSocket As Long, ByVal BytesTotal As Long, ByVal FirstBufferAfterOverflow As Boolean) Dim d() As Byte, s$ ReDim d(BytesTotal - 1) sv.GetData hSocket, VarPtr(d(0)), BytesTotal '★★关键代码 s = d Text2.Text = Text2.Text & s & vbCrLf Debug.Print "收到:" & BytesTotal End Sub Private Sub sv_TCPAccepted(ByVal hSocket As Long) cHsocket = hSocket Text1.Text = Text1.Text & sv.GetPeerHostIPAndPort(hSocket) & vbCrLf End Sub Private Sub sv_TCPDisConnect(ByVal hSocket As Long) Text3.Text = Text3.Text & sv.GetPeerHostIPAndPort(hSocket) & vbCrLf End Sub Private Sub udp1_NewDatagram(ByVal BytesTotal As Long, ByVal FirstBufferAfterOverflow As Boolean) Dim d() As Byte, s$ ReDim d(BytesTotal - 1) udp1.GetData VarPtr(d(0)), BytesTotal s = d Text2.Text = Text2.Text & s & vbCrLf End Sub '------------------------------------------------------- '客户端 Option Explicit Dim WithEvents cl As cTCPClient Dim WithEvents udp1 As cUDP Dim cid& Private Sub Command1_Click() cid = cl.Connect("QgB1", 35912) End Sub Private Sub Command2_Click() cl.Disconnect cid End Sub Private Sub Command3_Click() Dim b() As Byte b = Text1.Text cl.SendData cid, VarPtr(b(0)), UBound(b) + 1 End Sub Private Sub Command4_Click() Dim d() As Byte, s$ s = "yessss" d = s udp1.RemoteIP = "127.0.0.1" udp1.RemotePort = 5616 u
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值