'================================================================
'= HTTPサーバーからページ情報を取得

'=    (HttpOpenRequest.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&)

' 指定されたハンドルに対するインターネットのオプション情報を取得
Declare Function Api_InternetQueryOption& Lib "wininet" Alias "InternetQueryOptionA" (ByVal hInternet&, ByVal lOption&, ByRef Buffer As Any, ByRef BufferLen&)

#define INTERNET_OPEN_TYPE_PRECONFIG 0  'プロキシまたはレジストリから直接コンフィギュレーションを取得
#define INTERNET_DEFAULT_FTP_PORT 21    'RFCで既定されたftpポート
#define INTERNET_DEFAULT_HTTP_PORT 80   'RFCで既定されたhttpポート
#define INTERNET_DEFAULT_HTTPS_PORT 443 'RFCで既定されたhttpsポート
#define INTERNET_SERVICE_HTTP 3         'HTTPサービス
#define INTERNET_FLAG_RELOAD -2147483648'ダウンロード時キャッシュを使わずサーバーから行う
#define HTTP_QUERY_STATUS_CODE 19       'サーバから返された状態コード
#define HTTP_QUERY_STATUS_TEXT 20       'サーバから返された補足のテキスト
#define HTTP_QUERY_RAW_HEADERS 21       'NUL文字で区切られた全てのヘッダ
#define HTTP_QUERY_RAW_HEADERS_CRLF 22  'CR/LFで区切られた全てのヘッダ
#define HTTP_QUERY_FLAG_REQUEST_HEADERS -2147483648 '応答ヘッダの取得
#define UserAgent "http sample"

Var Shared hSession As Long
Var Shared hConnect As Long
Var Shared hHttpOpenRequest As Long

Var Shared Edit1 As Object
Var Shared Edit2 As Object
Var Shared Button1 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Edit2.Attach GetDlgItem("Edit2") : Edit2.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Function GetQueryInfo(ByVal HttpRequest As Long, ByVal InfoLevel As Long) As String
Function GetQueryInfo(ByVal HttpRequest As Long, ByVal InfoLevel As Long) As String
    Var Buffer As String * 1024
    Var BufferLen As Long
    Var Ret As Long

    BufferLen = Len(Buffer)
    Ret = Api_HttpQueryInfo(HttpRequest, InfoLevel, Buffer, BufferLen, 0)
    GetQueryInfo = Left$(Buffer, BufferLen)
End Function

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Host As String
    Var StatusCode As String
    Var StatusText As String
    Var RawHeaders As String
    Var RawHeadersCrLf As String
    Var Server As String
    Var Ret As Long

    Edit2.SetWindowText ""

    Host = Left$(Edit1.GetWindowText, InStr(Edit1.GetWindowText, "/") - 1)

    'インターネットに接続       http sample   レジストリの設定に従う
    hSession = Api_InternetOpen(UserAgent, INTERNET_OPEN_TYPE_PRECONFIG, ByVal 0, ByVal 0, 0)

    If CLng(hSession) Then
        'HTTPサーバーに接続
        hConnect = Api_InternetConnect(hSession, Host, INTERNET_DEFAULT_HTTP_PORT, ByVal 0, ByVal 0, INTERNET_SERVICE_HTTP, 0, 0)

        If hConnect > 0 Then
            'サーバー上で欲しいURLを指定
            hHttpOpenRequest = Api_HttpOpenRequest(hConnect, "HEAD", Right$(Edit1.GetWindowText, Len(Edit1.GetWindowText) - InStr(Edit1.GetWindowText, "/") + 1), "HTTP/1.1", ByVal 0, 0, INTERNET_FLAG_RELOAD, 0)

            If Clng(hHttpOpenRequest) Then
                'ヘッダーを要求
                Ret = Api_HttpSendRequest(hHttpOpenRequest, ByVal 0, 0, 0, 0)

                If Ret Then        'ファイルの内容を受信
                    'サーバから返された状態コード
                    StatusCode = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE)
                    'サーバから返された補足のテキスト
                    StatusText = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_TEXT)
                    'NUL文字で区切られた全てのヘッダ
                    RawHeaders = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS)

                    'CR/LFで区切られた全てのヘッダ
                    RawHeadersCrLf = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF)
                    Edit2.SetWindowText RawHeadersCrLf
                End If
            End If
        End If
    End If

    'すべてのハンドルをクローズ
    Ret = Api_InternetCloseHandle(hHttpOpenRequest)
    Ret = Api_InternetCloseHandle(hSession)
    Ret = Api_InternetCloseHandle(hConnect)
End Sub

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