|
|
WSH(VBScript)を使い、(仮称)十進BASICの機能強化を試みる
VBスクリプトをEXECUTE文で実行。引数をWITH句に渡す。
その実行結果(戻値)を、標準入出力からは受け取れないようなので、
一旦ファイルに落としてから、それを読み込むことで結果を受け取ることにした。
その為、ループ内での使用には不向きです。
なお、スクリプトに関する知識は持ち合わせていないので、ネット上のサンプルを
参考(借用?)にした。また、エラー処理等はしていません。
スクリプト、作業ファイル等のPATH、ファイル名を指定、変更してください。
詳しくはネット上より検索してください。(リンクは、ほんの一部です)
WSH
http://wsh.style-mods.net/index.htm
http://www.happy2-island.com/vbs/cafe01/capter00600.shtml
●unicode
'asc.vbs
Dim objFS, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(WScript.arguments(1),8,true,0)
objTS.WriteLine ascw(WScript.arguments(0))
'objTS.WriteLine chrw(WScript.arguments(0))
objTS.Close
-----------------------------------------------------------
LET TMP$="asc.tmp" !'作業ファイル
LET F$="Ω"
EXECUTE "asc.vbs" WITH(F$,TMP$)
OPEN #1:NAME TMP$
INPUT #1:UNICODE$
CLOSE #1
PRINT F$,UNICODE$,ORD(F$)
FILE DELETE TMP$
END
●日数計算
'datediff.vbs
Dim objFS,objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(WScript.arguments(3),8,true,0)
objTS.WriteLine DateDiff(WScript.arguments(0),WScript.arguments(1),WScript.arguments(2))
objTS.Close
'設定値 内容
'yyyy 年
'q 四半期
'm 月
'y 年間通算日（日数）
'd 日
'w 曜日（曜日を表す数値）
'ww 週（何週間か）
'h 時
'n 分
's 秒
-----------------------------------------------------------
LET TMP$="datediff.tmp" !'作業ファイル
LET A$="Y"
LET B$="01/01"
LET C$=DATE$
LET C$(5:4)="/"
LET C$(8:7)="/"
EXECUTE "datediff.vbs" WITH(A$,B$,C$,TMP$)
OPEN #1:NAME TMP$
INPUT #1:DATEDIFF$
PRINT "元旦から ";C$;" まで"
PRINT DATEDIFF$;"日です"
CLOSE #1
FILE DELETE TMP$
END
●特殊フォルダー名取得
'specialfolder.vbs
Dim objWshShell,objFS,objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objWshShell = CreateObject("WScript.Shell")
Set objTS = objFS.OpenTextFile(WScript.arguments(1),8,true,0)
objTS.WriteLine objWshShell.SpecialFolders(WScript.arguments(0))
objTS.Close
'以下特殊フォルダ名
'AllUsersDesktop
'AllUsersStartMenu
'AllUsersPrograms
'AllUsersStartup
'Desktop
'Favorites
'Fonts
'MyDocuments
'NetHood
'PrintHood
'Programs
'Recent
'SendTo
'StartMenu
'Startup
'Templates
-----------------------------------------------------------
!'「最近使ったファイル」の削除
LET TMP$="specialfolder.tmp" !'作業ファイル
LET F$="Recent" !'取得フォルダー名
EXECUTE "specialfolder.vbs" WITH(F$,TMP$)
OPEN #1:NAME TMP$
LINE INPUT #1:RECENTFOLDER$
CLOSE #1
LET RECENT$=RECENTFOLDER$ & "\*.*"
LET N=FILES(RECENT$)
IF N>0 THEN
DIM NAME$(N)
FILE LIST RECENT$,NAME$
END IF
FOR I=1 TO N
WHEN EXCEPTION IN
FILE DELETE RECENTFOLDER$ & "\" & NAME$(I)
PRINT RECENTFOLDER$ & "\" & NAME$(I)
USE
END WHEN
NEXT I
FILE DELETE TMP$
END
●文字列式の計算
'eval.vbs
Dim objFS, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(WScript.arguments(1),8,true,0)
objTS.WriteLine Eval(WScript.arguments(0))
objTS.Close
-----------------------------------------------------------
LET TMP$="eval.tmp"
LET F$="exp(1)*sqr(2)*log(3)*sin(45*3.141592/180)" !'文字列式
!'INPUT PROMPT "計算式:":F$
EXECUTE "eval.vbs" WITH(F$,TMP$)
OPEN #1:NAME TMP$
INPUT #1:ANSWER$
CLOSE #1
PRINT ANSWER$;EXP(1)*SQR(2)*LOG(3)*SIN(45*3.141592/180)
FILE DELETE TMP$
END
●ファイル日付取得
'filedate.vbs
Dim objFS, objFile, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile(WScript.arguments(0))
Set objTS = objFS.OpenTextFile(WScript.arguments(1),8,true,0)
objTS.WriteLine objFile.DateLastModified
'objTS.WriteLine objFile.DateLastAccessed
'objTS.WriteLine objFile.DateCreated
objTS.Close
-----------------------------------------------------------
ASK DIRECTORY S$
LET TMP$="filedate.tmp"
FILE GETNAME F$,"ファイル|*.*" !'カレントディレクトリが変わる
SET DIRECTORY S$ !'カレントディレクトリを元に戻す
EXECUTE "filedate.vbs" WITH(F$,TMP$)
OPEN #1:NAME TMP$
INPUT #1:FILEDATE$
CLOSE #1
PRINT F$;" ";FILEDATE$
FILE DELETE TMP$
END
●サブフォルダ名取得
'subfolder.vbs
Dim objFS, objFolder,objSubFolder,obj,objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(WScript.arguments(0))
Set objSubFolder = objFolder.SubFolders
Set objTS = objFS.OpenTextFile(WScript.arguments(1),8,true,0)
for each obj in objSubFolder
objTS.WriteLine obj
next
objTS.Close
-----------------------------------------------------------
LET TMP$="subfolder.tmp"
ASK DIRECTORY S$
DIRECTORY GETNAME F$
SET DIRECTORY S$
EXECUTE "subfolder.vbs" WITH(F$,TMP$)
OPEN #1:NAME TMP$
DO
INPUT #1,IF MISSING THEN EXIT DO:SUBFOLDER$
PRINT SUBFOLDER$
LOOP
CLOSE #1
FILE DELETE TMP$
END
●フォルダサイズ取得
'foldersize.vbs
Dim objFS, objFolder,objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(WScript.arguments(0))
Set objTS = objFS.OpenTextFile(WScript.arguments(1),8,true,0)
objTS.WriteLine objFolder.Size
objTS.Close
-----------------------------------------------------------
ASK DIRECTORY S$
DIRECTORY GETNAME F$
LET TMP$="foldersize.tmp"
SET DIRECTORY S$
EXECUTE "foldersize.vbs" WITH(F$,TMP$)
OPEN #1:NAME TMP$
INPUT #1:FOLDERSIZE$
CLOSE #1
PRINT F$
PRINT FOLDERSIZE$;" byte"
FILE DELETE TMP$
END
●ドライブ種
'drivetype.vbs
Dim objFS, objDrive, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objDrive = objFS.GetDrive(WScript.arguments(0))
Set objTS = objFS.OpenTextFile(WScript.arguments(1),8,true,0)
select case objDrive.DriveType
case 0
objTS.WriteLine "不明"
case 1
objTS.WriteLine "リムーバブルディスク"
case 2
objTS.WriteLine "固定ディスク"
case 3
objTS.WriteLine "ネットワークドライブ"
case 4
objTS.WriteLine "CD-ROM ドライブ"
case 5
objTS.WriteLine "RAM ディスク"
end select
objTS.Close
-----------------------------------------------------------
LET TMP$="drivetype.tmp"
DATA C,D,E,F
FOR I=1 TO 4
READ F$
EXECUTE "drivetype.vbs" WITH(F$,TMP$)
NEXT I
RESTORE
OPEN #1:NAME TMP$
FOR I=1 TO 4
READ F$
INPUT #1:DRIVETYPE$
PRINT F$;": ドライブ ";DRIVETYPE$
NEXT I
CLOSE #1
FILE DELETE TMP$
END
●ドラッグ&ドロップ
下記のファイル及び下記ファイルのショートカットにファイルをドラッグ&ドロップすると
指定のパスにドラッグ&ドロップしたファイルのリストができる
'DragDrop.vbs
Set oWArgv = WScript.Arguments
If oWArgv.length = 0 Then
WScript.Quit
End If
Dim objFS, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("c:\temp\filelist.txt",2,true,0) 'パス、ファイル名を指定、変更する
For i = 0 To oWArgv.Count - 1
objTS.WriteLine oWArgv.item(i)
Next
objTS.Close
-----------------------------------------------------------
但し、下記のようにしてもリアルタイムに監視はできないようだ
LET F$="c:\temp\filelist.txt"
DO
LET FILEEXIST$="EXIST"
WHEN EXCEPTION IN
OPEN #1:NAME F$,ACCESS INPUT
CLOSE #1
USE
LET FILEEXIST$="NOT EXIST" !'エラー発生(ファイルが存在しない)
END WHEN
LOOP UNTIL FILEEXIST$="EXIST"
●エクセルの関数を使う
'excelcalc.vbs
Dim excelApp, book, sheet,objFS,objTS
Set excelApp = CreateObject("Excel.Application")
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile(WScript.arguments(2),8,true,0)
'excelApp.Visible = True
excelApp.Visible = False
excelApp.DisplayAlerts = False
Set book = excelApp.Workbooks.Open(WScript.arguments(0))
'Set book = excelApp.Workbooks.Open(WScript.Arguments(0), False, True)
Set sheet = book.WorkSheets("Sheet1")
Sheet.Range("a1").Value = WScript.arguments(1)
'Sheet.Range("b1").Formula = "=sqrt(a1)"
objTS.WriteLine Sheet.Range("b1")
objTS.Close
excelApp.Quit
Set excelApp = Nothing
-----------------------------------------------------------
LET TMP$="excelcalc.tmp"
LET XLS$="calc.xls" !'予めエクセルファイルを作成し、セルb1に関数式を設定しておく。パスを指定すること
INPUT PROMPT "X=":X
EXECUTE "excelcalc.vbs" WITH(XLS$,X,TMP$)
OPEN #1:NAME TMP$
INPUT #1:VALUE$
CLOSE #1
PRINT VALUE$
FILE DELETE TMP$
END
●ショートカット作成
'shortcut.vbs
Dim mylink,Wshshell,oShellLink,objFS
mylink = WScript.arguments(0)
set WshShell = WScript.CreateObject("WScript.Shell")
Set objFS = CreateObject("Scripting.FileSystemObject")
set oShellLink = WshShell.CreateShortcut(WScript.arguments(1))
oShellLink.TargetPath = WSHShell.ExpandEnvironmentStrings(mylink)
oShellLink.WindowStyle = 1
oShellLink.IconLocation = WSHShell.ExpandEnvironmentStrings(mylink & ", 0")
oShellLink.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(objFS.GetParentFolderName(mylink))
oShellLink.Save
-----------------------------------------------------------
ASK DIRECTORY S$
FILE GETNAME F$,"ファイル|*.*"
IF F$="" THEN STOP
SET DIRECTORY S$
LET SAVENAME$=F$ & "へのショートカット.lnk"
EXECUTE "shortcut.vbs" WITH(F$,SAVENAME$)
END
●ZIP圧縮
http://home.a00.itscom.net/hatada/wsh/wsh01.html
LET VBS$="zipcompress.vbs"
DIM F$(100)
DO
FILE GETNAME S$
IF S$<>"" THEN
LET N=N+1
LET F$(N)=S$ !'圧縮するファイル名の登録
PRINT S$
END IF
LOOP UNTIL S$="" !'キャンセルでループ脱出
FILE GETSAVENAME ZIPNAME$,"ZIPファイル|*.zip" !'圧縮ファイル名指定
IF ZIPNAME$="" THEN STOP
IF POS(UCASE$(ZIPNAME$),".ZIP")=0 THEN LET ZIPNAME$=ZIPNAME$ & ".zip"
OPEN #1:NAME VBS$
PRINT #1:"Dim Filename, objFSO, objFile, bs, i, strbuf"
PRINT #1:"bs = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)"
PRINT #1:"For i = 0 To UBound(bs)"
PRINT #1:"strbuf = strbuf & Chr(bs(i))"
PRINT #1:"Next"
PRINT #1:"Filename=Array(_"
FOR I=1 TO N-1
PRINT #1:CHR$(34);F$(I);CHR$(34);",_"
NEXT I
PRINT #1:CHR$(34);F$(N);CHR$(34);")"
PRINT #1:"Set objFSO = WScript.CreateObject(";CHR$(34);"Scripting.FileSystemObject";CHR$(34);")"
PRINT #1:"Set objFile = objFSO.OpenTextFile(";CHR$(34);ZIPNAME$;CHR$(34);", 2, True, 0)"
PRINT #1:"objFile.Write(strbuf)"
PRINT #1:"objFile.Close"
PRINT #1:"for i=0 to UBound(Filename)"
PRINT #1:"CreateObject(";CHR$(34);"Shell.Application";CHR$(34);").NameSpace(";CHR$(34);ZIPNAME$;CHR$(34);").CopyHere(Filename(i))"
PRINT #1:"WScript.sleep 2000"
PRINT #1:"next"
CLOSE #1
EXECUTE VBS$
FILE DELETE VBS$
END
●クリップボード読み出し
http://d.hatena.ne.jp/t_amago/20071125/p2
http://hideprogram.web.fc2.com/vbscript/IEClipboardAndSendKeys.html
●レジストリー読み出し
http://wsh.style-mods.net/topic10.htm
●ファイルのダウンロード
http://d.hatena.ne.jp/tt4cs/20120206/1328527888
●メール送信
http://www.upken.jp/kb/YzmsJoCRHLnrDokWNlwzICIofVmZFp.html
●正規表現
●OS情報 等
http://ichi-note.sblo.jp/article/34919600.html
http://tunemicky.blogspot.jp/2012/08/vbscript-25.html
●音声合成
'voice.vbs
CreateObject("SAPI.SpVoice").Speak WScript.arguments(0)
-----------------------------------------------------------
!'音声時計?(但し、英語です)
LET D$=DATE$
LET D$(5:4)="/"
LET D$(8:7)="/"
LET A$=D$ & " " & TIME$
PRINT A$
EXECUTE "voice.vbs" WITH(A$)
END
※Office 2003等(Excelの読み上げ機能)がインストールされていればコントロールパネル「音声認識」より
日本語合成エンジン(LH Kenji,LH Naoko)が選択できる
※備考
日本語TTS(text-to-speech)エンジンのインストール(ランタイムと言語パック)
http://www.ka-net.org/blog/?p=291
'speech.vbs
Set tts=CreateObject("Speech.SpVoice")
tts.volume=WScript.arguments(1) '音量 0～100
tts.Rate=WScript.arguments(2) '読み上げ速度 -10:遅い～10:速い
tts.Speak WScript.arguments(0)
-----------------------------------------------------------
LET VOLUME=90
LET RATE=-1
!'LET F$="C:\BASICw32\README.TXT"
FILE GETNAME F$,"テキストファイル|*.txt"
IF F$="" THEN STOP
OPEN #1:NAME F$,ACCESS INPUT
DO
LINE INPUT #1,IF MISSING THEN EXIT DO:A$
PRINT A$
IF A$<>"" THEN
EXECUTE "speech.vbs" WITH(A$,VOLUME,RATE)
WAIT DELAY 2 !'この間に実行中断できる
END IF
LOOP
CLOSE #1
END
まだまだいろいろなことができそうだ!
恐るべし、WSH!!!
|
|