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
|
