vb6 WinHTTP 통신시 서버의 상태가 항상 쾌적한것은 아니기 때문에

적절한 에러 처리와 재통신을 시도하여야 하는 상황이 있습니다.

그럴때 아래의 WinHTTP 함수 예제를 이용하여 코딩하시면 만족스럽게 사용할 수 있습니다.

 

[소스 코드]

 

Function oWinhttp_GetData(Winhttp As Object, ByVal rType As Integer, ByVal wType As String, ByVal Url As String, ParamArray vParams() As Variant) As String

On Error GoTo error

    Dim SizeParam As Long

    Dim i As Long

    

    SizeParam = UBound(vParams) + 1

    With Winhttp

        Select Case UCase(wType)

            Case "GET"

                .Open "GET", Url, True

                Do

                    If i >= SizeParam Then: Exit Do

                    .SetRequestHeader Split(vParams(i), ": ")(0), Split(vParams(i), ": ")(1)

                    i = i + 1

                Loop

                .send

                .WaitForResponse

            Case "POST"

                If SizeParam >= 0 Then

                    .Open "POST", Url, True

                    Do

                        If i >= SizeParam - 1 Then: Exit Do

                        .SetRequestHeader Split(vParams(i), ": ")(0), Split(vParams(i), ": ")(1)

                        i = i + 1

                    Loop

                    .send vParams(i)

                    .WaitForResponse

                End If

        End Select

        

        

        Select Case rType

            Case 0

                oWinhttp_GetData = .ResponseText

            Case 1

                oWinhttp_GetData = .GetAllResponseHeaders

        End Select

    End With

error: '에러가 발생하면 타임아웃이나, 자체버그로 인해 발생한거니까 일로와짐

        '리턴값에 딱히 조절한게 없으므로 ""를 리턴값으로 가짐

    Winhttp.Abort

End Function

 

[활용 예제]

 

Dim Winhttp As Object

Set Winhttp = CreateObject("Winhttp.WinHttpRequest.5.1")

 

Do

       wData = oWinhttp_GetData(Winhttp, 0, "GET", "http://naver.com", _

                                                        "Content-Type: application/x-www-form-urlencoded", _

                                                        "User-Agent: Mozilla/5.0(iPad; U; iPhone OS 3_2; en-us) AppleWebKit/531.21.10 Mobile/7B314")

        If Len(wData) Then: Exit Do '타임아웃이 발생하거나 오류가 발생하면 Len(wData) = 0 이므로, 

                                     'Len(wData) = true 이면 루프를 종료함

        Sleep 1000

         '루프가 종료되지 않았다면 1초 기다렸다가 재접속

Loop

 

Do Loop 문을 이용하여 호출하는 URL로부터 값을 받지 못했을댄 sleep 함수를 이용해 1초후 재 호출 합니다.

위에 소스코드에서 보면 에러처리를 통해 프로그램 자체가 작동중지 또는 오류를 뿜지 않도록 처리 해야합니다.

 

위 예제를 통해 응용하여 vb6에서 보다 완벽한 winhttp 통신을 구현해보세요.

Visual Basic 6.0 기능중 웹브라우저 인터넷 컨트롤러(Web Browser) 기능 이용시 호출한 사이트의 IE 버전 호환성으로 인해

제대로 출력이 이루어지지 않는 경우가 있습니다.

 

그럴때 아래와 같은 방법으로 처리해주시면 됩니다.

 

[설정 방법]

1. 레지스트리 편집기(regedit.exe) 에서

 

2. HKEY_CURRENT_USER\SOFTWARE\Microsoft\InternetExplorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION 디렉토리로 이동

 

3. 이름 : 본인프로그램.exe

값 : 원하는 버전 값(10진수)

└> 값 추가 후 프로그램을 실행하면 원하는 IE버전으로 웹브라우저 적용

 

[IE 버전별 추가 값]

11001 (0x2AF9)
Internet Explorer 11. Webpages are displayed in IE11 Standards mode, regardless of the !DOCTYPE directive.

11000 (0x2AF8)
Internet Explorer 11. Webpages containing standards-based !DOCTYPE directives are displayed in IE9 mode.

10001 (0x2AF7)
Internet Explorer 10. Webpages are displayed in IE10 Standards mode, regardless of the !DOCTYPE directive.

10000 (0x2710)
Internet Explorer 10. Webpages containing standards-based !DOCTYPE directives are displayed in IE9 mode.

9999 (0x270F)
Internet Explorer 9. Webpages are displayed in IE9 Standards mode, regardless of the !DOCTYPE directive.

9000 (0x2328)
Internet Explorer 9. Webpages containing standards-based !DOCTYPE directives are displayed in IE9 mode.

8888 (0x22B8)
Webpages are displayed in IE8 Standards mode, regardless of the !DOCTYPE directive.

8000 (0x1F40)
Webpages containing standards-based !DOCTYPE directives are displayed in IE8 mode.

