【基本関数】 : baseFunction


  Ss、Dd

  

REM **********************************************************
REM シングルクォートで囲む
REM **********************************************************
Function Ss( strValue )

	Ss = "'" & strValue & "'"

End Function

REM **********************************************************
REM ダブルクォートで囲む
REM **********************************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End Function
  

  GetStringDir

  

REM **********************************************************
REM 文字列より機械的にフォルダ部分を取得する
REM **********************************************************
Function GetStringDir( strValue )

	Dim aData,I,str

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

	GetStringDir = str

End Function
  

  ByteLen

  

REM **********************************************************
REM 文字列のバイト計算
REM **********************************************************
function ByteLen( strTarget )

	Dim i,nLen,nRet,strMoji,nAsc

	nRet = 0

	nLen = Len( strTarget )

	For i = 1 to nLen
		nRet = nRet + 2
		strMoji = Mid( strTarget, i, 1 )
		nAsc = Asc( strMoji )
		if &H20 <= nAsc and nAsc <= &H7E then
			nRet = nRet - 1
		end if
		if &HA1 <= nAsc and nAsc <= &HDF then
			nRet = nRet - 1
		end if
	Next

	ByteLen = nRet

end function
  

  Lpad、LpadB、Rpad、RpadB

  

REM **********************************************************
REM 指定数、指定文字列左側を埋める
REM **********************************************************
Function Lpad( strValue, str, nLen )

	Lpad = Right( String(nLen,str) & strValue, nLen )

End Function
Function LpadB( strValue, str, nLen )

	Dim strWork,nLen2
	
	strWork = Right( String(nLen,str) & strValue, nLen )
	nLen2 = nLen

	Do While ByteLen( strWork ) > nLen
		nLen2 = nLen2 - 1
		if nLen2 <= 0 then
			Exit Do
		end if
		strWork = Right( String(nLen,str) & strValue, nLen2 )
	Loop
	LpadB = strWork

End Function

REM **********************************************************
REM 指定数、指定文字列右側を埋める
REM **********************************************************
Function Rpad( strValue, str, nLen )

	Rpad = Left( strValue & String(nLen,str), nLen )

End Function
Function RpadB( strValue, str, nLen )

	Dim strWork,nLen2

	strWork = Left( strValue & String(nLen,str), nLen )
	nLen2 = nLen

	Do While ByteLen( strWork ) > nLen
		nLen2 = nLen2 - 1
		if nLen2 <= 0 then
			Exit Do
		end if
		strWork = Left( strValue & String(nLen,str), nLen2 )
	Loop
	RpadB = strWork

End Function
  

  RegTrim

  

REM **********************************************************
REM 正規表現のトリム
REM **********************************************************
Function RegTrim( strValue )

	Dim regEx, str

	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "^[ \s]+"
	str = regEx.Replace( strValue, "" )
	regEx.Pattern = "[ \s]+$"
	RegTrim = regEx.Replace( str, "" )

End Function
  

  WscriptQuit

  

REM **********************************************************
REM Wscript で実行された場合はメッセージを表示して終了
REM **********************************************************
Function WscriptQuit( )

	if ScriptType <> 1 then
		Exit Function
	end if

	Dim str

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		strMessage = "コマンドプロンプトより cscript " & WScript.ScriptFullName
		strMessage = strMessage & " と指定して実行して下さい   " & vbCrLf & vbCrLf
		strMessage = strMessage & "( この文字列をクリップボードにコピーしたい場合は"
		strMessage = strMessage & " ctrl+c です )"
		WScript.Echo strMessage
		WScript.Quit
	end if

End Function
  

  Crun、Crun2

REM **********************************************************
REM Wscript で実行された場合は Cscript で実行しなおす
REM **********************************************************
Function Crun( )

	if ScriptType <> 1 then
		Exit Function
	end if

	Dim str

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		str = WScript.ScriptFullName
		GetWshShell
		strParam = " "
		For I = 0 to Wscript.Arguments.Count - 1
			if instr(Wscript.Arguments(I), " ") < 1 then
				strParam = strParam & Wscript.Arguments(I) & " "
			else
				strParam = strParam & Dd(Wscript.Arguments(I)) & " "
			end if
		Next
		Call WshShell.Run( "cmd.exe /c cscript.exe " & Dd(str) & strParam & " & pause", 3 )
		WScript.Quit
	end if

