tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトルBASIC認証が必要なホームページへのアクセス
記事No15149
投稿日: 2011/04/05(Tue) 12:12
投稿者だんぼる
初めまして、だんぼると申します。

Basic認証が必要なホームページ上のスペースに、プログラムの追加データを
置いてあります。(厳密なアクセス制限でないことは了承済)
トップページと追加データのリストのページと、追加方法の説明ページがあります。
いろいろと探してみたところ、VB6でのBasic認証ページへのアクセス方法
を見つけ、下記のサンプルを作ってみました。
(フォームにコマンドボタンをひとつ設置)

試してみたところ、トップページのアクセスにはダイアログが表示されることなく
成功するのですが、その先のページにアクセスしようとするとダイアログが表示されて
しまいます。

パケットキャプチャソフト「Wireshark」で調べてみたところ、通常のブラウザで
アクセスした際はトップページにてIDパスを入力後、その他のページにアクセスした
際もヘッダに「Authorization: Basic〜」が入っていました。

しかしVB6から開いた際は、トップページにアクセスする際に「Authorization: Basic〜」
が入っているだけで、以降のページにアクセスした際は含まれていませんでした。

この部分が原因かと思うのですが、トップページ以外も認証ダイアログを表示せずに
アクセスする方法、ありますでしょうか。
宜しくお願い致します。


Option Explicit

Const BASE64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"abcdefghijklmnopqrstuvwxyz0123456789+/"
Dim objIE
Dim objShell

Private Sub Command1_Click()
    Dim strHEAD As String
    'Shell.Applicationオブジェクトの作成
    Set objShell = CreateObject("Shell.Application")

    'IEオブジェクトの作成(ダミー)
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True 'IEウィンドウを表示

    strHEAD = "Authorization: Basic " & StrToBase64("「ユーザID」:「パスワード」") & vbCrLf
    objIE.Navigate "「認証が必用なページのトップページ」", , , , strHEAD
    
End Sub
Function StrToBase64$(ByVal src$)
    
    Dim tempDigit$, temp64$, mo&
    tempDigit$ = StrToDigit$(src$)
    
    temp64$ = DigitToBase64$(StrToDigit$(src$))
    temp64$ = temp64$ & String$((4 - (Len(temp64$) Mod 4)) Mod 4, "=")
    
    StrToBase64$ = temp64$
End Function
Function DigitToBase64$(ByVal src$)
    Dim i&, ret$, c&
    
    src$ = src$ & String$((6 - (Len(src$) Mod 6)) Mod 6, "0")
    For i = 1 To Len(src$) Step 6
    c = DigitToInt("00" & Mid$(src$, i, 6)) + 1
    ret$ = ret$ & Mid$(BASE64, c, 1)
    Next
    
    DigitToBase64$ = ret$
End Function
Function StrToDigit$(ByVal src$)

    Dim i&, c&, ret$
    
    For i = 1 To Len(src$)
    c = Asc(Mid$(src$, i, 1))
    If c >= 0 Then
    ret$ = ret$ & IntToDigit$(c)
    Else
    ret$ = ret$ & IntToDigit$((c And -256) / 256)
    ret$ = ret$ & IntToDigit$(c And 255)
    End If
    Next
    StrToDigit$ = ret$
End Function
Private Function IntToDigit$(ByVal x&)
    Dim i&, ret$
    
    For i = 7 To 0 Step -1
    If (x And 2 ^ i) = 0 Then ret$ = ret$ & "0" Else ret$ = ret$ & "1"
    Next
    IntToDigit$ = ret$
End Function
Private Function DigitToInt&(ByVal x$)
    Dim i&, ret&
    
    For i = 1 To 8
    If Mid$(x$, i, 1) = "1" Then ret = ret + 2 ^ (8 - i)
    Next
    DigitToInt = ret
End Function

[ツリー表示へ]
タイトルRe: BASIC認証が必要なホームページへのアクセス
記事No15150
投稿日: 2011/04/07(Thu) 16:18
投稿者花ちゃん
どなたからもレスがないようなので、
詳しくは知りませんが、No.15044 の回答と同じ事ではないのですか?

