Take it easy!

　それまで自PCが最初にメールサーバーへ接続した時間を取得して出社時間、最後のチェックをもって退社時間としていた。しかしメールサーバーの停止処置によりこの作業がとん挫。

そこで自PC内でOracleExpressを稼働させ勤怠管理してみようと言う発想からスタート。

ボタン操作が必須にはなるが、Oracleへの接続を試す意味でも有効であると認識。今回は単純に出社データ追加と退社データ追加をボタンで操作する。

クラスを丸ごと記載するが特に問題は無いと思われる。

Imports System.Data.Common
Imports Oracle.DataAccess.Client
Public Class Form1
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
‘ProviderFactoryの設定
Dim factory As DbProviderFactory = _
DbProviderFactories.GetFactory(”Oracle.DataAccess.Client”)
Dim csbuilder As DbConnectionStringBuilder = _
factory.CreateConnectionStringBuilder
csbuilder(”Data Source”) = “localhost:1521/xe”
csbuilder(”User ID”) = “OraUser”
csbuilder(”Password”) = “OraPassword”

‘データベース接続
Dim conn As DbConnection = factory.CreateConnection()
conn.ConnectionString = csbuilder.ConnectionString
conn.Open()

‘データアクセス処理
Dim cmd As DbCommand = factory.CreateCommand()
cmd.Connection = conn
cmd.CommandType = CommandType.Text
cmd.CommandText = “SELECT * FROM MyName_Table”
Dim reader As DbDataReader = cmd.ExecuteReader()
Do While reader.Read()
Label1.Text = reader.GetString(0)
Loop
‘Close
conn.Close()
conn.Dispose()

Dim My_Day As String = Format(Now, “yyyy/MM/dd”)
Dim My_Time As String = Format(Now, “HH:mm:ss”)
TextBox1.Text = My_Day
TextBox2.Text = My_Time
End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
‘Time Get
Dim My_Day As String = Format(Now, “yyyy/MM/dd”)
Dim My_Time As String = Format(Now, “HH:mm:ss”)
Dim My_Name As String = Label1.Text
Dim My_In As String = “IN”
Dim OraConn As New OracleConnection
Dim strSQL As String = “INSERT INTO K_OUTIN(K_NAME, K_DATE, INOROUT, K_TIME) ”
strSQL &= ” VALUES(’” & My_Name & “‘, ‘” & My_Day & “‘, ‘” & My_In & “‘, ‘” & My_Time & “‘) ”

OraConn.ConnectionString = _
“user id=OraUser;” & _
“password=OraPassword;” & _
“Data Source=localhost:1521/xe”
Dim OraCmd As New OracleCommand(strSQL, OraConn)
OraConn.Open()
OraCmd.ExecuteNonQuery()
OraConn.Close()
Label2.Text = “データ追加完了！”
End Sub
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
‘Time Get
Dim My_Day As String = Format(Now, “yyyy/MM/dd”)
Dim My_Time As String = Format(Now, “HH:mm:ss”)
Dim My_Name As String = Label1.Text
Dim My_Out As String = “OUT”
Dim OraConn As New OracleConnection
Dim strSQL As String = “INSERT INTO K_OUTIN(K_NAME, K_DATE, INOROUT, K_TIME) ”
strSQL &= ” VALUES(’” & My_Name & “‘, ‘” & My_Day & “‘, ‘” & My_Out & “‘, ‘” & My_Time & “‘) ”

OraConn.ConnectionString = _
“user id=OraUser;” & _
“password=OraPassword;” & _
“Data Source=localhost:1521/xe”
Dim OraCmd As New OracleCommand(strSQL, OraConn)
OraConn.Open()
OraCmd.ExecuteNonQuery()
OraConn.Close()
Label2.Text = “データ追加完了！”
End Sub

Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
Me.Close()
Application.Exit()
End Sub

End Class

　VS2010では悲しいことにデータベースエクスプローラではSQL2000がサポートされない。

