タグ:vbs ( 6 ) タグの人気記事

スクリプト少しだけ拡張しました

このエントリで、コマンドラインからHTMLコンテンツ取得するスクリプトについて書きましたが、wget.classに1つメソッドを追加してみました。注)正規表現のパターンのところがなぜかエキブロ投稿時にひっかかるために、タグの所は全角になってます。

Public Sub GetTitleElement()
Dim S1,S2
Set objRe = new RegExp
objRe.Pattern = "<title>Amazon.co.jp: (.+?)</title>
\n<link rel=""related"" type=""text/html"" href=""(.+?)"" />"
objRe.Global = True
objRe.ignoreCase = True
Set matches = objRe.Execute(my_htmlContents)
For Each match in matches
S1 = match.SubMatches(0)
S2 = match.SubMatches(1)
my_Title = S1 & S2 & vbCrLf
WScript.Echo my_Title
Next
End Sub

このクラスをつかったwsfファイルで
Dim objWget
Set objWget = New wget
objWget.CharCode = "UTF-8"
objWget.Fetch()
objWget.GetTitleElement()

として、コマンドラインで
cscript wget.wsf //nologo http://b.hatena.ne.jp/h5y1m141/atomfeed?tag=200701
と実行すると、私のはてブで[200701]という今月読んでいる(もしくは読んだ)本の情報が以下のように出力されます。

おまけより割引してほしい―値ごろ感の経済心理学: 本: 徳田 賢二http://www.amazon.co.jp/gp/product/448006334X

食糧テロリズム―多国籍企業はいかにして第三世界を飢えさせているか: 本: ヴァンダナシヴァ,Vandana Shiva,浦本 昌紀,金井塚 務,竹内 誠也http://www.amazon.co.jp/gp/product/475032454X

ヒューマン2.0: 本: 渡辺 千賀http://www.amazon.co.jp/gp/product/4022731222

マネーロンダリング入門―国際金融詐欺からテロ資金まで: 本: 橘 玲http://www.amazon.co.jp/gp/product/4344980093

カレーを作れる子は算数もできる: 本: 木幡 寛http://www.amazon.co.jp/gp/product/4061498630

脳を鍛える筋トレ PNFとはなにか: 本: 市川 繁之、鈴木 克憲、織田 淳太郎
http://www.amazon.co.jp/gp/product/4334033741

テレビはなぜ、つまらなくなったのか―スターで綴るメディア興亡史: 本: 金田 信一郎
http://www.amazon.co.jp/gp/product/4822201589

ユニクロvsしまむら—専門店2大巨頭圧勝の方程式: 本: 月泉 博http://www.amazon.co.jp/gp/product/4532313007

本当は、今回ついかしたメソッドは、wget.classに実装しないで、別途hatena.classのような奴をつくって、hatena.class はwget.class を継承するようなやり方にそのうちに変更していこうかと思います。

どうでもいいけど、このサイトをこの前知ったんだけど、VBScriptからSOAPClient オブジェクトつかうことで、SOAPをつかってアクセスするようなwebサービスも利用できるんだね。てっきりそういうのは、.NET じゃないとできないのかと思っていた・・
[PR]
by h5y1m141 | 2007-01-11 21:24

コマンドラインからHTMLコンテンツ取得するスクリプト

タイトルの通りなのですが、コマンドラインからHTMLコンテンツ取得するVBScript 作ったのですが、単につくるだけでは芸が無いのと、今後の拡張を考えて、wget というクラスを1つ作り、それを継承する形ではてなやアマゾンのwebサービス利用できるようなものを目指してにしていこうかと思っています。

で、作りかけだけど、wget クラスは以下のような感じに。
Class Wget
Private my_url
Private objHTTP
Private outputStream
Private html
Private ADTYPETEXT
Private ADTYPEBINARY
Private code
Private my_htmlContents 'HTMLのBody要素全体を格納
Private objRe

Private Sub Class_Initialize()
ADTYPETEXT = 2
ADTYPEBINARY = 1
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
Set outputStream = CreateObject("ADODB.Stream")
code = "Shift_JIS"
my_htmlContents = ""
End Sub

Property Let Url(address)
my_url = address
End Property

Property Let CharCode(str)
code = str
End Property

