Hatena::Groupbookstore

古都の微熱 RSSフィード

|

2012-02-02

memo

| 02:11 |  memo - 古都の微熱 を含むブックマーク はてなブックマーク -  memo - 古都の微熱  memo - 古都の微熱 のブックマークコメント

2012/02/02放送のアメトーーク "読書芸人" で露出した本 ISBN or ASIN付リスト
http://ingurimonguri.tumblr.com/post/16924060639/2012-02-02

ZaferZafer2012/02/19 07:00Mighty useful. Make no mistake, I appreicate it.

kt_kyotokt_kyoto2012/03/28 23:57スパムコメントに的確に褒められた複雑さ

FrankieFrankie2013/12/27 04:14Great intgihs! That's the answer we've been looking for.

AshleyAshley2013/12/27 12:58I might be <a href="http://uiioopj.com">betiang</a> a dead horse, but thank you for posting this!

ArmanArman2013/12/30 00:13Great arcilte, thank you again for writing. http://hrfblvi.com [url=http://exjyoeigbp.com]exjyoeigbp[/url] [link=http://kwlwqynfhks.com]kwlwqynfhks[/link]

2012-01-30

某社の社是

| 02:55 |  某社の社是 - 古都の微熱 を含むブックマーク はてなブックマーク -  某社の社是 - 古都の微熱  某社の社是 - 古都の微熱 のブックマークコメント

「世界中の情報を整理し、世界中の人々がアクセスできて使えるようにする」

http://www.google.co.jp/search?ie=UTF-8&q=%E4%B8%96%E7%95%8C%E4%B8%AD%E3%81%AE%E6%83%85%E5%A0%B1%E3%82%92%E6%95%B4%E7%90%86%E3%81%97%E3%80%81%E4%B8%96%E7%95%8C%E4%B8%AD%E3%81%AE%E4%BA%BA%E3%80%85%E3%81%8C%E3%82%A2%E3%82%AF%E3%82%BB%E3%82%B9%E3%81%A7%E3%81%8D%E3%81%A6%E4%BD%BF%E3%81%88%E3%82%8B%E3%82%88%E3%81%86%E3%81%AB%E3%81%99%E3%82%8B

書店で働いていると、顧客から発せられるあいまいな情報を Google を窓口にして Web にあたることが頻繁におこる。それで、もう「全然整理されてないしアクセスできるようになってないじゃん!」と思わされる。ちなみに、そもそも Web にあたることができない人も多い。そもそも最近整理されているのか? されてなくないか? 世界中の人々がアクセスできて使えるようになるどころか、Web は相変わらず構造化されないし、ソーシャルグラフはは収益化の対象物に落とし込まれているし、Perl の棚に面陳している Spidering Hacks といったスクレイピングの本が相変わらず売れる。「ややこしくて雑多な情報は整理せずにそのままにしておくのがそれはそれでいいんだろうなー」と思ったりもする。

MartinaMartina2012/06/05 18:49A minute saved is a minute eraend, and this saved hours!

xmuxdzggzuxmuxdzggzu2012/06/06 00:11TmPETv <a href="http://tuqxajrqntre.com/">tuqxajrqntre</a>

