マイケルジャクソン急死真相暴露　怠慢警官・公務員のハレンチ行為紹介

キーワードサーチ

▼キーワード検索

プロフィール

AKB48激安放出中握手権CDDVD写真集てんこ盛り

フォローする

カレンダー

楽天カード

お気に入りブログ

ほぼ週間!!くいしん… くいしんぼ〜さん
????? オヤじぃさん

コメント新着

ヤフオクからきたけど@ Re:Yahooオークション落札、こんなハレンチ出品者がまだいた(03/06) このフォームのどこがハレンチなんだろう …

ミュウミュウ財布@ tomdwok@gmail.com 突然訪問します失礼しました。あなたのブ…

ヴィトン通販@ efmfnzclws@gmail.com 今日は　よろしくお願いしますね^^すごい…

ヴィトンコピー@ jqgghwgag@gmail.com 突然訪問します失礼しました。あなたのブ…

ボッテガ財布@ ddxabohuu@gmail.com こんにちは、またブログ覗かせていただき…

フリーページ

2010.09.01

twitter APIでツイッターあるキーワードで発言を検索その発言者一括フォローのスクリプト作りましたVBSソースもあるよ

テーマ：英語のお勉強日記(8438)

カテゴリ：カテゴリ未分類

Dim objIE0,sIe
dim xml,doc,BaseURL
Set doc = CreateObject("Microsoft.XMLDOM")
Dim s,u(4000),nn(4000),e(99)
Set Fs = WScript.CreateObject("Scripting.FileSystemObject")
Set rankHtm = Fs.OpenTextFile("twittCeleb.htm",1)
Set objIEx = CreateObject("InternetExplorer.application")
objIEx.Navigate "about:blank"
Do While objIEx.Busy

Loop
objIEx.Width=600
objIEx.Height=500
objIEx.Visible = true
objIEx.StatusBar = True
objIEx.StatusText = t_date & " htm作成中"
objIEx.ToolBar = false
objIEx.MenuBar = false
objIEx.Document.Write "検索キー:<input name=q size=20><br>"
objIEx.Document.Write "検索:<input name=start type=checkbox>"
objIEx.Document.Write "終了:<input name=end type=checkbox><br>"

'Set xml = CreateObject("MSXML2.XMLHTTP")
Set xml = CreateObject("WinHttp.WinHttpRequest.5.1")
tUsername = "" 'Range("tusername")
tPassword = "" 'Range("tpasswd")
endd=false

Do
WScript.Sleep 100
if objIEx.Document.all.start.checked=true then exit do
if objIEx.Document.all.end.checked=true then
endd=true
exit do
end if
Loop
if endd=true then exit do
objIEx.Document.all.start.checked=false
qq=objIEx.Document.all.q.value
objIEx.Document.Write "search key=" & qq & "<br>"

