2009年08月14日

amazon awsの署名認証

amazon awsで署名認証が導入される

visual basic だと
サンプルがあまりにも少なすぎて

amazon developer communityにようやく一つあるんだけど

VB.NetでAmazon Product Advertising API のSampleにあるように

amazonのサンプルは英語だと動くんだけど
日本語だと

urlencodeがうまくいかなくて
searchIndexをblended以外にして
日本語のキーワードで検索すると

結果がなしになる

なので

上記のサイトをコピペシテ

日本語にも対応させてもらった
Imports System
Imports System.Collections.Generic
Imports System.Text
Imports System.Web
Imports System.Security.Cryptography


Dim MY_AWS_ACCESS_KEY_ID As String = "アクセスキー"
Dim MY_AWS_SECRET_KEY As String = "シークレットキー"
Dim DESTINATION As String = "ecs.amazonaws.jp"


Namespace AmazonProductAdvtApi
Class SignedRequestHelper
Private endPoint As String
Private akid As String
Private secret As Byte()
Private signer As HMAC

Private Const REQUEST_URI As String = "/onca/xml"
Private Const REQUEST_METHOD As String = "GET"

'
' * Use this constructor to create the object. The AWS credentials are available on
' * http://aws.amazon.com
' *
' * The destination is the service end-point for your application:
' * US: ecs.amazonaws.com
' * JP: ecs.amazonaws.jp
' * UK: ecs.amazonaws.co.uk
' * DE: ecs.amazonaws.de
' * FR: ecs.amazonaws.fr
' * CA: ecs.amazonaws.ca
'

Public Sub New(ByVal awsAccessKeyId As String, ByVal awsSecretKey As String, ByVal destination As String)
Me.endPoint = destination.ToLower()
Me.akid = awsAccessKeyId
Me.secret = Encoding.UTF8.GetBytes(awsSecretKey)
Me.signer = New HMACSHA256(Me.secret)
End Sub

'
' * Sign a request in the form of a Dictionary of name-value pairs.
' *
' * This method returns a complete URL to use. Modifying the returned URL
' * in any way invalidates the signature and Amazon will reject the requests.
'

Public Function Sign(ByVal request As IDictionary(Of String, String)) As String
' Use a SortedDictionary to get the parameters in naturual byte order, as
' required by AWS.
Dim pc As New ParamComparer()
Dim sortedMap As New SortedDictionary(Of String, String)(request, pc)

' Add the AWSAccessKeyId and Timestamp to the requests.
sortedMap("AWSAccessKeyId") = Me.akid
sortedMap("Timestamp") = Me.GetTimestamp()

' Get the canonical query string
Dim canonicalQS As String = Me.ConstructCanonicalQueryString(sortedMap)

' Derive the bytes needs to be signed.
Dim builder As New StringBuilder()
builder.Append(REQUEST_METHOD).Append(vbLf).Append(Me.endPoint).Append(vbLf).Append(REQUEST_URI).Append(vbLf).Append(canonicalQS)

Dim stringToSign As String = builder.ToString()
Dim toSign As Byte() = Encoding.UTF8.GetBytes(stringToSign)

' Compute the signature and convert to Base64.
Dim sigBytes As Byte() = signer.ComputeHash(toSign)
Dim signature As String = Convert.ToBase64String(sigBytes)

' now construct the complete URL and return to caller.
Dim qsBuilder As New StringBuilder()
qsBuilder.Append(" http://").Append(Me.endPoint).Append(REQUEST_URI).Append("?").Append(canonicalQS).Append("&Signature=").Append(Me.PercentEncodeRfc3986(signature))

Return qsBuilder.ToString()
End Function

'
' * Sign a request in the form of a query string.
' *
' * This method returns a complete URL to use. Modifying the returned URL
' * in any way invalidates the signature and Amazon will reject the requests.
'

Public Function Sign(ByVal queryString As String) As String
Dim request As IDictionary(Of String, String) = Me.CreateDictionary(queryString)
Return Me.Sign(request)
End Function

'
' * Current time in IS0 8601 format as required by Amazon
'

Private Function GetTimestamp() As String
Dim currentTime As DateTime = DateTime.UtcNow
Dim timestamp As String = currentTime.ToString("yyyy-MM-ddTHH:mm:ssZ")
Return timestamp
End Function