　どっこらしょ、っと二種類のDB、テーブルへ接続してレコードを取得、DataGridViewへ放り込んだソース。

　備忘録として記録。

Imports System.Data.SqlClient
Public Class Form1
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        If RadioButton2.Checked Then
            Dim connectionStr As String
            Dim sqlStr As String
            Dim dtsrc As New DataTable
            Dim nsda As SqlDataAdapter
            Try
                ‘接続
                connectionStr = “Server=ServerAddress;Initial Catalog=DB_Name;User ID=User;Password=password”
                Dim tnc1 As String = “”
                Dim tnc2 As String = “”
                Dim tnc3 As String = “”
                Dim tnc4 As String = “”
                Dim dbname As String = “”
                Select Case ComboBox1.Text
                    Case anyting
                        dbname = “dbname”
                End Select
                sqlStr = “Select * From  ” & dbname & ” ”
                If TextBox1.Text <> “” Then
                    tnc1 = TextBox1.Text
                    sqlStr = sqlStr & ” Where nou_tcd = ” & tnc1 & “”
                End If
                If TextBox2.Text <> “” Then
                    tnc2 = TextBox2.Text
                    sqlStr = sqlStr & ” or nou_tcd = ” & tnc2 & “”
                End If
                If TextBox3.Text <> “” Then
                    tnc3 = TextBox3.Text
                    sqlStr = sqlStr & ” or nou_tcd = ” & tnc3 & “”
                End If
                If TextBox4.Text <> “” Then
                    tnc4 = TextBox4.Text
                    sqlStr = sqlStr & ” or nou_tcd = ” & tnc4 & “”
                End If
                ‘コネクション生成
                Using con = New SqlConnection(connectionStr)
                    ‘接続
                    con.Open()
                    ‘SqlCommand生成
                    Dim cmd = New SqlCommand(sqlStr, con)
                    nsda = New SqlDataAdapter(cmd)
                    nsda.Fill(dtsrc)
                    DataGridView1.DataSource = dtsrc
                    con.Close()
                    con.Dispose()
                End Using
            Catch ex As Exception
                MsgBox(ex.Message)
            Finally
            End Try
        ElseIf RadioButton1.Checked Then
            Dim connectionStr As String
            Dim sqlStr As String
            Dim dtsrc As New DataTable
            Dim nsda As SqlDataAdapter
            Try
                ‘接続
                connectionStr = “Server=ServerAddress;Initial Catalog=DB_Name;User ID=User;Password=password”
                Dim otherdb As String = “otherdb”
                sqlStr = “Select * From  ” & otherdb & ” ”
                ‘コネクション生成
                Using con = New SqlConnection(connectionStr)
                    ‘接続
                    con.Open()
                    ‘SqlCommand生成
                    Dim cmd = New SqlCommand(sqlStr, con)
                    nsda = New SqlDataAdapter(cmd)
                    nsda.Fill(dtsrc)
                    DataGridView1.DataSource = dtsrc
                    con.Close()
                    con.Dispose()
                End Using
            Catch ex As Exception
                MsgBox(ex.Message)
            Finally
            End Try
        End If
    End Sub
    Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
        Me.Close()
    End Sub
    Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
        Dim setcont1 As String = “使い方説明”
        Dim setcontal As String
        setcontal = setcont1 & vbCrLf
        MsgBox(setcontal)
    End Sub
End Class

‘MDB内に指定したテーブルが存在するか
    ‘Table存在確認関数
    Private Function isExistsTable(ByVal strTableName As String)
        Dim objCat, objTable
        objCat = CreateObject(”ADOX.Catalog”)
        objCat.ActiveConnection = CONN
        isExistsTable = False
        For Each objTable In objCat.Tables
            If objTable.Type = “TABLE” Then
                If objTable.Name = strTableName Then
                    isExistsTable = True
                    Exit For
                End If
            End If
        Next
        objCat = Nothing
    End Function

