Inet1のプロパティとPerlの環境変数について

解決

ひよっこＶＢ 2003-09-13 17:47:25 No: 79410

自分でつくったCGI(Perl)にVBのインターネットトランスファコントロールで他の人がアクセスする仕組みを作っています。CGI側の環境変数で誰がアクセスしてきたかを識別して所定以外のVBからアクセスしてきた場合エラーとする方法を考えていますがいいアイデアが出てきません。Inet1のプロパティで任意に文字列が設定できる箇所が何箇所かありますが、どれかの項目がCGI側の環境変数で取得できる項目はないでしょうか。もちろん$ENV{'REMOTE_ADDR'}でクアイアントのIPは取得できるのですが、相手は固定ＩＰではないので、IPでアクセスを制限するわけにもいかず困っています。どなたかＷＥＢ関係に詳しいかたがおられましたらご指導よろしくお願いします。

魔界の仮面弁士 2003-09-13 20:16:59 No: 79411

インターネットトランスファコントロールのExecuteメソッドにて、
Headers引数を指定すると、HTTP応答ヘッダを指定できます。
他にも、WebBrowserコントロールのNavigate2メソッドのHeaders引数や、
XMLHTTPオブジェクトのsetRequestHeaderメソッドなどでも、
任意のHTTP応答ヘッダを指定することができます。

Headers引数では、たとえば「"LOGON_CHECK: Hiyokko-VB" & vbCrLf」のような
文字列を指定すれば、cgi側の環境変数「HTTP_LOGON_CHECK」にて、
「Hiyokko-VB」という文字列が得られる事になります。

ひよっこＶＢ 2003-09-14 01:06:45 No: 79412

魔界の仮面弁士様さっそくのご回答ありがとうございます。
日ごろこのサイトでご活躍・超有名人の魔界の仮面弁士様にご回答いただきびっくりしております。
さっそく試して見ましたがうまくできないんです。
Private Sub Command1_Click()
Dim STRURL As String
Dim REDATA() As String
STRURL = "http://61.192.xxx.xxx/test.cgi"

Me.Inet1.Execute "LOGON_CHECK:MyUSER_LOGON" & vbCrLf

REDATA = Split(Me.Inet1.OpenURL(STRURL), " ")
For CNT = 0 To 10
Debug.Print "NO." & CNT & REDATA(CNT)
Next CNT
End Sub

Headers引数の指定方法がわるいのでしょうか？
いまやっていることは、ＣＧＩで$ENV{'HTTP_LOGON_CHECK'}などの環境変数をの内容を力させてＣＧＩが認識できたかどうかのテストを行っていますが、$ENV{'HTTP_LOGON_CHECK'}の値はNULLになって返ってきます。

お忙しいでしょうが、どうかもう少しお付き合いくださいませ。

魔界の仮面弁士 2003-09-14 02:30:38 No: 79413

> Me.Inet1.Execute "LOGON_CHECK:MyUSER_LOGON" & vbCrLf
引数の渡し方が間違っています。ヘルプで確認してみてください。

第1引数がURL、第2引数がメソッド(HTTP要求コマンド)、
第3引数が要求ボディ(今回は未指定)、そして第4引数がヘッダです。

> Headers引数の指定方法がわるいのでしょうか？
URLを記述すべき所に、Headersを指定しているのが問題かと思います。

InetSpyなどのツールを使って、InetとWebサーバとの間で、
どのようなデータがやりとりされているのかを、
確認してみては如何でしょう。
http://hide.maruo.co.jp/software/inetspy.html

ひよっこＶＢ 2003-09-14 04:03:15 No: 79414

魔界の仮面弁士様ありがとうございます。
自分でもこのへんが・・・ってわかっていたんでヘルプを見たのですが、なんせＶＢ歴２ヶ月の「ひよっこ」なのなもんで・・・・。
ヘルプでは全部省略可って書いてありましたので、こんな書き方になってしまいました。
Me.Inet1.Execute , , ,"LOGON_CHECK:MyUSER_LOGON" & vbCrLf
って書いて見ましたけどやっぱり・・・ダメでした。

