プログラマメモ
VBScript_Common

最終更新：2009年01月13日 17:50
inouework
- view
管理者のみ編集可
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
'*********************************************************************
「VBScript_Common」をウィキ内検索