分享
 
 
 

如何在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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有