ごめんなさい。反則だとは思うのですが、具体的に記述方法、お教えいただけませんでしょうか？

Take1 2003-09-15 00:25:16 No: 79415

横からすみません
Inetの場合...

Inet1.Execute STRURL, "GET", , "LOGON_CHECK: MyUSER_LOGON" & vbCrLf

WebBrowserの場合...

WebBrowser1.Navigate2 STRURL, , , , _
"LOGON_CHECK: MyUSER_LOGON" & vbCrLf

#Test.cgi

#!/usr/local/bin/perl

$LogCek = $ENV{'HTTP_LOGON_CHECK'};

($sec, $min, $hour, $mday, $mon, $year, $DD) = localtime();
$mo = $mon + 1;
$DTday = "$mo/$mday $hour:$min";

print<<"_EOM_";
Content-type: text/html
<HTML>
<HEAD>
<TITLE>InetTest</TITLE>
</HEAD>
<BODY bgcolor="#0000ff" text="#ffff00">
 
<CENTER>
YourCheckLog : $LogCek
 
Month/Day Time : $DTday
</CENTER>
</BODY>
</HTML>
_EOM_

Take1 2003-09-15 00:30:25 No: 79416

補足として
MyUSER_LOGON
がString変数ならダブルクォーテーションの外に出して＋か＆で
つないでください。

ひよっこＶＢ 2003-09-15 00:53:24 No: 79417

Take2様ありがとうございます。
Private Sub Command1_Click()
Dim STRURL As String
Dim TEMP
Dim REDATA() As String

STRURL = "http://61.192.76.205/EM03_VB/index2.cgi"

Me.Inet1.Execute STRURL, "GET", , "LOGON_CHECK: MyUSER_LOGON" & vbCrLf

REDATA = Split(Me.Inet1.OpenURL(STRURL), " ")←ERROR

For CNT = 0 To 10
Debug.Print "NO." & CNT & REDATA(CNT)
Next CNT
End Sub
←ERRORでStill executing last request ってエラーが出てしまいます。
この行く削除するとＯＫなんですが、CGIが出力したHTMLを取り込むことができません。
経験不足でわたしがとんでもない勘違いをしているのかもわかりませんが（どうもそのような気がしてきました・・・）どうぞ「ひよっこ」のめんどう見てやってくださいませ。よろしくお願いします。

魔界の仮面弁士 2003-09-15 09:09:27 No: 79418

今回は、OpenURLは使いません。Executeメソッドを発行するだけです。

Webサーバからの応答結果を得たい場合は、StateChangedイベントなどで
処理完了を監視し、その上でGetChunkメソッドを使って取得するようにします。

こうした「非同期」によるコーディングが面倒である場合は、最初に回答した
XMLHTTPオブジェクトを利用してみてください。こちらは、非同期モードと
同期モードの両方を利用する事ができるので、コーディングも楽かと。

Dim URL As String
Dim oXMLHttpRequest As Object 'As MSXML2.XMLHTTP40

URL = "http://〜〜"

'XMLHTTPオブジェクトを生成します。
Set oXMLHttpRequest = CreateObject("Msxml2.XMLHTTP")

'第1引数は、HTTPコマンド(GET,HEAD,POST,TRACEなど)
'第2引数は、リソースの位置(http://〜, https://〜など)
'第3引数は、Trueなら非同期モード、Falseなら同期モード
oXMLHttpRequest.open "GET", URL, False

'必要に応じて、追加のHTTP要求ヘッダを指定します。
oXMLHttpRequest.setRequestHeader "LOGON_CHECK", "MyUSER_LOGON"

'sendメソッドにて、データの要求処理を開始します。
' - 必要に応じて、第1引数にHTTP要求ボディとするデータを
' - 「X.send bodyData」のようにして指定する事もできます。
' - なお、引数を指定する場合、その引数のデータ型は、
' - 「Byte型の1次元配列」「String型」「IStream型」「XMLDocument型」
' - の4種類のいずれかを示すVariant型である必要があります。
oXMLHttpRequest.send '今回は、引数無しで sendメソッドを呼び出します。