質問されるなら、詳しい環境等を書かないと注意事項に書いてある通りレスが
付かないかも。(マナーを守らない人と判断され)

又、コードを投稿されるなら、動作確認できるようなコードにするとか、コードに
コメントを入れるとかしないと何を使用とされているのか見ている人には解りづらく
回答する気にもなれないのでは。
(アクセスできたとしても最終的に何がしたいのか解らない)

 http://hanatyan.sakura.ne.jp/hazimeni.htm#keijiban

[ツリー表示へ]
タイトルRe^2: BASIC認証が必要なホームページへのアクセス
記事No15151
投稿日: 2011/04/07(Thu) 18:12
投稿者だんぼる

失礼しました、動作可能なソースに変更しました。

[実行環境]
VisualBasic6.0(SP5)
WindowsXP(SP3)
IE8.0

No.15044 の回答についてですが、Basic認証ではCookie等は使用されず、認証後は
ブラウザが自動でヘッダに「Authorization: Basic 〜」を追加してくれるようです。
しかし以下のようにVBからヘッダに認証情報を追加して開いた際は、最初のページは
開くのですが、以降のページには「Authorization: Basic 〜」を追加してくれてい
ないようです。
IEのその当たりの挙動に関しては仕様が公開されておらず、VBから操作することは出来
ないようです。

また、トップページに写真等が貼り付けられている場合も写真ファイルの取得で認証
エラーになるらしく、認証ダイアログが表示されてしまいます。

APIか何かで、httpリクエストを送る際、毎回「Authorization: Basic 〜」を追加で
きればいいのかなとは思うのですが、その方法もよくわからず現在調べております。



Option Explicit

Const BASE64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"abcdefghijklmnopqrstuvwxyz0123456789+/"
Dim objIE
Dim objShell

Private Sub Command1_Click()
    Dim strHEAD As String
    'Shell.Applicationオブジェクトの作成
    Set objShell = CreateObject("Shell.Application")

    'IEオブジェクトの作成(ダミー)
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True 'IEウィンドウを表示

    strHEAD = "Authorization: Basic " & StrToBase64("user:user01") & vbCrLf
    objIE.Navigate "http://cult.jp/danboru/test/Index.html", , , , strHEAD
    
End Sub
'******↓↓↓ 以下、Base64への変換 ↓↓↓ ******
Function StrToBase64$(ByVal src$)
    
    Dim tempDigit$, temp64$, mo&
    tempDigit$ = StrToDigit$(src$)
    
    temp64$ = DigitToBase64$(StrToDigit$(src$))
    temp64$ = temp64$ & String$((4 - (Len(temp64$) Mod 4)) Mod 4, "=")
    
    StrToBase64$ = temp64$
End Function
Function DigitToBase64$(ByVal src$)
    Dim i&, ret$, c&
    
    src$ = src$ & String$((6 - (Len(src$) Mod 6)) Mod 6, "0")
    For i = 1 To Len(src$) Step 6
    c = DigitToInt("00" & Mid$(src$, i, 6)) + 1
    ret$ = ret$ & Mid$(BASE64, c, 1)
    Next
    
    DigitToBase64$ = ret$
End Function
Function StrToDigit$(ByVal src$)

    Dim i&, c&, ret$
    
    For i = 1 To Len(src$)
    c = Asc(Mid$(src$, i, 1))
    If c >= 0 Then
    ret$ = ret$ & IntToDigit$(c)
    Else
    ret$ = ret$ & IntToDigit$((c And -256) / 256)
    ret$ = ret$ & IntToDigit$(c And 255)
    End If
    Next
    StrToDigit$ = ret$
End Function
Private Function IntToDigit$(ByVal x&)
    Dim i&, ret$
    
    For i = 7 To 0 Step -1
    If (x And 2 ^ i) = 0 Then ret$ = ret$ & "0" Else ret$ = ret$ & "1"
    Next
    IntToDigit$ = ret$