'
' * Percent-encode (URL Encode) according to RFC 3986 as required by Amazon.
' *
' * This is necessary because .NET's HttpUtility.UrlEncode does not encode
' * according to the above standard. Also, .NET returns lower-case encoding
' * by default and Amazon requires upper-case encoding.
'

Private Function PercentEncodeRfc3986(ByVal str As String) As String
str = HttpUtility.UrlEncode(str, System.Text.Encoding.UTF8)
'str.Replace("'", "%27").Replace("(", "%28").Replace(")", "%29").Replace("*", "%2A").Replace("!", "%21").Replace("%7e", "~")
str = str.Replace("'", "%27").Replace("(", "%28").Replace(")", "%29").Replace("*", "%2A").Replace("!", "%21").Replace("%7e", "~").Replace("+", "%20")


Dim sbuilder As New StringBuilder(str)
For i As Integer = 0 To sbuilder.Length - 1

If sbuilder(i) = "%"c Then
'コメント化
'If [Char].IsDigit(sbuilder(i + 1)) AndAlso [Char].IsLetter(sbuilder(i + 2)) Then
sbuilder(i + 1) = [Char].ToUpper(sbuilder(i + 1)) '日本語対策で追加
sbuilder(i + 2) = [Char].ToUpper(sbuilder(i + 2))
'End If
End If

Next
Return sbuilder.ToString()
End Function

'
' * Convert a query string to corresponding dictionary of name-value pairs.
'

Private Function CreateDictionary(ByVal queryString As String) As IDictionary(Of String, String)
Dim map As New Dictionary(Of String, String)()

Dim requestParams As String() = queryString.Split("&"c)

For i As Integer = 0 To requestParams.Length - 1
If requestParams(i).Length < 1 Then
Continue For
End If

Dim sep As Char() = {"="c}
Dim param As String() = requestParams(i).Split(sep, 2)
For j As Integer = 0 To param.Length - 1
param(j) = HttpUtility.UrlDecode(param(j), System.Text.Encoding.UTF8)
Next
Select Case param.Length
Case 1
If True Then
If requestParams(i).Length >= 1 Then
If requestParams(i).ToCharArray()(0) = "="c Then
map("") = param(0)
Else
map(param(0)) = ""
End If
End If
Exit Select
End If
Case 2
If True Then
If Not String.IsNullOrEmpty(param(0)) Then
map(param(0)) = param(1)
End If
End If
Exit Select
End Select
Next

Return map
End Function

'
' * Consttuct the canonical query string from the sorted parameter map.
'

Private Function ConstructCanonicalQueryString(ByVal sortedParamMap As SortedDictionary(Of String, String)) As String
Dim builder As New StringBuilder()

If sortedParamMap.Count = 0 Then
builder.Append("")
Return builder.ToString()
End If

For Each kvp As KeyValuePair(Of String, String) In sortedParamMap

builder.Append(Me.PercentEncodeRfc3986(kvp.Key))
builder.Append("=")
builder.Append(Me.PercentEncodeRfc3986(kvp.Value))
builder.Append("&")
Next
Dim canonicalString As String = builder.ToString()
canonicalString = canonicalString.Substring(0, canonicalString.Length - 1)
Return canonicalString
End Function
End Class

'
' * To help the SortedDictionary order the name-value pairs in the correct way.
'

Class ParamComparer
Implements IComparer(Of String)
Public Function Compare(ByVal p1 As String, ByVal p2 As String) As Integer Implements IComparer(Of String).Compare

Return String.CompareOrdinal(p1, p2)
End Function

End Class
End Namespace



--------------
こんな感じで使う
public function CreateURL(AFID as string,ItemSearch as string,Keyword as string) as string

Dim URL As New Dictionary(Of String, String)
URL("Service") = "AWSECommerceService"
URL("Version") = "2008-04-07"
URL("AssociateTag") = AFID
URL("ContentType") = "Text/XML"
URL("Operation") = "ItemSearch"
URL("ResponseGroup") = "Small,ItemAttributes,Reviews,EditorialReview,Images,BrowseNodes,SalesRank,Offers"
URL("SearchIndex") = SearchIndex
'URL(KeywordType) = System.Web.HttpUtility.UrlEncode(Keyword)
URL(KeywordType) = Keyword

