VBScript : Picasa へ画像ファイルをアップロード

  比較的簡単なプロトコルです



PHP : Zend Gdata による Picasa アップロード で実装した時は気が付かなかったのですが、 Java のサンプルがある説明ページに詳細な手順(プロトコル)が記述されていました。ここだけでは解りにくいのですが、当然認証が必要になりますので、ClientLogin documentation
参照すると、認証に関する説明があります。

サービスの種類はこちらのページにあります。

ClientLogin for installed applications で説明されていますが、ClientLogin で取得した Auth を以降の http ヘッダで Authorization: GoogleLogin auth=yourAuthValue というように設定しておけば良いわけです。アツプロードにはメタデータを同時に設定する方法と、簡単にファイルのみ送る方法が記述されていますが、簡単なほうをテストしています。

バイナリデータのポストは、Twitpic のアップロードでもっと複雑な事をしているので必要ならば参照して下さい。

関連する記事

VBScript : Twitpic に画像をアップロード



  VBScript : img_upload.wsf



ユーザーid や アルバムid は、そのアルバムの右サイドにある RSS の URL を見れば解ります。画像の名前は、http ヘッダの Slug に指定します。

※ /user/ユーザーid/albumid/アルバムid という構成になっています

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 = "メールアドレス"    ' またはユーザーID
023.strPass = "パスワード"
024.strVersion = "winofsql-imgupload-1.01"  ' 内容は自由
025.' *********************************************************
026.' アップロード用データ
027.' ※ アルバムの RSS リンクより取得
028.' ( /user/ユーザーid/albumid/アルバムid )
029.' *********************************************************
030.strUserid = "ユーザーID"
031.strAlbumid = "アルバムID"
032.strImage = "画像のパス"
033.strImageTitle = "VBS_UPLOAD_IMAGE.jpg"  ' Filename
034.strImageType = "image/jpeg"
035. 
036. 
037.' **********************************************************
038.' Google 認証用 URL
039.' **********************************************************
040.target_url = "https://www.google.com/accounts/ClientLogin"
041. 
042.' *********************************************************
043.' API へ向けて送信準備
044.' *********************************************************
045.Call objHTTP.Open( "POST",target_url, False )
046.' POST 用 HTTP ヘッダ
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.' Authorization:
078.strAuth = "GoogleLogin auth=" & aAuth(1)
079.Wscript.Echo("ログインの結果" & vbCrLf & vbCrLf & strAuth)
080. 
081. 
082.' *********************************************************
083.' 画像アップロード用データ
084.' *********************************************************
085.'strUserid = "ユーザーID"
086.'strAlbumid = "アルバムID"  ' Gata テスト用
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.' 結果の XML( テキスト )
121.' *********************************************************
122.Wscript.Echo("結果の XML" & vbCrLf & vbCrLf & objHTTP.responseText)
123. 
124.' *********************************************************
125.' DOM としてロードして title 取得
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.' SHIFT_JIS を UTF-8 に変換して URLエンコード
139.' ※ 全ての文字をパーセントエンコーディングします
140.' ***********************************************************
141.Function URLEncode(str)
142. 
143.    Stream.Open
144.    Stream.Charset = "shift_jis"
145.    ' shift_jis で入力文字を書き込む
146.    Stream.WriteText str
147.    ' コピーの為にデータポインタを先頭にセット
148.    Stream.Position = 0
149.  
150.    Stream2.Open
151.    Stream2.Charset = "utf-8"
152.    ' shift_jis を utf-8 に変換
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.    ' 0~9
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.    ' A~Z
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.    ' a~z
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>














   SQLの窓    create:2010/06/13  update:2018/02/18   管理者用(要ログイン)





フリーフォントWEBサービス

SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