「HTAでランチャー作成」の編集履歴（バックアップ）一覧はこちら
「HTAでランチャー作成」(2014/07/31 (木) 18:57:05) の最新版変更点
追加された行は緑色になります。
削除された行は赤色になります。
メモ帳、TeraTerm,ブラウザ、エクスプローラー、エクセルを呼び出す例
起動時と終了時に時刻をログファイル「稼動ログ.txt」に残すおまけ付き
<html>
<head>
<hta:application>
<style type="text/css">
.demo1 {
border-top: 1px solid #ccc;
border-right: 1px solid #999;
border-bottom: 1px solid #999;
border-left: 1px solid #ccc;
padding: 5px 5px;
margin: 2px 1px;
font-weight: bold;
cursor: pointer;
color: #666;
}
</style>
<SCRIPT Language="VBScript">
Const ForReading = 1
Const ForWriting = 2
Const ForApending = 8
'Const vbShortDate = 2
'Const vbShortTime = 4
Const DATELOGNAME = "稼動ログ.txt"
Function fnWriteTime
Dim objFileSys
Dim strScriptPath
Dim strOpenFile
Dim objTextStream
Dim strText
Set objFileSys = CreateObject("Scripting.FileSystemObject")
strScriptPath = Replace(ScriptFullName,ScriptName,"")
strOpenFile = objFileSys.BuildPath(strScriptPath,DATELOGNAME)
Set objTextStream = objFileSys.OpenTextFile(strOpenFile, ForReading)
Dim WriteBuf: WriteBuf = ""
Dim Found: Found = False
Dim StrDate:StrDate = FormatDateTime(Date, vbShortDate)
Dim NowTime:NowTime = FormatDateTime(Time, vbShortTime)
Do Until objTextStream.AtEndOfLine = True
strText = objTextStream.ReadLine
strVal = Split(strText, ",")
If StrComp(StrDate, strVal(0), 1) = 0 then
Found = True
If Len(strval(1)) = 0 Then
' 開始に入れる
WriteBuf = WriteBuf & strval(0) & "," & NowTime & vbCrLf
Else
' 終了に入れる
WriteBuf = WriteBuf & strval(0) & "," & strval(1) & "," & NowTime & vbCrLf
End If
Else
' バッファに溜め込む
WriteBuf = WriteBuf & strText & vbCrLf
End If
Loop
If Found = False Then
WriteBuf = WriteBuf & StrDate & "," & NowTime & vbCrLf
End If
objTextStream.Close
Set objTextStream = Nothing
Set objFileSys = Nothing
' 書き込み
fnFileWrite(WriteBuf)
End Function
Function fnFileWrite(Str)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(DATELOGNAME, ForWriting, True)
objFile.WriteLine Str
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
End function
Const Maximized = -4137 // ウィンドウの最大化
Function RunExcel(fname)
Dim xl
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open(fname)
xl.DisplayAlerts = true
xl.Visible = True '立ち上げたExcelを表示する
'Sleep(1000)
'最前面に表示する
toFront(xl.Caption)
if xl.WindowState = -4143 then
xl.WindowState = Maximized
else
xl.WindowState = -4143
end if
set xl = nothing
End Function
Function RunExec(Cmd)
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Return = WshShell.Run(Cmd, 1, true)
set WshShell = nothing
End Function
Function RunExplore(Path)
dim objShell
set objShell = CreateObject("shell.application")
objShell.Explore(Path)
set objShell = nothing
End Function
Sub Sleep(millisec)
Dim Wshell
Dim dstart
Set Wshell = CreateObject("WScript.Shell")
dstart = timer * 1000
Do while True
Wshell.Run "%comspec% /c @",0,1
'■環境によっては、単純に ＞ Wshell.Run "@",0,1 でも動くのだが…
if timer * 1000 >= dstart + millisec then Exit Do
Loop
Set Wshell = Nothing
End Sub
Function toFront(Name)
' 前面に出す
Dim objWShell
Set objWShell = CreateObject("WScript.Shell")
objWShell.AppActivate Name
'objWShell.SendKeys "% X"
set objWShell = nothing
'CreateObject("WScript.Shell").AppActivate Name
End Function
Function RunIE(urlIE)
Dim objIE
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True
'操作したいページを表示
objIE.Navigate2 urlIE
'開ききるのを待ちます
Do While objIE.busy
Sleep(1000)
Loop
'Do While objIE.readyState < 4
' Sleep(1000)
'Loop
' 前面に出す
toFront(objIE.LocationName)
set objIE = nothing
End Function
' ロードイベント
Sub Window_onLoad
window.offscreenBuffering = True
Call fnWriteTime
'Call fnFileWrite("開始")
End Sub
Sub Window_onBeforeUnLoad
Call fnWriteTime
'Call fnFileWrite("終了")
End Sub
' ボタンイベント
Sub ie_onClick
RunIE("http://www.yahoo.co.jp")
End Sub
Sub excel_onClick
RunExcel("C:\Opt\worktimerec\hoge.xlsx")
End Sub
Sub notepad_onClick
RunExec("notepad")
End Sub
Sub teraterm_onClick
RunExec("ap_server_jboss.ttl")
End Sub
Sub exploler_onClick
RunExplore("C:\")
End Sub
</SCRIPT>
<SCRIPT language="JavaScript">
<!--
// ウィンドウを指定されたサイズに変更する
function init() {
resizeTo(550,100);
}
//-->
</SCRIPT>
</head>
<body onLoad="init()">
<input class="demo1" id="notepad" type="button" value="メモ帳"/>
<input class="demo1" id="teraterm" type="button" value="TeraTerm"/>
<input class="demo1" id="ie" type="button" value="Yahoo!"/>
<input class="demo1" id="exploler" type="button" value="エクスプローラ"/>
<input class="demo1" id="excel" type="button" value="Excel"/>
</BODY>
</html>