‘開いているExcelBookとSheetをチェック
　’とりあえずBook名を引数に開いているかどうか
Imports Excel = Microsoft.Office.Interop.Excel
    ‘ExcelOpen検知関数
    ‘Open: fExcelOpen(ExFileName) = True
    Private Function fExcelOpen(ByVal ExFileName As String) As Boolean
        Dim oExcel As Excel.Application
        Dim oBooks As Excel.Workbooks
        Dim oBook As Excel.Workbook
        Dim fsts As Boolean = “False”
        Dim oSheets As Excel.Sheets
        Dim oSheet As Excel.Worksheet
        Try
            ‘別プロセスのExcelを取得する
            ‘GetObjext第1引数のファイルパスは省略する
            oExcel = GetObject(, “Excel.Application”)
            ‘開いているブックを全て取得する
            oBooks = oExcel.Workbooks
            ‘ブック毎に確認
            For Each oBook In oBooks
                If oBook.Name = ExFileName Then
                    fsts = True
                End If
            Next
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        Finally
            ‘COMコンポーネントの解放
            If Not oSheet Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oSheet)
                oSheet = Nothing
            End If
            If Not oSheets Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oSheets)
                oSheets = Nothing
            End If
            ‘COMコンポーネントの解放
            If Not oBook Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oBook)
                oBook = Nothing
            End If
            If Not oBooks Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oBooks)
                oBooks = Nothing
            End If
            If Not oExcel Is Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(oExcel)
                oExcel = Nothing
            End If
        End Try
        Return fsts
    End Function

　データグリッドへ表示した列の内容を別のフォームへ渡す。

　渡す側のフォーム（データグリッド表示後）
    Public Form4 As New Form4
    Public MeArray As New ArrayList
    Public Sub New(ByVal fr As Form4)
        MyBase.New()
        Form4 = fr
        InitializeComponent()
    End Sub
    Private Sub myDataGrid_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles DataGrid1.CurrentCellChanged
        Const RowRule As Integer = 18 ‘RowCount固定している。実際にはTable.Rows.Count - 1 など
        Dim cm As CurrencyManager = CType(DataGrid1.BindingContext(DataGrid1.DataSource, DataGrid1.DataMember), CurrencyManager)
        Dim dr As DataRow = CType(cm.Current, DataRowView).Row
        For i As Integer = 0 To RowRule
            MeArray.Add(dr.ItemArray(i))
        Next
        If Form4 Is Nothing = False Then
            Form4.OurArray = Me.MeArray
        End If
        Form4.Show()
        Me.Hide()

    End Sub

　受け取り側のフォーム
    ‘Form3の配列を取得
    Private Form3 As Form3
    Private mHensu As New ArrayList
    Public Property OurArray() As ArrayList
        Get
            Return mHensu
        End Get
        Set(ByVal Value As ArrayList)
            For i As Integer = 0 To 18 ‘行の項目数を固定しているため
                mHensu.Add(Value(i))
            Next
        End Set
    End Property

ファイルサーバーに接続してログインし、必要なフォルダをドライブ割り当てして作業するケースでの手法。作業後はドライブを切断する。

