SQL Server via ODBC

[Massimiliano_Chiodi]

Eccola.

Public Sub addtable(tabella as String)
  // aggiunge una tabella all'array delle tabelle bloccate
  tabelle.Append(tabella)  
End Sub

Public Sub constructor(nomeprocedura as string)
  procedura = nomeprocedura  
End Sub

Public Sub destructor()
  if tabelle.Ubound > -1 then 
    // probabilmente non sono state sbloccate tutte le tabelle
    self.unlock
  end if
End Sub

Public Function lock() as Boolean
  if tabelle.Ubound < 0 then 
    Return true
    exit Function
  end if
  
  // blocca una o più tabelle
  // se una di queste è già bloccata mi fermo 
  // e ritorno false
  
  If Not app.db.Connected() then
    dim ko as new koalamsgbox
    ko.Visualizza(app.msg_errore_aperturadatabase + ": " + app.db.errormessage,"Blocco Tabelle")
    ko.Show
    Return false
    exit Function
  else
    // 21/05/2014 Mods per codicepage Mysql
    if app.dbdatabasetype = "MySQL" then app.db.SQLExecute("SET NAMES utf8 COLLATE utf8_general_ci; SET CHARACTER SET utf8")
    Dim sql As String
    
    sql = ""
    sql = sql + "SELECT * from semafori "
    'sql = sql + "WHERE utente = '" + procedure.utente + "' "
    if tabelle.Ubound > 0 then 
      sql = sql + "WHERE tabella in ("
      sql = sql + "'" + join(tabelle(),"','") + "'"
      sql = sql + ");"
    else
      sql = sql + "WHERE tabella = '" + tabelle(0) + "' "
      sql = sql + "AND utente <> '" + app.utente + "';"
    end if
    
    dim rsitem as RecordSet
    
    rsitem = app.db.SQLSelect(sql)
    if app.db.Error then 
      dim ko as new koalamsgbox
      ko.Visualizza("Errore durante la selezione dei dati dalla tabella semafori : " + app.db.ErrorMessage,"Blocco Tabelle")
      ko.Show
      Return false
      exit Function
    else
      
      if rsitem.eof then 
        // perfetto non ho blocchi !!!
        // quindi andesso li metto 
        
        for contatore as integer = 0 to tabelle.Ubound
          dim row as new DatabaseRecord
          row.Column("utente") = app.utente
          row.Column("procedura") = procedura
          row.Column("tabella") = tabelle(contatore)
          row.Column("host") = gethostname()
          
          app.db.InsertRecord("semafori",row)
          if app.db.Error then 
            dim ko as new koalamsgbox
            ko.Visualizza("Errore durante l'inserimento di un blocco nella tabella semafori : " + app.db.ErrorMessage,"Blocco Tabelle")
            ko.Show
            Return false
            exit Function
          else
            app.db.Commit()
            if app.db.Error then 
              dim ko as new koalamsgbox
              ko.Visualizza("Errore durante l'apporto delle modifiche alla tabella semafori : " + app.db.ErrorMessage,"Blocco Tabelle")
              ko.Show
              Return false
              exit Function
            end if
          end if
        next
        
        Return true
        exit Function
        
      else
        dim msg as string
        msg = "Attenzione, alcune tabelle risultano impegnate : " + EndOfLine
        
        while not rsitem.eof
          msg = msg + "- " + rsitem.Field("utente").utfValue + ", Proc. : " + rsitem.Field("procedura").utfValue + EndOfLine
          rsitem.MoveNext
        wend
        
        msg = msg + "attendere qualche secondo e riprovare"
        dim ko as new koalamsgbox
        ko.Visualizza(msg,"Blocco Tabelle")
        ko.Show
        Return false
      end if
    end if 
  end if
  
End Function

Public Sub unlock()
  
  If Not app.db.Connected() then
    dim ko as new koalamsgbox
    ko.Visualizza(app.msg_errore_aperturadatabase + ": " + app.db.errormessage,"Blocco Tabelle")
    ko.Show
    exit sub
  else
    // 21/05/2014 Mods per codicepage Mysql
    if app.dbdatabasetype = "MySQL" then app.db.SQLExecute("SET NAMES utf8 COLLATE utf8_general_ci; SET CHARACTER SET utf8")
    Dim sql As String
    
    sql = ""
    sql = sql + "DELETE from semafori "
    sql = sql + "WHERE utente = '" + app.utente + "' "
    if tabelle.Ubound > 0 then 
      sql = sql + "AND tabella in ("
      sql = sql + "'" + Join(tabelle(),"','") + "'"
      sql = sql + ");"
    else
      sql = sql + "AND tabella = '" + tabelle(0) + "';"
    end if
    
    app.db.SQLExecute(sql)
    
    if app.db.Error then 
      dim ko as new koalamsgbox
      ko.Visualizza("Errore durante lo sbloccaggio delle tabelle : " + app.db.ErrorMessage,"Blocco Tabelle")
      ko.Show
      exit sub
    else
      app.db.Commit
      if app.db.Error then 
        dim ko as new koalamsgbox
        ko.Visualizza("Errore durante l'apporto delle modifiche alla tabella semafori : " + app.db.ErrorMessage,"Blocco Tabelle") 
        ko.Show
        exit sub
      end if
    end if
  end if