'なお、今回は同期モードを指定してありますので、通信が完了するまで
'sendメソッドの実行がブロックされます。

'statusプロパティは、ステータスコードを返します。
'例えば、指定したURLにリソースが無い場合は、404という値が返されます。
If oXMLHttpRequest.Status >= 400 Then

    'statusTextプロパティから、状態テキストを取得します。
    ' - 指定したリソースが無い時(.status=404)には、Webサーバから
    ' - "Not Found"などの文字列が、statusTextとして返されます。
    MsgBox oXMLHttpRequest.statusText, vbCritical, "通信失敗"

Else

    'getAllResponseHeadersメソッドを使って、サーバから返された
    'すべてのHTTP応答ヘッダを、イミディエイトウィンドウに表示させます。
    Debug.Print oXMLHttpRequest.getAllResponseHeaders()

    'getAllResponseHeadersメソッドの替わりに、getResponseHeaderメソッドを
    '使って、個々のHTTP応答ヘッダを取り出す事もできます。
    Label1.Caption = oXMLHttpRequest.getResponseHeader("Content-Type")
    Label2.Caption = oXMLHttpRequest.getResponseHeader("Date")

    'responseTextプロパティを使って、サーバから返された
    'HTTP応答ボディを、String型のデータとして取得します。
    ' - HTTP応答ヘッダの "Content-Type" にて、文字コードが
    ' - "Content-Type: text/html; charset=EUC-jp" などのように
    ' - 指定されている場合は、正しく表示されます。しかし、
    ' - サーバから文字コードが返されない場合は、XMLHTTPオブジェクトが
    ' - 文字コードを判別できないため、文字化けする事があります。
    Debug.Print oXMLHttpRequest.responseText

    'responseBodyプロパティを使って、サーバから返された
    'HTTP応答ボディを、Byte型の1次元配列として取得します。
    ' - こちらは、先述のresponseTextとは異なり、文字化けの心配がありません。
    ' - ただし、文字コードの変換を伴わないので、バイナリデータとしてではなく
    ' - 文字列として取得したい場合は、ADODB.Streamなどを用いて、文字コードの
    ' - 変換作業を、自前で行う必要があります。
    Dim B() As Byte
    B = oXMLHttpRequest.responseBody

    '取得したByte配列データを、ファイルとして保存してみます。
    'Dim F As Integer
    'F = FreeFile()
    'Open "C:\test.html" For Output As #F
    'Put #F, , B
    'Close #F

    'responseXMLプロパティを使って、サーバから返された
    'HTTP応答ボディを、XMLDocumentとして取得します。
    ' - このプロパティは、サーバがXMLデータを返す時のみ有効です。
    ' - おそらく、今回のひよっこＶＢさんの要件では使用しないでしょう。
    'Set oXMLDocument = oXMLHttpRequest.responseXML

    'responseStreamプロパティは、IStream型のデータを返します。
    ' - このプロパティも、今回の要件では使用しないでしょうね。
    'Set oStream = oXMLHttpRequest.responseStream

End If
Set oXMLHttpRequest = Nothing

なお上記では、解説のために、多少冗長的なコードになっていますが、今回、最低限使わなくてはいけないのは、openメソッド(データのURLなどを指定)、setRequestHeaderメソッド(追加の要求ヘッダを指定)、openメソッド(データの送受信を開始)、そして、いずれかのresponse系プロパティ(結果の取得)だけです。

魔界の仮面弁士 2003-09-15 09:17:49 No: 79419

上記回答の、最後の1文を訂正…。m(_ _)m

> 最低限使わなくてはいけないのは《中略》openメソッド(データの送受信を開始)、そして
コード中にもコメントしてありますように、送受信を開始するのは、
openメソッドではなく、「sendメソッド」です。失礼しました。

