Ir para o conteúdo
valkiely

[Duvida] Login/Registro com BD

Mensagens Recomendadas

valkiely

Pessoal eu tenho um sistema de login/registro, agora quero ligar o registro a base de dados, ou seja, quando alguem se registra aparece a conta na base de dados será que alguem me pode ajuda?

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
valkiely

Tu nao tens nenhum codigo ja feito com db, é que isso era mesmo muito preciso, e eu nao tou a conseguir ligar ja vendo isso :'(

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
acao

boas

cod de login não tenho, mas deixo o cod completo de um registo de Msg.

mas penso que 1 hora para analisar cod num tutorial extenso é muito pouco, e saberá que aqui não se fazem trabalhos apenas se ajuda, mas mesmo assim vou deixar parte deste trabalho que já fiz á muito tempo.

No modulo

Option Explicit
Public cnnMsgNotasOficios As New ADODB.Connection
Public vInclusao As Boolean

No form splash aonde faço a ligação à base dados


Option Explicit

Private Sub Form_Load()
  'Centraliza o formulário na área de trabalho do MDI:
Me.Left = (frmRegistoMsgNotasOficios.ScaleWidth - Me.Width) / 2
Me.Top = (frmRegistoMsgNotasOficios.ScaleHeight - Me.Height) / 2
End Sub

Private Sub Timer1_Timer()
Dim vAdsb1964 As String
Dim vAdmin As String
vAdsb1964 = "Adsb1964"
vAdmin = "Admin"
On Error GoTo errConexao
cnnMsgNotasOficios.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source = D:\BaseDados\MsgNotasOficios.mdb;Jet OLEDB:database Password= " & vAdsb1964 & ";persist security info=True;User Id =" & vAdmin & ";"
cnnMsgNotasOficios.Open
Unload Me
frmRegistoMsgNotasOficios.Show
Exit Sub
errConexao:
With Err
If .Number <> 0 Then
	MsgBox "Houve um erro na conexão com o banco de dados." & _
	vbCrLf & "O sistema será encerrado.", _
	vbCritical + vbOKOnly + vbApplicationModal, _
	"Erro na conexão"
	.Number = 0
Set cnnMsgNotasOficios = Nothing
End
End If
End With
End Sub

No form


Option Explicit
Dim vCodNovoMsg As Long
Dim vNumeroCadMsg As Long
Dim vAnoMsg As Long
Dim vCodMsg As Long
Dim vConsCamposEditados As Boolean
Dim vDataHojeMsgConsCamposEditados As String

Public Sub ConsCamposEditados()
   If vInclusao = True Then Exit Sub
   Dim cnnComando As New ADODB.Command
   Dim rsConsCamposEditados As New ADODB.Recordset
   Dim vConfMsg As Integer
   Dim vAssuntoMsgConsCamposEditados As String
   On Error GoTo errGravacao
   Screen.MousePointer = vbHourglass
   vConsCamposEditados = False
   With cnnComando
    ActiveConnection = cnnMsgNotasOficios
    .CommandType = adCmdText
    .CommandText = "SELECT *FROM ConsMsg WHERE AnoMsg = '" & lblAnoMsg.Caption & _
    "' and NumeroMsg = " & txtNumeroMsg.Text & ";"
    Set rsConsCamposEditados = .Execute
   End With
   With rsConsCamposEditados
    If .EOF And .BOF Then
    Else
	    vAssuntoMsgConsCamposEditados = !assuntoMsg
	    vDataHojeMsgConsCamposEditados = CDate(Format(Now, "dd/mm/yyyy"))
    End If
   End With
   If vInclusao = False And txtAssuntoMsg.Text <> vAssuntoMsgConsCamposEditados And _
    lblDataMsg.Caption = vDataHojeMsgConsCamposEditados Then
    vConsCamposEditados = True
   Else
    vConsCamposEditados = False
   End If
