
error tipo byref
Publicado por pablo (2 intervenciones) el 15/12/2011 11:55:22
buenos dias estoy creando un programa el cual inicia en frmlogin y me da este error tipo byref ac{a el codigo:
Public conexion_basedatos As New ADODB.Connection
Public conexion_tablas As New ADODB.Recordset
Global datos As String
Global X As String
Sub abrir()
conexion_basedatos.ConnectionString = App.Path + "\basedatos.mdb"
conexion_basedatos.Provider = "microsoft.jet.oledb.4.0"
conexion_basedatos.Open
End Sub
Sub cerrar()
conexion_basedatos.Close
End Sub
Option Explicit
Option Explicit
DefInt A-Z
Const ENCRYPT = 1
Const DECRYPT = 2
Const CLAVE As String = "Clave"
Const SECCION As String = "Clave"
Private Sub Main()
If Module1.ElPassword = vbNullString Then
MDIForm1.Show
Exit Sub
Else
FrmLogin.Show 1
If FrmLogin.Correcto Then
frmPrincipal.Show
End If
End If
Set FrmLogin = Nothing
End Sub
Public Property Get ElPassword() As String
ElPassword = GetSetting(App.EXEName, SECCION, CLAVE, "")
End Property
Public Property Let ElPassword(ByVal sPass As String)
Dim PassEncrip As String
PassEncrip = Encriptar(sPass, sPass, ENCRYPT)
Call SaveSetting(App.EXEName, SECCION, CLAVE, PassEncrip)
End Property
Sub Eliminar_Password()
If Module1.ElPassword = vbNullString Then
MsgBox "No hay establecido un Password para eliminar. ", vbCritical
Exit Sub
End If
If MsgBox(" Esta opción elimina la clave del registro para que " & _
" al iniciar NO pida un Password." & _
" ¿¿ Eliminar ??", vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If
Call DeleteSetting(App.EXEName, SECCION, CLAVE)
End Sub
'-----------------------------------------------------------------------------
Function Nuevo_Password(El_Password As String, PassConfirm As String) As Boolean
If El_Password = vbNullString Or PassConfirm = vbNullString Then
MsgBox " Datos incompletos", vbCritical
Exit Function
End If
If El_Password = PassConfirm Then
Module1.ElPassword = El_Password
MsgBox " Contraseña creada correctamente ", vbInformation
Nuevo_Password = True
Else
MsgBox "La contraseña que confirmó no es correcta", vbCritical
Nuevo_Password = False
End If
End Function
Function Cambiar_Password(Old_Password As String, _
New_Password As String, _
Confirm_Password As String) As Boolean
Dim PassDesen As String
If (Old_Password = vbNullString) Or _
(New_Password = vbNullString) Or _
(Confirm_Password = vbNullString) Then
MsgBox " Datos incompletos ", vbCritical
Cambiar_Password = False
Exit Function
End If
PassDesen = Encriptar(Old_Password, Module1.ElPassword, DECRYPT)
If Old_Password = PassDesen Then
If New_Password = Confirm_Password Then
Module1.ElPassword = New_Password
MsgBox " Password cambiado correctamente.", vbInformation
Cambiar_Password = True
Else
MsgBox " La contraseña que confirmó no es correcta. ", vbExclamation
Cambiar_Password = False
End If
Else
MsgBox " El antiguo Password es incorrecto ", vbExclamation
Cambiar_Password = False
End If
End Function
________________________________________________________________
Function Login(PassWord As String) As Boolean
_____________________________________________ACA EL ERROR !!!____________________
Dim PassDesen As String
If PassWord = vbNullString Then
MsgBox " Debe escribir una contraseña ", vbCritical
Login = False
Exit Function
End If
PassDesen = Encriptar(PassWord, ElPassword, DECRYPT)
If PassWord = PassDesen Then
Login = True
Else
MsgBox " Password incorrecto ", vbExclamation
Login = False
End If
End Function
Function Encriptar( _
UserKey As String, Text As String, Action As Single _
) As String
Dim UserKeyX As String
Dim Temp As Integer
Dim Times As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim rtn As String
If Text = vbNullString Or UserKey = vbNullString Then
Encriptar = vbNullString
Exit Function
End If
n = Len(UserKey)
ReDim UserKeyASCIIS(1 To n)
For i = 1 To n
UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1))
Next
ReDim TextASCIIS(Len(Text)) As Integer
For i = 1 To Len(Text)
TextASCIIS(i) = Asc(Mid$(Text, i, 1))
Next
If Action = ENCRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) + UserKeyASCIIS(j)
If Temp > 255 Then
Temp = Temp - 255
End If
rtn = rtn + Chr$(Temp)
Next
ElseIf Action = DECRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) - UserKeyASCIIS(j)
If Temp < 0 Then
Temp = Temp + 255
End If
rtn = rtn + Chr$(Temp)
Next
End If
Encriptar = rtn
End Function
POR FAVOR NECESITO AYUDA
Public conexion_basedatos As New ADODB.Connection
Public conexion_tablas As New ADODB.Recordset
Global datos As String
Global X As String
Sub abrir()
conexion_basedatos.ConnectionString = App.Path + "\basedatos.mdb"
conexion_basedatos.Provider = "microsoft.jet.oledb.4.0"
conexion_basedatos.Open
End Sub
Sub cerrar()
conexion_basedatos.Close
End Sub
Option Explicit
Option Explicit
DefInt A-Z
Const ENCRYPT = 1
Const DECRYPT = 2
Const CLAVE As String = "Clave"
Const SECCION As String = "Clave"
Private Sub Main()
If Module1.ElPassword = vbNullString Then
MDIForm1.Show
Exit Sub
Else
FrmLogin.Show 1
If FrmLogin.Correcto Then
frmPrincipal.Show
End If
End If
Set FrmLogin = Nothing
End Sub
Public Property Get ElPassword() As String
ElPassword = GetSetting(App.EXEName, SECCION, CLAVE, "")
End Property
Public Property Let ElPassword(ByVal sPass As String)
Dim PassEncrip As String
PassEncrip = Encriptar(sPass, sPass, ENCRYPT)
Call SaveSetting(App.EXEName, SECCION, CLAVE, PassEncrip)
End Property
Sub Eliminar_Password()
If Module1.ElPassword = vbNullString Then
MsgBox "No hay establecido un Password para eliminar. ", vbCritical
Exit Sub
End If
If MsgBox(" Esta opción elimina la clave del registro para que " & _
" al iniciar NO pida un Password." & _
" ¿¿ Eliminar ??", vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If
Call DeleteSetting(App.EXEName, SECCION, CLAVE)
End Sub
'-----------------------------------------------------------------------------
Function Nuevo_Password(El_Password As String, PassConfirm As String) As Boolean
If El_Password = vbNullString Or PassConfirm = vbNullString Then
MsgBox " Datos incompletos", vbCritical
Exit Function
End If
If El_Password = PassConfirm Then
Module1.ElPassword = El_Password
MsgBox " Contraseña creada correctamente ", vbInformation
Nuevo_Password = True
Else
MsgBox "La contraseña que confirmó no es correcta", vbCritical
Nuevo_Password = False
End If
End Function
Function Cambiar_Password(Old_Password As String, _
New_Password As String, _
Confirm_Password As String) As Boolean
Dim PassDesen As String
If (Old_Password = vbNullString) Or _
(New_Password = vbNullString) Or _
(Confirm_Password = vbNullString) Then
MsgBox " Datos incompletos ", vbCritical
Cambiar_Password = False
Exit Function
End If
PassDesen = Encriptar(Old_Password, Module1.ElPassword, DECRYPT)
If Old_Password = PassDesen Then
If New_Password = Confirm_Password Then
Module1.ElPassword = New_Password
MsgBox " Password cambiado correctamente.", vbInformation
Cambiar_Password = True
Else
MsgBox " La contraseña que confirmó no es correcta. ", vbExclamation
Cambiar_Password = False
End If
Else
MsgBox " El antiguo Password es incorrecto ", vbExclamation
Cambiar_Password = False
End If
End Function
________________________________________________________________
Function Login(PassWord As String) As Boolean
_____________________________________________ACA EL ERROR !!!____________________
Dim PassDesen As String
If PassWord = vbNullString Then
MsgBox " Debe escribir una contraseña ", vbCritical
Login = False
Exit Function
End If
PassDesen = Encriptar(PassWord, ElPassword, DECRYPT)
If PassWord = PassDesen Then
Login = True
Else
MsgBox " Password incorrecto ", vbExclamation
Login = False
End If
End Function
Function Encriptar( _
UserKey As String, Text As String, Action As Single _
) As String
Dim UserKeyX As String
Dim Temp As Integer
Dim Times As Integer
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim rtn As String
If Text = vbNullString Or UserKey = vbNullString Then
Encriptar = vbNullString
Exit Function
End If
n = Len(UserKey)
ReDim UserKeyASCIIS(1 To n)
For i = 1 To n
UserKeyASCIIS(i) = Asc(Mid$(UserKey, i, 1))
Next
ReDim TextASCIIS(Len(Text)) As Integer
For i = 1 To Len(Text)
TextASCIIS(i) = Asc(Mid$(Text, i, 1))
Next
If Action = ENCRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) + UserKeyASCIIS(j)
If Temp > 255 Then
Temp = Temp - 255
End If
rtn = rtn + Chr$(Temp)
Next
ElseIf Action = DECRYPT Then
For i = 1 To Len(Text)
j = IIf(j + 1 >= n, 1, j + 1)
Temp = TextASCIIS(i) - UserKeyASCIIS(j)
If Temp < 0 Then
Temp = Temp + 255
End If
rtn = rtn + Chr$(Temp)
Next
End If
Encriptar = rtn
End Function
POR FAVOR NECESITO AYUDA
Valora esta pregunta


0