Codigo BD Procedimiento SP_nombre
SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE Procedure [dbo].[SPMAN_EMPRESA]
@TIPOPE char (1),
@EMPRCOD CHAR(7),
@EMPRDES VARCHAR(100),
@EMPRRUC CHAR(11),
@EMPRCONT VARCHAR(50),
@EMPRTLF VARCHAR(50),
@EMPRDEPA VARCHAR(50),
@EMPRPRO VARCHAR(50),
@EMPRDIS VARCHAR(50),
@EMPRDIR VARCHAR(100),
@EMPREMA VARCHAR(50),
@USUACOD VARCHAR(50),
@EMPRPASS VARCHAR(50)
--@USUAFECACT DATETIME
As Begin
Declare
@VLMenErr varchar (150)
SET DATEFORMAT dmy
Begin Tran Tran_ManTituSer
/************************************ Insertar ****************************************/
If @TipOpe = 'I'
Begin
SELECT @EMPRCOD = ISNULL(MAX(EMPRCOD), 0) FROM EMPRESA
SELECT @EMPRCOD = CONVERT(NUMERIC(7),SUBSTRING (@EMPRCOD,2,7)+1000001)
SELECT @EMPRCOD='E'+SUBSTRING (@EMPRCOD,2,7)
Insert EMPRESA
(EMPRCOD ,EMPRDES ,EMPRRUC ,EMPRCONT,EMPRTLF,
EMPRDEPA ,EMPRPRO ,EMPRDIS ,EMPREMA,
EMPRDIR , USUACOD, USUAFECACT,EMPRPASS)
Values
(@EMPRCOD ,@EMPRDES ,@EMPRRUC ,@EMPRCONT,@EMPRTLF,
@EMPRDEPA,@EMPRPRO ,@EMPRDIS
,@EMPRDIR ,@EMPREMA , @USUACOD, GETDATE(),@EMPRPASS)
If @@Error<>0
Begin
Select @VLMenErr = 'Error al Insertar Registro de TARIFARIO...!!!'
Goto EtqError
End
End
/********************************** Modifica ***************************************/
If @TipOpe = 'U'
Begin
Update EMPRESA Set
EMPRCOD =@EMPRCOD,
EMPRDES=@EMPRDES,
EMPRRUC =@EMPRRUC,
EMPRCONT=@EMPRCONT,
EMPRTLF=@EMPRTLF,
EMPRDEPA=@EMPRDEPA,
EMPRPRO=@EMPRPRO,
EMPRDIS=@EMPRDIS,
EMPRDIR =@EMPRDIR,
EMPREMA=@EMPREMA,
USUACOD = @USUACOD,
USUAFECACT = GETDATE(),
EMPRPASS=@EMPRPASS
WHERE @EMPRCOD = EMPRCOD
If @@Error<>0
Begin
Select @VLMenErr = 'Error al actualizar registro de TARIFARIO...!!!'
Goto EtqError
End
End
/**************************** Elimina ********************************/
If @TipOpe='D'
Begin
Delete EMPRESA
WHERE @EMPRCOD =EMPRCOD
If @@Error<>0
Begin
Select @VLMenErr = 'Error al eliminar Registro de TARIFARIO..!!!'
Goto EtqError
End
End
/*********************************************************************************/
Commit Tran Tran_ManTituSer
Goto EtqSalir
EtqError:
RollBack Tran Tran_ManTituSer
RAISERROR (@VLMenErr,16,1)
Goto EtqSalir
EtqSalir:
End
'=========================================
Vb6
1. conexion DNS
2. diseño de formulario
3. cargar referencias
codigo de modulo
'======================================================
Public Cnx As New ADODB.Connection
Sub Main()
Cnx.ConnectionString = "Dsn=nombre;user id=sa; password;"
Cnx.Open
Form1.Show
End Sub
Public Sub EJECUTAR(ByVal SQL As String)
Cnx.Execute SQL
End Sub
'======================================================
Contenido de formulario
matriz de text1(0) al 2,
combo1,Fecha (DtPicker)
Command1(0) al 3
Command2 para reporte
Codigo Formulario
'======================================================
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Command1_Click(Index As Integer)
On Error GoTo x
Dim R As String
Select Case Index
Case 0
Call limpiar
Case 1
If lblestado.Caption = "NUEVO" Then
R = MsgBox("SEGURO DE INGRESAR", vbYesNo)
If R = vbYes Then Call MANTENIMIENTO("I")
ElseIf lblestado.Caption = "EDICION" Then
R = MsgBox("SEGURO DE MODIFICAR", vbYesNo)
If R = vbYes Then Call MANTENIMIENTO("U")
End If
Case 2
If lblestado.Caption = "EDICION" Then
R = MsgBox("SEGURO DE ELIMINAR", vbYesNo)
If R = vbYes Then Call MANTENIMIENTO("D")
End If
Case 3
Call RellenarLista
End Select
Exit Sub
x:
MsgBox Err.Description
End Sub
Sub limpiar()
For i = 0 To 1
Text1(i).Text = ""
Next i
Combo1.Text = "ACTIVADO"
lblestado.Caption = "NUEVO"
Fecha.Value = Date
Text1(0).Enabled = False
Text1(0).BackColor = RGB(0, 0, 0)
End Sub
Function RellenarLista()
On Error GoTo LineaError
Dim RS As New ADODB.Recordset
RS.CursorLocation = adUseClient
If Text1(1).Text = "" Then
RS.Open "select * from Persona", Cnx, adOpenStatic, adLockReadOnly
ElseIf Text1(1).Text <> "" Then
RS.Open "select * from Persona where nombre like '%" & Trim$(Text1(1).Text) & "%'", Cnx, adOpenStatic, adLockReadOnly
End If
Set DataGrid1.DataSource = RS
DataGrid1.Columns(0).Width = 1000
DataGrid1.Columns(1).Width = 2500
DataGrid1.Columns(2).Width = 2000
DataGrid1.Columns(3).Width = 2000
Set RS = Nothing
Exit Function
If DataGrid1.ApproxCount <> 0 Then
DataGrid1.SetFocus
End If
Exit Function
LineaError:
MsgBox Err.Description, vbCritical
End Function
Sub MANTENIMIENTO(tipo As String)
On Error GoTo ErrorSQL
Dim xCadena As String ''
If tipo = "I" Then
xCadena = "EXEC SP_PERSONA 'I','" & Text1(0).Text & "','" & Text1(1).Text & "','" & Combo1.Text & "','" & Fecha.Value & "'"
ElseIf tipo = "U" Then
xCadena = "EXEC SP_PERSONA 'U','" & Text1(0).Text & "','" & Text1(1).Text & "','" & Combo1.Text & "','" & Fecha.Value & "'"
ElseIf tipo = "D" Then
xCadena = "EXEC SP_PERSONA 'D','" & Text1(0).Text & "','" & Text1(1).Text & "','" & Combo1.Text & "','" & Fecha.Value & "'"
End If
Cnx.Execute xCadena
Text1(1).Text = ""
Call RellenarLista
Exit Sub
ErrorSQL:
MsgBox Err.Description
End Sub
Private Sub Command2_Click()
On Error GoTo NOVA:
CrtRpt.Reset
CrtRpt.ReportFileName = "C:\Persona.rpt"
CrtRpt.StoredProcParam(0) = Text1(0).Text
CrtRpt.Destination = crptToWindow
CrtRpt.WindowState = crptMaximized
CrtRpt.Action = 0
Exit Sub
NOVA:
MsgBox Err.Description, vbExclamation
EtiqErrorSQL:
Screen.MousePointer = vbDefault
End Sub
Private Sub DataGrid1_Click()
lblestado.Caption = "EDICION"
Call enviar
End Sub
Function enviar()
If DataGrid1.ApproxCount = 0 Then Exit Function
Text1(0).Text = DataGrid1.Columns(0).Text: Text1(0).BackColor = RGB(250, 250, 250)
Text1(1).Text = DataGrid1.Columns(1).Text
Combo1.Text = DataGrid1.Columns(2).Text
Fecha.Value = DataGrid1.Columns(3).Text
Exit Function
End Function
Private Sub Form_Load()
Call limpiar
End Sub
No hay comentarios:
Publicar un comentario