End Function
Function Crun2( nCol )

	if ScriptType <> 1 then
		Exit Function
	end if

	Dim str

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		str = WScript.ScriptFullName
		GetWshShell
		strParam = " "
		For I = 0 to Wscript.Arguments.Count - 1
			if instr(Wscript.Arguments(I), " ") < 1 then
				strParam = strParam & Wscript.Arguments(I) & " "
			else
				strParam = strParam & Dd(Wscript.Arguments(I)) & " "
			end if
		Next
		Call WshShell.Run( "cmd.exe /c mode con: cols=" _
			& nCol & " & cscript.exe " & Dd(str) & strParam & " & pause", 3 )
		WScript.Quit
	end if

End function


  GetInline

  

REM **********************************************************
REM ソース内のテキストリソースを取得
REM **********************************************************
Function GetInline( strName )

	GetInline = RegTrim( getResource( strName ) ) & vbCrLf

End Function
  

  ScriptType

  

REM **********************************************************
REM 実行中のスクリプトのタイプ
REM 1:WSH, 2:HTA, 3:ASP, 0:不明
REM **********************************************************
Function ScriptType( )

	Dim nType

	nType = 0

	if IsObject( Wscript ) then
		nType = 1
	else
		if IsObject( window ) then
			nType = 2
		else
			if IsObject( Server ) then
				nType = 3
			end if
		end if
	end if

	ScriptType = nType

End Function
  

  GetObj

  

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

	Dim ExecuteString

	ExecuteString = "Dim " & strTarget & " : "
	ExecuteString = ExecuteString & "Set " & strTarget & " = "

	Select Case ScriptType
		Case 1
			ExecuteString = ExecuteString & _
			"WScript.CreateObject("
		Case 2
			ExecuteString = ExecuteString & _
			"CreateObject("
		Case 3
			ExecuteString = ExecuteString & _
			"Server.CreateObject("
		Case Else
			ExecuteString = ExecuteString & _
			"CreateObject("
	End Select

	ExecuteString = ExecuteString & Dd( strObjectName ) & ")"

	ExecuteGlobal ExecuteString

End Function
  

  GetFso

  

REM **********************************************************
REM FileSystemObject の取得
REM ExecuteGlobal で定義されたグローバルな変数は
REM ローカルスコープで即参照できない
REM **********************************************************
Function GetFso( )

	if not IsObject( Fso ) then
		Call GetObj( "Fso", "Scripting.FileSystemObject" )
	end if

End Function
  

  GetTextFile、GetTextFileUnicode

  

REM **********************************************************
REM テキストファイル一括取得
REM **********************************************************
Function GetTextFile( strPath )

	GetFso

	Dim objHandle

	on error resume next
	Set objHandle = Fso.OpenTextFile( strPath, 1 )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		GetTextFile = ""
	else
		GetTextFile = objHandle.ReadAll
		objHandle.Close
	end if
	on error goto 0

End Function

Function GetTextFileUnicode( strPath )

	GetFso

	Dim objHandle

	on error resume next
	Set objHandle = Fso.OpenTextFile( strPath, 1, , True )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		GetTextFile = ""
	else
		GetTextFile = objHandle.ReadAll
		objHandle.Close
	end if
	on error goto 0

End Function
  

  PutTextFile、PutTextFileUnicode

  

REM **********************************************************
REM テキストファイル一括書き込み
REM **********************************************************
Function PutTextFile( strPath, strValue )

	GetFso

	Dim objHandle

	on error resume next
	Set objHandle = Fso.CreateTextFile( strPath, True )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
	else
		objHandle.Write( strValue )
		objHandle.Close
	end if
	on error goto 0

End Function

REM **********************************************************
REM テキストファイル一括書き込み( Unicode )
REM **********************************************************
Function PutTextFileUnicode( strPath, strValue )

	GetFso

	Dim objHandle

	on error resume next
	Set objHandle = Fso.CreateTextFile( strPath, True, True )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
	else
		objHandle.Write( strValue )
		objHandle.Close
	end if
	on error goto 0

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:46:22
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