Saida:
   Screen.MousePointer = vbDefault
   Set cnnComando = Nothing
   Set rsConsCamposEditados = Nothing
   Exit Sub
errGravacao:
   With Err
    If .Number <> 0 Then
	    MsgBox "Nao foi possivel a leitura da tabela ConsMsg.", _
	    vbExclamation + vbOKOnly + vbApplicationModal, "Erro"
	    .Number = 0
	    GoTo Saida
    End If
   End With
End Sub
Public Sub GravarDados()
   Dim cnnComando As New ADODB.Command
   Dim vConfMsg As Integer
   Dim vErro As Boolean
   Dim vSQL As String
    If txtNumeroMsg.Text = Empty Then Exit Sub
	    On Error GoTo errGravacao
	    vCodNovoMsg = txtNumeroMsg.Text
	    'Inicializa as variáveis auxiliares:
	    vConfMsg = vbExclamation + vbOKOnly + vbSystemModal
	    vErro = False
    'Verifica os dados digitados:
    If txtNumeroMsg.Text = Empty Then
	    MsgBox "O campo Número Msg não foi preenchido, clik em novo", vConfMsg, "erro"
	    vErro = True
    End If
    If lblAnoMsg.Caption = Empty Then
	    MsgBox "O campo AnoMsg não foi preenchido", vConfMsg, "erro"
	    vErro = True
    End If
    If txtAssuntoMsg.Text = Empty Then
	    MsgBox "O campo AssuntoMsg não foi preenchido", vConfMsg, "erro"
	    vErro = True
    End If
    If lblDataMsg.Caption = Empty Then
	    MsgBox "O campo DataMsg não foi preenchido", vConfMsg, "erro"
	    vErro = True
    End If
    'Se aconteceu um erro de digitação, sai da sub sem gravar:
    If vErro Then Exit Sub

    Screen.MousePointer = vbHourglass
    'Verifica a operação e cria o comando SQL correspondente:
    If vInclusao Then
	    vSQL = "INSERT INTO CadMsg" & _
	    "(NumeroMsg, AnoMsg, AssuntoMsg, DataMsg)VALUES (" & _
	    txtNumeroMsg.Text & ",'" & _
	    lblAnoMsg.Caption & "','" & _
	    txtAssuntoMsg.Text & "','" & _
	    lblDataMsg.Caption & "');"
    Else
	    'Alteração:
	    vSQL = "UPDATE CadMsg SET  NumeroMsg = " & txtNumeroMsg.Text & _
	    ", AnoMsg = " & lblAnoMsg.Caption & _
	    ", AssuntoMsg = '" & txtAssuntoMsg.Text & _
	    "', DataMsg = '" & lblDataMsg.Caption & _
	    "'WHERE CodMsg = " & vCodMsg & ";"
	    End If
   With cnnComando
    .ActiveConnection = cnnMsgNotasOficios
    .CommandType = adCmdText
    .CommandText = vSQL
    .Execute
   End With
   MsgBox "Gravação concluida com sucesso.", _
   vbApplicationModal + vbInformation + vbOKOnly, _
   "gravação Ok"
   'Chama a sub que limpa os dados do formulário:
   LimparTela
   cmdNovoMsg.SetFocus
Saida:
   Screen.MousePointer = vbDefault
   Set cnnComando = Nothing
   Exit Sub
errGravacao:
   With Err
    If .Number <> 0 Then
	    MsgBox "Erro durante a gravação dos dados no registro." & vbCrLf & _
	    "Faça Enter antes da gravar.", _
	    vbExclamation + vbOKOnly + vbApplicationModal, _
	    "Operação cancelada"
	    .Number = 0
	    GoTo Saida
    End If
   End With
