Imports C1.Win.C1TrueDBGrid Imports System Imports System.IO Imports System.Data Imports System.Data.SqlTypes Imports System.Data.SqlClient Imports System.Diagnostics ''' ''' Namesace TKB.VV.Utils fasst die Utility-Klassen für die Vertragsverwaltung ''' zusammen. ''' ''' yes ''' ''' ''' ''' ''' ''' ''' ''' Namespace TKB.VV.Utils ''' ''' Klasse für das Speichern bzw. Auslesen von Image-Dateien in der Datenbank ''' ''' ''' Es werden folgende Datebanktabellen berücksichtigt: ''' ''' ''' Dokument Attribut DocImage ''' ''' Profile Attribut V_Uebersicht (Profillayout des C1TrueDBGrids der ''' Vertragsübersicht|Vertragselemente ''' ''' yes Public Class MyDocMgmt ''' ''' Grid-Layoutfile speichern ''' ''' C1Truedbgrind, von welchem das Layout gespeichert werden soll ''' Nummer des Grids: 1=Vertragsübersicht... ''' ''' Public Function Save_LayoutFile(ByRef c1data As C1TrueDBGrid, ByVal GridNo As Integer, ByVal Profilnr As Integer) As Boolean Dim filename As String = Globals.clsapplication.sTmp_filepath + Trim(Str(Profilnr)) + Trim(Str(GridNo)) + ".lyt" c1data.SaveLayout(filename) Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from profil where profilnr = " & Str(Profilnr), Connection) 'mitarbeiternr=" + Str(Globals.clsmitarbeiter.iMitarbeiternr.Value) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read) Dim mydata(fs.Length) As Byte fs.Read(mydata, 0, fs.Length) fs.Close() Try Connection.ConnectionString = Globals.sConnectionString Connection.Open() DA.Fill(ds, "profil") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then ' Neues Profil sepeichern myRow = ds.Tables(0).NewRow myRow.Item(1) = Globals.clsmitarbeiter.iMitarbeiternr.Value myRow.Item(2) = "" Select Case GridNo Case 1 myRow.Item(3) = mydata End Select ds.Tables(0).Rows.Add(myRow) DA.Update(ds, "profil") Else myRow = ds.Tables(0).Rows(0) Select Case GridNo Case 1 myRow.Item(3) = mydata End Select DA.Update(ds, "profil") End If Catch ex As Exception MsgBox(ex.Message) Return False End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return True End Function Private Function Get_Layoutfile_from_db(ByVal filename As String, ByVal GridNo As Integer, ByVal Profilnr As Integer) As Boolean 'Exit Function Dim connection As New SqlConnection() Dim da As New SqlDataAdapter("Select * From profil where profilnr=" & Str(Profilnr), connection) 'mitarbeiternr=" + Str(Globals.clsmitarbeiter.iMitarbeiternr.Value) Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da) Dim ds As New DataSet() Try connection.ConnectionString = Globals.sConnectionString connection.Open() da.Fill(ds, "docs") Dim myRow As DataRow myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte Select Case GridNo Case 1 MyData = myRow.Item(3) End Select Dim K As Long K = UBound(MyData) Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing Return True Catch ex As Exception Return False End Try CB = Nothing ds = Nothing da = Nothing connection.Close() connection = Nothing Return True End Function Public Function Get_Layout(ByRef c1data As C1TrueDBGrid, ByVal GridNo As Integer, ByVal Profilnr As Integer) As Boolean Dim filename As String = Globals.clsapplication.sTmp_filepath + Trim(Str(Profilnr)) + Trim(Str(GridNo)) + ".lyt" If File.Exists(filename) Then c1data.LoadLayout(filename) Return True End If If Get_Layoutfile_from_db(filename, GridNo, Profilnr) Then c1data.LoadLayout(filename) Return True End If Return False End Function ''' ''' Dokument in der Tabelle Dokument speichern ''' ''' Nummer des Dokument-Datensatzes ''' Zu speichender Dateiname ''' ''' Public Function Save_Document(ByVal Dokumentnr As Integer, ByVal Filename As String) As Boolean Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from dokument where dokumentnr =" + Str(dokumentnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read) Dim mydata(fs.Length) As Byte fs.Read(mydata, 0, fs.Length) fs.Close() Try Connection.ConnectionString = Globals.sConnectionString Connection.Open() DA.Fill(ds, "Dokument") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then Return False Else myRow = ds.Tables(0).Rows(0) myRow.Item(16) = mydata DA.Update(ds, "Dokument") End If Catch ex As Exception MsgBox(ex.Message) Return False End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return True End Function ''' ''' Liest das Dokument aus der DB und speichert dieses unter einem temporären Filenamen ab ''' ''' ''' ''' Public Function Get_Dokument(ByVal DokumentNr As Integer) As String Dim Filename As String = Globals.clsapplication.sTmp_filepath If Right(Filename, 1) <> "\" Then Filename = Filename + "\" Dim connection As New SqlConnection() Dim da As New SqlDataAdapter("Select * From Dokument where DokumentNr=" + Str(DokumentNr), connection) Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da) Dim ds As New DataSet() Try connection.ConnectionString = Globals.sConnectionString connection.Open() da.Fill(ds, "Dokument") Dim myRow As DataRow myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte MyData = myRow.Item(16) Dim K As Long K = UBound(MyData) Filename = Filename + myRow.Item(6) Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing Catch ex As Exception MsgBox(ex.Message, MsgBoxStyle.Critical) Return "" Finally connection.Close() connection = Nothing End Try CB = Nothing ds = Nothing da = Nothing Return Filename End Function Public Function Show_Document(ByVal Dokumentnr As Integer) As Boolean Dim tmpfilename As String = Me.Get_Dokument(Dokumentnr) If tmpfilename <> "" Then OpenSystemFile(tmpfilename) Return True End If Return False End Function Public Function OpenSystemFile(ByVal sFileName As String) As Boolean If Len(sFileName) > 0 Then System.Diagnostics.Process.Start(sFileName) ' ' ShellExecute(GetDesktopWindow(), vbNullString, sFileName, vbNullString, vbNullString, vbNormalFocus) Return True End If End Function Public Function Save_RptDatei(ByVal Auswertungnr As Integer, ByVal AuswertungName As String) As String Dim filename As String = AuswertungName Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from AuswertungRptDatei where AuswertungDateiNr = " & Str(Auswertungnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read) Dim mydata(fs.Length) As Byte fs.Read(mydata, 0, fs.Length) fs.Close() Try Connection.ConnectionString = Globals.sConnectionString Connection.Open() DA.Fill(ds, "RptFile") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then ' Neues Datei speichern myRow = ds.Tables(0).NewRow myRow.Item(0) = Auswertungnr myRow.Item(1) = AuswertungName myRow.Item(2) = RptName(AuswertungName) myRow.Item(3) = mydata myRow.Item(4) = Now myRow.Item(5) = Now myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value ds.Tables(0).Rows.Add(myRow) DA.Update(ds, "RptFile") Else myRow = ds.Tables(0).Rows(0) myRow.Item(1) = AuswertungName myRow.Item(2) = RptName(AuswertungName) myRow.Item(3) = mydata myRow.Item(5) = Now myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value DA.Update(ds, "RptFile") End If Catch ex As Exception MsgBox(ex.Message) Return False End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing Return RptName(AuswertungName) End Function Public Function RptName(ByVal path As String) As String Dim i As Integer Dim file As String = path i = InStrRev(file.Trim, "\") If i = 0 Then Return file.Trim Else Return Right(file.Trim, Len(file.Trim) - i) End If End Function Public Function Get_RptDatei(ByVal Auswertungnr As String, Optional ByVal fname As String = "") As String Dim connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from AuswertungRptDatei where AuswertungDateiNr = " & Str(Auswertungnr), connection) Dim CB As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim Filename As String = "" Try connection.ConnectionString = Globals.sConnectionString connection.Open() DA.Fill(ds, "RptFile") Dim myRow As DataRow myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte Filename = Globals.clsapplication.sTmp_filepath + "\" + myRow.Item(2).ToString If fname <> "" Then Filename = fname End If MyData = myRow.Item(3) Dim K As Long K = UBound(MyData) Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing Catch ex As Exception Return "" End Try CB = Nothing ds = Nothing DA = Nothing connection.Close() connection = Nothing Return filename End Function Public Function Save_Architekturfile(ByVal Applikationnr As Integer, ByVal iFilename As String) Dim filename As String = iFilename Dim Connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from ApplikationArchitektur where applikationnr = " & Str(Applikationnr), Connection) Dim cb As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim fs As New FileStream(filename, FileMode.OpenOrCreate, FileAccess.Read) Dim mydata(fs.Length) As Byte fs.Read(mydata, 0, fs.Length) fs.Close() Try Connection.ConnectionString = Globals.sConnectionString Connection.Open() DA.Fill(ds, "RptFile") Dim myRow As DataRow If ds.Tables(0).Rows.Count = 0 Then ' Neues Datei speichern myRow = ds.Tables(0).NewRow myRow.Item(0) = Applikationnr myRow.Item(1) = mydata ' myRow.Item(4) = Now ' myRow.Item(5) = Now ' myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value ds.Tables(0).Rows.Add(myRow) DA.Update(ds, "RptFile") Else myRow = ds.Tables(0).Rows(0) myRow.Item(1) = mydata ' myRow.Item(2) = RptName(AuswertungName) ' myRow.Item(3) = mydata ' myRow.Item(5) = Now ' myRow.Item(6) = Globals.clsmitarbeiter.iMitarbeiternr.Value DA.Update(ds, "RptFile") End If Catch ex As Exception MsgBox(ex.Message) Return False End Try fs = Nothing cb = Nothing ds = Nothing DA = Nothing Connection.Close() Connection = Nothing End Function Public Function Get_Architekturfile(ByVal Applikationnr As String, Optional ByVal fname As String = "") As String Dim connection As New SqlConnection() Dim DA As New SqlDataAdapter("select * from ApplikationArchitektur where applikationnr = " & Str(Applikationnr), connection) Dim CB As SqlCommandBuilder = New SqlCommandBuilder(DA) Dim ds As New DataSet() Dim Filename As String = "" Try connection.ConnectionString = Globals.sConnectionString connection.Open() DA.Fill(ds, "RptFile") Dim myRow As DataRow myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte Filename = Globals.clsapplication.sTmp_filepath + "\architekturfile.xml" If fname <> "" Then Filename = fname End If MyData = myRow.Item(1) Dim K As Long K = UBound(MyData) Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing Catch ex As Exception Return "" End Try CB = Nothing ds = Nothing DA = Nothing connection.Close() connection = Nothing Return Filename End Function End Class End Namespace