jrfanpdljrfanpdl2012/06/07 02:28B108vo , [url=http://gqekjscppvni.com/]gqekjscppvni[/url], [link=http://isnqvxdepavp.com/]isnqvxdepavp[/link], http://lgiobtzylsou.com/

qdsywlanuqdsywlanu2012/06/07 08:16t1IBC3 <a href="http://qplquxjaqckg.com/">qplquxjaqckg</a>

ydxbdujydxbduj2012/06/07 22:05MAg4YS , [url=http://kzbygxryzubi.com/]kzbygxryzubi[/url], [link=http://jcnwnefmggvl.com/]jcnwnefmggvl[/link], http://vdbfykrtxsly.com/

2012-01-28

Amazon Product Advertising API を Excel VBA で直接たたく

| 03:47 |  Amazon Product Advertising API を Excel VBA で直接たたく - 古都の微熱 を含むブックマーク はてなブックマーク -  Amazon Product Advertising API を Excel VBA で直接たたく - 古都の微熱  Amazon Product Advertising API を Excel VBA で直接たたく - 古都の微熱 のブックマークコメント

 *ツッコミ歓迎

電子署名が必須になってから、ただただしさんのAmazon-Auth-Proxy の存在を知り、家のサーバーに置いてそこを経由させたり、Product Advertising API用リバースプロキシを使っていたりしたけどやっぱり Excel だけで完結させたい。ああ昔はよかった。とか言ってないでがんばって Excel VBA で直接たたくことにする。例として

1列目にISBNを入れると、2列目にタイトル、3列目に著者、4列目に出版社、5列目に定価がでるシート

を作ってみる。処理の工夫としては、再帰的な Excel 関数としての実装はしない、入力や変更をワークシートにのっぺり監視させる。といったところ。まあ署名に必要な部分はほとんどコピペなわけですが...

VBE を起動し、標準モジュールを3つ作成し、Module1 に処理を書いていくことにします。

その前に署名作成のための下準備として以下をググってModule2 にコピペ

'Hmac-SHA256
'http://plus-sys.jugem.jp/?eid=215
Public Function Hmac(sKey, rawTextToSign As String) As String

Dim arKey() As Byte
Dim ipad As String
Dim opad As String
Dim buff() As Byte, offset As Integer

'初期化
    ipad = ""
    opad = ""
    hash = ""
    ReDim arKey(0 To 63)

'秘密鍵から1文字づつ読込み、文字コードへ変換後配列へ格納
    For i = 0 To Len(sKey) - 1
        arKey(i) = Asc(Mid(sKey, i + 1, 1))
    Next

'64文字に満たない分は、ゼロセット
    For i = Len(sKey) To 63
        arKey(i) = 0
    Next

'innerpad及びouterpad作成
    For i = 0 To 63
        ipad = ipad & Chr(arKey(i) Xor &H36)
        opad = opad & Chr(arKey(i) Xor &H5C)
    Next

'ハッシュ処理1回目
'(innerpad+メッセージ文字列)をハッシュ・・・ハッシュ結果1
    hash = CreateSHA256HashString(ipad & rawTextToSign)

'ハッシュ処理2回目
    buff = StrConv(opad, vbFromUnicode)
    offset = UBound(buff)
    ReDim Preserve buff(offset + Len(hash) \ 2)

    For i = 1 To (Len(hash) \ 2)
        buff(offset + i) = CByte("&H" & Mid(hash, (i - 1) * 2 + 1, 2))
    Next
    hash = CreateSHA256Hash(buff)
    Hmac = hash

End Function

Function StrHex(text As String) As String

Dim lCount As Long
Dim sResult As String
Dim lLength As Long

    lLength = Len(text)
    
    For lCount = 1 To lLength Step 2
        sResult = sResult & Chr(Val("&H" & Mid(text, lCount, 2)))
    Next
    
    StrHex = sResult

End Function

'URL エンコード
'http://www.geocities.co.jp/SilkRoad/4511/vb/urlenc.htm
Public Function UrlEncode(ByRef strSource As String) As String

 Dim lngLength As Long                                          '文字列のサイズ(S-JIS 変換後)を格納する
 Dim bytSource() As Byte                                        'ANSI/S-JIS に変換した文字列を格納するバイト型配列
 Dim strBuffer As String                                        'URL エンコードされた文字列を一時格納するバッファ
 Dim bytSingle As Byte                                          '配列から抜き出した 1 バイトを格納する
 Dim strSingleHex As String                                     '文字コードを 16 進化した文字列を格納する
 Dim lngReadCount As Long                                       'bytSource 読み込み位置カウンタ
 Dim lngWriteCount As Long                                      'strBuffer 書き込み位置カウンタ
 
    lngLength = LenB(StrConv(strSource, vbFromUnicode))         'ANSI/S-JIS 変換後のサイズを求める
    If Not CBool(lngLength) Then Exit Function                  '0 バイトの場合関数を抜ける
    ReDim bytSource(lngLength - 1)                              'ANSI/S-JIS 変換文字列を格納する領域を確保
    bytSource = StrConv(strSource, vbFromUnicode)               'ANSI/S-JIS に変換し bytSource に格納
    
    strBuffer = String$(lngLength * 3, vbNullChar)              'URL エンコード文字列一時格納バッファを確保
    strSingleHex = "%00"                                        '16 進化した文字コードを格納するバッファを確保
    lngWriteCount = 1                                           '書き込みカウンタは 1 から開始
    
    Do                                                          '文字列の終端までループ
        bytSingle = bytSource(lngReadCount)                     '配列から 1 バイト抜く(毎回参照するより速い?)
        If ((bytSingle >= &H81) And (bytSingle <= &H9F)) Or _
           ((bytSingle >= &HE0) And (bytSingle <= &HEF)) Then   'Shift-JIS 2 バイト文字と確認された場合
            Mid(strSingleHex, 2, 2) = Hex$(bytSingle)           '文字コードを 16 進数に変換(上位バイト)
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
            If lngReadCount = lngLength Then Exit Do            '文字列の終端に達した場合、ループを抜ける
            bytSingle = bytSource(lngReadCount)                 '配列から 1 バイト抜く
            Mid(strSingleHex, 2, 2) = Hex$(bytSingle)           '文字コードを 16 進数に変換(下位バイト)
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
        ElseIf bytSingle = &H20 Then                            '半角スペース文字(" ")の場合
            Mid(strBuffer, lngWriteCount, 1) = "+"              '"+" を代わりに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 1                   '書き込みカウンタを 1 増やす
        ElseIf ((bytSingle >= &H40) And (bytSingle <= &H5A)) Or _
               ((bytSingle >= &H61) And (bytSingle <= &H7A)) Or _
               ((bytSingle >= &H30) And (bytSingle <= &H39)) Or _
               (bytSingle = &H2A) Or _
               (bytSingle = &H2D) Or _
               (bytSingle = &H2E) Or _
               (bytSingle = &H5F) Then                          '無変換文字であった場合
            Mid(strBuffer, lngWriteCount, 1) = Chr$(bytSingle)  '文字コードを文字列に戻して書き込む(^^;
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 1                   '書き込みカウンタを 1 増やす
        Else                                                    'その他の文字の場合
            If bytSingle <= &HF Then                            'Hex$() の結果が 1 文字になる場合
                Mid(strSingleHex, 2, 1) = "0"                   '0 を先頭に付加
                Mid(strSingleHex, 3, 1) = Hex$(bytSingle)       '文字コードを 16 進数に変換
            Else                                                '0 を付加する必要がない場合
                Mid(strSingleHex, 2, 2) = Hex$(bytSingle)       '文字コードを 16 進数に変換
            End If
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
        End If
    Loop Until lngReadCount = lngLength

    Erase bytSource                                             'バイト型配列を消去
    
    If lngWriteCount > 1 Then                                   'バッファに文字列が書き込まれた場合
        UrlEncode = Left$(strBuffer, lngWriteCount - 1)         'バッファの余分な部分を削り、戻り値とする
    End If

End Function

Public Function HEX2BIN(ByVal hx As String) As String
    Dim num As Long
    Dim bin As String
    Dim i As Integer
    num = CLng("&H" & hx)
        For i = Len(hx) * 4 - 1 To 0 Step -1
            bin = bin & -CInt((num And (2 ^ i)) <> 0)
        Next
    HEX2BIN = bin
End Function


'n進数の文字列strNumberを10進数の数字に変換して返す
'http://www5d.biglobe.ne.jp/~tomoya03/shtml/algorithm/Convert.htm
Public Function ncdec(ByVal n As Long, ByVal strNumber As String) As Long

    Dim lngt As Long
    Dim c As Long
    Dim i As Long
    lngt = 0&
    c = 1&
    For i = 1& To Len(strNumber)
        lngt = lngt + subncdec(Left$(Right$(strNumber, i), 1)) * c
        c = c * n
    Next i
    ncdec = lngt

End Function

Public Function subncdec(ByVal b As String) As Long
    
    Dim r As Long
    r = Asc(UCase(b))
    If r > 64& Then
        subncdec = r - 55&
    Else
        subncdec = CLng(b)
    End If
    
End Function

Module3 にも以下をググってコピペ

'advapi32.dll
'http://su-u.jp/juju/%B5%A4%A4%DE%A4%B0%A4%EC%C6%FC%B5%AD/2007-03-08.html
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
                            (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _
                             ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" _
                            (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" _
                            (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, _
                             ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" _
                            (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" _
                            (ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" _
                            (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, _
                             ByVal dwFlags As Long) As Long

Private Const PROV_RSA_FULL   As Long = 1
Private Const PROV_RSA_AES    As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000

Private Const HP_HASHVAL      As Long = 2
Private Const HP_HASHSIZE     As Long = 4

Private Const ALG_TYPE_ANY    As Long = 0
Private Const ALG_CLASS_HASH  As Long = 32768

Private Const ALG_SID_MD2     As Long = 1
Private Const ALG_SID_MD4     As Long = 2
Private Const ALG_SID_MD5     As Long = 3
Private Const ALG_SID_SHA     As Long = 4
Private Const ALG_SID_SHA_256 As Long = 12
Private Const ALG_SID_SHA_384 As Long = 13
Private Const ALG_SID_SHA_512 As Long = 14

Private Const CALG_MD2        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
Private Const CALG_MD4        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
Private Const CALG_MD5        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const CALG_SHA        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const CALG_SHA_256    As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
Private Const CALG_SHA_384    As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
Private Const CALG_SHA_512    As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)

' Create Hash
Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As String
    Dim hProv As Long, hHash As Long
    Dim abytHash(0 To 63) As Byte
    Dim lngLength As Long
    Dim lngResult As Long
    Dim strHash As String
    Dim i As Long
    strHash = ""
    If CryptAcquireContext(hProv, vbNullString, vbNullString, _
                           IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), _
                           CRYPT_VERIFYCONTEXT) <> 0& Then
        If CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) <> 0& Then
            lngLength = UBound(abytData()) - LBound(abytData()) + 1
            If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&) _
                             Else lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&)
            If lngResult <> 0& Then
                lngLength = UBound(abytHash()) - LBound(abytHash()) + 1
                If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, 0&) <> 0& Then
                    For i = 0 To lngLength - 1
                        strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2)
                    Next
                End If
            End If
            CryptDestroyHash hHash
        End If
        CryptReleaseContext hProv, 0&
    End If
    CreateHash = LCase$(strHash)