End Sub
Public Sub LimparTela()
   LimparDados
   vInclusao = True
   txtNumeroMsg.Text = Empty
   lblAnoMsg.Caption = Empty
   lblDataMsg.Caption = Empty
   cmdConsNumeroMsg.Visible = True
   Label3.Visible = True
   cmdNovoMsg.SetFocus
   vCodNovoMsg = 0
   vNumeroCadMsg = 0
   vAnoMsg = 0
   vCodMsg = 0
   vConsCamposEditados = False
End Sub
Public Sub LimparDados()
   txtAssuntoMsg.Text = Empty
End Sub
Private Sub cmdConsNumeroMsg_Click()
   frmConsPesqEditarRegMsg.Show
End Sub
Private Sub cmdNovoMsg_Click()
   Dim vOk As Integer
   On Error GoTo errcmdNovoMsg
   Screen.MousePointer = vbHourglass
   ConsCamposEditados
   If vInclusao = False Then
    If txtNumeroMsg.Text <> Empty And txtAssuntoMsg.Text <> Empty And vConsCamposEditados = True Then
	    vOk = MsgBox("Ainda não gravou os dados editados da tela, deseja GRAVAR ?", _
	    vbYesNo + vbQuestion + vbApplicationModal, "Saída")
	    If vOk = vbYes Then
		    GravarDados
	    ElseIf vOk = vbNo Then
	    LimparTela
	    MsgBox "O registo não foi editado"
	    End If
    ElseIf lblDataMsg.Caption <> vDataHojeMsgConsCamposEditados Then
	    MsgBox "O registo não pode ser editado, a DataMsg é diferente de hoje"
    ElseIf txtAssuntoMsg.Text = Empty Then
	    MsgBox "O registo não foi editado, o campo Assunto Msg está vazio"
    End If
    Else
    GravarDados
   End If
   cmdConsNumeroMsg.Visible = False
   Label3.Visible = False
   txtNumeroMsg.Enabled = True
   txtNumeroMsg.SetFocus
   Dim cnnComando As New ADODB.Command
   Dim rsNumeroMsg As New ADODB.Recordset
   vAnoMsg = Year(Date)
   With cnnComando
    .ActiveConnection = cnnMsgNotasOficios
    .CommandType = adCmdStoredProc
    .CommandText = "ConsNumeroMsg"
    Set rsNumeroMsg = .Execute
   End With
   With rsNumeroMsg
    If .EOF And .BOF = True Then
	    vNumeroCadMsg = 1
    Else
	    .MoveFirst
	    vNumeroCadMsg = rsNumeroMsg!NumeroMsg + 1
    End If
   End With
   txtAssuntoMsg.SetFocus
Saida:
   Set cnnComando = Nothing
   Set rsNumeroMsg = Nothing
   Screen.MousePointer = vbDefault
   Exit Sub
errcmdNovoMsg:
   With Err
    If .Number <> 0 Then
	    MsgBox "Não foi possível a leitura da tabela  ConsNumeroMsg:", _
	    vbInformation + vbOKOnly + vbApplicationModal, _
	    "Erro ao carregar tabela"
	    .Number = 0
	    GoTo Saida
    End If
   End With
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
   'Se a tecla Enter foi pressionada, passa o foco para o próximo controle na
   'seqüência de TabIndex:
   If KeyAscii = vbKeyReturn Then
    SendKeys "{Tab}"
    KeyAscii = 0
   End If
End Sub
Private Sub Form_Load()
  'Centraliza o formulário na área de trabalho do MDI:
   Me.Left = (frmRegistoMsgNotasOficios.ScaleWidth - Me.Width) / 2
   Me.Top = (frmRegistoMsgNotasOficios.ScaleHeight - Me.Height) / 2
   txtNumeroMsg.Enabled = False
   vConsCamposEditados = False
   vInclusao = True
   vCodNovoMsg = 0
   vNumeroCadMsg = 0
   vAnoMsg = 0
   vCodMsg = 0
