'================================================================
'= HTTPサーバーの情報を取得
'=    (HttpSendRequest.bas)
'================================================================
#include "Windows.bi"

' インターネットのハンドルの作成
Declare Function Api_InternetOpen& Lib "wininet" Alias "InternetOpenA" (ByVal sAgent$, ByVal lAccessType&, ByVal sProxyName$, ByVal sProxyBypass$, ByVal lFlags&)

' インターネット上のサーバに接続し、ハンドルを返す
Declare Function Api_InternetConnect& Lib "wininet" Alias "InternetConnectA" (ByVal hSession&, ByVal sServerName$, ByVal nServerPort&, ByVal sUsername$, ByVal sPassword$, ByVal lService&, ByVal lFlags&, ByVal lContext&)

' HTTPリクエストの作成
Declare Function Api_HttpOpenRequest& Lib "wininet" Alias "HttpOpenRequestA" (ByVal hHttpSession&, ByVal sVerb$, ByVal sObjectName$, ByVal sVersion$, ByVal sReferer$, ByVal something&, ByVal lFlags&, ByVal lContext&)

' 指定されたHTTPリクエストをサーバへ送信
Declare Function Api_HttpSendRequest& Lib "wininet" Alias "HttpSendRequestA" (ByVal HttpRequest&, ByVal sHeaders$, ByVal lHeadersLength&, sOptional As Any, ByVal lOptionalLength&)

' HTTPリクエストに関連する情報の取得
Declare Function Api_HttpQueryInfo& Lib "wininet" Alias "HttpQueryInfoA" (ByVal HttpRequest&, ByVal lInfoLevel&, ByRef Buffer As Any, ByRef BufferLen&, ByRef lIndex&)

' Win32インターネット関数のハンドルのクローズ
Declare Function Api_InternetCloseHandle% Lib "wininet" Alias "InternetCloseHandle" (ByVal hInet&)

#define INTERNET_OPEN_TYPE_PRECONFIG 0   'IEの設定に従い接続
#define INTERNET_SERVICE_HTTP 3          'HTTP･HTTPSを指定
#define INTERNET_FLAG_RELOAD -2147483648 'ローカルのキャッシュを無視し、常にサーバからデータを取得
#define INTERNET_DEFAULT_HTTP_PORT 80    'RFCで既定されたhttpポート
#define HTTP_QUERY_CONTENT_TYPE 1        'リソースのタイプ
#define HTTP_QUERY_VERSION 18            'サーバに最後に返された応答コード
#define HTTP_QUERY_SERVER 37             '
#define HTTP_QUERY_TITLE 38              '

Var Shared Text(4) As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object

For i = 0 To 4
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1)))
    Text(i).SetFontSize 14
Next
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hInet As Long
    Var hConnect As Long
    Var hRequest As Long
    Var Ret As Long
    Var Buffer As String * 1024

    '初期化
    hInet = Api_InternetOpen("", INTERNET_OPEN_TYPE_PRECONFIG, ByVal 0, ByVal 0, 0)

    If hInet <> 0 Then
        'HTTPサービスに接続
        hConnect = Api_InternetConnect(hInet, Edit1.GetWindowText, INTERNET_DEFAULT_HTTP_PORT, ByVal 0, ByVal 0, INTERNET_SERVICE_HTTP, 0, 0)

        If hConnect <> 0 Then
            'HTTPリクエストのハンドルを開く
            hRequest = Api_HttpOpenRequest(hConnect, "GET", ByVal 0, ByVal 0, ByVal 0, 0, INTERNET_FLAG_RELOAD, 0)

            If hRequest <> 0 Then
                'HTTPサーバーにリクエストを送信
                Ret = Api_HttpSendRequest(hRequest, ByVal 0, 0, ByVal 0, 0)

                If Ret Then
                    'HTTPサーバーの種類をリクエスト
                    If Api_HttpQueryInfo(hRequest, HTTP_QUERY_SERVER, Buffer, Len(Buffer), 0) <> 0 Then
                        Text(3).SetWindowtext Buffer
                    End If

                    'HTTPのバージョンをリクエスト
                    If Api_HttpQueryInfo(hRequest, HTTP_QUERY_VERSION, Buffer, Len(Buffer), 0) <> 0 Then
                        Text(4).SetWindowText Buffer
                    End If
                End If
            End If
        End If
    End If

    ' ハンドルを閉じる
    If hInet <> 0 Then
        Ret = Api_InternetCloseHandle(hInet)
    End If

    If hConnect <> 0 Then
        Ret = Api_InternetCloseHandle(hConnect)
    End If

    If hRequest <> 0 Then
        Ret = Api_InternetCloseHandle(hRequest)
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Edit1_SetFocus edecl ()
Sub Edit1_SetFocus()
    Text(3).SetWindowText ""
    Text(4).SetWindowtext ""
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End