End Function

' Create Hash From String(Shift_JIS)
Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String
    CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID)
End Function

' Create Hash From File
Private Function CreateHashFile(ByVal strFileName As String, ByVal lngAlgID As Long) As String
    Dim abytData() As Byte
    Dim intFile As Integer
    Dim lngError As Long
    On Error Resume Next
        If Len(Dir(strFileName)) > 0 Then
            intFile = FreeFile
            Open strFileName For Binary Access Read Shared As #intFile
            abytData() = InputB(LOF(intFile), #intFile)
            Close #intFile
        End If
        lngError = Err.Number
    On Error GoTo 0
    If lngError = 0 Then CreateHashFile = CreateHash(abytData(), lngAlgID) _
                    Else CreateHashFile = ""
End Function

' MD5
Public Function CreateMD5Hash(abytData() As Byte) As String
    CreateMD5Hash = CreateHash(abytData(), CALG_MD5)
End Function
Public Function CreateMD5HashString(ByVal strData As String) As String
    CreateMD5HashString = CreateHashString(strData, CALG_MD5)
End Function
Public Function CreateMD5HashFile(ByVal strFileName As String) As String
    CreateMD5HashFile = CreateHashFile(strFileName, CALG_MD5)
End Function

' SHA-1
Public Function CreateSHA1Hash(abytData() As Byte) As String
    CreateSHA1Hash = CreateHash(abytData(), CALG_SHA)
End Function
Public Function CreateSHA1HashString(ByVal strData As String) As String
    CreateSHA1HashString = CreateHashString(strData, CALG_SHA)
End Function
Public Function CreateSHA1HashFile(ByVal strFileName As String) As String
    CreateSHA1HashFile = CreateHashFile(strFileName, CALG_SHA)
End Function

' SHA-256
Public Function CreateSHA256Hash(abytData() As Byte) As String
    CreateSHA256Hash = CreateHash(abytData(), CALG_SHA_256)
End Function
Public Function CreateSHA256HashString(ByVal strData As String) As String
    CreateSHA256HashString = CreateHashString(strData, CALG_SHA_256)
End Function
Public Function CreateSHA256HashFile(ByVal strFileName As String) As String
    CreateSHA256HashFile = CreateHashFile(strFileName, CALG_SHA_256)
End Function

' SHA-384
Public Function CreateSHA384Hash(abytData() As Byte) As String
    CreateSHA384Hash = CreateHash(abytData(), CALG_SHA_384)
End Function
Public Function CreateSHA384HashString(ByVal strData As String) As String
    CreateSHA384HashString = CreateHashString(strData, CALG_SHA_384)
End Function
Public Function CreateSHA384HashFile(ByVal strFileName As String) As String
    CreateSHA384HashFile = CreateHashFile(strFileName, CALG_SHA_384)
End Function

' SHA-512
Public Function CreateSHA512Hash(abytData() As Byte) As String
    CreateSHA512Hash = CreateHash(abytData(), CALG_SHA_512)
End Function
Public Function CreateSHA512HashString(ByVal strData As String) As String
    CreateSHA512HashString = CreateHashString(strData, CALG_SHA_512)
End Function
Public Function CreateSHA512HashFile(ByVal strFileName As String) As String
    CreateSHA512HashFile = CreateHashFile(strFileName, CALG_SHA_512)
End Function

下準備は以上。まず Excel Objects の Sheet に以下の通り書く。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    GetBookInfoFromAmazon
End Sub

あとは Module1 に GetBookInfoFromAmazon の処理を書いていく。


Dim KeyId As String
Dim sKey, AWSKeyId As String
Dim isbn As String
Dim ecsaddress As String
Dim associateid, AssociateID22, AssociateID20, APIVersion As String

Dim ISBNCol, ISBNRowIndex, TitleCol, AuthorCol, PublisherCol, PriceCol As Integer

Dim timestamp As String

Dim base64Array As Variant
Dim URI As String
Dim xml, itemAttributes As Object

Public Sub GetBookInfoFromAmazon()

''API初期設定
'Amazon Product Advertising API KeyID & SecretKey etc
AWSKeyId = "********************"
sKey = "*************************************"

'Associate ID
AssociateID22 = "********-22"
AssociateID20 = "********-20"

'APIVersion
APIVersion = "2011-08-11"

''シート初期設定
'ISBN入力列
ISBNCol = 1

'ISBN のスタート行
ISBNRowIndex = 1

'タイトル列
TitleCol = 2

''列初期設定 不要な場合は 0 にしておく
'著者列
AuthorCol = 3

'出版社列
PublisherCol = 4

'価格列
PriceCol = 5



'書誌情報取得
'ISBN 行が空になったら終了
While ActiveSheet.Cells(ISBNRowIndex, ISBNCol) <> ""
     
     'ISBN
     isbn = ActiveSheet.Cells(ISBNRowIndex, ISBNCol)
     
     'タイトル列が空欄であれば取得に向かう
     If Not ActiveSheet.Cells(ISBNRowIndex, TitleCol) <> "" Then
        
        '署名作成に使うタイムスタンプ
        timestamp = Format(Date, "yyyy-mm-dd") & "T" & Format(CDate(DateAdd("h", -9, Time)), "hh%3AMM%3Ass") & "Z"

        'JP
        If isbn Like "9784*" Then
            ecsaddress = "ecs.amazonaws.jp"
            associateid = AssociateID22
        ElseIf isbn Like "4*" Then
            ecsaddress = "ecs.amazonaws.jp"
            associateid = AssociateID22
        'US
        ElseIf isbn Like "9780*" Then
            ecsaddress = "ecs.amazonaws.com"
            associateid = AssociateID20
        ElseIf isbn Like "0*" Then
            ecsaddress = "ecs.amazonaws.fr"
            associateid = AssociateID22
        'FR
        ElseIf isbn Like "9782*" Then
            ecsaddress = "ecs.amazonaws.fr"
            associateid = AssociateID22
        ElseIf isbn Like "2*" Then
            ecsaddress = "ecs.amazonaws.fr"
            associateid = AssociateID22
        'UK
        ElseIf isbn Like "9781*" Then
            ecsaddress = "ecs.amazonaws.co.uk"
            associateid = AssociateID22
        ElseIf isbn Like "1*" Then
            ecsaddress = "ecs.amazonaws.co.uk"
            associateid = AssociateID22
        End If
        
        Dim rawText, rawTextToSign As String
        Dim hash, hash_2, hash_cut2, hash_10, hash_cut10 As String
        
        rawText = "AWSAccessKeyId=" & AWSKeyId & "&AssociateTag=" & associateid & "&IdType=ISBN&ItemId=" & isbn & "&Operation=ItemLookup&ResponseGroup=Request%2CLarge&SearchIndex=Books&Service=AWSECommerceService&Timestamp=" & timestamp & "&Version=" & APIVersion
        rawTextToSign = "GET" & vbLf & ecsaddress & vbLf & "/onca/xml" & vbLf & rawText
        hash = Hmac(sKey, rawTextToSign)
         
        '2進数に変換
        Dim k As Integer
        For k = 1 To 64 Step 2
            hash_cut2 = Mid(hash, k, 2)
            hash_2 = hash_2 & HEX2BIN(hash_cut2)
        Next
         
        '不足が出るので00で埋める
        hash_2 = hash_2 & "00"
          
        'BASE64エンコード
        Dim sign As String
        For k = 1 To 256 Step 6
            hash_cut10 = Mid(hash_2, k, 6)
            hash_10 = ncdec(2, hash_cut10)
            base64Array = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "+", "/")
            sign = sign & base64Array(hash_10)
        Next
         
        '不足が出るので=で埋める
        sign = sign & "="
        
        'URLエンコード
        sign = UrlEncode(sign)
        URI = "http://" & ecsaddress & "/onca/xml?" & rawText & "&Signature=" & sign
        
        'XML オブジェクト作成
        Set xml = CreateObject("Microsoft.XMLDOM")
            xml.async = False
            xml.Load URI
        Set itemAttributes = xml.selectSingleNode("ItemLookupResponse/Items/Item/ItemAttributes")
        
        
        '取得失敗の場合は最後に手入力させる由
        If itemAttributes Is Nothing Then
            MsgBox ("書誌情報が見つかりませんでした。ISBNを確認の上もう一度入力してください。再度このエラーが出た場合はお手数ですが最後に手入力してください。")
            ActiveSheet.Cells(ISBNRowIndex, ISBNCol) = ""
            Cells(ISBNRowIndex, ISBNCol).Select
        
        '取得成功
        Else

        'タイトル
        If Not TitleCol = 0 Then
            Dim title As String
            title = itemAttributes.selectSingleNode("Title").text
            ActiveSheet.Cells(ISBNRowIndex, TitleCol) = title
        End If

        '著者
        If Not AuthorCol = 0 Then
            Dim authorText As String
            Dim Author As Object
            Dim j As Integer
            authorText = ""
            Set Author = itemAttributes.selectNodes("Author")
                For j = 0 To Author.Length - 1
                  authorText = authorText & Author(j).text & " "
                  If j <> Author.Length - 1 Then
                      authorText = authorText & ""
                  End If
                Next
            ActiveSheet.Cells(ISBNRowIndex, AuthorCol) = authorText
        End If
        
        '出版社
        If Not PublisherCol = 0 Then
            ActiveSheet.Cells(ISBNRowIndex, PublisherCol) = itemAttributes.selectSingleNode("Publisher").text
        End If
        
        '定価
        If Not PriceCol = 0 Then
            Dim teika As Integer
                teika = 0
                teika = itemAttributes.selectSingleNode("ListPrice/Amount").text
                ActiveSheet.Cells(ISBNRowIndex, PriceCol) = teika
        End If
           
       End If
   
    Else
     
    '次の行を処理するためにインクリメント
    ISBNRowIndex = ISBNRowIndex + 1
       
    End If