URL("ItemPage") = Page

If BrowseNode.Length > 0 Then
URL("BrowseNode") = BrowseNode
End If

'helper
Dim helper As New AmazonProductAdvtApi.SignedRequestHelper(MY_AWS_ACCESS_KEY_ID, MY_AWS_SECRET_KEY, DESTINATION)
Dim AmazonURL As String = helper.Sign(URL)

Return AmazonURL

end function

Visual Basic 2008逆引き大全555の極意

aws 特価 署名認証 特価
posted by kiyo at 20:35| xml | このブログの読者になる | 更新情報をチェックする

2009年07月09日

正規表現を使う

正規表現というと

Perlって気がするけど

Visual Basic でも

正規表現が使える

Imports System.Text.RegularExpressions

と最初に書いて

MTみたいな感じで

{Entries}
{/Entries}


に囲まれた部分を取得しようとしたときに

({Entries} と {/Entries}も含まれる)

Dim Template = "朝だよ{Entries}おはよう{/Entries}sexy honey"

Dim ret As New Regex("{Entries}(.|\n)+{/Entries}", RegexOptions.Multiline)

Dim EntryHTML As String = ret.Match(Template).Value

って
感じで

EntryHTML


{Entries}おはよう{/Entries}

ってなる



僕が使っているこの本2005だけど


Visual Basic 2005逆引き大全500の極意
visual basic関連サイト


基本的なところは
OKで

足りない

この正規表現や
Background なんかは


ネットとかで調べたり

もう一冊使ってますが

これ

一冊で

90%以上OKです

正規表現 VB2008
posted by kiyo at 21:40| 文字 | このブログの読者になる | 更新情報をチェックする

2009年06月02日

NVelocity

NVelocityっていう
テンプレートエンジンがあるみたい

PHPだと

Smarty

とかが有名だし
Perlだと

数か数の

moduleがあるから
それ入れればいいんだけど

しかし

それらは

if
とか

foreach
とか
使うだけだと

重い
単に置換するだけなら

replaceで

いけるけど

問題は

if


foreach

をどうやって
実現するかなんだけど

ちょっと

考えて
簡易テンプレートエンジンを

作ってみたいなあ

そうしたら

PCで

Movable type
みたいなのを

FTP

使って
できるような

気がする

そうすると

サーバーに
重いって

文句いわれない

(数々文句いわれ続けてます)
NVelocity NVelocity テンプレート テンプレート
posted by kiyo at 22:35| ファイル | このブログの読者になる | 更新情報をチェックする

2009年04月24日

IE(internet explorer)を開く

objIEがObject でいいのかどうか?だが

こんな感じで
いつも使っている

リダイレクトするURLだと
ちゃんと読み込みを確認してはくれないこともある

Public Sub OpenIE(ByVal objIE As Object, ByVal URL As String)

objIE.Navigate(URL)

Do While objIE.Busy
DoEvents()
Loop

Do While (objIE.document.readyState <> "complete")
DoEvents()
Loop

Do While objIE.readyState <> "4"
DoEvents()
Loop

Sleep(1000)
End Sub
でもつかえているんで
いいかな
IE internet explorer
posted by kiyo at 21:10| ブログ | このブログの読者になる | 更新情報をチェックする

2009年04月23日

Movable typeのインポートファイル

Movable typeや他のブログでも
インポートするときに

ItemのDictionaryにそれぞれの値を入力して

MTImportItem(Item)

とすると

インポートのフォーットで1記事分を返してくれます。 

