끝나지 않는 프로그래밍 일기


더 기능을 추가하려고 했으나 시험 기간인 덕분인지 추가할 시간도 없네요. 소스가 많이 더럽습니다.

TRAN.zip

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