【基本関数】 : 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
  




yahoo  google  MSDN  MSDN(us)  WinFAQ  Win Howto  tohoho  ie_DHTML  vector  wdic  辞書  天気 


[webwsh]
CCBot/2.0 (https://commoncrawl.org/faq/)
19/07/24 11:29:01
InfoBoard Version 1.00 : Language=Perl

BatchHelper COMprog CommonSpec Cprog CprogBase CprogSAMPLE CprogSTD CprogSTD2 CprogWinsock Cygwin GameScript HTML HTMLcss InstallShield InstallShieldFunc JScript JScriptSAMPLE Jsfuncs LLINK OldProg OracleGold OracleSilver PRO PRObrowser PROc PROconePOINT PROcontrol PROftpclient PROjscript PROmailer PROperl PROperlCHAT PROphp PROphpLesson PROphpLesson2 PROphpLesson3 PROphpfunction PROphpfunctionArray PROphpfunctionMisc PROphpfunctionString PROsql PROvb PROvbFunction PROvbString PROvbdbmtn PROvbonepoint PROwebapp PROwin1POINT PROwinSYSTEM PROwinYOROZU PROwindows ProjectBoard RealPHP ScriptAPP ScriptMaster VBRealtime Vsfuncs a1root access accreq adsi ajax amazon argus asp aspSample aspVarious aspdotnet aw2kinst cappvariety centura ckeyword classStyle cmaterial cmbin cmdbapp cmenum cmlang cmlistbox cmstd cmstdseed cmtxt cs daz3d db dbCommon dbaccess dnettool dos download flex2 flex3 flex4 framemtn framereq freeWorld freesoft gimp ginpro giodownload google hdml home hta htmlDom ie9svg install java javaSwing javascript jetsql jquery jsp jspTest jspVarious lightbox listasp listmsapi listmsie listmsiis listmsnt listmspatch listmsscript listmsvb listmsvc memo ms msde mysql netbeans oraPlsql oracle oracleWiper oraclehelper orafunc other panoramio pear perl personal pgdojo pgdojo_cal pgdojo_holiday pgdojo_idx pgdojo_ref pgdojo_req php phpVarious phpguide plsql postgres ps r205 realC realwebapp regex rgaki ruby rule sboard sc scprint scquest sdb sdbquest seesaa setup sh_Imagick sh_canvas sh_dotnet sh_google sh_tool sh_web shadowbox shgm shjquery shvbs shweb sjscript skadai skywalker smalltech sperl sqlq src systemdoc tcpip tegaki three toolbox twitter typeface usb useXML vb vbdb vbsfunc vbsguide vbsrc vpc wcsignup webanymind webappgen webclass webparts webtool webwsh win8 winofsql wmi work wp youtube