プログラマメモ VBScript_Common


※上記の広告は60日以上更新のないWIKIに表示されています。更新することで広告が下部へ移動します。

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	西暦4桁
'  YY		西暦2桁
'  MM		月2桁
'  M		月1桁
'  DD		日2桁
'  D		日1桁
'  HH24	時2桁(24時間)
'  H24	時1桁(24時間)
'  HH		時2桁(12時間)
'  H		時1桁(12時間)
'  II		分2桁
'  I		分1桁
'  SS		秒2桁
'  S		秒1桁
'  XX		午前/午後
'  ZZ		AM/PM
'*********************************************************************