• 软件测试技术
  • 软件测试博客
  • 软件测试视频
  • 开源软件测试技术
  • 软件测试论坛
  • 软件测试沙龙
  • 软件测试资料下载
  • 软件测试杂志
  • 软件测试人才招聘
    暂时没有公告

字号: | 推荐给好友 上一篇 | 下一篇

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

发布: 2007-5-25 09:21 | 作者: qaymuic | 来源: 互联网 | 查看: 284次 | 进入软件测试论坛讨论

领测软件测试网

给出示例代码如下:

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

 

 

延伸阅读

文章来源于领测软件测试网 https://www.ltesting.net/


关于领测软件测试网 | 领测软件测试网合作伙伴 | 广告服务 | 投稿指南 | 联系我们 | 网站地图 | 友情链接
版权所有(C) 2003-2010 TestAge(领测软件测试网)|领测国际科技(北京)有限公司|软件测试工程师培训网 All Rights Reserved
北京市海淀区中关村南大街9号北京理工科技大厦1402室 京ICP备2023014753号-2
技术支持和业务联系:info@testage.com.cn 电话:010-51297073

软件测试 | 领测国际ISTQBISTQB官网TMMiTMMi认证国际软件测试工程师认证领测软件测试网