【基本関数】 : baseFunction

  GetCn、GetRs、GetStream、GetAdox



  
REM **********************************************************
REM ADO Connection オブジェクトの取得
REM **********************************************************
Function GetCn( )

	if not IsObject( Cn ) then
		Call GetObj( "Cn", "ADODB.Connection" )
	end if

End Function

REM **********************************************************
REM ADO Recordset オブジェクトの取得
REM **********************************************************
Function GetRs( )

	if not IsObject( Rs ) then
		Call GetObj( "Rs", "ADODB.Recordset" )
	end if

End Function

REM **********************************************************
REM ADO Stream オブジェクトの取得
REM **********************************************************
Function GetStream( )

	if not IsObject( Stream ) then
		Call GetObj( "Stream", "ADODB.Stream" )
	end if

End Function

REM **********************************************************
REM ADOX.Catalog の取得
REM **********************************************************
Function GetAdox( )

	if not IsObject( Adox ) then
		Call GetObj( "Adox", "ADOX.Catalog" )
	end if

End Function
  



  CurDir



  
REM **********************************************************
REM カレントディレクトリを返す
REM **********************************************************
Function CurDir( )

	GetWshShell

	CurDir = WshShell.CurrentDirectory

End Function
  



  ScriptDir

  
REM **********************************************************
REM スクリプトが存在する場所を返す
REM **********************************************************
Function ScriptDir( )

	Dim obj,strPath,aData,I

	ScriptDir = ""

	Select Case ScriptType
		Case 1
			GetFso

			strPath = WScript.ScriptFullName
			Set obj = Fso.GetFile( strPath )
			Set obj = obj.ParentFolder
			ScriptDir = obj.Path
		Case 2
			strPath = window.location
			aData = Split( strPath, "/" )
			strPath = ""
			For I = 3 to Ubound( aData ) - 1
				if I <> 3 then
					strPath = strPath & "\"
				end if
				strPath = strPath & aData( I )
			Next
			ScriptDir = strPath
		Case 3
			ScriptDir = Server.MapPath( "./" )
		Case Else
	End Select

End Function
  



  GetShellDir

  
REM **********************************************************
REM Shell フォルダを返す
REM **********************************************************
Function GetShellDir( nID )

	Dim objFolder,objFolderItem

	GetShell

	Set objFolder = Shell.Namespace(nID)
	Set objFolderItem = objFolder.Self
	GetShellDir = objFolderItem.Path

End Function
  



  各種ディレクトリ

  
REM **********************************************************
REM プログラムフォルダを返す ( Program Files )
REM **********************************************************
Function ProgDir( )
	ProgDir = GetShellDir( &H26 )
End Function

REM **********************************************************
REM テンプレートフォルダを返す
REM **********************************************************
Function TemplateDir( )
	TemplateDir = GetShellDir( &H15 )
End Function

REM **********************************************************
REM ユーザーフォルダを返す
REM **********************************************************
Function UserDir( )
	UserDir = GetShellDir( &H28 )
End Function

REM **********************************************************
REM テンポラリフォルダを返す
REM **********************************************************
Function TempDir( )
	TempDir = GetShellDir( &H28 ) & "\Local Settings\Temp"
End Function

REM **********************************************************
REM Windows ディレクトリの取得
REM **********************************************************
Function WinDir( )

	WinDir = GetShellDir( &H24 )

End Function

REM **********************************************************
REM Windows System ディレクトリの取得
REM **********************************************************
Function SysDir( )

	SysDir = GetShellDir( &H25 )

End Function

REM **********************************************************
REM SpecialFolder の取得
REM **********************************************************
Function GetSpecialFolder( strName )
	GetWshShell
	GetSpecialFolder = WshShell.SpecialFolders(strName)
End Function

REM **********************************************************
REM SendTo ディレクトリの取得
REM **********************************************************
Function SendtoDir( )
	SendtoDir = GetSpecialFolder("SendTo")
End Function

REM **********************************************************
REM お気に入りディレクトリの取得
REM **********************************************************
Function FavDir( )
	FavDir = GetSpecialFolder("Favorites")
End Function

REM **********************************************************
REM デスクトップディレクトリの取得
REM **********************************************************
Function DesktopDir( )
	DesktopDir = GetSpecialFolder("Desktop")
End Function

REM **********************************************************
REM StartMenu ディレクトリの取得
REM **********************************************************
Function MenuDir( )
	MenuDir = GetSpecialFolder("StartMenu")
End Function

REM **********************************************************
REM MyDocuments ディレクトリの取得
REM **********************************************************
Function MyDocDir( )
	MyDocDir = GetSpecialFolder("MyDocuments")
End Function
 
REM **********************************************************
REM スタートアップディレクトリの取得
REM **********************************************************
Function StartupDir( )
	StartupDir = GetSpecialFolder("Startup")
End Function
  



  GetUser

  
REM **********************************************************
REM ユーザ名の取得
REM **********************************************************
Function GetUser( )
	GetWshNetwork
	GetUser = WshNetwork.UserName
End Function
  



  GetCpname

  
REM **********************************************************
REM コンピュータ名の取得
REM **********************************************************
Function GetCpname( )
	GetWshNetwork
	GetCpname = WshNetwork.ComputerName
End Function
  



  OkCancel、YesNo、MsgOk、MsgErr

  
REM **********************************************************
REM メッセージボックス
REM **********************************************************
Function OkCancel( str )

	Dim ret

	if ScriptType <> 3 then
	else
		Exit Function
	end if

	if vbOK = MsgBox( str & "", vbOKCancel, "laylaClass" ) then
		OkCancel = True
	else
		OkCancel = False
	end if

End Function

