client/Seguridad/ScreenCapture.vb

355 lines
12 KiB
VB.net

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