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:
DeteccionNOTA: SI SE LES OCURRE ALGUNA MEJORA O ALGO ME AVISAN