なお、同期モードではなく、非同期モードでも構わないという事であれば、
XMLHTTPを用いず、「Inet」や「WebBrowser」でもOKでしょうね。

ちなみに、WebBrowserから結果を得るためには、データの取得完了後に、そのDocumentプロパティの内容を、IPersistStream型の変数に受けて、それをSaveメソッドで保存してやればOKです。(MSHTML/DOMとして取得する方法もありますが、DOM経由の場合は、正確な結果を得る事ができなくなります)

ひよっこＶＢ 2003-09-15 18:57:29 No: 79420

魔界の仮面弁士様、Take1様ありがとうございます。
魔界の仮面弁士様の丁寧なご指導、今日１日じっくり取り組んでみます。
これをものにしたらひよっこＶＢから、子チキンＶＢに改名できそうです。
がんばってみます。また結果ご報告しますね。本当にありがとうございます。

ひよっこＶＢ 2003-09-16 03:47:37 No: 79421

魔界の仮面弁士様できました。やっとExecute で送信要求を発行して
受信電文を取得できました。感激です。ご指導ありがとうございました。
でもここで問題が・・・・・。一歩前進したと思ったら、またつまずい
ちゃいました。

Private Sub Command1_Click()
Dim STRURL As String
STRURL = "http://vvv.xxx.yyy.zzz/TEST_DIR/TEST.cgi"
Inet1.Execute STRURL, "GET", , "LOGON_CHECK: MyUSER" & vbCrLf
End Sub
'-----------------------------------------------------------------
'Execute で送信要求を発行します。
'CGI側で$ENV{'HTTP_LOGON_CHECK'}が"MyUSER"以外はHTMLを送信しない
ように作っています。
$ENV{'HTTP_LOGON_CHECK'}が"MyUSER"の場合、許可された人からの要求
だと判断して で分割されるHTMLを300行送信します。（１行最大200
バイト程度です＜可変長＞）
'-----------------------------------------------------------------
Private Sub Inet1_StateChanged(ByVal State As Integer)
 Dim RX_DATA As Variant
 Dim LINE_DATA() As String
 Dim CNT As Integer

 If State = 12 Then
 RX_DATA = Inet1.GetChunk(60000, icString)

LINE_DATA = Split(RX_DATA, " ")
 For CNT = 0 To 300
 Debug.Print "NO." & CNT & LINE_DATA(CNT)
 Next CNT
 End If
End Sub
'------------------------------------------------------------------
'受信したデータを編集して表示します。
'この時サイズは200バイト ×300件なので60000としました。
イミーデント表示は、
NO.235 からしか表示しません。サイズの問題なのでしょうか？

つまづきながら一歩ずつ前進（？）しているような・・・・？
結果がでなければ前進も意味ないような。複雑な心境なのです。

ひよっこＶＢ 2003-09-16 03:50:33 No: 79422

追記：
質問のポイントが変わってしまいましたが、再度ご指導くださいませ。
できの悪い生徒ですが、なんとか「ひよっこＶＢ」から進化して、困
っている人に回答できるような「力」をつけたいです。（随分先のこ
とでしょうけど・・・・）

Take1 2003-09-16 18:42:26 No: 79423

もう少しですね。
ここからはご自分で答えを見つけるのは困難だと思いますので
見本になるかどうかあやしいですけど
参考程度にコーディングしてみました
完全ではないので改良してください。

Private Sub Inet1_StateChanged(ByVal State As Integer)

If State = 12 Then

        Dim mBool As Boolean
        Dim RX_DATA As Variant
        Dim CNT As Integer

RX_DATA = Inet1.GetChunk(1024, icByteArray)
mBool = False

        Do
            RX_DATA = RX_DATA & Inet1.GetChunk(1024, icByteArray)
            If LenB(Inet1.GetChunk(1024, icByteArray)) = 0 Then mBool = True
        Loop While mBool = False

RX_DATA = StrConv(RX_DATA, vbUnicode) 'バイナリからUnicodeへ