Public Sub Print()
WScript.Echo my_htmlContents
End Sub

Public Sub GetCommentElement()
Set objRe = new RegExp
objRe.Pattern = ""
objRe.Global = True
objRe.ignoreCase = True
Set matches = objRe.Execute(my_htmlContents)
End Sub

Public Sub Fetch()
' エキブロの仕様のため、下記のオープンは英語のOpenに置換して使ってください
Call objHTTP.オープン("GET",my_url,False)
objHTTP.Send()
html = objHTTP.responseBody

'ADODB.Streamを利用してHTMLコンテンツ取得
outputStream.Type = ADTYPEBINARY
outputStream.オープン()
outputStream.Write(html)
outputStream.Position = 0

outputStream.Type = ADTYPETEXT
outputStream.Charset = code
my_htmlContents = outputStream.ReadText()
outputStream.Close()
End Sub

End Class
で、このクラスをつかってwsfファイルを作成します。エキブロの仕様のため、一部のタグがつかえなかったりするので、必要と思われる所だけピックアップ

Dim objWget
Set objWget = New wget

Dim colArgs,tempData
Set colArgs = WScript.Arguments
If ChkArgs(colArgs) Then
objWget.url = colArgs(0)
Wscript.Echo "OK"
objWget.CharCode = "UTF-8"
objWget.Fetch()
objWget.Print
End if

Function ChkArgs(colArgs)
If colArgs.Count <>1 then
Wscript.StdErr.WriteLine("引数指定エラー")
ChkArgs = False
Wscript.Quit()
Else
ChkArgs = True
End if

End Function

Set objWget = Nothing
使うときには、コマンドラインで以下のように入力すれば、OK。
cscript wget.wsf //nologo http://b.hatena.ne.jp/h5y1m141/vbs/
[PR]
by h5y1m141 | 2007-01-07 20:11

iTunes のプレイリスト作成スクリプト

Windows Script ノスゝメというページにMP3自動更新プレイリストを作成するスクリプトがあったのですが、WMI つかえば、もう少しスマートにできそうな気がしたので、ちょっと書いてみました。

PC上のMP3とAVI ファイルを検索して、ファイル出力しますが、MP3だけでよいという場合には11行目の

& "Where Extension ='mp3' or Extension='avi'")



& "Where Extension ='mp3'")

と変更すればO.K.


==MakePlayList.vbs==
Option explicit
Dim strComputer
Dim objWMIService
Dim colFiles
Dim objFIle
Dim strPlayList
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("SELECT * FROM CIM_DataFile "_
& "Where Extension ='mp3' or Extension='avi'")

For Each objFIle in colFiles
strPlayList = strPlayList & objFile.Drive & _
objFile.Path & objFile.FileName & "." & _
objFile.Extension & vbCrLf
Next

' プレイリスト作成

Dim objFSO
Dim strNewFile
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set strNewFile = objFSO.CreateTextFile(".\PlayList.m3u", True)
strNewFile.Write(strPlayList)
strNewFile.Close
Set strNewFile = Nothing
==ここまで==
[PR]
by h5y1m141 | 2005-04-21 10:13 | 業界動向

電話ログシステムのvbs版

電話をかけるだけで、その音声がブログにアップされる「電話ログ」なるものを考え付いた方がいらっしゃるのだけど、ご本人が書かれているとおり、色々なものの組み合わせになっている。

電話からの入力はS Rec午後のこ~だに頼るけど、それ以外のPerl の処理とタスクスケジューラーの部分は、VBScript(と別途BASP21コンポーネント)だけで出来そうなきがするので、ちょろっと書いてみた。

手元にテスト利用可能なFTPサーバーなかったので、FTPのPutの処理があやしいかもしれないけど、たぶんこれで問題ない気がする。

==ここからUpToMoblog.vbs==
Option explicit
On Error Resume Next
Dim strComputer
Dim objWMIService
Dim colMonitoredEvents
Dim objLatestEvent

strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\cimv2")
If Err <>0 then
Wscript.Echo now & vbtab & "Can't connect tagetmachine."
Wscript.Quit
Else
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent " _
& "WITHIN 10 WHERE " _
& "Targetinstance ISA 'CIM_DirectoryContainsFile' and " _
& "TargetInstance.GroupComponent= " _
& "'Win32_Directory.Name=""c:\\\\temp""'")
Do

