TODOPIC

Lenguajes de programación para PC => Visual Basic => Mensaje iniciado por: sadamssh en 09 de Junio de 2007, 21:54:47

Título: Codigo Fuente y Programa para detectar ausencia de tensión en un circuito
Publicado por: sadamssh en 09 de Junio de 2007, 21:54:47

Hola, acá les dejo el código fuente de un programa que desarrolle en visual Basic y también les dejo el programa compilado. La función principal es detectar la ausencia de tensión en un circuito y te lo informa. Espero que les sirva Saludos

Codigo Fuente Formulario 1:
------------------------------------------------------------------------------------------------------
Private Sub Form_Load()
    cBar5.Value = 0
    HoraEjec.Caption = Time
    IP.Caption = Winsock1.LocalIP
End Sub


Private Sub Timer1_Timer()
    Static iPor As Integer
        iPor = (iPor + 1) Mod 101
            If (iPor = 100) Then
                Timer1.Enabled = False
            End If
        cBar5.Value = iPor
        Progreso.Caption = "Cargando Programa"
        End Sub
Private Sub IdentCircuit_Timer()
Label2.Caption = "Identificando Circuito"
End Sub
Private Sub Cargdll_Timer()
Label2.Caption = "Cargando dll"
End Sub

Private Sub VerifSystem_Timer()
Label2.Caption = "Identificando Sistema Operativo"
End Sub
Private Sub ContLPT_Timer()
Label2.Caption = "Controlando Puerto LPT"
End Sub
Private Sub RegistEq_Timer()
Label2.Caption = "Identificando el equipo"
End Sub

Private Sub IrAlForm3_Timer()
Form2.Show
Form1.Hide
End Sub
------------------------------------------------------------------------------------------------------

Codigo Fuente Formulario 2:
------------------------------------------------------------------------------------------------------
Private Sub Command1_Click()
MsgBox "¿Desea Salir Del Sistema?", vbYesNo, "Mensaje del sistema"
End
End Sub

Private Sub ContVol_Timer()
dato = Leer(&H379)
If (dato And &H40) = 0 Then LblVolt = "Hay 0V en el pin 10.Dispositivo conectado" Else LblVolt = "Hay 5V en el pin 10. Dispositivo desconectado"
If (dato And &H40) = 0 Then LblVolt.BackColor = &H8000& Else LblVolt.BackColor = &HFF&
End Sub

Private Sub DefHora_Timer()
 Label3.Caption = Format(Now, " hh:mm:ss")
End Sub

Private Sub DspControl_Timer()
dato = Leer(&H379)
If (dato And &H40) = 0 Then DspEstado.BackColor = &H8000& Else DspEstado.BackColor = &HFF&
If (dato And &H40) = 0 Then DspEstado.Caption = "Dispositivo Funcionando" Else DspEstado.Caption = "Dispositivo Fuera De Servicio"
End Sub


Private Sub Form_Load()

End Sub

Private Sub MsgAlert_Timer()
dato = Leer(&H379)
If (dato And &H40) = 0 Then Label4 = "Dispositivo Funcionando" Else Label4 = "ALERTA..! Dispositivo Fuera De Servicio"
If (dato And &H40) = 0 Then Label4.BackColor = &H8000& Else Label4.BackColor = &HFF&
End Sub
------------------------------------------------------------------------------------------------------

Modulos:
------------------------------------------------------------------------------------------------------
Public Declare Function Leer Lib "Inpout32.dll" _
Alias "Inp32" (ByVal PortAddress As Integer) As Byte

Public Declare Sub Escribir Lib "Inpout32.dll" _
Alias "Out32" (ByVal PortAddress As Integer, ByVal Value As Byte)

Public Declare Sub Sleep Lib "Kernel32.dll" (ByVal PortAddress As Integer)

Public Function BinADec(Valbin As String) As Integer
Dim ValAn As Integer
Dim PosBin As Integer
ValAn = 0
PosBin = 1
Do
   If PosBin = (Len(Valbin) + 1) Then Exit Do
   If Right(Left(Valbin, PosBin), 1) = "1" Then
      ValAn = (ValAn + 0.5) * 2
   Else
      ValAn = ValAn * 2
   End If
   PosBin = PosBin + 1
Loop
BinADec = ValAn
End Function

Public Function DecABin(ValDec As Integer) As String
Dim Valdec2 As String
Dim Valdec1 As Integer
Dim res As Integer
Dim Bin As String
Valdec1 = ValDec
    Do
        If Valdec1 = 0 Then
            Exit Do
        End If
        res = Valdec1 Mod 2
        Bin = res
        Valdec2 = Bin + Valdec2
        Valdec1 = Int(Valdec1 / 2)
    Loop
If Len(Valdec2) < 9 Then Valdec2 = String$((8 - Len(Valdec2)), "0") + Valdec2
DecABin = Valdec2
End Function

Sub Delay(Segundos As Double)
  Dim TempTime As Double
  TempTime = Timer
  While Timer - TempTime < Segundos
    DoEvents
    If Timer < TempTime Then
      TempTime = TempTime - 24# * 3600#
    End If
  Wend
End Sub
------------------------------------------------------------------------------------------------------


Este es el link de descarga: Deteccion (http://www.chatsp.com.ar/Deteccion.zip)

NOTA: SI SE LES OCURRE ALGUNA MEJORA O ALGO ME AVISAN