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

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

给出示例代码如下:

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航