Public Function MTImportItem(ByVal Item As Dictionary(Of String, String)) As String
        Dim Import As String
        Dim LF As String = Chr(10)

        Import = "AUTHOR: " & Item("Author") & LF
        Import &= "TITLE: " & Item("Title") & LF
        'Import &= "BASENAME: " & "post" & Item("No") & ".html" & LF
        Import &= "STATUS: " & Item("Status") & LF
        Import &= "CONVERT BREAKS: " & Item("Breaks") & LF
        Import &= "PRIMARY CATEGORY: " & Item("Category") & LF
        Import &= "DATE: " & Item("Date") & LF

        If Item("Tags").Length > 0 Then
            Import &= "TAGS: " & Item("Tags") & LF
        End If

        Import &= "-----" & LF
        Import &= "BODY:" & LF
        Import &= Item("Body") & LF
        Import &= "-----" & LF

        If Item("Extended").Length > 0 Then
            Import &= "EXTENDED BODY:" & LF
            Import &= Item("Extended") & LF
            Import &= "-----" & LF
        End If

        If Item("Excerpt").Length > 0 Then
            Import &= "EXCERPT:" & LF
            Import &= Item("Excerpt") & LF
            Import &= "-----" & LF
        End If

        If Item("Keywords").Length > 0 Then
            Import &= "KEYWORDS:" & LF
            Import &= Item("Keywords") & LF
            Import &= "-----" & LF
        End If

        If Item("Comment").Length > 0 Then
            Import &= "COMMENT:" & LF
            Import &= Item("Comment") & LF
            Import &= "-----" & LF
        End If
        Import &= "--------" & LF

        Return Import
    End Function

posted by kiyo at 20:45| ブログ | このブログの読者になる | 更新情報をチェックする

2009年04月07日

ブログ投稿ツール

VB2008で今までつくったものの中でも
今でも使っている、アフィリ用のブログ投稿ツールを

公開しました

URLは

http://www.affiliate-tool.com/

です。

これは

Yahooニュースからアクセスを引っ張ってくるために
無料ブログを使って

かんたんに複数のブログに投稿できるようにしたツールです。
公開から2週間くらいたったけど

なんと

予想を上回る現在約600人くらいのダウンロード

うれしいんだけど

ちゃんと動いているのかなあとかってとっても心配。

まだ、使っているツールはあるので
そのうち公開しようと思う。

やっぱり

使ってくれるひとがいると
うれしいなあ。
アフィリエイト
posted by kiyo at 22:00| VB2008で作成したツール | このブログの読者になる | 更新情報をチェックする

2009年01月13日

フォームのリサイズ(resize)

フォームの大きさを変更したときのコード





そして


フォームを最小化したら


タスクトレイにアイコンを表示して


フォーム自身は表示しないようにする








Private Sub FormResize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Resize


'FormResizeのときの動作





If Me.WindowState = FormWindowState.Minimized Then


Me.Visible = False


NotifyIcon1.Visible = True


Exit Sub


End If





SplitContainer3.Height = TabControl1.Height - 25


SplitContainer3.Width = TabControl1.Width - 8





TableLayoutPanel11.Height = SplitContainer3.Height - 60


TableLayoutPanel11.Width = SplitContainer3.Panel1.Width - 10





ListView1.Width = SplitContainer3.Panel1.Width - 10


ListView1.Height = (TableLayoutPanel11.Height - 70) / 2


ListView2.Width = SplitContainer3.Panel1.Width - 10


ListView2.Height = (TableLayoutPanel11.Height - 70) / 2





End Sub





そうとうはしょって書きましたが





タブコントロールを使っていて





フォームをリサイズしたときに


まず





タブコントロールのサイズを変更します








タブの中にSplitContainer3があって


それをまた変更します





その中のTableLayoutPanel11を変更





そして





TableLayoutPanel11の中の





Listview1


Listview2





のサイズも変更します

面倒ですが変更するものは


回りから内側に変更していけばエラーになりにくい

VB2008 resize

posted by kiyo at 21:34| フォーム | このブログの読者になる | 更新情報をチェックする

2009年01月08日

Livedoor にAtomでポスト

LivedoorにAtomで投稿するときのXML

カテゴリに前に書いたカテゴリを取得して
カテゴリの名前を入れれば
カテゴリを設定して投稿してくれます


Public Function AtomXML(ByVal Title As String, ByVal Body As String, ByVal Category As String)
        Dim XMLString As String

        XMLString = "<?xml version=""1.0"" encoding=""UTF-8""?>"
        XMLString &= "<entry xmlns=""http://purl.org/atom/ns#"" xmlns:dc=""http://purl.org/dc/elements/1.1/"">"
        XMLString &= "<title>" & Title & "</title>"
        XMLString &= "<dc:subject>" & Category & "</dc:subject>"
        XMLString &= "<content type=""text/html"" mode=""escaped"">"
        XMLString &= "<![CDATA[" & Body & "]]>"
        XMLString &= "</content>"
        XMLString &= "</entry>"

        Return XMLString
    End Function
