001.
<JOB>
002.
<COMMENT>
003.
************************************************************
004.
URLEncode用
005.
************************************************************
006.
</COMMENT>
007.
<OBJECT id=
"Stream"
progid=
"ADODB.Stream"
/>
008.
<OBJECT id=
"Stream2"
progid=
"ADODB.Stream"
/>
009.
<OBJECT id=
"StreamBin"
progid=
"ADODB.Stream"
/>
010.
<COMMENT>
011.
************************************************************
012.
HTTP通信用
013.
************************************************************
014.
</COMMENT>
015.
<OBJECT id=
"objHTTP"
progid=
"Msxml2.ServerXMLHTTP"
/>
016.
<OBJECT id=
"objDOMDoc"
progid=
"Msxml2.DOMDocument"
/>
017.
018.
<SCRIPT language=VBScript>
019.
020.
021.
022.
strEmail =
"メールアドレス"
023.
strPass =
"パスワード"
024.
strVersion =
"winofsql-imgupload-1.01"
025.
026.
027.
028.
029.
030.
strUserid =
"ユーザーID"
031.
strAlbumid =
"アルバムID"
032.
strImage =
"画像のパス"
033.
strImageTitle =
"VBS_UPLOAD_IMAGE.jpg"
034.
strImageType =
"image/jpeg"
035.
036.
037.
038.
039.
040.
target_url =
"https://www.google.com/accounts/ClientLogin"
041.
042.
043.
044.
045.
Call
objHTTP.Open(
"POST"
,target_url,
False
)
046.
047.
Call
objHTTP.setRequestHeader(
"Content-Type"
,
"application/x-www-form-urlencoded"
)
048.
049.
050.
051.
052.
strData =
"accountType=GOOGLE"
053.
strData = strData &
"&Email="
& rfc3986_convert(URLEncode(strEmail))
054.
strData = strData &
"&Passwd="
& rfc3986_convert(URLEncode(strPass))
055.
strData = strData &
"&service=lh2"
056.
strData = strData &
"&source="
& rfc3986_convert(URLEncode(strVersion))
057.
Call
objHTTP.SetRequestHeader(
"Content-Length"
,Len(strData))
058.
059.
060.
061.
062.
Dim
lResolve : lResolve = 60 * 1000
063.
Dim
lConnect : lConnect = 60 * 1000
064.
Dim
lSend : lSend = 60 * 1000
065.
Dim
lReceive : lReceive = 60 * 1000
066.
Call
objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
067.
Call
objHTTP.Send(strData)
068.
069.
070.
071.
072.
strResult = objHTTP.responseText
073.
074.
aData = Split(strResult,vbLf)
075.
aAuth = Split(aData(2),
"="
)
076.
077.
078.
strAuth =
"GoogleLogin auth="
& aAuth(1)
079.
Wscript.Echo(
"ログインの結果"
& vbCrLf & vbCrLf & strAuth)
080.
081.
082.
083.
084.
085.
086.
087.
target_url =
"http://picasaweb.google.com/data/feed/api/user/"
088.
target_url = target_url & strUserid &
"/albumid/"
& strAlbumid
089.
090.
Call
objHTTP.Open(
"POST"
,target_url,
False
)
091.
Call
objHTTP.SetRequestHeader(
"Authorization"
, strAuth )
092.
Call
objHTTP.SetRequestHeader(
"Content-Type"
, strImageType )
093.
Call
objHTTP.SetRequestHeader(
"Slug"
, strImageTitle )
094.
095.
096.
StreamBin.Open
097.
StreamBin.Type = 1
098.
099.
100.
StreamBin.LoadFromFile(strImage)
101.
102.
nLen = StreamBin.Size
103.
StreamBin.Position = 0
104.
strData = StreamBin.Read(nLen)
105.
StreamBin.Close
106.
107.
Call
objHTTP.SetRequestHeader(
"Content-Length"
,nLen)
108.
109.
110.
111.
112.
lResolve = 60 * 1000
113.
lConnect = 60 * 1000
114.
lSend = 60 * 1000
115.
lReceive = 60 * 1000
116.
Call
objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
117.
Call
objHTTP.Send(strData)
118.
119.
120.
121.
122.
Wscript.Echo(
"結果の XML"
& vbCrLf & vbCrLf & objHTTP.responseText)
123.
124.
125.
126.
127.
objDOMDoc.async =
False
128.
objDOMDoc.loadXML(objHTTP.responseText)
129.
If
(objDOMDoc.parseError.errorCode <> 0)
Then
130.
Wscript.Echo(
"XMLロードエラー"
)
131.
Else
132.
Set
objNode = objDOMDoc.getElementsByTagName(
"title"
).item(0)
133.
Wscript.Echo(
"結果のタイトル"
& vbCrLf & vbCrLf & objNode.firstChild.nodeValue)
134.
End
If
135.
136.
137.
138.
139.
140.
141.
Function
URLEncode(str)
142.
143.
Stream.Open
144.
Stream.Charset =
"shift_jis"
145.
146.
Stream.WriteText str
147.
148.
Stream.Position = 0
149.
150.
Stream2.Open
151.
Stream2.Charset =
"utf-8"
152.
153.
Stream.CopyTo Stream2
154.
Stream.Close
155.
156.
157.
Stream2.Position = 0
158.
159.
160.
StreamBin.Open
161.
StreamBin.Type = 1
162.
163.
164.
Stream2.CopyTo StreamBin
165.
Stream2.Close
166.
167.
168.
StreamBin.Position = 0
169.
170.
Buffer =
""
171.
StreamBin.Read(3)
172.
Do
while not StreamBin.EOS
173.
LineBuffer = StreamBin.Read(16)
174.
175.
For
i = 1 to LenB( LineBuffer )
176.
CWork = MidB(LineBuffer,i,1)
177.
Cwork = AscB(Cwork)
178.
Cwork = Hex(Cwork)
179.
Cwork = Ucase(Cwork)
180.
if Len(Cwork) = 1 then
181.
Buffer = Buffer &
"%0"
& Cwork
182.
else
183.
Buffer = Buffer &
"%"
& Cwork
184.
end if
185.
Next
186.
187.
Loop
188.
189.
StreamBin.Close
190.
191.
URLEncode = Buffer
192.
193.
End
Function
194.
195.
196.
197.
198.
Function
rfc3986_convert(str)
199.
200.
Dim
strResult,I,strWork
201.
202.
strResult = str
203.
204.
strResult = Replace(strResult,
"%2D"
,
"-"
)
205.
strResult = Replace(strResult,
"%2E"
,
"."
)
206.
207.
208.
For
I = &H30 to &H39
209.
strWork = Hex(I)
210.
strWork =
"%"
& Ucase(strWork)
211.
strResult = Replace(strResult,strWork, Chr(I))
212.
Next
213.
214.
215.
For
I = &H41 to &H5A
216.
strWork = Hex(I)
217.
strWork =
"%"
& Ucase(strWork)
218.
strResult = Replace(strResult,strWork, Chr(I))
219.
Next
220.
221.
strResult = Replace(strResult,
"%5F"
,
"_"
)
222.
223.
224.
For
I = &H61 to &H7A
225.
strWork = Hex(I)
226.
strWork =
"%"
& Ucase(strWork)
227.
strResult = Replace(strResult,strWork, Chr(I))
228.
Next
229.
230.
strResult = Replace(strResult,
"%7E"
,
"~"
)
231.
232.
rfc3986_convert = strResult
233.
234.
End
Function
235.
</SCRIPT>
236.
</JOB>