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

    技术2022-05-11  63

    给出示例代码如下:

    sendemail.frm

    VERSION 5.00Begin 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   EndEndAttribute VB_Name = "Form1"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocal As Long) As LongPrivate Const AF_INET = 2Private Const SOCK_STREAM = 1Private Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As LongPrivate Declare Function WSAStartup Lib "wsock32.dll" (ByVal wversion As Long, lpwsadata As wsadata) As LongPrivate Type wsadatawversion As Integerwhighversion As Integerszdescription(0 To 256) As Byteszsystemstatus(0 To 128) As Byteimaxsockets As Integerimaxudpdg As Integerlpvendorinfo As LongEnd TypeDim sendok As BooleanDim rcptok As BooleanPrivate Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wmsg As Long, ByVal levent As Long) As LongPrivate Const FD_READ = &H1Private Declare Function WSACleanup Lib "wsock32.dll" () As LongDim mailok As BooleanPrivate Declare Function connect Lib "wsock32.dll" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As LongPrivate Type sockaddrsin_family As Integersin_port As Integersin_addr As Longsin_zero As String * 8End TypePrivate Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As LongPrivate Type hostenth_name As Longh_aliases As Longh_addrtype As Integerh_length As Integerh_addr_list As LongEnd TypeDim sll As LongPrivate Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As IntegerPrivate 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 LongPrivate Declare Function recv Lib "wsock32.dll" (ByVal s As Long, ByVal buf As Any, ByVal buflen As Long, ByVal flags As Long) As LongPrivate Sub Command1_Click()

    Dim rc As LongDim xxz As wsadataDim sck As sockaddrmailok = Falsercptok = Falsesendok = FalseText5.Text = ""sll = 0sck.sin_family = AF_INETsck.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 SubPrivate Function getipaddress(host As String) As LongDim he As LongDim hedesthost As hostentDim addrlist As LongDim rc As Longhe = gethostbyname(host)If he = 0 ThenMsgBox "主机名错误或网络错误!"rc = 0Exit FunctionEnd IfCopyMemory hedesthost, ByVal he, Len(hedesthost)CopyMemory addrlist, ByVal hedesthost.h_addr_list, 4CopyMemory rc, ByVal addrlist, hedesthost.h_lengthgetipaddress = rcEnd Function

     

    Private Sub Text5_KeyDown(KeyCode As Integer, Shift As Integer)Dim datareceived As StringDim datasend As Stringdatareceived = String$(255, Chr(0))rc = recv(sll, datareceived, 255, 0)If rc <= 0 Then Exit SubText5.Text = Text5.Text & Left(datareceived, rc)If Left(datareceived, 3) = "220" Then datasend = "helo " & Text4.Text & vbCrLfIf Left(datareceived, 3) = "250" And mailok = False Thendatasend = "mail from:" & Text4.Text & vbCrLfmailok = TrueElseIf Left(datareceived, 3) = "250" And mailok = True And rcptok = False Thendatasend = "rcpt to:" & Text2.Text & vbCrLfrcptok = TrueElseIf Left(datareceived, 3) = "250" And rcptok = True And sendok = False Thendatasend = "data" & vbCrLfsendok = TrueElseIf Left(datareceived, 3) = "250" And sendok = True ThenText5.Text = Text5.Text & "邮件发送成功!"closesocket sllWSACleanupExit SubEnd IfIf Left(datareceived, 3) = "354" Then datasend = Text3.Text & vbCrLf & "." & vbCrLfIf Left(datareceived, 1) = "5" ThenText5.Text = Text5.Text & "邮件发送失败!"closesocket sllWSACleanupEnd Ifrc = send(sll, ByVal datasend, Len(datasend), 0)

    End Sub

     

    最新回复(0)