posted by kiyo at 22:08| xml | このブログの読者になる | 更新情報をチェックする

2009年01月07日

Livedoor にカテゴリを設定して投稿する準備

Livedoor にカテゴリを設定して投稿する準備
LivedoorにVisual Basic2008からカテゴリを設定して投稿できるようにした。
投稿のURLと
設定してあるカテゴリを取得するURL
そしてアップロードするURL

エンドポイントっていうのかなあ
それを取得するには


http://cms.blog.livedoor.com/atom/

にAtomAPIで
こんな感じで
xml=atomget(username,password,endurl)
   Function atomget(ByVal username As String, ByVal password As String, ByVal endurl As String) As String

        'HTTP接続の作成
        Dim webreq As HttpWebRequest = CType(WebRequest.Create(endurl), HttpWebRequest)
        webreq.Method = "GET" 'GET指定
        webreq.UserAgent = "Blogposter" 'UA設定(ソフト名)

        'WSSE認証の作成
        Dim shasp As New System.Security.Cryptography.SHA1CryptoServiceProvider() 'SHA処理用
        Dim nowt As DateTime = DateTime.Now '現在の時間取得
        Dim tim As String = nowt.ToString("yyyy-MM-ddTHH:mm:ssZ") '文字列にする(2005-12-11T22:39:56Z)の形式
        Dim non As String = "inininininininininin" 'Nonce(WSSEに必須の20文字の文字列)
        Dim b64 As String = System.Convert.ToBase64String(shasp.ComputeHash(System.Text.Encoding.UTF8.GetBytes(non & tim & password))) 'NonceTimePasswordをSHA→Base64エンコード
        Dim ninsyou As String = "UsernameToken Username=""" & username & """, PasswordDigest=""" & b64 & """, Nonce=""" & System.Convert.ToBase64String(System.Text.Encoding.ASCII.GetBytes(non)) & """, Created=""" & tim & """" '認証文の完成
        webreq.Headers.Add("X-WSSE", ninsyou) 'HTTP接続に付ける

        'HTTP接続を実行
        Dim st As System.IO.Stream = webreq.GetResponse().GetResponseStream() '接続
        Dim sr As New System.IO.StreamReader(st, System.Text.Encoding.GetEncoding("UTF-8")) 'デコード
        Return sr.ReadToEnd() '応答を文字列化

    End Function


これで

以下のような
xmlが得られる

<?xml version="1.0" encoding="UTF-8"?>
<feed xmlns="http://purl.org/atom/ns#">
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.post" href="http://cms.blog.livedoor.com/atom/blog_id=123" title="テニス"/>
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.feed" href="http://cms.blog.livedoor.com/atom/blog_id=123" title="テニス"/>
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.categories" href="http://cms.blog.livedoor.com/atom/blog_id=123/svc=categories" title="テニス" />
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.upload" href="http://cms.blog.livedoor.com/atom/blog_id=123/svc=upload" title="テニス" />
</feed>

posted by kiyo at 21:56| xml | このブログの読者になる | 更新情報をチェックする

2008年11月21日

ファイル名に使えない文字を見つける

テキストボックスからなど文字を入力してもらい

それを(フォルダ)ディレクトリ名とかファイル名に用いる場合がある

ファイル名やフォルダ名には使えない文字がある
たとえば

: // ? | などはファイル名に使えない

これらはいちいちチェックすることは大変に面倒くさいことである


あるんだなあそんな関数が!

Path.GetInvalidFileNameChars()
に配列で、ファイル名に使えない文字が入っている

凄い

ということで

テキストを入力すると
使えない文字を返すというべたなFunction

最初に見つかった使えない文字を返します

  Public FunctionNotFileName(ByVal InputText As String) As String

        Dim invalidch As Char() = Path.GetInvalidFileNameChars()
        Dim ReturnText As String = ""
        For Each c As Char In invalidch

            If InStr(InputText, c) > 0 Then
                ReturnText = c
                Exit For
            End If

        Next
        Return ReturnText

    End Function
posted by kiyo at 20:54| VB2008の文字変換 | このブログの読者になる | 更新情報をチェックする