End Function
Private Function DigitToInt&(ByVal x$)
    Dim i&, ret&
    
    For i = 1 To 8
    If Mid$(x$, i, 1) = "1" Then ret = ret + 2 ^ (8 - i)
    Next
    DigitToInt = ret
End Function

[ツリー表示へ]
タイトルRe^3: BASIC認証が必要なホームページへのアクセス
記事No15152
投稿日: 2011/04/07(Thu) 19:23
投稿者花ちゃん
> No.15044 の回答についてですが、Basic認証ではCookie等は使用されず、認証後は
> ブラウザが自動でヘッダに「Authorization: Basic 〜」を追加してくれるようです。

私は、そのような処理が必要な事に遭遇しておりませんし、今まで同様の質問やコードを
見た事がないので詳しくは知りませんが、前期のコードを試した限りでは、一度
手動で、ID 等を入力すれば、次回からは、ダイアログが表示される事がありません、
と言う事は、Cookie がきいているということなので、前期の方法等で認証
(又は、 Cookie を付与)したのではだめなのですか?

[ツリー表示へ]
タイトルInternetSetCookie API
記事No15153
投稿日: 2011/04/08(Fri) 13:15
投稿者花ちゃん
> APIか何かで、httpリクエストを送る際、毎回「Authorization: Basic 〜」を追加で
> きればいいのかなとは思うのですが、その方法もよくわからず現在調べております。


設定および WinInet API を使用して、URL の Cookie を取得する方法

http://support.microsoft.com/kb/196062/ja

[ツリー表示へ]
タイトルRe: BASIC認証が必要なホームページへのアクセス
記事No15156
投稿日: 2011/04/08(Fri) 15:31
投稿者YuO
> 試してみたところ、トップページのアクセスにはダイアログが表示されることなく
> 成功するのですが、その先のページにアクセスしようとするとダイアログが表示されて
> しまいます。
> パケットキャプチャソフト「Wireshark」で調べてみたところ、通常のブラウザで
> アクセスした際はトップページにてIDパスを入力後、その他のページにアクセスした
> 際もヘッダに「Authorization: Basic〜」が入っていました。
> しかしVB6から開いた際は、トップページにアクセスする際に「Authorization: Basic〜」
> が入っているだけで、以降のページにアクセスした際は含まれていませんでした。

IEオブジェクトがNavigateメソッドの引数で渡されたAuthorizationリクエストヘッダフィールドを,
認証用のAuthorizationリクエストヘッダフィールドであると認識していないのだと思います。

試していませんが,BeforeNavigateイベントやBeforeNavigate2イベントを使って,
Authorizationリクエストヘッダフィールドを追加してみることで回避できませんか。

[ツリー表示へ]
タイトルRe^2: BASIC認証が必要なホームページへのアクセス
記事No15158
投稿日: 2011/04/08(Fri) 17:49
投稿者だんぼる
花ちゃん様、YuO様、ご返答頂きましてありがとうございます。

<花ちゃん様
忙しい中、開示策を提示して頂きましてありがとうございます。
ブラウザにてアクセスした際に表示されるダイアログに「パスワードを保存する」
というチェックボックスがありますので、最悪自動ログインは出来なくてもプログラム
の方から、教えて頂いたCookie操作にてパスワードを保存し、OKボタンだけクリック
してもらう形でも対応できそうです。
(パスワードがCookieに保存されているかはまだ未検証です)

<You様
まさにおっしゃった状況かと思います。
BeforeNavigate2イベントをキャッチしたのですが、ここでのヘッダの書き換えは
参照のみで出来ないようです。
ここで再度Navigateメソッドにてヘッダを付けて飛ばそうとしましたが、エラーとなって
しまいます。
「'Navigate'メソッドは失敗しました:'IWebBrowser2'オブジェクト」
それとこの方法だとページに画像ファイルが含まれていると、そこでのBeforeNavigate2
イベントが発生しないので、画像の取得がうまくいかない物と思われます。