Set objLatestEvent = colMonitoredEvents.NextEvent
Wscript.Echo now & vbtab & objLatestEvent.TargetInstance.PartComponent
call UseFTP
call sendEmail
Loop
End if

Sub sendEmail

Dim objBobj
Dim strSvrname
Dim strMailTo
Dim strMailFrom
Dim strMailSubj
Dim strMailBody
Dim strMailAttachment
Dim Msg

Set objBobj = WScript.CreateObject("basp21")
strSvrname = "xxxx.xxxx.xxx.xxx"
strMailTo = "xxxx.xxxx.xxx.xxx"
strMailFrom = "xxxx.xxxx.xxx.xxx"
strMailSubj = "xxxx.xxxx.xxx.xxx"
strMailBody = "xxxx.xxxx.xxx.xxx"
strMailAttachment = "xxxx.xxxx.xxx.xxx"

msg = objBobj.SendMail(strSvrname,strMailTo,strMailFrom,strMailSubj,strMailBody,strMailAttachment)

End sub

Sub UseFTP

Dim objFTP
Dim strFTPSvrname
Dim strFTPloginuser
Dim strFTPloginpasswd
Dim rc

Set objFTP = CreateObject("basp21.FTP")
strFTPSvrname = "xxxx.xxxx.xxx.xxx"
strFTPloginuser = "xxxx.xxxx.xxx.xxx"
strFTPloginpasswd = "xxxx.xxxx.xxx.xxx"

rc = objFTP.Connect(strFTPSvrname,strFTPloginuser,strFTPloginpasswd)

If rc= 0 Then
objFTP.Command("pasv")
rc = objFTP.PutFile("C:\temp","html/images",1)
objFTP.Close
End if

End sub
==ここまでUpToMoblog.vbs==

ちなみに上記のスクリプトの"xxxx.xxxx.xxx.xxx" の箇所を適宜修正して
利用する必要がありますけど。

strSvrname:SMTPサーバーを指定
strMailTo:宛先のメールアドレスを指定
strMailFrom:送信者のメールアドレスを指定
strMailSubj:メールの題名を指定
strMailBody:メールの本文を指定
strMailAttachment:メールに添付するファイルを指定
strFTPSvrname:FTPサーバーを指定
strFTPloginuser:FTPサーバーへのログインIDを指定
strFTPloginpasswd:FTPサーバーへのログインパスワードを指定
[PR]
by h5y1m141 | 2005-04-18 14:45 | 業界動向

[メモ]スクリーンセーバーの設定変更するvbs

社内のPCのスクリーンセーバーの設定を一括で変更可能かどうか調べていたら、WMI経由でスクリーンセーバーのタイムアウトの設定を変更できそうなので、とりあえずメモ

How Can I Change the Screensaver Timeout Value?

[PR]
by h5y1m141 | 2005-03-23 14:27 | 業界動向

インストールされているアプリケーションをリストアップするvbs

今勤めている会社は、クライアントPCの数が1200台前後で、PCの入れ替え作業の際にそのPCにインストールされているアプリケーションが何だったのかを自動的に取得できるスクリプトを一生懸命考えたことがあり、昔に一度作ったのだがあまりきれいなやり方ではなかったので、最近勉強中のWMI 使ってうまくできないかなぁと思ったら、できた!

下記スクリプトの実行結果は、コントロールパネルのアプリケーションの追加と削除で表示される内容と一緒のはず。
Option Explicit

Dim strComputer
Dim refRegistry
Dim strKeyPath
Dim retval
Dim arrSubKeys
Dim SubKey
Dim strAppsName

strComputer = "."
Const HKEY_LOCAL_MACHINE = &H80000002

Set refRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")

strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"

retval = refRegistry.EnumKey (HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys)

For each SubKey in arrSubKeys
retval = refRegistry.GetStringValue (HKEY_LOCAL_MACHINE,strKeyPath & "\" &_
subkey, "DisplayName", strAppsName)
If strAppsName<>"" then
Wscript.Echo strAppsName
End if
Next
[PR]
by h5y1m141 | 2004-12-17 14:45 | 業界動向