00001 'Attribute VB_Name = "Common"
00002 '! @brief 各種共通関数群
00003 '! <p>スクリプト情報、パス情報(FileSystemObjectを使わない)、SQL用関数など</p>
00004 '---------------------------------------------------------------------
00005 '* @brief スクリプトの置かれたパスを返す。
00006 '* @note スクリプトのフルパスから右側のスクリプト名を取り除けばOK
00007 '---------------------------------------------------------------------
00008 Function getScriptPath()
00009 Dim nm 'スクリプトのファイル名(パスなし)
00010 Dim fullnm 'スクリプトのファイル名(フルパス)
00011
00012 nm = Wscript.ScriptName
00013 fullnm = Wscript.ScriptFullName
00014
00015 If Trim(fullnm) = "" Then
00016 getScriptPath = ""
00017 Exit Function
00018 End If
00019
00020 getScriptPath = Left(fullnm,Len(fullnm) - Len(nm))
00021 Exit Function
00022 End Function
00023
00024 '---------------------------------------------------------------------
00025 '* @brief スクリプトのベース名を返す。
00026 '* @note スクリプト名称の拡張子を取り外したもの。
00027 '---------------------------------------------------------------------
00028 Function getScriptBaseName()
00029 Dim nm 'スクリプトのファイル名(パスなし)
00030 Dim arrName
00031
00032 nm = Wscript.ScriptName
00033 arrName = Split(nm,".")
00034
00035
00036 getScriptBaseName = arrName(0) ''きっと、スクリプト名を.で区切った左側だろう。
00037 Exit Function
00038 End Function
00039
00040 '---------------------------------------------------------------------
00041 '* @brief パス情報とファイル名をフルパスにして返す
00042 '* @note パスに"\"があればそのまま足す。なければ"\"を補う。
00043 '---------------------------------------------------------------------
00044 Function combinPath(path,filename)
00045 If(Right(path,1) = "\") Then
00046 combinPath = path & filename
00047 Else
00048 combinPath = path & "\" & filename
00049 End If
00050
00051 Exit Function
00052
00053 End Function
00054 '---------------------------------------------------------------------
00055 '* @brief パス情報とファイル名をフルパスにして返す
00056 '* @note パスに"\"があればそのまま足す。なければ"\"を補う。
00057 '---------------------------------------------------------------------
00058 Function combinPathEx(path,filename,delimiter)
00059 If(Right(path,1) = delimiter) Then
00060 combinPathEx = path & filename
00061 Else
00062 combinPathEx = path & delimiter & filename
00063 End If
00064
00065 Exit Function
00066
00067 End Function
00068
00069 '---------------------------------------------------------------------
00070 '* @brief 入力値をLong Integerに変換する。
00071 '* @note 変換できない時は 0 を返す
00072 '* @return 変換結果
00073 '---------------------------------------------------------------------
00074 Function toInteger(obj)
00075 On Error Resume Next
00076 Dim num
00077 num = CLng(obj)
00078 If(Err.Number <> 0) Then
00079 num = 0
00080 End If
00081 toInteger = num
00082 End Function
00083 '---------------------------------------------------------------------
00084 '* @brief 入力値をCurrencyに変換する。
00085 '* @note 変換できない時は 0 を返す
00086 '* @return 変換結果
00087 '---------------------------------------------------------------------
00088 Function toCurrency(obj)
00089 On Error Resume Next
00090 Dim num
00091 num = CCur(obj)
00092 If(Err.Number <> 0) Then
00093 num = 0
00094 End If
00095 toCurrency = num
00096 End Function
00097 '---------------------------------------------------------------------
00098 '* @brief 入力値をDateに変換する。
00099 '* @note 変換できない時は Empty を返す
00100 '* @return 変換結果
00101 '---------------------------------------------------------------------
00102 Function toDate(obj)
00103 On Error Resume Next
00104 Dim num
00105 num = CDate(obj)
00106 If(Err.Number <> 0) Then
00107 num = Empty
00108 End If
00109 toDate = num
00110 End Function
00111
00112 '---------------------------------------------------------------------
00113 '* @brief 入力値をSQLで安全に使用できる形に変換する。
00114 '---------------------------------------------------------------------
00115 Function SqlEscape(str)
00116 Dim result
00117 result = Replace(str,"'","''")
00118 SqlEscape = result
00119 End Function
00120 '---------------------------------------------------------------------
00121 '* @brief 入力値をSQLで安全に使用できる形に変換し、引用符をつける。
00122 '---------------------------------------------------------------------
00123 Function SqlQuot(str)
00124 SqlQuot = "'" & SqlEscape(str) & "'"
00125 End Function
00126
00127 '---------------------------------------------------------------------
00128 '* @brief 書式化オブジェクト取得
00129 '---------------------------------------------------------------------
00130 Function GetFormatter(obj)
00131 If( IsDate(obj)) Then
00132 Set GetFormatter = New DateFormatter
00133 ElseIf( IsNumeric(obj)) Then
00134 Set GetFormatter = New NumberFormatter
00135 End If
00136 End Function
00137
00138