q_utf8=""
for i= 1 to len(qq)
zz=SJIStoUTF8(mid(qq,i))
'if i>1 then
' zz=right(zz,len(zz)-1)
'end if
q_utf8=q_utf8 & zz
next
objIEx.Document.Write "utf8 key=" & q_utf8 & "<br>"
xml.Open "POST", "http://search.twitter.com/search.json?q=" & q_utf8, "false", tUsername, tPassword
xml.setRequestHeader "Content-Type", "content=text/html; charset=unicode" 'shift-jis"
xml.send
tResult = xml.responsetext 'you can view Twitter’s response in debug window
Set oTs2 = Fs.OpenTextFile("q\" & qq & ".txt",2,true)
oTs2.writeline xml.responsetext
oTs2.close
moto=xml.responseText
do
id=strmid(moto,"""id"":",",")
if id="" then exit do
objIEx.Document.Write "id=" & id & ":"
xml.Open "POST", "http://api.twitter.com/1/friendships/create/" & id & ".xml", "false", tUsername, tPassword
xml.setRequestHeader "Content-Type", "content=text/html; charset=unicode" 'shift-jis"
xml.send
tResult = xml.responsetext 'you can view Twitter’s response in debug window
doc.loadXML (xml.responseText)
If instr(doc.documentElement.selectSingleNode("error").nodeTypedValue,"not")>0 Then
msg = doc.documentElement.selectSingleNode("error").nodeTypedValue
objIEx.Document.write "エラー:" + "[" + msg + "]"
else
objIEx.Document.write "created"
end if
objIEx.Document.write "<br>"
loop
doc.loadXML (xml.responseText)
' objIEx.Document.Write doc.documentElement.selectSingleNode("error").nodeTypedValue
'if instr(doc.documentElement.selectSingleNode("error").nodeTypedValue,"not")>0 then
' exit for
'end if

' objIEx.Document.Write "<br>"
loop
objIEx.Document.Write "done"
Set xml = Nothing
Function strmid(org,mae,usiro)
pos = InStr(org, mae)
If pos > 0 Then
strmid = Right(org, Len(org) - pos - Len(mae) + 1)
org = strmid
pos = InStr(strmid, usiro)
If usiro = "" Then
' strmid = ""
Else
If pos > 0 Then
strmid = Left(strmid, pos - 1)
End If
End If
Else
strmid = ""
End If
End Function
Function SJIStoUTF8(strSJIS)

strUNICODE = ASCW(strSJIS) 'ASCWでユニコードにする

'コードを２進にしてワークに代入する
strWORK2 = HEX16toSTR2(HEX(strUNICODE))

'切り取って、UTF8の２進数を作成する
'xxxx xxxx xxxx xxxx を下記に割り当てる
'1110xxxx 10xxxxxx 10xxxxxx
strUTF8CODE = "1110" & Mid(strWORK2, 1, 4)
strUTF8CODE = strUTF8CODE & "10" & Mid(strWORK2, 5, 6)
strUTF8CODE = strUTF8CODE & "10" & Mid(strWORK2, 11, 6)

'作成した２進数を１６進数に戻す
strWORK16 = STR2toHEX16(strUTF8CODE)

'%を付けて格納
strRET = "" 'リターン値を初期化
strRET = strRET & "%" & Mid(strWORK16, 1, 2) '%を付けた文字列を作成
strRET = strRET & "%" & Mid(strWORK16, 3, 2)
strRET = strRET & "%" & Mid(strWORK16, 5, 2)

'リターン値を代入
SJIStoUTF8 = strRET

End Function
'HEX16進文字列を受け取り2進数文字列を返す
Function HEX16toSTR2(strHEX)

Dim n 'ループカウンタ
Dim i 'ループのカウンタ
Dim n8421 '8 4 2 1の数値計算用
Dim str2STR

Dim nCHK

str2STR = "" '結果のエリアを初期化する

'文字数分ループする
For n = 1 To Len(strHEX)
On Error Resume Next 'エラー発生時次の行へ
nCHK = 0 '0で初期化
nCHK = CInt("&h" & Mid(strHEX, n, 1)) 'n文字目を数値変換
On Error Goto 0 'エラー処理を通常に戻す

n8421 = 8 '初期値に８を代入する(上からチェックしたいので)
For i = 1 To 4 '４回まわるよ
If (nCHK And n8421) = 0 Then 'Andでビットをチェックする
str2STR = str2STR & "0" 'ビットは立ってないよ
Else
str2STR = str2STR & "1" 'ビットは立ってるよ
End If
'次のビットをチェックしたいので２で割る
n8421 = n8421 / 2
Next
Next

'リターン値をセットして終了
HEX16toSTR2 = str2STR

End Function

'2進文字列を受け取り16進文字列を返す
Function STR2toHEX16(str2)

Dim strHEX
Dim n 'ループカウンタ
Dim i 'ループのカウンタ
Dim n8421 '8 4 2 1の数値計算用
Dim nBYTE

'頭４文字単位かチェックする
n = Len(str2) Mod 4 '足りない文字数を計算する
If n <> 0 Then
str2 = String(4 - n, "0") & str2 '頭に文字０を追加する
End If

strHEX = "" '結果のエリアを初期化する

'文字数分ループする
For n = 1 To Len(str2) Step 4 '４文字(1バイト)単位にループを作る
n8421 = 8 '初期値に８を代入する(上から計算したいので)
nBYTE = 0 '1バイト計算用変数を初期化
For i = 0 To 3 '４回まわるよ(4ビット分)
'ビットが立っているかチェックする
If Mid(str2, n + i, 1) = "1" Then
nBYTE = nBYTE + n8421 'ビットに対応した数値を＋する
End If
'次のビットを計算したいので２で割る
n8421 = n8421 / 2
Next
'計算して、１倍との数値が完成したので１６進文字にしてセットする
strHEX = strHEX & Hex(nBYTE)
Next

'リターン値をセットして関数を抜ける
STR2toHEX16 = strHEX

End Function

お気に入りの記事を「いいね！」で応援しよう