POST/GET Transmitter 프로젝트.
더 기능을 추가하려고 했으나 시험 기간인 덕분인지 추가할 시간도 없네요. 소스가 많이 더럽습니다.
Private Declare Function GetCapture Lib "user32" () As Long
Private Declare Function SetCapture Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Dim WinHttp As New WinHttpRequest
Private Sub bMinus_Click()
Dim bIndex As Integer
bIndex = arrCheck.UBound
' 최소 입력란 초과
If bIndex = 0 Then
MsgBox "최소 입력 수를 벗어났습니다!", vbCritical, "입력 범위 오류!"
Exit Sub
End If
Unload arrCheck(bIndex)
Unload arrHeader(bIndex)
Unload arrSplit(bIndex)
Unload arrValue(bIndex)
bPlus.Top = bPlus.Top - 500
bMinus.Top = bMinus.Top - 500
End Sub
Private Sub bPlus_Click()
Dim bIndex As Integer
bIndex = arrCheck.UBound
' 최대 입력란 초과
If bIndex = 9 Then
MsgBox "최대 입력 수를 벗어났습니다!", vbCritical, "입력 범위 오류!"
Exit Sub
End If
Load arrCheck(bIndex + 1)
Load arrHeader(bIndex + 1)
Load arrSplit(bIndex + 1)
Load arrValue(bIndex + 1)
arrCheck.Item(bIndex + 1).Visible = True
arrHeader.Item(bIndex + 1).Visible = True
arrSplit.Item(bIndex + 1).Visible = True
arrValue.Item(bIndex + 1).Visible = True
arrCheck.Item(bIndex + 1).Top = arrCheck.Item(bIndex).Top + 500
arrHeader.Item(bIndex + 1).Top = arrHeader.Item(bIndex).Top + 500
arrSplit.Item(bIndex + 1).Top = arrSplit.Item(bIndex).Top + 500
arrValue.Item(bIndex + 1).Top = arrValue.Item(bIndex).Top + 500
arrCheck.Item(bIndex + 1).Value = False
arrHeader.Item(bIndex + 1).Text = vbNullString
arrValue.Item(bIndex + 1).Text = vbNullString
bPlus.Top = bPlus.Top + 500
bMinus.Top = bMinus.Top + 500
End Sub
Private Sub bReset_Click()
Dim bIndex As Integer
Combo1.ListIndex = 0
Combo2.ListIndex = 0
iAddress.Text = vbNullString
BODY.Text = vbNullString
GetHeader.Text = vbNullString
iParameter.Text = vbNullString
Set WinHttp = Nothing
arrCheck(0).Value = 0
arrHeader(0).Text = vbNullString
arrValue(0).Text = vbNullString
bIndex = arrCheck.UBound
For i = 1 To bIndex
Unload arrCheck(i)
Unload arrValue(i)
Unload arrHeader(i)
Unload arrSplit(i)
bPlus.Top = bPlus.Top - 500
bMinus.Top = bMinus.Top - 500
Next i
End Sub
Private Sub bSave_Click()
On Error GoTo Err:
FN = "PGHTML-" & Replace(Now, ":", "-") & ".txt"
Open App.Path & "\" & FN For Output As #1
Print #1, "--------------------" & Now & "--------------------"
Print #1, "SITE: "; Combo1.Text & "://" & iAddress.Text & " " & Combo2.Text
Print #1, GetHeader.Text
Print #1, "PARAMETERS: " & iParameter.Text & vbCrLf
For i = arrCheck.LBound To arrCheck.UBound
If arrHeader(i).Text <> vbNullString And arrValue(i).Text <> vbNullString Then
If arrCheck(i).Value Then
CTF = "TRUE"
Else
CTF = "FALSE"
End If
Print #1, CTF & " HEADERS(" & i & ")[" & arrHeader(i).Text & "]: " & arrValue(i).Text
End If
Next i
Print #1, vbCrLf & "BODY: " & vbCrLf & BODY.Text
Close #1
MsgBox "폴더 내에 " & FN & " 파일이 성공적으로 저장되었습니다.", vbInformation, "저장 완료!"
Exit Sub
Err:
MsgBox Err.Description, vbCritical, "에러 코드: " & Err.Number & "!"
End Sub
Private Sub bSend_Click()
On Error GoTo Err:
WinHttp.Open Combo2.Text, Combo1.Text & "://" & iAddress.Text
For i = arrCheck.LBound To arrCheck.UBound
If arrCheck(i).Value Then WinHttp.SetRequestHeader arrHeader(i).Text, arrValue(i).Text
Next i
WinHttp.Send iParameter.Text
If WinHttp.Option(WinHttpRequestOption_EnableHttp1_1) = True Then
E11 = "HTTP/1.1"
Else
E11 = "HTTP"
End If
GetHeader = E11 & " " & WinHttp.Status & " " & WinHttp.StatusText & vbCrLf & WinHttp.GetAllResponseHeaders
If oNormal.Value = True Then
BODY.Text = WinHttp.ResponseText
ElseIf oUnicode.Value = True Then
BODY.Text = StrConv(WinHttp.ResponseBody, vbUnicode)
End If
BODY.Text = Replace(BODY.Text, Chr(13), vbCrLf)
BODY.Text = Replace(BODY.Text, Chr(10), vbCrLf)
Exit Sub
Err:
MsgBox Err.Description, vbCritical, "에러 코드: " & Err.Number & "!"
End Sub
Private Sub dcButton1_Click()
Clipboard.SetText BODY.Text
MsgBox "클립보드에 BODY의 내용을 복사했습니다.", vbInformation, "클립보드로 복사하기"
End Sub
Private Sub Form_Load()
Combo1.AddItem "HTTP"
Combo1.AddItem "HTTPS"
Combo1.ListIndex = 0
Combo2.AddItem "GET"
Combo2.AddItem "POST"
Combo2.AddItem "PUT"
Combo2.AddItem "DELETE"
Combo2.AddItem "HEAD"
Combo2.AddItem "OPTIONS"
Combo2.ListIndex = 0
End Sub
Private Sub Form_Resize()
If WindowState = 0 Then
If Height <> 7935 Then Height = 7935
If Width <> 12510 Then Width = 12510
End If
End Sub
'소스 관련' 카테고리의 다른 글
| VB6 -> C# 포팅, 네이버 로그인, 네이버 쪽지 전송, 네이버 메일 전송 (10) | 2012.12.02 |
|---|---|
| 유용한 getImageFromURL, DownloadRemoteImageFile 함수 (4) | 2012.12.02 |
| 프로세스 클리너 프로젝트 진행 중 개발 중단 (0) | 2012.11.23 |
| 캡션에 특정 단어가 들어가있으면 프로세스 종료 TerminateTask. (0) | 2012.08.01 |
| 위젯 용량체크 프로그램 소스 (0) | 2012.07.18 |
TRAN.zip