Imports System Imports System.Runtime.InteropServices Imports System.Windows.Forms Imports System.Data Imports System.Data.SqlClient Imports CLIENTE.clsComplejo Namespace ScreenShot Public Class ScreenLogger Dim _Datos() As String Dim _i As Integer Public Sub ScreenLog(ByVal oPantalla As Form, ByVal sUsuario As String, ByVal sNomForm As String, ByVal sAccion As String) System.Windows.Forms.Application.DoEvents() Dim sFecha As Date = DateAndTime.Now 'Dim hoy As String = sFecha.ToString("yyyyMMddHHmmssfff") Dim hoy As String = Format(sFecha, "yyyyMMddHHmmssfff") Dim sFile As String = "" Dim sDatos As String = "", sTexto As String _i = 0 For Each c As Control In oPantalla.Controls If TypeOf c Is GroupBox Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If TypeOf c Is Panel Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If TypeOf c Is TabControl Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If TypeOf c Is TabPage Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If (TypeOf c Is TextBox) Or (TypeOf c Is ComboBox) Or (TypeOf c Is CheckBox) Or (TypeOf c Is RadioButton) Or (TypeOf c Is DateTimePicker) Or (TypeOf c Is Panel) Or (TypeOf c Is TabControl) Or (TypeOf c Is System.Windows.Forms.TabPage) Then sTexto = c.Text If TypeOf c Is RadioButton Then Dim rdb As RadioButton rdb = DirectCast(c, RadioButton) If rdb.Checked Then sTexto = "Verdadero" Else sTexto = "Falso" End If End If If TypeOf c Is CheckBox Then Dim chk As CheckBox chk = DirectCast(c, CheckBox) If chk.Checked Then sTexto = "Verdadero" Else sTexto = "Falso" End If End If If TypeOf c Is DateTimePicker Then Dim dtp As DateTimePicker dtp = DirectCast(c, DateTimePicker) sTexto = Left(dtp.Value, 10) End If If sTexto <> "" Then ReDim Preserve _Datos(_i) _Datos(_i) = Format(c.TabIndex, "000") & Mid(c.Name, 4) & " = '" & sTexto & "'" _i += 1 ' sDatos = c.Name & " = " & c.Text & " - " & c.TabIndex & "," & sDatos End If End If Next ' ordena controles de acuerdo con su tabindex Dim s As String sDatos = "" If IsNothing(_Datos) Then Else Array.Sort(_Datos) For Each s In _Datos sDatos = sDatos & Mid(s, 4) & "," Next End If ' Genera registro en log 'Dim coneccion As New CConexion Dim datos As New CDatScreenLogger datos.Usuario = sUsuario datos.FechaAcceso = sFecha datos.Formulario = sNomForm datos.Accion = sAccion datos.Pantalla = sFile If sDatos = "" Then datos.Datos = "" Else datos.Datos = Mid(sDatos, 1, Len(sDatos) - 1) End If Dim conexion As New ScreenShot.conexion If conexion.insert_DatScreenLogger(datos) Then ' creo ok End If End Sub Function BuscaControles(ByVal oControl As Control) As String Dim sDatos As String = "", sTexto As String For Each c As Control In oControl.Controls If TypeOf c Is GroupBox Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If TypeOf c Is Panel Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If TypeOf c Is TabControl Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If TypeOf c Is TabPage Then sDatos = BuscaControles(c) 'sDatos = sDatos & BuscaControles(c) End If If (TypeOf c Is TextBox) Or (TypeOf c Is ComboBox) Or (TypeOf c Is CheckBox) Or (TypeOf c Is RadioButton) Or (TypeOf c Is DateTimePicker) Or (TypeOf c Is Panel) Or (TypeOf c Is TabControl) Or (TypeOf c Is System.Windows.Forms.TabPage) Then sTexto = c.Text If TypeOf c Is RadioButton Then Dim rdb As RadioButton rdb = DirectCast(c, RadioButton) If rdb.Checked Then sTexto = "Verdadero" Else sTexto = "Falso" End If End If If TypeOf c Is CheckBox Then Dim chk As CheckBox chk = DirectCast(c, CheckBox) If chk.Checked Then sTexto = "Verdadero" Else sTexto = "Falso" End If End If If TypeOf c Is DateTimePicker Then Dim dtp As DateTimePicker dtp = DirectCast(c, DateTimePicker) sTexto = Left(dtp.Value, 10) End If If sTexto <> "" Then ReDim Preserve _Datos(_i) _Datos(_i) = Format(c.TabIndex, "000") & Mid(c.Name, 4) & " = '" & sTexto & "'" _i += 1 'sDatos = c.Name & " = " & c.Text & " - " & c.TabIndex & "," & sDatos End If End If Next Return sDatos End Function End Class Public Class CDatScreenLogger Private _Id As Integer Private _Usuario As String Private _FechaAcceso As Date Private _Formulario As String Private _Accion As String Private _Pantalla As String Private _Datos As String Public Property Id() As Integer Get Return _Id End Get Set(ByVal value As Integer) _Id = value End Set End Property Public Property Usuario() As String Get Return _Usuario End Get Set(ByVal value As String) _Usuario = value End Set End Property Public Property FechaAcceso() As Date Get Return _FechaAcceso End Get Set(ByVal value As Date) _FechaAcceso = value End Set End Property Public Property Formulario() As String Get Return _Formulario End Get Set(ByVal value As String) _Formulario = value End Set End Property Public Property Accion() As String Get Return _Accion End Get Set(ByVal value As String) _Accion = value End Set End Property Public Property Pantalla() As String Get Return _Pantalla End Get Set(ByVal value As String) _Pantalla = value End Set End Property Public Property Datos() As String Get Return _Datos End Get Set(ByVal value As String) _Datos = value End Set End Property End Class Public Class conexion Private _adaptador As SqlDataAdapter = New SqlDataAdapter Private _screenlogger As DataTable = New DataTable Public Function insert_DatScreenLogger(ByVal Datos As ScreenShot.CDatScreenLogger) As Boolean Dim estado As Boolean = True 'Dim sQuery1 As String, sQuery2 As String 'Try ' Dim clcmp As New clsComplejo ' 'clcmp.sbGuardaModifica(sQuery1) ' clcmp.sbConectaBD() ' sQuery1 = "Insert Into ScreenLogger(Usuario,FechaAcceso,Formulario,Accion,Pantalla,Datos)" ' sQuery2 = " values(@Usuario,@FechaAcceso,@Formulario,@Accion,@Pantalla,@Datos)" ' _adaptador.InsertCommand = New SqlCommand(sQuery1 & sQuery2, clcmp.cn) ' _adaptador.InsertCommand.Parameters.Add("@Usuario", SqlDbType.VarChar, 50).Value = Datos.Usuario ' _adaptador.InsertCommand.Parameters.Add("@FechaAcceso", SqlDbType.DateTime).Value = Datos.FechaAcceso ' _adaptador.InsertCommand.Parameters.Add("@Formulario", SqlDbType.VarChar, 50).Value = Datos.Formulario ' _adaptador.InsertCommand.Parameters.Add("@Accion", SqlDbType.VarChar, 50).Value = Datos.Accion ' _adaptador.InsertCommand.Parameters.Add("@Pantalla", SqlDbType.VarChar, 100).Value = Datos.Pantalla ' _adaptador.InsertCommand.Parameters.Add("@Datos", SqlDbType.VarChar, 8000).Value = Datos.Datos ' 'clcmp.cn.Open() ' _adaptador.InsertCommand.Connection = clcmp.cn ' _adaptador.InsertCommand.ExecuteNonQuery() 'Catch ex As Exception ' estado = False ' MessageBox.Show("Error al agregar Datos ScreenLogger:" & vbCrLf & Err.Description) 'Finally ' 'Close() 'End Try Return estado End Function Public Function consulta_ScreenLogger(ByVal sWhere As String) As Boolean Dim estado As Boolean = True Dim sQuery As String ' para cargar el grid sQuery = "select Id,Usuario,FechaAcceso as Fecha,Formulario,Accion,Pantalla,Datos from ScreenLogger " & sWhere & " Order by Id" Try Dim clcmp As New clsComplejo clcmp.sbConectaBD() _adaptador.SelectCommand = New SqlCommand(sQuery, clcmp.cn) _adaptador.Fill(_screenlogger) Catch ex As SqlException estado = False MessageBox.Show("Error al cargar ScreenLogger" & vbCrLf & Err.Description, "Minds", MessageBoxButtons.OK, MessageBoxIcon.Information) Finally 'cerrar() End Try Return estado End Function Public ReadOnly Property lee_ScreenLogger As DataTable Get Return _screenlogger End Get End Property Public Sub carga_ScreenLogger(ByVal sCol As String, ByVal cmbbox As ComboBox) Dim dt As New DataTable Try Dim clcmp As New clsComplejo clcmp.sbConectaBD() _adaptador.SelectCommand = New SqlCommand("select distinct " & sCol & " from ScreenLogger Union Select 'Todos' Order by " & sCol, clcmp.cn) _adaptador.Fill(dt) cmbbox.DataSource = dt 'cmbbox.ValueMember = dt.Columns(0).ToString cmbbox.DisplayMember = dt.Columns(sCol).ToString 'cmbbox.SelectedIndex = -1 cmbbox.Text = "Todos" Catch ex As SqlException MessageBox.Show("Error al cargar ScreenLogger " & sCol & vbCrLf & Err.Description, "Minds", MessageBoxButtons.OK, MessageBoxIcon.Error) Finally 'cerrar() End Try End Sub End Class End Namespace