Cookieを使う方法と、BeforeNavigateを使う方法、両方法とももう少し勉強しながら
試していきたいと思います。

[ツリー表示へ]
タイトルRe^3: BASIC認証が必要なホームページへのアクセス
記事No15162
投稿日: 2011/04/10(Sun) 13:33
投稿者花ちゃん
> BeforeNavigate2イベントをキャッチしたのですが、ここでのヘッダの書き換えは
> 参照のみで出来ないようです。
> ここで再度Navigateメソッドにてヘッダを付けて飛ばそうとしましたが、エラーとなって
> しまいます。

その後、見ておられないようなので、解決されたのかも知れませんが、もしまだでしたら
DocumentComplete イベントでなら、再度Navigateメソッドにてヘッダを付けて飛ばす事が
できます。又は、NavigateComplete2 イベントでも可。

IE.Silent = True で起動すれば、DocumentComplete イベントで付加する事ができます。
(一度テストコードを投稿していたのですが...。)

[ツリー表示へ]
タイトルRe^3: BASIC認証が必要なホームページへのアクセス
記事No15163
投稿日: 2011/04/10(Sun) 22:38
投稿者YuO
なるほど……。
MSDN: Navigate2 Method (IWebBrowser2)
http://msdn.microsoft.com/en-us/library/aa752134.aspx
まで遡ると,確かにHeadersは[in]って書いてありますね……。

なので,イベントでハンドラ追加すればどうにかなる物でもなさそうです。
画像やらcssやらjsやらが無効になることが前提でよければ,
BeforeNavigate2イベントでHeadersにAuthorizationが無ければキャンセルして,
改めてNavigateメソッドでAuthorizationを追加してリクエストしてみてはどうでしょうか。
これであれば,ユーザーがIE画面上でリンクをクリックしても,それを捉えることができます。

[ツリー表示へ]
タイトルRe: BASIC認証が必要なホームページへのアクセス【解決】
記事No15164
投稿日: 2011/04/11(Mon) 09:50
投稿者だんぼる
花ちゃん様、YuO様、本当にありがとうございました。

花ちゃん様の投稿の
> IE.Silent = True で起動すれば、DocumentComplete イベントで付加する事ができます。
を調べようとGoogleにて「VB6 IE.Silent = True」と検索したところ、なんと花ちゃん様
が投稿して頂いた記事がキャッシュで表示できました!

そちらにて動作確認してみたところ、ほぼ希望の動作となることを確認しました。

最初、「DocumentComplete」か「NavigateComplete2」では次ページへのリンクをクリック
した際、認証ダイアログが先に表示されてしまうのではないかと思ったのですが、
「IE.Silent = True」というのがミソだったのですね!

一瞬「ページを表示できません」というようなメッセージが表示されますので、そこだけ
なんとかごまかして実用ソースにしていきたいと思います。

本当にいろいろとありがとうございました。

以下ソースです。(ほぼ花ちゃん様ご提供のソース)
新規プロジェクトに「Command1」ボタンを追加。
プロジェクト→参照設定→Microsoft Internet Controls にチェック。
(こちら、当方環境では参照設定のリストに「Microsoft Internet Controls」が
存在しなかった為、参照にて直接dllを参照しました。system32\ieframe.dllです。)

Option Explicit

Const BASE64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"abcdefghijklmnopqrstuvwxyz0123456789+/"

Private WithEvents IE As SHDocVw.InternetExplorer
Private myURL         As String
Private SNo           As Integer

Private Sub Command1_Click()
    Dim strHEAD As String
  
   strHEAD = "Authorization: Basic " & StrToBase64("user:user01") & vbCrLf
   Set IE = New SHDocVw.InternetExplorer
   myURL = "http://cult.jp/danboru/test/Index.html"
   SNo = 1
   IE.Navigate myURL, , , , strHEAD
   IE.Silent = True
   IE.Visible = True