Wend
    
End Sub

結果


べんりー

この処理を覚えるといろいろ応用が利きます。たとえば見積書とか納品書とか明細書とか。

べんりー

ちなみに私は日々の補充注文書に使っています。ISBN 入れると FAX 番号まで入った注文書ができます。


べんりー

これは紙に印刷することなく LAN 経由でこのまま FAX しているので完全ペーパーレスです。ペーパーレスオフィスは神話じゃなかった。世の書店員は出版社一覧や電話帳をめくってしこしこ手書き FAX するような暇があったらもっと棚整理とか家族サービスすればいいのに、と強く思います。

閑話休題


版元名から FAX 番号が引けるような WebAPI は存在しないので、上記のようにあらかじめ登録が必要な、かなり泥臭い実装なわけですが...きくところによるとメイン帳合の電話帳が今度改訂されるらしいので生データでもらえないか交渉してみたい。

このシートは最初リーマンショックのころに勤務時間が激減した昼勤務の午前に自宅で暇を持て余して作っていたものでもう 3 年ぐらい使っていて、出張先でも使っているしなんというかもはやすっかり手になじんだ大切な仕事道具となってしまった。昔の書店員が愛着を持っていた、自前のスリップ箱みたいなものか?(違うか)

当時は仕事中に仕事ツールを開発できる人がうらやましいと思っていたものですが、今はそうでもない。

