게시판 본문 COM / COM+ by VB 6.0 - Read Only

안녕하세요...항상 좋은 정보를 얻고 있음에도 드디어 용기를 내어 글을 씁니다.

먼저 아래 코드는 여러 CP업체들에게 저희 회원정보를 넘겨주는 것을 NT Platform에 있는 업체들에게 이 DLL을 넘겨주려 합니다.

리턴하는 문자열은 XML로 업체에서 DOM을 이용해 변수화 시켜려고 하고 있습니다.
나름대로 열심히 공부해서 만들어 놓긴 했는데...
주위에 이걸 검증해줄 수 있는 분이 아무도 없어...
서비스 보류입니다...ㅡㅡ;

Option Explicit

Dim objXML As MSXML2.ServerXMLHTTP

Dim DB As ADODB.Connection
Dim objCmd As ADODB.Command
Dim Param As ADODB.Parameter

Private mURL As String
Private mCpNum As String
Private mCpPass As String
Private mSubmitData As String
Private mCase As String

Private m_DBcon As String
Private m_bolFrientsMemberCP As Boolean
Private m_ErrorCase As Integer
Private m_ErrorMsg As String
Private m_UserIP As String

Public Function GetDBString() As String
' DB정보
Dim DBstring As String
With objXML
.open "POST", "http://www.localhost.com", True, "sonner\administrator", "pass1234"
'테스트 URL입니다.
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

.send "AuthorID=sonner&AuthorKey=9424004"

While .readyState <> 4
.waitForResponse 2000
Wend

DBstring = Trim(StrConv(.responseBody, vbUnicode))

If Len(DBstring) = 0 Then
m_ErrorCase = 101 'DB Connection 정보 획득 실패
Else
m_DBcon = DBstring
End If
End With

GetDBString = m_DBcon
End Function

Public Function IsFrientsCp() As Boolean
Dim DB As New ADODB.Connection
Dim objCmd As New ADODB.Command
Dim Param(4) As New ADODB.Parameter
Dim i As Integer

If Len(GetDBString()) <> 0 Then
DB.open m_DBcon

With objCmd
.ActiveConnection = DB
.CommandType = adCmdStoredProc
.CommandText = "usp_CPLogin_Check"

Set Param(0) = .CreateParameter("@CpNum", adChar, adParamInput, 10, mCpNum)
Set Param(1) = .CreateParameter("@CpPass", adVarChar, adParamInput, 20, mCpPass)
Set Param(2) = .CreateParameter("@mCase", adChar, adParamInput, 4, mCase)
Set Param(3) = .CreateParameter("@ResultCode", adInteger, adParamOutput)

For i = 0 To UBound(Param) - 1
.Parameters.Append Param(i)
Next

.Execute , , adExecuteNoRecords

Select Case CInt(.Parameters("@ResultCode").Value)
Case 111 ' 협력업체 번호 에러
m_bolFrientsMemberCP = False
m_ErrorCase = 111
Case 112 ' 협력업체 인증번호 에러
m_bolFrientsMemberCP = False
m_ErrorCase = 112
Case 2 ' 접근 가능 Case 에러
m_bolFrientsMemberCP = False
m_ErrorCase = 113
Case 1
m_bolFrientsMemberCP = True
Case Else '모르는 에러?
m_bolFrientsMemberCP = False
m_ErrorCase = 999
End Select
End With
IsFrientsCp = m_bolFrientsMemberCP
Else
IsFrientsCp = False
End If

End Function
Public Sub ErrorCase(ByVal ErrorCode As Integer)
' Dim DB As New ADODB.Connection
' Dim objCmd As New ADODB.Command
' Dim Param(4) As New ADODB.Parameter
' Dim i As Integer
' Dim strReturnDB As String

If ErrorCode > 0 Then
Select Case ErrorCode
Case 101
m_ErrorMsg = "DataBase 접근 권한이 없습니다."
Case 111
m_ErrorMsg = "등록되지 않은 업체입니다..확인 후 다시 시도해 주세요."
Case 112
m_ErrorMsg = "인증번호가 틀립니다. 확인 후 다시 시도해 주세요."
Case 113
m_ErrorMsg = "접근권한이 없는 코드입니다.확인 후 다시 시도해 주세요."
Case 301
m_ErrorCase = ErrorCode
m_ErrorMsg = "인증 받지 않은 접속입니다."
Case Else
m_ErrorMsg = "검사되지 않은 장애번호"
End Select
' 에러 DB Insert
End If
End Sub
Public Function GetFrientsData() As String
Dim strBasicInfo As String

strBasicInfo = "CpNum=" & mCpNum & "&mCase=" & mCase & "&"

If IsFrientsCp Then
With objXML
.open "POST", mURL, True, "sonner\administrator", "dpswlsldj"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

.send strBasicInfo & mSubmitData

While .readyState <> 4
.waitForResponse 2000
Wend

GetFrientsData = Trim(StrConv(.responseBody, vbUnicode))
End With
Else
Call ErrorCase(301)

GetFrientsData = _
"<?xml version='1.0' encoding='euc-kr'?>" & vbCrLf & _
"<frients_data>" & vbCrLf & _
" <error>" & vbCrLf & _
" <errorNo>" & m_ErrorCase & "</errorNo>" & vbCrLf & _
" <description>" & m_ErrorMsg & "</description>" & vbCrLf & _
" </error>" & vbCrLf & _
"</frients_data>"
End If

End Function

Private Sub Class_Initialize()
Set objXML = New MSXML2.ServerXMLHTTP40

m_bolFrientsMemberCP = False
m_ErrorCase = 0
m_DBcon = ""
m_ErrorMsg = ""
m_UserIP = ""
End Sub

Private Sub Class_Terminate()
Set objXML = Nothing
End Sub

Public Property Get URL() As String
URL = mURL
End Property

Public Property Let URL(ByVal vNewValue As String)
mURL = vNewValue
' 입력값이 없다면 테스트
If Trim(mURL) = "" Then mURL = "http://www.localhost.com/xmltest.asp"
End Property

Public Property Get CpCheckNum() As String
CpCheckNum = mCpNum
End Property

Public Property Let CpCheckNum(ByVal vNewValue As String)
mCpNum = vNewValue
End Property

Public Property Get CpCheckPass() As String
CpCheckPass = mCpPass
End Property

Public Property Let CpCheckPass(ByVal vNewValue As String)
mCpPass = vNewValue
End Property

Public Property Get SubmitData() As String
SubmitData = mSubmitData
End Property

Public Property Let SubmitData(ByVal vNewValue As String)
mSubmitData = vNewValue
End Property

Public Property Get ActionCase() As String
ActionCase = mCase
End Property

Public Property Let ActionCase(ByVal vNewValue As String)
mCase = vNewValue
End Property

'-----------------------------------------------------------------------------
이상입니다..모든것들이 다 유동적인 상황(개발중)이라 DB정보 하나 얻어오는데도
WebPage에서 가져와야 할 정도 입니다.

위의 코드가 DLL로서 제대로 작성된 것인지...ㅡㅡ;
ASP상에서 CreateObject()하는 부분도 3일을 고생하다가...아으...등잔 밑이 어둡다고..
여기서 해결책을 찾았습니다..
제대로..결과도 나오고...윗분들은 만족하지만..
전 이게 과연 검증된 코드인가...여기에는 자신이 없어서..
조언 부탁드립니다.
저도 따끔한 충고 부탁드립니다.