Imports System.Data.OleDB
    Public Declare Function WNetAddConnection2 Lib “mpr.dll” Alias “WNetAddConnection2A” (ByRef lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Integer) As Integer
    Public Declare Function WNetCancelConnection Lib “mpr.dll” Alias “WNetCancelConnection2A” (ByVal lpName As String, ByVal lpPlof As Integer, Optional ByVal fForce As Boolean = False) As Boolean
    Public Structure NETRESOURCE
        Public dwScope As Integer
        Public dwType As Integer
        Public dwDisplayType As Integer
        Public dwUsage As Integer
        Public lpLocalName As String
        Public lpRemoteName As String
        Public lpComment As String
        Public lpProvider As String
    End Structure
    Private Const RESOURCE_CONNECTED As Integer = &H1
    Private Const RESOURCETYPE_ANY As Integer = &H0
    Private Const RESOURCEDISPLAYTYPE_SHARE As Integer = &H3
    Private Const CONNECT_UPDATE_PROFILE As Integer = &H1
    Public Function ConnectSrv(ByVal pstrRemoteName As String, ByVal pstrUID As String, ByVal pstrPWD As String) As Long
        Dim typNetResource As NETRESOURCE
        Dim lngRet As Long
        With typNetResource
            .dwScope = RESOURCE_CONNECTED
            .dwType = RESOURCETYPE_ANY
            .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
            .lpLocalName = “Z:” ‘実際には空きドライブを検索するのがベター
            .lpRemoteName = pstrRemoteName
        End With
        lngRet = WNetAddConnection2(typNetResource, pstrPWD, pstrUID, CONNECT_UPDATE_PROFILE)
        If lngRet = 0 Then
            TextBox1.Text = “Connected”
        Else
            TextBox1.Text = “Disconnect”
        End If
    End Function
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim Cn As New OleDbConnection(”Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Z:\xxx\xxx.mdb”) ‘今回はmdbを操作
        Dim SQLCm As OleDbCommand = Cn.CreateCommand
        Dim Adapter As New OleDbDataAdapter(SQLCm)
        Dim Table As New DataTable
        SQLCm.CommandText = “SELECT * FROM xxx ORDER BY xxx.xxx”
        Adapter.Fill(Table)
        DataGrid1.DataSource = Table

        ‘実作業

        Table.Dispose()
        Adapter.Dispose()
        SQLCm.Dispose()
        Cn.Dispose()
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim RmHost As String = “\\サーバーアドレス\フォルダ”
        Dim RmUID As String = “ユーザー名”
        Dim RmPWD As String = “パスワード”
        ConnectSrv(RmHost, RmUID, RmPWD)
    End Sub
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim result As Boolean
        result = WNetCancelConnection(”Z:”, CONNECT_UPDATE_PROFILE, True)
        Debug.WriteLine(result.ToString())
        If result = “0″ Then
            TextBox1.Text = “Disconnect”
        Else
            TextBox1.Text = “Connected”
        End If
    End Sub
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        WNetCancelConnection(”Z:”, CONNECT_UPDATE_PROFILE, True)
        Me.Close()
    End Sub

　VB.NETを使用していて、標準のPrintDocumentコントロールを使用すると、用紙幅を検知できないため、自動で折り返しが利かない。逃げの手ではあるが強制的に改行させる関数を作ってみた。

    ‘文字列切断関数
    ‘ rsltStr = fStrCut(MyString,Keta)
    Private Function fStrCut(ByVal MyString As String, ByVal Keta As Integer) As String
        If Keta < 0 Or Keta > 70 Then
            fStrCut = MyString
            MsgBox(”正しい桁ではない”, vbOKOnly, “Column Error”)
            Exit Function
        End If
        If Len(MyString) < Keta Then
            fStrCut = MyString
            Exit Function
        End If
        ‘文字列の長さ
        Dim stringLen As Integer = Len(MyString)
        If stringLen = Keta Then
            fStrCut = MyString
            Exit Function
        End If
        ‘行数
        Dim rowCount As Integer = Fix(stringLen / Keta)
        ‘最後の行の長さ
        Dim lastRowLen As Integer = stringLen Mod Keta
        ‘出力用文字列を格納する動的配列
        Dim stringArray As New ArrayList
        ‘文字列切り出し
        For fi As Integer = 0 To rowCount - 1
            Dim fk As Integer = Keta * fi + 1
            Dim str As String = Microsoft.VisualBasic.Strings.Mid(MyString, fk, Keta) & vbCrLf
            stringArray.Add(str)
        Next fi
        If lastRowLen <> 0 Then
            Dim ostr As String = Microsoft.VisualBasic.Strings.Right(MyString, lastRowLen)
            If ostr <> “” And lastRowLen <> Keta Then
                stringArray.Add(ostr)
            End If
        End If
        Dim returnStr As String = “”
        For fj As Integer = 0 To stringArray.Count - 1
            returnStr = returnStr & stringArray(fj)
        Next fj
        Return returnStr
    End Function