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