激減した同期らとはぜひこういう話をしたかった。いやしたくなかったのか。まあこういうのは一人でやるに限る。

yaboyabo2013/10/05 13:03貴重なコード公開、ありがとうございます。
ただし、複数のISBNを扱うと、
二つ目以降では誤ったSignatureが作成されエラーとなるようです。
文字列の連結の取扱いに何か間違いがあるのではないでしょうか。

kt_kyotokt_kyoto2013/11/04 14:15>yabo
もうこのコードは使っていないしご指摘の箇所を検証する暇もないのですがその後どんなもんでしょうか

RafaelRafael2013/12/12 16:06Stay with this guys, you're henpilg a lot of people.

SuasieSuasie2013/12/13 21:14So excited I found this article as it made things much <a href="http://dnizvvrmg.com">quecikr!</a>

JefersonJeferson2013/12/15 05:16Great aritcle, thank you again for writing. http://sbcsrdejrwz.com [url=http://mcaljvqsyg.com]mcaljvqsyg[/url] [link=http://uozkxt.com]uozkxt[/link]

ErnaneErnane2013/12/15 12:22This is just the <a href="http://xwltrwuks.com">pecreft</a> answer for all forum members

MaryjoyMaryjoy2013/12/17 23:02Super inoaimftrve writing; keep it up. http://mxwnlalztw.com [url=http://pmtuosqnu.com]pmtuosqnu[/url] [link=http://fgageil.com]fgageil[/link]

