Imports Microsoft.VisualBasic
Imports System.Data.SqlClient
Imports System.Data
Imports System.Globalization
Public Class SQLGestioneDatabase
Dim collValoriCampi As New Collection
Dim collValoriChiavi As New Collection
Public Function ApriDatabase(ByVal ConnectionString As String, Optional ByVal forzaDB As String = "")
Dim Conn As New System.Data.SqlClient.SqlConnection
Dim StringadiConnessione As String
If Left(Web.HttpContext.Current.Session("Ambiente"), 6) = "uCloud" Then
Select Case ConnectionString
Case "SECURITY"
StringadiConnessione = ConfigurationManager.ConnectionStrings("SECURITYConnectionString").ToString
Case "C2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("C2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "N2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("N2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "S2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("S2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "M2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("M2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "KFDM"
StringadiConnessione = ConfigurationManager.ConnectionStrings("KFDMConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "D2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("KFDMConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "CONNECTA"
StringadiConnessione = ConfigurationManager.ConnectionStrings("ConnectaConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "CONNECTA", "CONNECTA" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "DOC2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("DOC2000ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "DOC2000", "DOC2000" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
End Select
Conn.ConnectionString = StringadiConnessione
If Conn.State <> ConnectionState.Open Then
Conn.Open()
End If
Return Conn
Exit Function
End If
If forzaDB = "" Then
'Recupera Stringa di Connessione da WEB.CONFIG (Sezione <connectionStrings>) in base al Modulo
Select Case ConnectionString
Case "SECURITY"
StringadiConnessione = ConfigurationManager.ConnectionStrings("SECURITYConnectionString").ToString
Case "C2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("C2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
Case "G2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("G2000-D001ConnectionString").ToString
Case "H2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("H2000-D001ConnectionString").ToString
Case "M2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("M2000-D001ConnectionString").ToString
Case "N2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("N2000-D001ConnectionString").ToString
Case "P2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("P2000-D001ConnectionString").ToString
Case "S2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("S2000-D001ConnectionString").ToString
If Web.HttpContext.Current.Session("Utente") = "QKWeJeIYrdEQ61awRDN6nQ==" Then
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & Web.HttpContext.Current.Session("ArchivioContabilePredefinito"))
End If
Case "T2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("T2000-D001ConnectionString").ToString
Case "X2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("X2000-D001ConnectionString").ToString
Case "B2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("B2000-D001ConnectionString").ToString
'ARCHIVI STANDARD
Case "S9999"
StringadiConnessione = ConfigurationManager.ConnectionStrings("S2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D999")
'StringadiConnessione = "Data Source=.\SQLEXPRESS;AttachDbFilename=|DataDirectory|\S2000-D999.mdf;Integrated Security=True;User Instance=True; Connect Timeout=60"
Case "C9999"
StringadiConnessione = ConfigurationManager.ConnectionStrings("C2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D999")
'StringadiConnessione = "Data Source=.\SQLEXPRESS;AttachDbFilename=|DataDirectory|\C2000-D999.mdf;Integrated Security=True;User Instance=True; Connect Timeout=60"
Case "N9999"
StringadiConnessione = ConfigurationManager.ConnectionStrings("N2000-D001ConnectionString").ToString
StringadiConnessione = Replace(StringadiConnessione, "D001", "D999")
'StringadiConnessione = "Data Source=.\SQLEXPRESS;AttachDbFilename=|DataDirectory|\N2000-D999.mdf;Integrated Security=True;User Instance=True; Connect Timeout=60"
''''''''''''''''
Case "KFDM"
StringadiConnessione = ConfigurationManager.ConnectionStrings("KFDMConnectionString").ToString
Case "D2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("KFDMConnectionString").ToString
Case "CONNECTA"
StringadiConnessione = ConfigurationManager.ConnectionStrings("ConnectaConnectionString").ToString
Case "DOC2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("DOC2000ConnectionString").ToString
Case "CONVENZIONE020"
StringadiConnessione = ConfigurationManager.ConnectionStrings("Convenzione020ConnectionString").ToString
Case "SPBBANK2_ITA"
StringadiConnessione = ConfigurationManager.ConnectionStrings("SPBBANK2_ITAConnectionString").ToString
End Select
Else
'Recupera Stringa di Connessione da WEB.CONFIG (Sezione <connectionStrings>) in base al Modulo
Select Case ConnectionString
Case "SECURITY"
StringadiConnessione = ConfigurationManager.ConnectionStrings("SECURITYConnectionString").ToString
Case "C2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("C2000-D001ConnectionString").ToString
Case "G2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("G2000-D001ConnectionString").ToString
Case "H2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("H2000-D001ConnectionString").ToString
Case "M2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("M2000-D001ConnectionString").ToString
Case "N2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("N2000-D001ConnectionString").ToString
Case "P2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("P2000-D001ConnectionString").ToString
Case "S2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("S2000-D001ConnectionString").ToString
Case "T2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("T2000-D001ConnectionString").ToString
Case "X2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("X2000-D001ConnectionString").ToString
Case "B2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("B2000-D001ConnectionString").ToString
'ARCHIVI STANDARD
Case "S9999"
StringadiConnessione = "Data Source=.\SQLEXPRESS;AttachDbFilename=|DataDirectory|\S2000-D999.mdf;Integrated Security=True;User Instance=True; Connect Timeout=60"
Case "C9999"
StringadiConnessione = "Data Source=.\SQLEXPRESS;AttachDbFilename=|DataDirectory|\C2000-D999.mdf;Integrated Security=True;User Instance=True; Connect Timeout=60"
Case "N9999"
StringadiConnessione = "Data Source=.\SQLEXPRESS;AttachDbFilename=|DataDirectory|\N2000-D999.mdf;Integrated Security=True;User Instance=True; Connect Timeout=60"
''''''''''''''''
Case "KFDM"
StringadiConnessione = ConfigurationManager.ConnectionStrings("KFDMConnectionString").ToString
Case "D2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("KFDMConnectionString").ToString
Case "CONNECTA"
StringadiConnessione = ConfigurationManager.ConnectionStrings("ConnectaConnectionString").ToString
Case "DOC2000"
StringadiConnessione = ConfigurationManager.ConnectionStrings("DOC2000ConnectionString").ToString
Case "CONVENZIONE020"
StringadiConnessione = ConfigurationManager.ConnectionStrings("Convenzione020ConnectionString").ToString
Case "SPBBANK2_ITA"
StringadiConnessione = ConfigurationManager.ConnectionStrings("SPBBANK2_ITAConnectionString").ToString
End Select
StringadiConnessione = Replace(StringadiConnessione, "D001", "D" & forzaDB)
End If
Conn.ConnectionString = StringadiConnessione
If Conn.State <> ConnectionState.Open Then
Conn.Open()
End If
Return Conn
End Function
Public Sub ChiudiDatabase(ByVal conn As System.Data.SqlClient.SqlConnection)
conn.Close()
conn.Dispose()
End Sub
Public Sub AddValoriCampo(ByVal NomeCampo As String, ByVal Valore As String, Optional ByVal tipoCampo As String = "S", Optional ByVal blancForzato As Boolean = False)
Dim ValoreCampo As New clsSqlTipiCampo(NomeCampo, Valore, tipoCampo, blancForzato)
collValoriCampi.Add(ValoreCampo)
ValoreCampo = Nothing
End Sub
Public Sub AddValoriChiave(ByVal NomeCampo As String, ByVal Valore As String, Optional ByVal tipoCampo As String = "S", Optional ByVal blancForzato As Boolean = False)
Dim ValoreChiave As New clsSqlTipiCampo(NomeCampo, Valore, tipoCampo, blancForzato)
collValoriChiavi.Add(ValoreChiave)
ValoreChiave = Nothing
End Sub
Public Function Exist(ByVal Id As Long, ByVal Tabella As String, ByVal StringaConnessione As String) As Boolean
Dim sSql As String
sSql = "Select Id From " & Tabella & _
" WHERE [id] = " & Id
Dim gestDb As New SQLGestioneDatabase
Dim ds As DataSet = gestDb.ApriDataset(sSql, StringaConnessione)
Dim row As DataRow
For Each row In ds.Tables(0).Rows
Return (True)
Next
Return (False)
End Function
Public Function Scrivi(ByVal NomeTabella As String, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing)
Dim valoriCampi As New clsSqlTipiCampo
Dim valore As String
Dim campo As String
Dim tipoCampo As String
Dim CampoBlanc As Boolean
Dim elencoCampi As String
Dim elencoValori As String
Dim sSql As String
Dim esito As Integer
For Each valoriCampi In collValoriCampi
campo = valoriCampi.Campo
valore = valoriCampi.Valore
tipoCampo = valoriCampi.TipoCampo
CampoBlanc = valoriCampi.CampoBlanc
elencoCampi = elencoCampi & "[" & campo & "], "
elencoValori = elencoValori & ToSqlValue(valore, tipoCampo) & ", "
Next
elencoCampi = Left(elencoCampi, Len(elencoCampi) - 2)
elencoValori = Left(elencoValori, Len(elencoValori) - 2)
sSql = "INSERT INTO [" & NomeTabella & "] (" & elencoCampi & ") VALUES (" & elencoValori & ")"
Try
esito = executeSql(sSql, StringaConnessione, MessaggioErrore, MessaggioSQL)
Catch ex As Exception
Dim log As New clsLog
log.WriteLine("SQLGestioneDatabase::Insert", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDatabase::Insert", "Sql_Error=" & sSql, , , MessaggioErrore)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::Insert - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::Insert - Sql_Error=" & sSql
End If
esito = 0
'Err.Raise(1001, " SQLGestioneDatabase::Insert", "ERRORE: " & ex.Message)
End Try
Return esito
End Function
Public Function Scrivi2(ByVal NomeTabella As String, ByVal cn As SqlConnection, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing)
Dim valoriCampi As New clsSqlTipiCampo
Dim valore As String
Dim campo As String
Dim tipoCampo As String
Dim CampoBlanc As Boolean
Dim elencoCampi As String
Dim elencoValori As String
Dim sSql As String
Dim esito As Integer
For Each valoriCampi In collValoriCampi
campo = valoriCampi.Campo
valore = valoriCampi.Valore
tipoCampo = valoriCampi.TipoCampo
CampoBlanc = valoriCampi.CampoBlanc
elencoCampi = elencoCampi & "[" & campo & "], "
elencoValori = elencoValori & ToSqlValue(valore, tipoCampo) & ", "
Next
elencoCampi = Left(elencoCampi, Len(elencoCampi) - 2)
elencoValori = Left(elencoValori, Len(elencoValori) - 2)
sSql = "INSERT INTO [" & NomeTabella & "] (" & elencoCampi & ") VALUES (" & elencoValori & ")"
Try
esito = executeSql2(sSql, cn, MessaggioErrore, MessaggioSQL)
Catch ex As Exception
Dim log As New clsLog
log.WriteLine("SQLGestioneDatabase::Insert", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDatabase::Insert", "Sql_Error=" & sSql, , , MessaggioErrore)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::Insert - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::Insert - Sql_Error=" & sSql
End If
esito = 0
'Err.Raise(1001, " SQLGestioneDatabase::Insert", "ERRORE: " & ex.Message)
End Try
Return esito
End Function
Public Sub InsertPrepare()
Dim el As Integer
For el = 1 To collValoriCampi.Count
collValoriCampi.Remove(1)
Next
For el = 1 To collValoriChiavi.Count
collValoriChiavi.Remove(1)
Next
End Sub
Public Function executeSql(ByVal sSql As String, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing, Optional ByVal forzaDB As String = "")
Dim cn As SqlClient.SqlConnection = ApriDatabase(StringaConnessione, forzaDB)
Dim myCommand As New SqlClient.SqlCommand(sSql, cn)
Dim esito As Integer
Try
myCommand.CommandTimeout = 7200
esito = myCommand.ExecuteNonQuery()
Catch ex As Exception
If Left(ex.Message, 22) = "SQL Server ha bloccato" Then
GoTo ChiudiConnessione
End If
Dim log As New clsLog
log.WriteLine("SQLGestioneDataBase::executeSql", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDataBase::executeSql", "Sql_Error=" & sSql, , , MessaggioErrore)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::executeSql - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::executeSql - Sql_Error=" & sSql
End If
esito = 0
'Err.Raise(1003, ex.Source, ex.Message)
'''''''''''''''''''''''''''''''
''''Visualizzazione ERRORE.aspx
'''''''''''''''''''''''''''''''
If Web.HttpContext.Current.Session("ARRIVO") <> "UPDATEDB" Then
Web.HttpContext.Current.Session("ARRIVO") = Nothing
Web.HttpContext.Current.Session("MessaggioErrore") = "ATTENZIONE: SQLGestioneDataBase::executeSql - ERRORE: " & ex.Message
Web.HttpContext.Current.Session("MessaggioSQL") = "ATTENZIONE: SQLGestioneDataBase::executeSql - Sql_Error=" & sSql
Web.HttpContext.Current.Response.Redirect("~/Moduli/Utility/GestioneErrori/Error.aspx", True)
End If
'''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''
ChiudiConnessione:
Finally
myCommand.Dispose()
ChiudiDatabase(cn)
End Try
Return esito
End Function
Public Function executeSql2(ByVal sSql As String, ByVal cn As SqlConnection, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing, Optional ByVal forzaDB As String = "")
Dim myCommand As New SqlClient.SqlCommand(sSql, cn)
Dim esito As Integer
Try
myCommand.CommandTimeout = 7200
esito = myCommand.ExecuteNonQuery()
Catch ex As Exception
If Left(ex.Message, 22) = "SQL Server ha bloccato" Then
GoTo ChiudiConnessione
End If
Dim log As New clsLog
log.WriteLine("SQLGestioneDataBase::executeSql", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDataBase::executeSql", "Sql_Error=" & sSql, , , MessaggioErrore)
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::executeSql - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::executeSql - Sql_Error=" & sSql
End If
esito = 0
log.WriteLine("SqlGestioneDatabase: executeSql", ex.Message)
Throw New Exception(ex.Message)
End Try
ChiudiConnessione:
Return esito
End Function
Public Function ApriDataset(ByVal strSelect As String, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing, Optional ByRef Esito As Integer = 0) As Data.DataSet
Dim sqlDA As New SqlClient.SqlDataAdapter
Dim ds As New DataSet
Dim Conn As New System.Data.SqlClient.SqlConnection
Conn = ApriDatabase(StringaConnessione)
sqlDA.SelectCommand = New SqlClient.SqlCommand(strSelect, Conn)
sqlDA.SelectCommand.CommandTimeout = 7200
Try
Esito = sqlDA.Fill(ds)
Catch ex As Exception
If Left(ex.Message, 22) = "SQL Server ha bloccato" Then
GoTo ChiudiConnessione
End If
Dim log As New clsLog
log.WriteLine("SQLGestioneDataBase::OpenDataset", "ERRORE: " & ex.Message)
log.WriteLine("SQLGestioneDataBase::OpenDataset", "Sql_Error=" & strSelect)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::OpenDataset - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::OpenDataset - Sql_Error=" & strSelect
End If
Esito = 0
'Err.Raise(1004, " SQLGestioneDataBase::OpenDataset", "ERRORE: " & ex.Message)
'''''''''''''''''''''''''''''''
''''Visualizzazione ERRORE.aspx
'''''''''''''''''''''''''''''''
If Web.HttpContext.Current.Session("ARRIVO") <> "UPDATEDB" Then
Web.HttpContext.Current.Session("ARRIVO") = Nothing
Web.HttpContext.Current.Session("MessaggioErrore") = "ATTENZIONE: SQLGestioneDataBase::executeSql - ERRORE: " & ex.Message
Web.HttpContext.Current.Session("MessaggioSQL") = "ATTENZIONE: SQLGestioneDataBase::executeSql - Sql_Error=" & strSelect
Web.HttpContext.Current.Response.Redirect("~/Moduli/Utility/GestioneErrori/Error.aspx", True)
End If
'''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''
End Try
ChiudiConnessione:
ChiudiDatabase(Conn)
Return ds
End Function
Public Function ApriDataset2(ByVal strSelect As String, ByVal conn As SqlConnection, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing, Optional ByRef Esito As Integer = 0) As Data.DataSet
Dim sqlDA As New SqlClient.SqlDataAdapter
Dim ds As New DataSet
sqlDA.SelectCommand = New SqlClient.SqlCommand(strSelect, conn)
sqlDA.SelectCommand.CommandTimeout = 7200
Try
Esito = sqlDA.Fill(ds)
Catch ex As Exception
If Left(ex.Message, 22) = "SQL Server ha bloccato" Then
GoTo ChiudiConnessione
End If
Dim log As New clsLog
log.WriteLine("SQLGestioneDataBase::OpenDataset", "ERRORE: " & ex.Message, )
log.WriteLine("SQLGestioneDataBase::OpenDataset", "Sql_Error=" & strSelect, )
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::OpenDataset - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::OpenDataset - Sql_Error=" & strSelect
End If
Esito = 0
Throw New Exception(ex.Message)
End Try
ChiudiConnessione:
Return ds
End Function
Public Function ApriDatasetAvanzato(ByVal strSelect As String, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing, Optional ByRef ForzaDb As Integer = 0, Optional ByRef Esito As Integer = 0) As Data.DataSet
Dim sqlDA As New SqlClient.SqlDataAdapter
Dim ds As New DataSet
Dim Conn As New System.Data.SqlClient.SqlConnection
Dim strForzaDb As String = Format(ForzaDb, "000")
Conn = ApriDatabase(StringaConnessione, strForzaDb)
sqlDA.SelectCommand = New SqlClient.SqlCommand(strSelect, Conn)
sqlDA.SelectCommand.CommandTimeout = 7200
Try
Esito = sqlDA.Fill(ds)
Catch ex As Exception
If Left(ex.Message, 22) = "SQL Server ha bloccato" Then
GoTo ChiudiConnessione
End If
Dim log As New clsLog
log.WriteLine("SQLGestioneDataBase::OpenDataset", "ERRORE: " & ex.Message)
log.WriteLine("SQLGestioneDataBase::OpenDataset", "Sql_Error=" & strSelect)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::OpenDataset - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::OpenDataset - Sql_Error=" & strSelect
End If
Esito = 0
'Err.Raise(1004, " SQLGestioneDataBase::OpenDataset", "ERRORE: " & ex.Message)
'''''''''''''''''''''''''''''''
''''Visualizzazione ERRORE.aspx
'''''''''''''''''''''''''''''''
If Web.HttpContext.Current.Session("ARRIVO") <> "UPDATEDB" Then
Web.HttpContext.Current.Session("ARRIVO") = Nothing
Web.HttpContext.Current.Session("MessaggioErrore") = "ATTENZIONE: SQLGestioneDataBase::executeSql - ERRORE: " & ex.Message
Web.HttpContext.Current.Session("MessaggioSQL") = "ATTENZIONE: SQLGestioneDataBase::executeSql - Sql_Error=" & strSelect
Web.HttpContext.Current.Response.Redirect("~/Moduli/Utility/GestioneErrori/Error.aspx", True)
End If
'''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''
End Try
ChiudiConnessione:
ChiudiDatabase(Conn)
Return ds
End Function
Public Function Cancella(ByVal Id As Long, ByVal nomeTabella As String, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing)
Dim esito As Integer
Dim sSql As String
sSql = "Delete From " & nomeTabella & " WHERE Id = " & Id
Dim gestDb As New SQLGestioneDatabase
Try
esito = gestDb.executeSql(sSql, StringaConnessione, MessaggioErrore, MessaggioSQL)
Catch ex As Exception
Dim log As New clsLog
log.WriteLine("SQLGestioneDataBase::Delete", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDataBase::Delete", "Sql_Error=" & sSql, , , MessaggioErrore)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::Delete - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::Delete - Sql_Error=" & sSql
End If
esito = 0
'Err.Raise(1004, " SQLGestioneDataBase::OpenDataset", "ERRORE: " & ex.Message)
End Try
Return esito
End Function
Public Function Cancella2(ByVal Id As Long, ByVal nomeTabella As String, ByVal cn As SqlConnection, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing)
Dim esito As Integer
Dim sSql As String
sSql = "Delete From " & nomeTabella & " WHERE Id = " & Id
Dim gestDb As New SQLGestioneDatabase
Try
esito = gestDb.executeSql2(sSql, cn, MessaggioErrore, MessaggioSQL)
Catch ex As Exception
Dim log As New clsLog
log.WriteLine("SQLGestioneDataBase::Delete", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDataBase::Delete", "Sql_Error=" & sSql, , , MessaggioErrore)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::Delete - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::Delete - Sql_Error=" & sSql
End If
esito = 0
'Err.Raise(1004, " SQLGestioneDataBase::OpenDataset", "ERRORE: " & ex.Message)
End Try
Return esito
End Function
Public Function Aggiorna(ByVal Id As Long, ByVal Tabella As String, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing) As Integer
Dim esito As Integer
Dim gestdb As New SQLGestioneDatabase
AddValoriChiave("Id", Id, "n")
If collValoriCampi.Count > 0 And collValoriChiavi.Count > 0 Then
esito = gestdb.Update(Tabella, collValoriCampi, collValoriChiavi, StringaConnessione, MessaggioErrore, MessaggioSQL)
End If
Return esito
End Function
Public Function Aggiorna2(ByVal Id As Long, ByVal Tabella As String, ByVal cn As SqlConnection, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing) As Integer
Dim esito As Integer
Dim gestdb As New SQLGestioneDatabase
AddValoriChiave("Id", Id, "n")
If collValoriCampi.Count > 0 And collValoriChiavi.Count > 0 Then
esito = gestdb.Update2(Tabella, collValoriCampi, collValoriChiavi, cn, MessaggioErrore, MessaggioSQL)
End If
Return esito
End Function
Public Function AggiornaEspl(ByVal Tabella As String, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing) As Integer
Dim esito As Integer
Dim gestdb As New SQLGestioneDatabase
If collValoriCampi.Count > 0 And collValoriChiavi.Count > 0 Then
esito = gestdb.Update(Tabella, collValoriCampi, collValoriChiavi, StringaConnessione, MessaggioErrore, MessaggioSQL)
End If
Return esito
End Function
Public Function ControlloModuloAttivo(ByVal CodCanale As String, ByVal Utente As String, ByVal CodPagina As String) As Integer
Dim esito As Integer
Dim sSql As String
Dim ds As New DataSet
Dim row As DataRow
Dim CodPagina2 As String
Dim Xsec As Integer = 0
Dim Data1 As Date
Dim Data2 As Date
Dim log As New clsLog
log.WriteLine("SQLGestioneDatabase: ", "Ambiente = " & Left(Web.HttpContext.Current.Session("Ambiente"), 6))
'Verifico Connessione UTENZA
If utente = "unimedia" Then
Else
If Left(Web.HttpContext.Current.Session("Ambiente"), 6) = "uCloud" Then
sSql = "Select UltimoAccesso " & _
"FROM Security_Utenti " & _
"WHERE (IDUtente = '" & Utente & "')"
ds = ApriDataset(sSql, "SECURITY")
If ds.Tables(0).Rows.Count > 0 Then
For Each row In ds.Tables(0).Rows
Data1 = row("UltimoAccesso").ToString
Data2 = Web.HttpContext.Current.Session("ControlloAccesso")
Xsec = DateDiff(DateInterval.Second, Data1, Data2)
Next
End If
If CDbl(Xsec) > 35 Or CDbl(Xsec) < -35 Then
log.WriteLine("SQLGestioneDatabase: ", "Utente = " & Utente)
log.WriteLine("SQLGestioneDatabase: ", "Data1 = " & Data1)
log.WriteLine("SQLGestioneDatabase: ", "Data2 = " & Data2)
log.WriteLine("SQLGestioneDatabase: ", "Differenza = " & Xsec & " sec.")
log.WriteLine("SQLGestioneDatabase: ", "XSEC = " & Xsec)
Web.HttpContext.Current.Response.Redirect("~/Moduli/Utility/GestioneErrori/ControlloAccesso.aspx", True)
End If
End If
End If
sSql = "SELECT Id FROM Security_FormNonAbilitate " & _
"WHERE CodCanale = '" & CodCanale & "' AND IDUtente = '" & Utente & "' AND IDForm = '" & CodPagina & "' AND TipoDisabilitazione='D'"
ds = ApriDataset(sSql, "SECURITY")
If ds.Tables(0).Rows.Count = 0 Then
esito = 0 'Esito uguale a zero -----> il form è abilitato per l'utente specificato
ds = New DataSet
CodPagina2 = Left(CodPagina, 1) & "0000"
If CodPagina = "C0075" Then
Else
sSql = "SELECT Id FROM Security_FormNonAbilitate " & _
"WHERE CodCanale = '" & CodCanale & "' AND IDUtente = '" & Utente & "' AND IDForm = '" & CodPagina2 & "' AND TipoDisabilitazione='D'"
ds = ApriDataset(sSql, "SECURITY")
If ds.Tables(0).Rows.Count <> 0 Then
esito = 2 'Esito uguale a due -----> il modulo non è abilitato per l'utente specificato
End If
End If
Else
esito = 1 'Esito uguale a uno -----> il form è non abilitato per l'utente specificato
End If
'-----------------------------------------------
'---- Rilegge per vedere se form in SOLA LETTURA
sSql = "SELECT Id FROM Security_FormNonAbilitate " & _
"WHERE CodCanale = '" & CodCanale & "' AND IDUtente = '" & Utente & "' AND IDForm = '" & CodPagina & "' AND TipoDisabilitazione='L'"
ds = ApriDataset(sSql, "SECURITY")
If ds.Tables(0).Rows.Count = 0 Then
Else
esito = 3 'Esito uguale a 3 -----> il form è IN SOLA LETTURA
End If
ds = Nothing
Return esito
End Function
Public Function AccessoAutorizzato(ByVal Utente As String, ByVal PIN As String) As Boolean
Dim ds As New DataSet
Dim gestDb As New SQLGestioneDatabase
Dim row As DataRow
Dim ssql As String
Dim ut As New Utility
Dim Giorno As String
Dim HHDa, MMDa, HHA, MMA As Int16
Dim CheGiorno As String
Dim esito As Boolean
esito = True
'Controllare in SECURITY_CONTROLLOACCESSI se per il PIN e' attivo CONTROLLO
ssql = "Select * from Security_ControlloAccessi where PIN = '" & PIN & "'"
ds = gestDb.ApriDataset(ssql, "SECURITY")
If ds.Tables(0).Rows.Count = 0 Then
esito = True
ds = Nothing
GoTo RestituisciValore
End If
For Each row In ds.Tables(0).Rows
If ut.nullInBlanc(row("AbilitaControlloAccessi")) <> "True" Then
'Se NO --> Esci. L'amministratore non ha attivato CONTROLLO ACCESSI
esito = True
ds = Nothing
GoTo RestituisciValore
End If
Next
ds = Nothing
'Se SI ---> controllo su SECURITY_UTENTI
'Controllare in SECURITY_CONTROLLOACCESSI se per il PIN e' attivo CONTROLLO
ssql = "Select * from Security_Utenti where IDUtente = '" & Utente & "' and CodiceDB ='" & PIN & "'"
ds = gestDb.ApriDataset(ssql, "SECURITY")
For Each row In ds.Tables(0).Rows
'Che giorno della settimana
Giorno = LCase(Now.ToString("dddd", New CultureInfo("it-IT")))
Select Case Giorno
Case "lunedì"
If ut.nullInBlanc(row("LUNEDIAccesso")) = "True" Then
CheGiorno = "LUNEDI"
Else
esito = False
ds = Nothing
GoTo RestituisciValore
End If
Case "martedì"
If ut.nullInBlanc(row("MARTEDIAccesso")) = "True" Then
CheGiorno = "MARTEDI"
Else
esito = False
ds = Nothing
GoTo RestituisciValore
End If
Case "mercoledì"
If ut.nullInBlanc(row("MERCOLEDIAccesso")) = "True" Then
CheGiorno = "MERCOLEDI"
Else
esito = False
ds = Nothing
GoTo RestituisciValore
End If
Case "giovedì"
If ut.nullInBlanc(row("GIOVEDIAccesso")) = "True" Then
CheGiorno = "GIOVEDI"
Else
esito = False
ds = Nothing
GoTo RestituisciValore
End If
Case "venerdì"
If ut.nullInBlanc(row("VENERDIAccesso")) = "True" Then
CheGiorno = "VENERDI"
Else
esito = False
ds = Nothing
GoTo RestituisciValore
End If
Case "sabato"
If ut.nullInBlanc(row("SABATOAccesso")) = "True" Then
CheGiorno = "SABATO"
Else
esito = False
ds = Nothing
GoTo RestituisciValore
End If
Case "domenica"
If ut.nullInBlanc(row("DOMENICAAccesso")) = "True" Then
CheGiorno = "DOMENICA"
Else
esito = False
ds = Nothing
GoTo RestituisciValore
End If
End Select
'Fascia oraria assegnata all'utente per la giornata di oggi
HHDa = ut.nullInzero(row(CheGiorno & "_HH_DA"))
MMDa = ut.nullInzero(row(CheGiorno & "_MM_DA"))
HHA = ut.nullInzero(row(CheGiorno & "_HH_A"))
MMA = ut.nullInzero(row(CheGiorno & "_MM_A"))
''''''''''''''''''''''
'INIZIO FASCIA ORARIA
''''''''''''''''''''''
If Now.Hour < HHDa Then
'FUORI FASCIA
esito = False
ds = Nothing
GoTo RestituisciValore
End If
If Now.Hour = HHDa And Now.Minute < MMDa Then
'FUORI FASCIA
esito = False
ds = Nothing
GoTo RestituisciValore
End If
''''''''''''''''''''
'FINE FASCIA ORARIA
''''''''''''''''''''
If Now.Hour > HHA Then
'FUORI FASCIA
esito = False
ds = Nothing
GoTo RestituisciValore
End If
If Now.Hour = HHA And Now.Minute > MMA Then
'FUORI FASCIA
esito = False
ds = Nothing
GoTo RestituisciValore
End If
Next
ds = Nothing
RestituisciValore:
Return esito
End Function
Public Function Update(ByVal nomeTabella As String, ByVal CollValoriCampi As Collection, ByVal CollValoriChiavi As Collection, ByVal StringaConnessione As String, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing)
Dim valoriCampi As New clsSqlTipiCampo
Dim valoriChiavi As New clsSqlTipiCampo
Dim elencoSet As String
Dim sWhere As String
Dim valore As String
Dim campo As String
Dim tipoCampo As String
Dim CampoBlanc As Boolean
Dim sSql As String
Dim esito As Integer
For Each valoriCampi In CollValoriCampi
campo = valoriCampi.Campo
valore = valoriCampi.Valore
tipoCampo = valoriCampi.TipoCampo
CampoBlanc = valoriCampi.CampoBlanc
elencoSet = elencoSet & "[" & campo & "] = " & ToSqlValue(valore, tipoCampo) & ", "
Next
If elencoSet.Length > 2 Then
elencoSet = Left(elencoSet, Len(elencoSet) - 2)
End If
For Each valoriChiavi In CollValoriChiavi
campo = valoriChiavi.Campo
valore = valoriChiavi.Valore
tipoCampo = valoriChiavi.TipoCampo
CampoBlanc = valoriChiavi.CampoBlanc
sWhere = sWhere & campo & "=" & ToSqlValue(valore, tipoCampo) & " AND "
Next
If sWhere.Length > 2 Then
sWhere = Left(sWhere, Len(sWhere) - 5)
End If
sSql = "UPDATE " & nomeTabella & " SET " & elencoSet & " WHERE " & sWhere
Try
esito = executeSql(sSql, StringaConnessione, MessaggioErrore, MessaggioSQL)
Catch ex As Exception
Dim log As New clsLog
log.WriteLine("SQLGestioneDatabase::Update", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDatabase::Update", "Sql_Error=" & sSql, , , MessaggioErrore)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::Update - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::Update - Sql_Error=" & sSql
End If
esito = 0
'Err.Raise(1001, " SQLGestioneDatabase::Update", "ERRORE: " & ex.Message)
End Try
Return esito
End Function
Public Function Update2(ByVal nomeTabella As String, ByVal CollValoriCampi As Collection, ByVal CollValoriChiavi As Collection, ByVal cn As SqlConnection, Optional ByRef MessaggioErrore As String = Nothing, Optional ByRef MessaggioSQL As String = Nothing)
Dim valoriCampi As New clsSqlTipiCampo
Dim valoriChiavi As New clsSqlTipiCampo
Dim elencoSet As String
Dim sWhere As String
Dim valore As String
Dim campo As String
Dim tipoCampo As String
Dim CampoBlanc As Boolean
Dim sSql As String
Dim esito As Integer
For Each valoriCampi In CollValoriCampi
campo = valoriCampi.Campo
valore = valoriCampi.Valore
tipoCampo = valoriCampi.TipoCampo
CampoBlanc = valoriCampi.CampoBlanc
elencoSet = elencoSet & "[" & campo & "] = " & ToSqlValue(valore, tipoCampo) & ", "
Next
If elencoSet.Length > 2 Then
elencoSet = Left(elencoSet, Len(elencoSet) - 2)
End If
For Each valoriChiavi In CollValoriChiavi
campo = valoriChiavi.Campo
valore = valoriChiavi.Valore
tipoCampo = valoriChiavi.TipoCampo
CampoBlanc = valoriChiavi.CampoBlanc
sWhere = sWhere & campo & "=" & ToSqlValue(valore, tipoCampo) & " AND "
Next
If sWhere.Length > 2 Then
sWhere = Left(sWhere, Len(sWhere) - 5)
End If
sSql = "UPDATE " & nomeTabella & " SET " & elencoSet & " WHERE " & sWhere
Try
esito = executeSql2(sSql, cn, MessaggioErrore, MessaggioSQL)
Catch ex As Exception
Dim log As New clsLog
log.WriteLine("SQLGestioneDatabase::Update", "ERRORE: " & ex.Message, , , MessaggioErrore)
log.WriteLine("SQLGestioneDatabase::Update", "Sql_Error=" & sSql, , , MessaggioErrore)
log = Nothing
If MessaggioErrore Is Nothing Then
'Segnalazione errore non prevista
Else
MessaggioErrore = "ATTENZIONE: SQLGestioneDataBase::Update - ERRORE: " & ex.Message
End If
If MessaggioSQL Is Nothing Then
'Segnalazione Stringa SQL non prevista
Else
MessaggioSQL = "ATTENZIONE: SQLGestioneDataBase::Update - Sql_Error=" & sSql
End If
esito = 0
'Err.Raise(1001, " SQLGestioneDatabase::Update", "ERRORE: " & ex.Message)
End Try
Return esito
End Function
Public Function ToSqlValue(ByVal Valore As String, ByVal Tipo As String)
' Tipo:
' s : stringa
' n : Numerico
' d : data/ora
' b : boolean
Dim r As String
Select Case LCase(Tipo)
Case "s", ""
r = "'" & Trim(Replace(Valore, "'", "''")) & "'"
Case "n"
If IsNumeric(Valore) Then
Dim v As Double
v = CDbl(Valore)
r = CStr(v)
r = Replace(v, ",", ".")
Else
r = "0"
End If
Case "d"
'Formato ISO 8601
'yyyy-mm-ddThh:mm:ss
'Il vantaggio dell'utilizzo del formato ISO 8601 consiste nel fatto che è uno standard internazionale. Inoltre, i valori datetime specificati in tale formato non presentano ambiguità e le impostazioni di SET DATEFORMAT o SET LANGUAGE non influiscono sul formato.
If IsDate(Valore) Then
r = "'" & Right("0000" & Year(Valore), 4) & "-" & Right("00" & Month(Valore), 2) & "-" & Right("00" & Day(Valore), 2)
If Hour(Valore) <> 0 Or Minute(Valore) <> 0 Or Second(Valore) <> 0 Then
r = r & "T" & Right("00" & Hour(Valore), 2) & ":" & Right("00" & Minute(Valore), 2) & ":" & Right("00" & Second(Valore), 2)
End If
r = r & "'"
ElseIf LCase(Valore) = "null" Then
r = "Null"
Else
r = "''"
End If
Case "b"
If LCase(Trim(Valore)) <> "true" And Valore <> "-1" And Valore <> "1" Then
r = "False"
Else
r = "True"
End If
r = Replace(Valore, "'", "")
Case Else
r = Valore
End Select
Return r
End Function
End Class
' Classe utilizzata per Insert/update ===================================================
Public Class clsSqlTipiCampo
Private lCampo As String
Private lValore As String
Private lTipoCampo As String
Private lCampoBlanc As Boolean
Public Sub New()
lCampo = ""
lValore = ""
lTipoCampo = "S"
lCampoBlanc = False
End Sub
Public Sub New(ByVal Campo As String, ByVal valore As String, ByVal TipoCampo As String, ByVal CampoBlanc As Boolean)
lCampo = Campo
lValore = valore
lTipoCampo = TipoCampo
lCampoBlanc = CampoBlanc
End Sub
Public Property Campo()
Get
Return lCampo
End Get
Set(ByVal Value)
lCampo = Value
End Set
End Property
Public Property Valore()
Get
Return lValore
End Get
Set(ByVal Value)
lValore = Value
End Set
End Property
Public Property TipoCampo()
Get
Return lTipoCampo
End Get
Set(ByVal Value)
lTipoCampo = Value
End Set
End Property
Public Property CampoBlanc()
Get
Return lCampoBlanc
End Get
Set(ByVal Value)
lCampoBlanc = Value
End Set
End Property
End Class