記事一覧

basic認証のページをvbから開く

vbからあるwebページを開くには

Dim tWeb As WebBrowser
Set tWeb = CreateObject("InternetExplorer.Application")
tWeb.Visible = True
tWeb.Navigate "http://www.ichipre.co.jp"

みたいな感じでできます。で、BASIC認証が設定されているページに対しては最後の行を

tWeb.Navigate "http://UID:PWD@www.ichipre.co.jp"

のようにすれば開くことができました。はい、過去形です。ずいぶん前ですが、セキュリティの関係から上記の書式は禁止になって使えなくなってしまいました(ちなみにこれは、一箇所レジストリを書き換えることで禁止を解けます)。

でも、これって結構困りますよね。でも大丈夫、調べたらちゃんと方法があるんですね。

tWeb.Navigate "http://www.ichipre.co.jp", , , , StrToBase64("UID:PWD")

上記のような感じです。ただし、StrToBase64関数は存在しないので作らないとダメですが。Base64については、wikipediaで調べました。話は逸れますが、wikipediaってホント便利ですよね。たまにウソが書いてありますが。

Const BASE64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"abcdefghijklmnopqrstuvwxyz0123456789+/"
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