FathiFathi2013/12/18 04:50Do you have more great artelcis like this one?

2012-01-27

コンサルじゃなくてNPO的な

| 02:11 |  コンサルじゃなくてNPO的な - 古都の微熱 を含むブックマーク はてなブックマーク -  コンサルじゃなくてNPO的な - 古都の微熱  コンサルじゃなくてNPO的な - 古都の微熱 のブックマークコメント

雇われ書店員が本業の一環としてやるにはつらい仕事の一つとして「購入代行」がある。これは「雇われ先の社割をつかってお友達のために小賢しく安く本を代理購入する」のそれではなくて、ごくごく一般的な接客中にありがちな「あーその本品切重版未定ですねー取り寄せもできませんねー(ってなんだ AMP で星の数ほどに出品されてるじゃん)」の「って AMP で星の数ほどに出品されてるじゃん」と心に浮かんだ明らかにその顧客にとってみれば有益な情報をふと魔が差してカジュアルに実際に伝えてみたら「あーそっかーいやー本当は新刊で欲しいんだけどねーでも絶版なら仕方ないかーうんありがとう家で発注するわ」とならずに「いやーインターネットとか苦手でやらないからわからないんじゃよ」とのたまうデジタルディバイドの溝にはまった大人にかわって「そんなもん私が代理購入してあげますよ!」と強く強く思わされる時のそれである。まさか雇われ書店員、それも AMP にいたってはそこにいる空売り業者や転売屋のやりかたを実際に快く思っていなかったり、また快く思わないでいることが望ましいような立場にあるようなチェーンストアの雇われ書店員が、いくら「どうしても欲しい顧客のニーズ」を考えたところでまさかそこで実際に AMP で代理購入してあげるというのはありえない話である。そもそもとしてそれをできる器用な書店員がいないだろうし、いたとしてもお墨付きをもらって実際そのようなことを「やりましょう」としてはじめようとするときっとアルバイトだらけのチェーンストアにおける「サービス標準化の壁」にぶち当たって1分以内に轟沈することは目に見えている。まあそのようなときはゲリラ的にやればいいのだろうけど、「AMP で代理購入」ともなるとそれは雇われ書店員ができるゲリラ活動の範疇を超えている。「商売じゃないそれは慈善事業だ」「それをやって書店に利益は出ない」といった反証を上げるまでもなく、そのあり得なさ具合はたとえば Amazonオンライン書店発のリアル書店をつくってそこにまともな書店員を置き「顧客の読みたい本をなんとしてでも用意してあげる」という方針でも掲げてそこにいる書店員に好きなように接客をやらせた結果「かれらこそが自社の AMP も活用しまくってこれまでのリアル書店にはなかったすばらしい小売サービスを提供してくれました」という未来が訪れた、というぐらいにあり得ない話だ。Amazon は、本ではなくて Kindle を売ることにしたのだ。 まああの手の情報端末とそこを流れる情報とその共有の仕組みとともにもっと世界に偏在しないと意味がないし、そこに実現される UI/UX こそがいまここにある、見渡せば世の中にぼこぼこあいているデジタルディバイドを埋めるものでないとまるで意味がない、ということはこれから何度も書いていきたいことだけど、重要なのは、リアル書店リアル書店で存続している間には少なくともそのような情報共有のイノベーションはまずもっておこらないだろうから、話を戻すと、リアル接客の機会が豊富なリアル書店にこそ自社の Web にせめて絶版本や品切本だけでもいいのでそれらのやり取りを可能にする AMP ライクな仕組みを持ってもらって、またそこで働く書店員はそれが接客のいちツールとしてとても有効なものだと認識して、「代理購入」の可能性も含めてそれをさらに活用できるような存在であってほしいということだ。

ポイントは、ガチ司書のように本の中身の照会も含めたリファレンス機能はいらない、「世に偏在する品切/絶版の不要本を融通する仕組み」とそれを「リアル書店という窓口」で「接客の一環」として「代理購入」にあたる行動をもとることができる存在としての書店員がはたして実際に存在しうるのかというところで、落としどころとしては人生に余裕のある司書書店員やその OB/OG たちが NPO としてあるいは慈善事業としてまた趣味でやるようなことになればいいのだろうとそのようなことを考えている。

2012-01-22

memo

| 02:11 |  memo - 古都の微熱 を含むブックマーク はてなブックマーク -  memo - 古都の微熱  memo - 古都の微熱 のブックマークコメント

2012/01/22 放送の情熱大陸で映っていた長友佑都の本棚 ISBN付リスト
http://ingurimonguri.tumblr.com/post/16294379507/2012-01-22

http://ingurimonguri.tumblr.com/post/16294379507/2012-01-22

|