End Sub

Proprietà :
procedura as string
tabelle() as string

koalamsgbox è una finestra con un timer che la chiude dopo due secondi

[Massimiliano_Chiodi]

Ti invio anche la classe database; cos puoi utilizzare tutti i tipi di db con la stessa applicazione;
io uso un file xml per configurare l’app.

[code]La classe database ( app.db )

Public Sub Close()
dbkoala.Close
End Sub

Public Sub Commit()
dbkoala.Commit
End Sub

Public Function Connect() as Boolean
Return dbkoala.Connect()

End Function

Public Function Connected() as Boolean
dim sql as string
sql = “SELECT 1”

dim rsuno as RecordSet
rsuno = app.db.SQLSelect(sql)

if app.db.Error then
if not app.testdb then
dim ko as new koalamsgbox
ko.Visualizza("Errore, non riesco a connettermi al database " + app.db.ErrorMessage,“Koala Database”)
ko.Show
Return false
else
Return true
end if
else
Return true
end if

End Function

Public Function ConnectionString() as String
select case me.type

case “Oracle”, “PostgreSQL”, “MySQL”

Return me.type + "," + me.Host + "," + str(me.Port) + "," + me.DatabaseName + "," + me.UserName

#if TargetWindows
  case "MsSQL"
    Return me.type + "," + me.Host + "," + str(me.Port) + "," + me.DatabaseName + "," + me.UserName
#endif

case “Sqlite”

Return ""

end Select
End Function

Public Sub Constructor(dbtype as String)
type = dbtype

select case type

case “PostgreSQL”
dbkoala = new PostgreSQLDatabase

case “MySQL”
dbkoala = new MySQLCommunityServer

#if TargetWindows
  case "MsSQL"
    dbkoala = new MSSQLServerDatabase
#endif

case “Oracle”
dbkoala = new OracleDatabase

case “Sqlite”
dbkoala = new SQLiteDatabase

case else
dim ko as new koalamsgbox
ko.visualizza(“tipo database non supportato”,“Koala Database”)
ko.Show

end Select
End Sub

// databasename una classe doppia !

Public Function DatabaseName() as String

if dbkoala isa PostgreSQLDatabase then
Return PostgreSQLDatabase(dbkoala).DatabaseName
exit Function
end if

if dbkoala isa MySQLCommunityServer then
Return MySQLCommunityServer(dbkoala).DatabaseName
exit Function
end if

#if TargetWindows
if dbkoala isa MSSQLServerDatabase then
Return MSSQLServerDatabase(dbkoala).DatabaseName
exit Function
end if
#endif

if dbkoala isa OracleDatabase then
Return OracleDatabase(dbkoala).DatabaseName
exit Function
end if

if dbkoala isa SQLiteDatabase then
Return SQLiteDatabase(dbkoala).DatabaseName
exit Function
end if
End Function

Public Sub DatabaseName(Assigns dbName as String)
if dbkoala isa PostgreSQLDatabase then
PostgreSQLDatabase(dbkoala).DatabaseName = dbName
exit sub
end if

if dbkoala isa MySQLCommunityServer then
MySQLCommunityServer(dbkoala).DatabaseName = dbName
exit sub
end if

#if TargetWindows
if dbkoala isa MSSQLServerDatabase then
MSSQLServerDatabase(dbkoala).DatabaseName = dbName
exit sub
end if
#endif

if dbkoala isa OracleDatabase then
OracleDatabase(dbkoala).DatabaseName = dbName
exit sub
end if

if dbkoala isa SQLiteDatabase then
SQLiteDatabase(dbkoala).DatabaseName = dbName
exit sub
end if
End Sub

Public Sub Destructor()
End Sub

Public Function Error() as Boolean
Return dbkoala.Error
End Function

Public Function ErrorCode() as Integer
Return dbkoala.errorCode
End Function

Public Function ErrorMessage() as String
Return dbkoala.errorMessage
End Function

Public Function FieldSchema(tabella as String) as RecordSet
Return dbkoala.FieldSchema(tabella)
End Function