7000 (0x1B58)
Webpages containing standards-based !DOCTYPE directives are displayed in IE7 Standards mode. This mode is kind of pointless since it's the default.

 

참고 URL : https://weblog.west-wind.com/posts/2011/may/21/web-browser-control-specifying-the-ie-version

VB6.0 에서 레지스트리 등록 및 삭제시 아래의 예제코드를 이용하여 활용

 

<Code>

Dim Result As Integer

    

If InStr(RegGetSectionValueName("SOFTWARE\Microsoft\Windows\CurrentVersion\Run"), "junche4") = 0 then

        Result = IIf(SHRegWriteString("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "junche4", App.Path & "\" & App.EXEName & ".exe"), 1, 0)

End If

    

If Result = 0 Then

        MsgBox "시작 프로그램 등록에 실패하였습니다", vbCritical, "오류"

End If

    

If InStr(RegGetSectionValueName("SOFTWARE\Microsoft\Windows\CurrentVersion\Run"), "junche4") Then

        Result = IIf(SHRegDelValue("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "junche4"), 1, 0)

End If

    

If Result = 0 Then

        MsgBox "시작 프로그램 등록에 등록된 기록을 삭제하는데 실패하였습니다", vbCritical, "오류"

End If

기존에 사용하셨던 vb6.0 sleep은
보통 1초이상 딜레이를 주면 1초동안 살짝 순단 현상이 발생했다가 다음 동작이
진행되는걸 보실수 있을겁니다. 아니면 쓰레드를 이용해 이러한점을 보완 하신분들도 계실테지요.
다만, VB6.0 에서의 쓰레드란 살얼음판 위를 걷는것과 같아서 거의 대부분 아예 VB6.0 외의
프로그래밍 툴로 넘어가시거나 하실텐데요.
제가 오늘 소개 해드릴 sleep을 대체할수 있는 비동기식 sleep(?) 딜레이(?) 를 줄수 있는 함수를 소개해드리려 합니다.

예를들어 Winhttp 통신을 여러번 해야하는 상황이라면 초마다 통신하기엔 컴퓨터에도 그렇고
사이트상에서도 본의 아니게 트래픽을 갉아먹는 행위를 하게 됩니다.
이러한 상황 또는 반복문 내에서 약간의 딜레이를 줄때 많이들 사용 하실텐데요.
그냥 일반 do loop문을 통해 딜레이를 주게되면 단 1~2초라도 순간 cpu사용량이 엄청납니다.
아래 함수를 통하여 cpu사용량 절전과 동시에 비동기식 sleep을 통해 딜레이를 사용해 보세요.

[함수 코드]
'상단에 sleep 선언
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function Pause( _
      ByVal Seconds As Single, _
      Optional ByVal PreventVBEvents As Boolean _
   )

'지정된 초 동안 일시 중지합니다. 초를 지정할 수 있습니다.
'1/100 초. sleep 루틴은 각주기마다 호출됩니다.
'DoEvents가 똑같이하는 동안 다른 응용 프로그램에 시간을줍니다.

   Const MaxSystemSleepInterval = 25 ' milliseconds
   Const MinSystemSleepInterval = 1 ' milliseconds
   
   Dim ResumeTime As Double
   Dim Factor As Long
   Dim SleepDuration As Double
   
   Factor = CLng(24) * 60 * 60
   
   ResumeTime = Int(Now) + (Timer + Seconds) / Factor
   
   Do
      SleepDuration = (ResumeTime - (Int(Now) + Timer / Factor)) * Factor * 1000
      If SleepDuration > MaxSystemSleepInterval Then SleepDuration = MaxSystemSleepInterval
      If SleepDuration < MinSystemSleepInterval Then SleepDuration = MinSystemSleepInterval
      Sleep SleepDuration
      If Not PreventVBEvents Then DoEvents
   Loop Until Int(Now) + Timer / Factor >= ResumeTime
   
End Function


[사용법]
ex) 1초, 0.1초 딜레이 (실제 초단위로 입력)
Do
~~
~~
  DoEvents
  Pause (1) '1초 동안 sleep 딜레이
  Pause (0.1) '0.1초 동안 sleep 딜레이
Loop

단순 sleep을 통해 버벅거렸던 프로그래밍을 위 함수를 이용해 비동기식 딜레이를 사용해보세요^^!
더좋은 최적화 코딩이 있다면 댓글로 공유 부탁드립니다.

VB6.0 에서 winhttp 통신 이후 파싱을 하다보면 html 태그 및 줄바꿈 등으로인해 파싱이 불편한 경우가 있는데요
그런 경우를 위해 아래의 함수들을 이용하여 정규식 및 replace 등을 이용하여 파싱을 한다면 한결 더 쉬워집니다!
함수들의 기능을 한가지 한가지 설명해 드리도록 하겠습니다.

□. 줄바꿈 라인을 모두 제거하는 함수
===============================================================
Function RemoveLines(myString As String)
    myString = Replace(myString, vbTab, vbnullstring)   ' tab 문자열을 제거
    myString = Replace(myString, Chr(13), vbnullstring)
    myString = Replace(myString, Chr(10), vbnullstring)
    myString = Replace(myString, vbCrLf, vbnullstring)
    myString = Replace(myString, vbNewLine, vbnullstring)
    RemoveLines = myString
End Function

ex)
Dim as Parsing string '변수선언
Parsing = "안녕하세요(tab)문자열을(줄바꿈)파싱할때 저를 이용하세요"

' 실제 문자열은 대략 아래와 같은 형태가 되겠죠.
'안녕하세요 문자열을
'파싱할때 저를 이용하세요

Parsing = RemoveLines(Parsing) '제거

'결과 : 안녕하세요문자열을파싱할때 저를 이용하세요
===============================================================
 
□. 정규식 패턴에 매칭되는 문자열을 찾는 함수 
===============================================================
Function RegExFind(myString As String, FindWhat As String)
On Error Resume Next
 
   '오브젝트 생성
   Dim objRegExp As RegExp
   Dim objMatch As Match
   Dim colMatches   As MatchCollection
   Dim RetStr As String
 
   Set objRegExp = New RegExp
   objRegExp.Pattern = FindWhat
   objRegExp.IgnoreCase = True
   objRegExp.Global = True
   objRegExp.MultiLine = True
   If (objRegExp.Test(myString) = True) Then
    Set colMatches = objRegExp.Execute(myString)
    For Each objMatch In colMatches
      RetStr = objMatch.Value
    Next
   Else
    RetStr = "" '매칭 되는것이 없을때는 공백 반환
   End If
   RegExFind = RetStr
End Function

ex)
Dim as Parsing string 
'변수선언
Parsing = "123정규식을 이용한 파싱입니다.456"

Parsing = 
RegExFind(Parsing, "[0-9]") '숫자를 필터링하는 정규식에 매칭되는 문자열 담기

'결과 : 123456
 ===============================================================

 □. 정규식 패턴에 매칭되는 문자열을 찾아서 원하는 문자열로 replace 해주는 함수 
===============================================================

Function RegExReplace(myString As String, FindThis As String, ReplaceWithThis As String)
On Error Resume Next
    'search string for item and then replace with new item:
    Dim sourse1 As String, resourse As Object
    sourse1 = myString
    Set resourse = New RegExp
    resourse.Pattern = FindThis
    resourse.Global = True
    resourse.IgnoreCase = True
    If resourse.Test(sourse1) = True Then
        myString = resourse.Replace(sourse1, ReplaceWithThis)
    End If
    RegExReplace = myString
End Function

ex)
Dim as Parsing string 
'변수선언
Parsing = "<b>정규식</b>을 이용한 <a href="#">html 태그를 제거하는 파싱</a>입니다."

