「共通関数の定義ファイルを追加」の編集履歴（バックアップ）一覧に戻る
共通関数の定義ファイルを追加 - (2008/02/20 (水) 15:15:40) のソース
// 現在のページ名
*&this_page()
**概要
共通関数を定義したクラスファイルを追加する。
クラスファイルには、データベースへの接続等、比較的どのシステムでも共通するであろう処理を記述してある。
**前提条件
-[[新しいwebサイトの作成]]
-[[BASP21のインストール]]
-[[.NET から COM（例：BASP21） を使う]]
**手順
[ソリューションエクスプローラ] -> 「新しい項目の追加」
&img(273.jpg)
「クラス」を選択 -> 「追加」
&img(274.jpg)
class1.vb を以下のように変更。
#highlight(vb.net){
Imports Microsoft.VisualBasic
Imports BASP21Lib
Public Class class_common
Inherits System.Web.UI.Page
' ******************************************************
' DB接続
' ******************************************************
Public Shared Function DBConnect( _
ByVal DBType As String, _
ByRef Cn As Data.Odbc.OdbcConnection, _
ByVal strTarget As String, _
ByVal strDB As String, _
ByVal strUser As String, _
ByVal strPass As String _
)
Dim ConnectionString As String = ""
If IsNothing(Cn) Then
Cn = New Data.Odbc.OdbcConnection()
End If
Select Case DBType
'Case "Excel"
' ConnectionString = _
' "Provider=Microsoft.Jet.odbc.4.0;" & _
' "Data Source=" & strTarget & ";" & _
' "Extended Properties=""Excel 8.0;IMEX=1;"""
'Case "MDB"
' ConnectionString = _
' "Provider=Microsoft.Jet.odbc.4.0;" & _
' "Data Source=" & strTarget & ";"
'Case "MySQL"
' ConnectionString = _
' "Provider=MSDASQL" & _
' ";DSN=" & strTarget & _
' ";DATABASE=" & strDB & _
' ";UID=" & strUser & _
' ";PWD=" & strPass & _
' ";"
Case "SQLServer"
ConnectionString = _
"Driver={SQL Server};" & _
"SERVER=" & strTarget & ";" & _
"DATABASE=" & strDB & ";" & _
"UID=" & strUser & ";" & _
"PWD=" & strPass & ";"
Case "ASP.NET開発サーバ"
ConnectionString = _
"Driver={SQL Server};" & _
"SERVER=" & strTarget & ";" & _
"DATABASE=" & strDB & ";" & _
"Integrated Security=SSPI;"
End Select
On Error Resume Next
Cn.ConnectionString = ConnectionString
Cn.Open()
If Err.Number <> 0 Then
Return False
Else
Return True
End If
On Error GoTo 0
End Function
' ******************************************************
' DB終了処理(接続を閉じる)
' ******************************************************
Public Shared Function DBClose( _
ByRef Cn As Data.Odbc.OdbcConnection _
)
On Error Resume Next
If Cn.State >= 1 Then
Cn.Close()
End If
On Error GoTo 0
Return True
End Function
' ******************************************************
' DB読込み
'
' 引数１： DBへの接続
' 引数２： テーブルリーダー（更新クエリ発行時は使用しませんが、ダミーで渡してください。）
' 引数３： SQL
' 引数４： 更新フラグ。
' True： SQL発行のみ行います。
' False： SQL発行後、テーブルリーダーを作成します。
' 戻り値： True（成功） , False(エラー発生)
' ******************************************************
Public Shared Function DBGet( _
ByRef Cn As Data.Odbc.OdbcConnection, _
ByRef Dtr As Data.DataTableReader, _
ByVal SqlQuery As String, _
ByVal bUpadateFlg As Boolean _
)
' コマンド作成
Dim command As Data.Odbc.OdbcCommand = New Data.Odbc.OdbcCommand
command.CommandText = SqlQuery
command.Connection = Cn
' テーブルアダプタ＋データセット作成
Dim DataAdapter As Data.Odbc.OdbcDataAdapter
Dim DataSet As Data.DataSet = New Data.DataSet
' テーブルリーダ初期化
Dtr = Nothing
Try
' 更新フラグによって処理分岐
If bUpadateFlg Then
command.ExecuteNonQuery()
Else
DataAdapter = New Data.Odbc.OdbcDataAdapter(command)
DataAdapter.Fill(DataSet)
Dtr = DataSet.CreateDataReader()
End If
Return True
Catch ex As Exception
Return False
End Try
End Function
' ******************************************************
' web.config中の、「AppSetting」で定義した文字列を取得する。
' ******************************************************
Public Shared Function getAppSettingString(ByVal str_temp As String)
Return System.Configuration.ConfigurationManager.AppSettings(str_temp)
End Function
Public Shared Function GetProfileString(ByVal strPath, ByVal strSection, ByVal strEntry)
On Error Resume Next
Dim bFound As Boolean
Dim fileno As Integer
Dim str_return As String = ""
Dim str_Line As String
Dim array_work As Array
fileno = FreeFile()
FileOpen(fileno, strPath, OpenMode.Input)
bFound = False
While Not EOF(fileno)
str_Line = LineInput(fileno)
If bFound Then
If Left(str_Line, 1) = "[" Then
Exit While
End If
str_Line = LTrim(str_Line)
If Left(str_Line, Len(strEntry)) = strEntry Then
array_work = Split(str_Line, "=")
If Trim(array_work(0)) = strEntry Then
If UBound(array_work) = 1 Then
str_return = Trim(array_work(1))
Exit While
End If
End If
End If
End If
If str_Line = "[" & strSection & "]" Then
bFound = True
End If
End While
FileClose(fileno)
On Error GoTo 0
Return str_return
End Function
' **********************************************************
' メール送信
' User が設定されていいると、認証を行う
' **********************************************************
Public Shared Function SendMail( _
ByVal strTo As String _
, ByVal strFrom As String _
, ByVal strSubject As String _
, ByVal strBody As String _
, ByVal strFile As String _
)
Dim basp As Basp21 = New Basp21()
' ログファイル用パス指定。
Dim str_logFilePath As String = HttpContext.Current.Server.MapPath("./mail.log")
' SMTPサーバ設定
Dim strServer As String = "メールサーバ"
Dim strPort As String = "ポート番号"
Dim strUser As String = "ユーザ名"
Dim strPass As String = "パスワード"
Dim strAuth As String = "認証タイプ"
If strPort <> "" Then
strServer &= ":" & strPort
End If
If strUser <> "" Then
strFrom &= vbTab & strUser & ":" & strPass
End If
If strAuth <> "" Then
strFrom &= vbTab & strAuth
End If
Dim ret As String
ret = basp.SendMail( _
strServer, _
strTo, _
strFrom, _
strSubject, _
strBody, _
strFile _
)
Dim fileno As Integer
fileno = FreeFile()
Try
' ファイルに書き込み
FileOpen(fileno, str_logFilePath, OpenMode.Append)
WriteLine(fileno, "------------------------------")
If ret <> "" Then
PrintLine(fileno, "エラーが発生しています")
WriteLine(fileno, "error : " & ret)
WriteLine(fileno, "Server : " & strServer)
Else
WriteLine(fileno, "メールは正しく送信されました")
End If
WriteLine(fileno, "MailTo : " & strTo)
WriteLine(fileno, "MailFrom : " & strFrom)
WriteLine(fileno, "MailSubject : " & strSubject)
WriteLine(fileno, "MailBody : " & strBody)
WriteLine(fileno, "MailFile : " & strFile)
Finally
FileClose(fileno)
End Try
Return ret
End Function
End Class
}
default.aspx.vb を以下のように変更する。
#highlight(vb.net){
Partial Class _Default
Inherits class_common
End Class
}