Public Function GetDB() as Database
return dbkoala
End Function

// anche la funzione Host una doppia funzione

Public Function Host() as String
Return dbkoala.Host
End Function

Public Sub Host(Assigns hostName as String)
dbkoala.Host = hostName
End Sub

Public Sub InsertRecord(tabella as string, dbrec as DatabaseRecord)
dbkoala.InsertRecord(tabella,dbrec)
End Sub

// doppia funzione
Public Function Password() as String
Return dbkoala.Password
End Function

Public Sub Password(Assigns pWord as String)
dbkoala.Password = pWord
End Sub

// anche port una doppia funzione

Public Function Port() as Integer
if dbkoala isa PostgreSQLDatabase then
Return PostgreSQLDatabase(dbkoala).Port
exit Function
end if

if dbkoala isa MySQLCommunityServer then
Return MySQLCommunityServer(dbkoala).Port
exit Function
end if

#if TargetWindows
if dbkoala isa MSSQLServerDatabase then
Return MSSQLServerDatabase(dbkoala).Port
exit Function
end if
#endif

if dbkoala isa OracleDatabase then
Return 0
exit Function
end if

if dbkoala isa SQLiteDatabase then
Return 0
exit Function
end if

End Function

Public Sub Port(Assigns portValue as Integer)
if dbkoala isa PostgreSQLDatabase then
PostgreSQLDatabase(dbkoala).Port = portValue
end if

if dbkoala isa MySQLCommunityServer then
MySQLCommunityServer(dbkoala).Port = portValue
end if

#if TargetWindows
if dbkoala isa MSSQLServerDatabase then
MSSQLServerDatabase(dbkoala).Port = portValue
end if
#endif

if dbkoala isa OracleDatabase then
// nulla…
end if

if dbkoala isa SQLiteDatabase then
// nulla…
end if
End Sub

Public Function Prepare(statement as String) as PreparedSQLStatement
select case type

case “PostgreSQL”
dim ps as PreparedSQLStatement = dbkoala.Prepare(statement)
if dbkoala.error then
dim ko as new koalamsgbox
ko.visualizza("Errore durante la preparazione del comando prepare : " + dbkoala.ErrorMessage,“Koala Database”)
ko.Show
end
Return PostgreSQLPreparedStatement(ps)

case “MySQL”
dim ps as PreparedSQLStatement = dbkoala.Prepare(statement)
if dbkoala.error then
dim ko as new koalamsgbox
ko.visualizza("Errore durante la preparazione del comando prepare : " + dbkoala.ErrorMessage,“Koala Database”)
ko.Show
end
Return MySQLPreparedStatement(ps)

#if TargetWindows
  case "MsSQL"
    dim ps as PreparedSQLStatement = dbkoala.Prepare(statement)
    if dbkoala.error then
      dim ko as new koalamsgbox
      ko.visualizza("Errore durante la preparazione del comando prepare : " + dbkoala.ErrorMessage,"Koala Database")
      ko.Show
    end
    Return MSSQLServerPreparedStatement(ps)
#endif

case “Oracle”
dim ps as PreparedSQLStatement = dbkoala.Prepare(statement)
if dbkoala.error then
dim ko as new koalamsgbox
ko.visualizza("Errore durante la preparazione del comando prepare : " + dbkoala.ErrorMessage,“Koala Database”)
ko.Show
end
Return OracleSQLPreparedStatement(ps)

case “Sqlite”
dim ps as PreparedSQLStatement = dbkoala.Prepare(statement)
if dbkoala.error then
dim ko as new koalamsgbox
ko.visualizza("Errore durante la preparazione del comando prepare : " + dbkoala.ErrorMessage,“Koala Database”)
ko.Show
end
Return SQLitePreparedStatement(ps)

end Select
End Function

Public Sub Rollback()
dbkoala.Rollback
End Sub

Public Sub SQLExecute(executeString as String)
dbkoala.SQLExecute(executeString)
End Sub

Public Function SQLSelect(query as String) as RecordSet
Return dbkoala.SQLSelect(query)
End Function

Public Function tableschema() as RecordSet
Return dbkoala.TableSchema()
End Function

// doppia funzione UserName
Public Function UserName() as String
Return dbkoala.Username
End Function

Public Sub UserName(Assigns userName as String)
dbkoala.Username = userName
End Sub

Propriet
dbkoala as database ( private )
type as string
[/code]

[Massimiliano_Chiodi]

NB: io ho chiamato la classe dbKoala, tu puoi chiamarla come vuoi per devi sostituire nel codice dbKoala con il nuovo nome

[Nedi_Freguglia]

Grazie mille, Max. Me le studier per bene!