Parsing = 
RegExReplace(Parsing, "<[^>]*>", vbnullstring) 'html 태그를 필터링하는 정규식에 매칭되는 문자열 담기

'결과 : 정규식을 이용한 html 태그를 제거하는 파싱 입니다.

 ===============================================================

 □. html 태그를 모두 제거해주는 함수
===============================================================
Function RemoveHTML(strText As String)
    Dim RegEx
    Set RegEx = New RegExp
    RegEx.Pattern = "<[^>]*>"
    RegEx.Global = True
    RegEx.IgnoreCase = True
    strText = Replace(strText, "&nbsp;", vbnullstring)
    RemoveHTML = RegEx.Replace(strText, vbnullstring)
End Function

ex)
Dim as Parsing string 
'변수선언
Parsing = "<html><head><title>Hello World</title></head><body>html 태그 제거 파싱</body></html>"

Parsing = 
RegExHTML(Parsing) 'html 태그를 정규식을 토해 모두 제거

'결과 : Hello Worldhtml 태그 제거 파싱
===============================================================

위에서 설명드린 각종 파싱에 유용한 함수들을
용도에 맞게 적절히 사용하여 코딩하시면 보다 손쉽게 파싱을 하실수 있습니다.

VB6.0 에서 Selenium(셀레니움)을 통해 크롬 브라우저를 호출하면 상단에 아래와 같은 메세지가 출력됩니다.

Chrome이 자동화된 테스트 소프트웨어에 의해 제어되고 있습니다.

'Chrome이 자동화된 테스트 소프트웨어에 의해 제어되고 있습니다.'

위와 같은 문구가 뜨는것을 원치 않을때는 아래과 같은 코드를 추가해주면 상단에 메세지가 사라집니다.

Selenium을 이용하여 코딩할시에 참고하시기 바랍니다.

<Code>

options.addArguments("disable-infobars");

options.AddArguments("enable-automation");

options.AddAdditionalCapability("useAutomationExtension", false);

 

+ Recent posts