Function YesNo( str )

	Dim ret

	if ScriptType <> 3 then
	else
		Exit Function
	end if

	if vbYes = MsgBox( str & "", vbYesNo, "laylaClass" ) then
		YesNo = True
	else
		YesNo = False
	end if

End Function

Function MsgOk( str )

	if ScriptType <> 3 then
	else
		Exit Function
	end if

	Call MsgBox( str & "", 0, "laylaClass" )

End Function

Function MsgErr( str )

	if ScriptType <> 3 then
	else
		Exit Function
	end if

	Call MsgBox( str & "", vbOKOnly + vbExclamation, "laylaClass" )

End Function
  



  Random、SameRandom

  
REM ************************************************
REM 指定範囲の整数の乱数を取得
REM ************************************************
Function Random( nMin, nMax )

	Randomize
	Random = nMin + Int(Rnd * (nMax - nMin + 1))

End function

Function SameRandom( nMin, nMax )

	SameRandom = nMin + Int(Rnd * (nMax - nMin + 1))

End function
  



  Han2Zen、Zen2Han

  
REM ************************************************
REM 半角を全角に変換
REM ************************************************
Function Han2Zen( strValue )

	Dim strRet,strTarget1,strTarget2,i,nLen

	strRet = strValue

	strTarget1 = GroupString( 1 )
	strTarget2 = GroupString( 5 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	strTarget1 = GroupString( 2 )
	strTarget2 = GroupString( 6 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	strTarget1 = GroupString( 3 )
	strTarget2 = GroupString( 7 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	strTarget1 = GroupString( 4 )
	strTarget2 = GroupString( 8 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	Han2Zen = strRet

End function

REM ************************************************
REM 全角を半角に変換
REM ************************************************
Function Zen2Han( strValue )

	Dim strRet,strTarget1,strTarget2,i,nLen

	strRet = strValue

	strTarget1 = GroupString( 5 )
	strTarget2 = GroupString( 1 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	strTarget1 = GroupString( 6 )
	strTarget2 = GroupString( 2 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	strTarget1 = GroupString( 7 )
	strTarget2 = GroupString( 3 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	strTarget1 = GroupString( 8 )
	strTarget2 = GroupString( 4 )

	nLen = Len(strTarget1)

	For i = 1 to nLen
		strRet = Replace(strRet,Mid(strTarget1,i,1), Mid(strTarget2,i,1) )
	Next

	Zen2Han = strRet

End function
  



  AtoI

  
REM ************************************************
REM 文字列(日付形式を含む)から整数
REM 通常文字列は 0 になる
REM ************************************************
Function AtoI( strValue )

	on error resume next
	AtoI = CLng( strValue )
	if Err.Number <> 0 then
		Err.Clear
		strValue = DateValue( strValue )
		if Err.Number <> 0 then
			AtoI = 0
		else
			AtoI = CLng( strValue )
		end if
	end if
	on error goto 0

End function
  



  ItoDate

  
REM ************************************************
REM 整数から日付文字列を取得
REM ************************************************
Function ItoDate( nData )

	nData = Fix(nData)
	ItoDate = Cdate(nData) & ""

End function
  



  DateSub

  
REM ************************************************
REM 日付表現の経過日数を取得
REM ************************************************
Function DateSub( vDate2, vDate1 )

	vDate2 = DateValue( vDate2 & "" )
	vDate1 = DateValue( vDate1 & "" )
	DateSub = CLng( vDate2 ) - CLng( vDate1 )

End function
  



  GetWmi

  
REM **********************************************************
REM 文字列を指定して、変数にオブシェクトを作成させる
REM **********************************************************
Function GetWmi( strTarget )

	Dim ExecuteString

	ExecuteString = "Dim " & strTarget & " : "
	ExecuteString = ExecuteString & "Set " & strTarget & " = "
	ExecuteString = ExecuteString & "GetObject("
	ExecuteString = ExecuteString & Dd("winmgmts:\\.\root\cimv2")
	ExecuteString = ExecuteString & ")"

	ExecuteGlobal ExecuteString

End Function
  



  GetOSVersion

  
REM **********************************************************
REM OS バージョンの取得
REM **********************************************************
Function GetOSVersion( )

	GetWmi("Wmi")

	Dim colTarget,str,aData,I,nTarget

	Set colTarget = Wmi.ExecQuery( "select Version from Win32_OperatingSystem" )
	For Each objRow in colTarget
		str = objRow.Version
	Next

	aData = Split( str, "." )
	For I = 0 to Ubound( aData )
		if I > 1 then
			Exit For
		end if
		if I > 0 then
			nTarget = nTarget & "."
		end if
		nTarget = nTarget & aData(I)
	Next

	GetOSVersion = CDbl( nTarget )

End Function
  



  GetExt

  
REM **********************************************************
REM 文字列の最後の . 以降の文字列の取得
REM **********************************************************
Function GetExt( strValue )

	Dim aData

	aData = Split(strValue,".")
	if Ubound( aData ) > 0 then
		GetExt = aData(Ubound( aData ))
		if Instr( GetExt, "\" ) > 0 then
			GetExt = ""
		end if
	else
		GetExt = ""
	end if

End Function
  



  GetFileName

  
REM **********************************************************
REM 文字列の最後の . 以降の文字列の取得
REM **********************************************************
Function GetFileName( strValue )

	Dim aData,str,I

	aData = Split(strValue,"\")
	strValue = aData(Ubound(aData))
	aData = Split(strValue,".")
	if Ubound( aData ) > 0 then
		For I = 0 to Ubound(aData)-1
			if I <> 0 then
				GetFileName = GetFileName & "."
			end if
			GetFileName = GetFileName & aData(I)
		Next
	else
		GetFileName = aData(0)
	end if

End Function
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