「VBScript_Common」の編集履歴（バックアップ）一覧はこちら
「VBScript_Common」(2009/01/13 (火) 17:50:32) の最新版変更点
追加された行は緑色になります。
削除された行は赤色になります。
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 共通定数
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Const OpenTextFile Option
Const FILE_R = 1
Const FILE_W = 2
Const FILE_A = 8
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 共通変数
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Dim Debug
Dim MyINI
Dim MyWin
Dim PGBIE ' IE オブジェクト
Dim m_lngBarNow
Dim m_lngBarMax
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 共通関数
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'----------------------------------------------------------------
' Name ：StartDebugLog
' Detail：デバッグログ初期設定
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartDebugLogHtml( _
ByVal vProgName _
)
Set Debug = New CLog
Debug.Stack = True
Call Debug.SetFileHtml( vProgName)
End Sub
'----------------------------------------------------------------
' Name ：StartDebugLog
' Detail：デバッグログ初期設定
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartDebugLogWsf( _
ByVal vProgName _
)
Set Debug = New CLog
Call Debug.SetFileWsf( vProgName)
End Sub
'----------------------------------------------------------------
' Name ：StartMyINIFile
' Detail：Iniファイルアクセス
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartMyINIFileHtml( _
ByVal vProgName _
)
Set MyINI = New CProfile
Call MyINI.SetFileHtml( vProgName)
End Sub
'----------------------------------------------------------------
' Name ：StartMyINIFile
' Detail：Iniファイルアクセス
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartMyINIFileWsf( _
ByVal vProgName _
)
Set MyINI = New CProfile
Call MyINI.SetFileWsf( vProgName)
End Sub
Sub SetWindow( _
ByRef vWindow _
)
Set MyWin = vWindow
End Sub
Sub MsgStatusBer( _
ByVal vstrMsg _
)
MyWin.status = vstrMsg
End Sub
'----------------------------------------------------------------
' Name ：SFSO
' Detail：ファイルシステムオブジェクトを取得する
' Return：ファイルシステムオブジェクト
'----------------------------------------------------------------
Function SFSO
Set SFSO = CreateObject( "Scripting.FileSystemObject")
End Function
Function getRunFolderPath()
Set objShell = CreateObject("Wscript.Shell")
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
getRunFolderPath = objFSO.GetParentFolderName(objFile)
End Function
Function TimeDiff(ByVal a, ByVal b)
Dim x
If b >= a Then
x = b - a
Else
x = (86400 - a) + b ' 真夜中の0時を跨いだときの対処
End If
TimeDiff = x
End Function
Sub ComCMD_Run( _
ByVal vstrPaht, _
ByVal vstrArg _
)
Const vbHide = 0 'ウィンドウを非表示
Const vbNormalFocus = 1 '通常のウィンドウ、かつ最前面のウィンドウ
Const vbMinimizedFocus = 2 '最小化、かつ最前面のウィンドウ
Const vbMaximizedFocus = 3 '最大化、かつ最前面のウィンドウ
Const vbNormalNoFocus = 4 '通常のウィンドウ、ただし、最前面にはならない
Const vbMinimizedNoFocus = 6 '最小化、ただし、最前面にはならない
Dim objWShell
Set objWShell = CreateObject("WScript.Shell")
objWShell.Run """" & vstrPaht & """ " & vstrArg, vbMinimizedFocus, False
Set objWShell = Nothing
Debug.Print "1"
End Sub
Sub ComCMD_Progress_Create()
Set PGBIE = CreateObject("InternetExplorer.Application")
PGBIE.Width = 180
PGBIE.Height = 100
PGBIE.Left = 0
PGBIE.Top = screen.height - 150
PGBIE.AddressBar = false
PGBIE.MenuBar = false
PGBIE.ToolBar = false
PGBIE.Resizable = false
PGBIE.Visible = true
End Sub
Sub ComCMD_Progress_Close()
If Not PGBIE is Nothing Then
PGBIE.Quit
Set PGBIE = Nothing
End If
End Sub
Sub ComCMD_Progress_Msg( _
ByVal vstrMsg _
)
PGBIE.StatusText = vstrMsg
End Sub
Sub ComCMD_Progress_Start( _
ByVal viniMax _
)
m_lngBarNow = 0
m_lngBarMax = viniMax
PGBIE.StatusText = "(" & m_lngBarNow & "%)" & _
String(lngLoop, "■") & String(10 - lngLoop, "□")
End Sub
Sub ComCMD_Progress_Add()
Dim lngNow
m_lngBarNow = m_lngBarNow + 1
lngNow = Fix( m_lngBarNow / (m_lngBarMax / 100))
PGBIE.StatusText = "(" & lngNow & "%)" & _
String(m_lngBarNow / (m_lngBarMax / 10), "■") & String(10 - m_lngBarNow / (m_lngBarMax / 10), "□") & _
" " & m_lngBarNow & " / " & m_lngBarMax
If m_lngBarNow / (m_lngBarMax / 10) >= 10 Then
PGBIE.Quit
Set PGBIE = Nothing
End If
End Sub
'*********************************************************************
' 日付型フォーマット関数 ver 1.0 00.10.19
'
' 引数(1)：[Date] フォーマットしたい日付型
' (2)：[String] フォーマット型（ページ後方に記載）
' 戻値 ：[String] フォーマットされた文字列
'*********************************************************************
Function FormatTime(datTime,strFormat)
Dim tmpFormat
Dim cntType
Dim FormatType
FormatType = Split("YYYY/YY/MM/M/DD/D/HH24/H24/HH/H/II/I/SS/S/XX/ZZ","/")
tmpFormat = Cstr(strFormat)
For cntType = 0 To Ubound(FormatType)
If InStr(tmpFormat,FormatType(cntType)) > 0 Then
Select Case FormatType(cntType)
Case "HH24"
tmpFormat = Replace(tmpFormat,"HH24",Right(CStr(Hour(datTime) + 100),2))
Case "H24"
tmpFormat = Replace(tmpFormat,"H24",CStr(Hour(datTime)))
Case "HH"
tmpFormat = Replace(tmpFormat,"HH",Right(CStr((Hour(datTime) Mod 12) + 100),2))
Case "H"
tmpFormat = Replace(tmpFormat,"H",CStr(Hour(datTime) Mod 12))
Case "II"
tmpFormat = Replace(tmpFormat,"II",Right(CStr(Minute(datTime) + 100),2))
Case "I"
tmpFormat = Replace(tmpFormat,"I",CStr(Minute(datTime)))
Case "SS"
tmpFormat = Replace(tmpFormat,"SS",Right(CStr(Second(datTime) + 100),2))
Case "S"
tmpFormat = Replace(tmpFormat,"S", CStr(Second(datTime)))
Case "YYYY"
If Len(CStr(Year(datTime))) = 2 Then
If Year(datTime) > 30 Then
tmpFormat = Replace(tmpFormat,"YYYY","19" & CStr(Year(datTime)))
Else
tmpFormat = Replace(tmpFormat,"YYYY","20" & CStr(Year(datTime)))
End If
Else
tmpFormat = Replace(tmpFormat,"YYYY",CStr(Year(datTime)))
End If
Case "YY"
tmpFormat = Replace(tmpFormat,"YY",Right(CStr(Year(datTime)),2))
Case "MM"
tmpFormat = Replace(tmpFormat,"MM",Right(CStr(Month(datTime) + 100),2))
Case "M"
tmpFormat = Replace(tmpFormat,"M",CStr(Month(datTime)))
Case "DD"
tmpFormat = Replace(tmpFormat,"DD",Right(CStr(Day(datTime) + 100),2))
Case "D"
tmpFormat = Replace(tmpFormat,"D",CStr(Day(datTime)))
Case "XX"
If Hour(datTime) < 12 Then
tmpFormat = Replace(tmpFormat,"XX","午前")
Else
tmpFormat = Replace(tmpFormat,"XX","午後")
End If
Case "ZZ"
If Hour(datTime) < 12 Then
tmpFormat = Replace(tmpFormat,"ZZ","AM")
Else
tmpFormat = Replace(tmpFormat,"ZZ","PM")
End If
End Select
End If
Next
FormatTime = CStr(tmpFormat)
End Function
'*********************************************************************
' フォーマット指定できる型について（日付型からの変換）
' YYYY 西暦４桁
' YY 西暦２桁
' MM 月２桁
' M 月１桁
' DD 日２桁
' D 日１桁
' HH24 時２桁（２４時間）
' H24 時１桁（２４時間）
' HH 時２桁（１２時間）
' H 時１桁（１２時間）
' II 分２桁
' I 分１桁
' SS 秒２桁
' S 秒１桁
' XX 午前/午後
' ZZ AM/PM
'*********************************************************************
Common
----
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 共通定数
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Const OpenTextFile Option
Const FILE_R = 1
Const FILE_W = 2
Const FILE_A = 8
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 共通変数
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Dim Debug
Dim MyINI
Dim MyWin
Dim PGBIE ' IE オブジェクト
Dim m_lngBarNow
Dim m_lngBarMax
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' 共通関数
'________________________________________________________________
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'----------------------------------------------------------------
' Name ：StartDebugLog
' Detail：デバッグログ初期設定
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartDebugLogHtml( _
ByVal vProgName _
)
Set Debug = New CLog
Debug.Stack = True
Call Debug.SetFileHtml( vProgName)
End Sub
'----------------------------------------------------------------
' Name ：StartDebugLog
' Detail：デバッグログ初期設定
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartDebugLogWsf( _
ByVal vProgName _
)
Set Debug = New CLog
Call Debug.SetFileWsf( vProgName)
End Sub
'----------------------------------------------------------------
' Name ：StartMyINIFile
' Detail：Iniファイルアクセス
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartMyINIFileHtml( _
ByVal vProgName _
)
Set MyINI = New CProfile
Call MyINI.SetFileHtml( vProgName)
End Sub
'----------------------------------------------------------------
' Name ：StartMyINIFile
' Detail：Iniファイルアクセス
' Arg(0)：ファイル名
'----------------------------------------------------------------
Sub StartMyINIFileWsf( _
ByVal vProgName _
)
Set MyINI = New CProfile
Call MyINI.SetFileWsf( vProgName)
End Sub
Sub SetWindow( _
ByRef vWindow _
)
Set MyWin = vWindow
End Sub
Sub MsgStatusBer( _
ByVal vstrMsg _
)
MyWin.status = vstrMsg
End Sub
'----------------------------------------------------------------
' Name ：SFSO
' Detail：ファイルシステムオブジェクトを取得する
' Return：ファイルシステムオブジェクト
'----------------------------------------------------------------
Function SFSO
Set SFSO = CreateObject( "Scripting.FileSystemObject")
End Function
Function getRunFolderPath()
Set objShell = CreateObject("Wscript.Shell")
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
getRunFolderPath = objFSO.GetParentFolderName(objFile)
End Function
Function TimeDiff(ByVal a, ByVal b)
Dim x
If b >= a Then
x = b - a
Else
x = (86400 - a) + b ' 真夜中の0時を跨いだときの対処
End If
TimeDiff = x
End Function
Sub ComCMD_Run( _
ByVal vstrPaht, _
ByVal vstrArg _
)
Const vbHide = 0 'ウィンドウを非表示
Const vbNormalFocus = 1 '通常のウィンドウ、かつ最前面のウィンドウ
Const vbMinimizedFocus = 2 '最小化、かつ最前面のウィンドウ
Const vbMaximizedFocus = 3 '最大化、かつ最前面のウィンドウ
Const vbNormalNoFocus = 4 '通常のウィンドウ、ただし、最前面にはならない
Const vbMinimizedNoFocus = 6 '最小化、ただし、最前面にはならない
Dim objWShell
Set objWShell = CreateObject("WScript.Shell")
objWShell.Run """" & vstrPaht & """ " & vstrArg, vbMinimizedFocus, False
Set objWShell = Nothing
Debug.Print "1"
End Sub
Sub ComCMD_Progress_Create()
Set PGBIE = CreateObject("InternetExplorer.Application")
PGBIE.Width = 180
PGBIE.Height = 100
PGBIE.Left = 0
PGBIE.Top = screen.height - 150
PGBIE.AddressBar = false
PGBIE.MenuBar = false
PGBIE.ToolBar = false
PGBIE.Resizable = false
PGBIE.Visible = true
End Sub
Sub ComCMD_Progress_Close()
If Not PGBIE is Nothing Then
PGBIE.Quit
Set PGBIE = Nothing
End If
End Sub
Sub ComCMD_Progress_Msg( _
ByVal vstrMsg _
)
PGBIE.StatusText = vstrMsg
End Sub
Sub ComCMD_Progress_Start( _
ByVal viniMax _
)
m_lngBarNow = 0
m_lngBarMax = viniMax
PGBIE.StatusText = "(" & m_lngBarNow & "%)" & _
String(lngLoop, "■") & String(10 - lngLoop, "□")
End Sub
Sub ComCMD_Progress_Add()
Dim lngNow
m_lngBarNow = m_lngBarNow + 1
lngNow = Fix( m_lngBarNow / (m_lngBarMax / 100))
PGBIE.StatusText = "(" & lngNow & "%)" & _
String(m_lngBarNow / (m_lngBarMax / 10), "■") & String(10 - m_lngBarNow / (m_lngBarMax / 10), "□") & _
" " & m_lngBarNow & " / " & m_lngBarMax
If m_lngBarNow / (m_lngBarMax / 10) >= 10 Then
PGBIE.Quit
Set PGBIE = Nothing
End If
End Sub
'*********************************************************************
' 日付型フォーマット関数 ver 1.0 00.10.19
'
' 引数(1)：[Date] フォーマットしたい日付型
' (2)：[String] フォーマット型（ページ後方に記載）
' 戻値 ：[String] フォーマットされた文字列
'*********************************************************************
Function FormatTime(datTime,strFormat)
Dim tmpFormat
Dim cntType
Dim FormatType
FormatType = Split("YYYY/YY/MM/M/DD/D/HH24/H24/HH/H/II/I/SS/S/XX/ZZ","/")
tmpFormat = Cstr(strFormat)
For cntType = 0 To Ubound(FormatType)
If InStr(tmpFormat,FormatType(cntType)) > 0 Then
Select Case FormatType(cntType)
Case "HH24"
tmpFormat = Replace(tmpFormat,"HH24",Right(CStr(Hour(datTime) + 100),2))
Case "H24"
tmpFormat = Replace(tmpFormat,"H24",CStr(Hour(datTime)))
Case "HH"
tmpFormat = Replace(tmpFormat,"HH",Right(CStr((Hour(datTime) Mod 12) + 100),2))
Case "H"
tmpFormat = Replace(tmpFormat,"H",CStr(Hour(datTime) Mod 12))
Case "II"
tmpFormat = Replace(tmpFormat,"II",Right(CStr(Minute(datTime) + 100),2))
Case "I"
tmpFormat = Replace(tmpFormat,"I",CStr(Minute(datTime)))
Case "SS"
tmpFormat = Replace(tmpFormat,"SS",Right(CStr(Second(datTime) + 100),2))
Case "S"
tmpFormat = Replace(tmpFormat,"S", CStr(Second(datTime)))
Case "YYYY"
If Len(CStr(Year(datTime))) = 2 Then
If Year(datTime) > 30 Then
tmpFormat = Replace(tmpFormat,"YYYY","19" & CStr(Year(datTime)))
Else
tmpFormat = Replace(tmpFormat,"YYYY","20" & CStr(Year(datTime)))
End If
Else
tmpFormat = Replace(tmpFormat,"YYYY",CStr(Year(datTime)))
End If
Case "YY"
tmpFormat = Replace(tmpFormat,"YY",Right(CStr(Year(datTime)),2))
Case "MM"
tmpFormat = Replace(tmpFormat,"MM",Right(CStr(Month(datTime) + 100),2))
Case "M"
tmpFormat = Replace(tmpFormat,"M",CStr(Month(datTime)))
Case "DD"
tmpFormat = Replace(tmpFormat,"DD",Right(CStr(Day(datTime) + 100),2))
Case "D"
tmpFormat = Replace(tmpFormat,"D",CStr(Day(datTime)))
Case "XX"
If Hour(datTime) < 12 Then
tmpFormat = Replace(tmpFormat,"XX","午前")
Else
tmpFormat = Replace(tmpFormat,"XX","午後")
End If
Case "ZZ"
If Hour(datTime) < 12 Then
tmpFormat = Replace(tmpFormat,"ZZ","AM")
Else
tmpFormat = Replace(tmpFormat,"ZZ","PM")
End If
End Select
End If
Next
FormatTime = CStr(tmpFormat)
End Function
'*********************************************************************
' フォーマット指定できる型について（日付型からの変換）
' YYYY 西暦４桁
' YY 西暦２桁
' MM 月２桁
' M 月１桁
' DD 日２桁
' D 日１桁
' HH24 時２桁（２４時間）
' H24 時１桁（２４時間）
' HH 時２桁（１２時間）
' H 時１桁（１２時間）
' II 分２桁
' I 分１桁
' SS 秒２桁
' S 秒１桁
' XX 午前/午後
' ZZ AM/PM
'*********************************************************************
表示オプション
横に並べて表示：
変化行の前後のみ表示：