End Sub

Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
   Debug.Print SNo, URL
   Dim strHEAD As String
  
   If SNo = 1 And URL = "http://cult.jp/danboru/test/Index.html" Then
      strHEAD = "Authorization: Basic " & StrToBase64("user:user01") & vbCrLf
      myURL = "http://cult.jp/danboru/test/Index.html"
      IE.Navigate2 myURL, , , , strHEAD
      SNo = 2
   End If
   If SNo = 2 And URL = "http://cult.jp/danboru/test/List.html" Then
      strHEAD = "Authorization: Basic " & StrToBase64("user:user01") & vbCrLf
      myURL = "http://cult.jp/danboru/test/List.html"
      IE.Navigate2 myURL, , , , strHEAD
      SNo = 3
      IE.Silent = False
   End If
End Sub
'******↓↓↓ 以下、Base64への変換 ↓↓↓ ******
Function StrToBase64$(ByVal src$)
    
    Dim tempDigit$, temp64$, mo&
    tempDigit$ = StrToDigit$(src$)
    
    temp64$ = DigitToBase64$(StrToDigit$(src$))
    temp64$ = temp64$ & String$((4 - (Len(temp64$) Mod 4)) Mod 4, "=")
    
    StrToBase64$ = temp64$
End Function
Function DigitToBase64$(ByVal src$)
    Dim i&, ret$, c&
    
    src$ = src$ & String$((6 - (Len(src$) Mod 6)) Mod 6, "0")
    For i = 1 To Len(src$) Step 6
    c = DigitToInt("00" & Mid$(src$, i, 6)) + 1
    ret$ = ret$ & Mid$(BASE64, c, 1)
    Next
    
    DigitToBase64$ = ret$
End Function
Function StrToDigit$(ByVal src$)

    Dim i&, c&, ret$
    
    For i = 1 To Len(src$)
    c = Asc(Mid$(src$, i, 1))
    If c >= 0 Then
    ret$ = ret$ & IntToDigit$(c)
    Else
    ret$ = ret$ & IntToDigit$((c And -256) / 256)
    ret$ = ret$ & IntToDigit$(c And 255)
    End If
    Next
    StrToDigit$ = ret$
End Function
Private Function IntToDigit$(ByVal x&)
    Dim i&, ret$
    
    For i = 7 To 0 Step -1
    If (x And 2 ^ i) = 0 Then ret$ = ret$ & "0" Else ret$ = ret$ & "1"
    Next
    IntToDigit$ = ret$
End Function
Private Function DigitToInt&(ByVal x$)
    Dim i&, ret&
    
    For i = 1 To 8
    If Mid$(x$, i, 1) = "1" Then ret = ret + 2 ^ (8 - i)
    Next
    DigitToInt = ret
End Function

[ツリー表示へ]
タイトルRe^2: BASIC認証が必要なホームページへのアクセス【解決】
記事No15165
投稿日: 2011/04/11(Mon) 10:27
投稿者花ちゃん
> 一瞬「ページを表示できません」というようなメッセージが表示されますので、そこだけ
> なんとかごまかして実用ソースにしていきたいと思います。

起動時は、IE.Visible = False で起動して、DocumentComplete イベントで
IE.Visible = True にしてやれば、どうでしょうか?

[ツリー表示へ]
タイトルRe^3: BASIC認証が必要なホームページへのアクセス【解決】
記事No15166
投稿日: 2011/04/11(Mon) 10:50
投稿者だんぼる
> 起動時は、IE.Visible = False で起動して、DocumentComplete イベントで
> IE.Visible = True にしてやれば、どうでしょうか?

花ちゃん様、ありがとうございます。

ソースに
Private Sub IE_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
   If IE.Visible = True Then
        IE.Visible = False
   End If
End Sub



IE_DocumentComplete内の最後に
   If IE.Visible = False Then
        IE.Visible = True
   End If

を追加してみました。
結果、一瞬IEが非表示になりますが、エラーページは表示されなくなりました。
スペックの低いPCだと、ちょっと消えている時間が大きくなってしまう為、こちらか、
エラーページが一瞬出てしまう旨を説明書きに加えておくか、どちらかで対応しようかと
思います。

[ツリー表示へ]