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
【必读】版权免责声明
1、本主题所有言论和内容纯属会员个人意见，与本论坛立场无关。2、本站对所发内容真实性、客观性、可用性不做任何保证也不负任何责任，网友之间仅出于学习目的进行交流。3、对提供的数字内容不拥有任何权利，其版权归原著者拥有。请勿将该数字内容进行商业交易、转载等行为，该内容只为学习所提供，使用后发生的一切问题与本站无关。 4、本网站不保证本站提供的下载资源的准确性、安全性和完整性;同时本网站也不承担用户因使用这些下载资源对自己和他人造成任何形式的损失或伤害。 5、本网站所有软件和资料均为网友推荐收集整理而来，仅供学习用途使用，请务必下载后两小时内删除，禁止商用。6、如有侵犯你版权的，请及时联系我们（电子邮箱1370723259@qq.com）指出，本站将立即改正。
| 