RX_DATA = Split(RX_DATA, " ")

 For CNT = 0 To 300 'この処理は が常に300個ないとERROR
 Debug.Print "NO." & CNT & RX_DATA(CNT)
 Next CNT

End If

End Sub

Take1 2003-09-16 21:51:21 No: 79424

実際に実行してみて少々不具合があってびっくりm(_ _)m

Private Sub Inet1_StateChanged(ByVal State As Integer)

If State = 12 Then

        Dim mBool As Boolean
        Dim RX_DATA As Variant
        Dim CNT As Integer

RX_DATA = Inet1.GetChunk(1024, icByteArray)
mBool = False

        Do
            DoEvents
            RX_DATA = RX_DATA & Inet1.GetChunk(1024, icByteArray)
            If LenB(Inet1.GetChunk(1024, icByteArray)) = 0 Then mBool = True
        Loop While mBool = False

RX_DATA = StrConv(RX_DATA, vbUnicode) 'バイナリからUnicodeへ

RX_DATA = Split(RX_DATA, " ")

 On Error Resume Next
 For CNT = 0 To 300 'この処理は が常に300個ないとERROR
 Debug.Print "NO." & CNT & RX_DATA(CNT)
 Next CNT
 Err.Clear

End If

End Sub

DoEventsをいれただけですけど...

魔界の仮面弁士 2003-09-16 22:16:27 No: 79425

そのコードだと、正しく取得出来ないと思いますよ。＞Take1さん

> RX_DATA = RX_DATA & Inet1.GetChunk(1024, icByteArray)
上記行で、先頭から1024バイト分を取得しているのに、

> If LenB(Inet1.GetChunk(1024, icByteArray)) = 0 Then mBool = True
ここでさらに、次の1024バイト分を空読みしてしまっていますので、
データが1024バイト単位に飛び飛びになってしまいます。

こんな感じでは如何でしょうか。

Private mstrLog As String
Private Const cSIZE As Long = 1024&

Private Sub Inet1_StateChanged(ByVal State As Integer)

    If State = icResponseCompleted Then
        Dim buf() As Byte
        Dim log() As Byte

        buf = Inet1.GetChunk(cSIZE, icByteArray)
        Do While UBound(buf) >= 0
            log = CStr(log) & CStr(buf)

'Debug.Print Format(UBound(log), "#,0") & "バイト受信"

            buf = Inet1.GetChunk(cSIZE, icByteArray)
        Loop
        mstrLog = StrConv(CStr(log), vbUnicode)

End If
End Sub

魔界の仮面弁士 2003-09-16 22:27:01 No: 79426

なお上記は、Webサーバが Shift_JIS 相当の文字列を返してくる時のみ有効です。
(EUC-JPなどの)他の文字コードを返してくるようなサーバの場合には、StrConvでの変換は
できませんので、その場合は、Streamオブジェクトを利用するようにしてみてください。

'参照設定で、"Microsoft ActiveX Data Objects (2.5以上) Library" をチェックしておきます。

Private Sub Inet1_StateChanged(ByVal State As Integer)
    If State = icResponseCompleted Then
        Dim Stm As ADODB.Stream
        Dim buf() As Byte

        Set Stm = New ADODB.Stream
        Stm.Open
        Stm.Type = adTypeBinary
        buf = Inet1.GetChunk(cSIZE, icByteArray)
        Do While UBound(buf) >= 0
            Stm.Write buf

Debug.Print Format(Stm.Size, "#,0") & "バイト受信"

            buf = Inet1.GetChunk(cSIZE, icByteArray)
        Loop
        Stm.Position = 0
        Stm.Type = adTypeText

        'Webサーバで使われている文字コードを指定
        '(EUC-JP とか、Shift_JIS とか UTF-8 とか ISO-2022-JP とか)
        Stm.Charset = "EUC-JP"

        'Webサーバで使われている改行コードを指定
        '(adLF、adCR、adCRLF のいずれか)
        Stm.LineSeparator = adLF

