Public Sub SaveActionLog(ByVal sActNo As String, ByVal sActtype As String, ByVal sActDesc As String)

Dim Database_Cnn As ADODB.Connection

Dim RS As ADODB.Recordset

Dim Cmd As ADODB.Command

Dim Param As ADODB.Parameter

Dim nValue As Long

On Error GoTo e

Set Cmd = New ADODB.Command

Set Param = New ADODB.Parameter

Set Database_Cnn = New ADODB.Connection

Database_Cnn.ConnectionString = "File Name=" & "C:\TY_Integration\UserControl\DB.udl"

Database_Cnn.Open

Cmd.CommandText = "Proc_SaveActionLog"

Cmd.CommandType = adCmdStoredProc

Cmd.ActiveConnection = Database_Cnn

Param.Name = "RetVal"

Param.Type = adInteger

Param.Direction = adParamReturnValue

Cmd.Parameters.Append Param

Set Param = New ADODB.Parameter

Param.Name = "@vchActNo"

Param.Type = adVarChar

Param.Size = 32

Param.Direction = adParamInput

Param.Value = sActNo

Cmd.Parameters.Append Param

Set Param = New ADODB.Parameter

Param.Name = "@vchActType"

Param.Type = adVarChar

Param.Size = 32

Param.Direction = adParamInput

Param.Value = sActtype

Cmd.Parameters.Append Param

Set Param = New ADODB.Parameter

Param.Name = "@vchActDesc"

Param.Type = adVarChar

Param.Size = 128

Param.Direction = adParamInput

Param.Value = sActDesc

Cmd.Parameters.Append Param

Cmd.Execute

nValue = Cmd.Parameters("RetVal").Value

Exit Sub

e:

'MsgBox Err.Description

End Sub

Public Function GetIPAddress() As String

Dim sHostName    As String * 256

Dim lpHost    As Long

Dim HOST      As HOSTENT

Dim dwIPAddr  As Long

Dim tmpIPAddr() As Byte

Dim i         As Integer

Dim sIPAddr  As String

If Not SocketsInitialize() Then

GetIPAddress = ""

Exit Function

End If

MAX_WSADescription = 256

MAX_WSASYSStatus = 128

ERROR_SUCCESS = 0

WS_VERSION_REQD = &H101

WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&

WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&

MIN_SOCKETS_REQD = 1

SOCKET_ERROR = -1

If gethostname(sHostName, 256) = SOCKET_ERROR Then

GetIPAddress = ""

MsgBox "Windows Sockets error " & str$(WSAGetLastError()) & _

" has occurred. Unable to successfully get Host Name."

SocketsCleanup

Exit Function

End If

sHostName = Trim$(sHostName)

lpHost = gethostbyname(sHostName)

If lpHost = 0 Then

GetIPAddress = ""

MsgBox "Windows Sockets are not responding. " & _

"Unable to successfully get Host Name."

SocketsCleanup

Exit Function

End If

CopyMemory HOST, lpHost, Len(HOST)

CopyMemory dwIPAddr, HOST.hAddrList, 4

ReDim tmpIPAddr(1 To HOST.hLen)

CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen

For i = 1 To HOST.hLen

sIPAddr = sIPAddr & tmpIPAddr(i) & "."

Next

GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)

SocketsCleanup

End Function

Public Function GetIPHostName() As String

Dim sHostName As String * 256

MAX_WSADescription = 256

MAX_WSASYSStatus = 128

ERROR_SUCCESS = 0

WS_VERSION_REQD = &H101

WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&

WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&

MIN_SOCKETS_REQD = 1

SOCKET_ERROR = -1

If Not SocketsInitialize() Then

GetIPHostName = ""

Exit Function

End If

If gethostname(sHostName, 256) = SOCKET_ERROR Then

GetIPHostName = ""

MsgBox "Windows Sockets error " & str$(WSAGetLastError()) & _

" has occurred.  Unable to successfully get Host Name."

SocketsCleanup

Exit Function

End If

GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)

SocketsCleanup

End Function

Public Function HiByte(ByVal wParam As Integer) As Byte

'note: VB4-32 users should declare this function As Integer

HiByte = (wParam And &HFF00&) \ (&H100)

End Function

Public Function LoByte(ByVal wParam As Integer) As Byte

'note: VB4-32 users should declare this function As Integer

LoByte = wParam And &HFF&

End Function

Public Sub SocketsCleanup()

If WSACleanup() <> ERROR_SUCCESS Then

MsgBox "Socket error occurred in Cleanup."

End If

End Sub

Public Function SocketsInitialize() As Boolean

Dim WSAD As WSADATA

Dim sLoByte As String

Dim sHiByte As String

MAX_WSADescription = 256

MAX_WSASYSStatus = 128

ERROR_SUCCESS = 0

WS_VERSION_REQD = &H101

WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&

WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&

MIN_SOCKETS_REQD = 1

SOCKET_ERROR = -1

If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then

MsgBox "The 32-bit Windows Socket is not responding."

SocketsInitialize = False

Exit Function

End If

If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

MsgBox "This application requires a minimum of " & _

CStr(MIN_SOCKETS_REQD) & " supported sockets."

SocketsInitialize = False

Exit Function

End If

If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _

(LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _

HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then

sHiByte = CStr(HiByte(WSAD.wVersion))

sLoByte = CStr(LoByte(WSAD.wVersion))

MsgBox "Sockets version " & sLoByte & "." & sHiByte & _

" is not supported by 32-bit Windows Sockets."

SocketsInitialize = False

Exit Function

End If

SocketsInitialize = True

End Function

Logo

DAMO开发者矩阵,由阿里巴巴达摩院和中国互联网协会联合发起,致力于探讨最前沿的技术趋势与应用成果,搭建高质量的交流与分享平台,推动技术创新与产业应用链接,围绕“人工智能与新型计算”构建开放共享的开发者生态。

更多推荐