End Sub
Private Sub Toolbar1_Buttonclick(ByVal Button As MSComctlLib.Button)
   Dim vOk As Integer
   'Verifica qual foi o botão clicado:
   Select Case Button.Index
    Case 1
	    'Botão Gravar:
	    ConsCamposEditados
	    If vInclusao = False Then
		    If txtNumeroMsg.Text <> Empty And txtAssuntoMsg.Text <> Empty And vConsCamposEditados = True Then
			    vOk = MsgBox("Ainda não gravou os dados editados da tela, deseja GRAVAR ?", _
			    vbYesNo + vbQuestion + vbApplicationModal, "Saída")
			    If vOk = vbYes Then
				    GravarDados
			    ElseIf vOk = vbNo Then
				    LimparTela
				    MsgBox "O registo não foi editado"
			    End If
		    ElseIf lblDataMsg.Caption <> vDataHojeMsgConsCamposEditados Then
			    MsgBox "O registo não pode ser editado, a DataMsg é diferente de hoje"
		    ElseIf txtAssuntoMsg.Text = Empty Then
			    MsgBox "O registo não foi editado, o campo Assunto Msg está vazio"
		    End If
	    Else
		    GravarDados
	    End If
    Case 2
	    'Botão Limpar:
	    LimparTela
    Case 3
	    'Botão Excluir:
    Case 4
	    'Botão Retornar:
    Unload Me
   End Select
End Sub


Private Sub txtAssuntoMsg_LostFocus()
   If txtAssuntoMsg.Text <> Empty And txtNumeroMsg.Text = Empty Then
    MsgBox "O campo número Msg não foi prenchido clik em NOVO"
   End If
End Sub
Private Sub txtNumeroMsg_LostFocus()
   Dim cnnComando As New ADODB.Command
   Dim rsSelecao As New ADODB.Recordset
   On Error GoTo errSelecao
   If Val(vNumeroCadMsg) > 0 Then
    vCodNovoMsg = vNumeroCadMsg
    txtNumeroMsg.Text = vCodNovoMsg
    lblAnoMsg.Caption = vAnoMsg
   Else
    vCodNovoMsg = txtNumeroMsg.Text
    vAnoMsg = lblAnoMsg.Caption
   End If
   'Verifica se foi digitado um código válido:
   Screen.MousePointer = vbHourglass
   With cnnComando
    .ActiveConnection = cnnMsgNotasOficios
    .CommandType = adCmdText
    'Monta o comando SELECT para selecionar o registro na tabela:
    .CommandText = "SELECT *FROM CadMsg WHERE NumeroMsg = " & vCodNovoMsg & _
    " And AnoMsg = '" & vAnoMsg & "';"
    Set rsSelecao = .Execute
   End With
   With rsSelecao
    If .EOF And .BOF Then
	    'Se o recordset está vazio, não retornou registro com esse código:
	    LimparDados
	    'Identifica a operacao como Inclusão:
	    vInclusao = True
	    lblDataMsg.Caption = CDate(Format(Now, "dd/mm/yyyy"))
    Else
	    'Senão, atribui aos campos os dados do registro:
	    vCodMsg = !CodMsg
	    txtAssuntoMsg.Text = !assuntoMsg
	    lblDataMsg.Caption = !DataMsg
	    'Identifica a operacao como Alteração:
	    vInclusao = False
	    'Habilita o botão Excluir:
    End If
   End With
   'Desabilita a digitação do campo código:
   txtNumeroMsg.Enabled = False
Saida:
   'Elimina o command e o recordset da memória:
   Set rsSelecao = Nothing
   Set cnnComando = Nothing
   Screen.MousePointer = vbDefault
   Exit Sub
errSelecao:
   With Err
    If .Number <> 0 Then
	    MsgBox "Houve um erro na recuperação do registro solicitado.", _
	    vbExclamation + vbOKOnly + vbApplicationModal, "Aviso"
	    .Number = 0
	    GoTo Saida
    End If
   End With
End Sub

cumps

acao

Editado por acao

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.