mstrLog = Stm.ReadText(adReadAll)

        Stm.Close
        Set Stm = Nothing
    End If
End Sub

ひよっこＶＢ 2003-09-16 22:28:50 No: 79427

Take1様、魔界の仮面弁士様ありがとうございます。こちらの対応が追いつかないぐらいアドバイスいただき、汗をかきかき、奮闘中です。ほんとうにありがとうございます。ペコリン！
アドバイスいただいたソースそのまま丸写しだと、ひよっこの成長にならないと思い、一行一行、噛みしめならが亀の前進状態ですが、きっとものにして見せます。
結果またご報告しますので、いましばらくご猶予くださいませ。
いっこうに改名できないひよっこＶＢより。

Take1 2003-09-16 22:57:33 No: 79428

>Do While UBound(buf) >= 0

なるほど!さすがです。
どうやってループを抜けようか苦戦しました。
これこそ見本ですね。
ありがとうございます。勉強になりました。

ひよっこＶＢ 2003-09-17 02:08:25 No: 79429

ちょっと勘違いしていたかもわかりません。
>Private Sub Inet1_StateChanged(ByVal State As Integer)
> Dim RX_DATA As Variant
> Dim LINE_DATA() As String
> Dim CNT As Integer

> If State = 12 Then
> RX_DATA = Inet1.GetChunk(60000, icString)
> LINE_DATA = Split(RX_DATA, " ")
> For CNT = 0 To 300
> Debug.Print "NO." & CNT & LINE_DATA(CNT)
> Next CNT
> End If
>End Sub
>'------------------------------------------------------------------
>'受信したデータを編集して表示します。
>'この時サイズは200バイト ×300件なので60000としました。
>イミーデント表示は、
>NO.235 からしか表示しません。サイズの問題なのでしょうか？
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ためしにFor CNT = 50 to 100 や
 For CNT = 101 to 150 等範囲を狭くすると正確にイミディエントウインドに表示されました。ってことは変数にはこの記述で正常の取込めているのかなっって思って次の実験をやって見ました。
Private Sub Command1_Click()
Dim TEST_STR1 As String '40BYTE
Dim TEST_STR2 As String '40BYTE
Dim TEST_STR3 As String '40BYTE
Dim TEST_STR4 As String '40BYTE
Dim TEST_TOTAL As String '160BYTE
Dim CNT As Integer

TEST_STR1 = "1234567890123456789012345678901234567890"
TEST_STR2 = TEST_STR1
TEST_STR3 = TEST_STR1
TEST_STR4 = TEST_STR1

TEST_TOTAL = TEST_STR1 & TEST_STR2 & TEST_STR3 & TEST_STR4 & vbCrvbLf

For CNT = 1 To 300
Debug.Print "NO." & CNT & TEST_TOTAL
Next CNT
End Sub
結果やっぱりイミディエントウンドには、NO.102からしか表示せず、1〜101が欠けちゃいます。単にミディエントウンドの表示キャパの問題だったとの結論付けは間違っているのでしょうか？HELPでもキャパに触れた記述は見つけられませんでしたけど・・・・・。

魔界の仮面弁士 2003-09-17 02:33:07 No: 79430

ご想像どおり、イミディエイトに表示可能な領域には限りがあります。
縦方向には、200行以下までです。

ちなみに、横方向には、(Shift_JIS換算で)1024バイト未満までとなっており、
データが横方向に溢れた場合は、次行に繰り越されるようになっています。

ひよっこＶＢ 2003-09-17 03:32:44 No: 79431

魔界の仮面弁士様、Take1様長らく親切なお付き合い、懇切丁寧なご指導ほんとうにありがとうございました。まだまだ最終仕上げまでは時間がかかると思いますが当初の目的（CGIが、特定クライアントからのアクセスに限って送信する）は解決しそうなので一旦「解決」とさせていただきます。
本当にありがとうございました。そしてまたまたお世話になると思いますので、どうかその節は、またよろしくお願いします。