ANTI MOUSTICS ( SISI, C VRAI :)))) )

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Declare Function DlPortReadPortUchar Lib "dlportio.dll" _
                (ByVal Port As Long) As Byte

Private Declare Sub DlPortWritePortUchar Lib "dlportio.dll" _
                (ByVal Port As Long, _
                ByVal Value As Byte)

Dim ActifSon    As Boolean
Public freq


Private Sub CmdPlay_Click()
If cmdplay.Caption = "Démarrer" Then
freq = Empty
freq = 15900
Form1.WindowState = 1
Timer1.Enabled = True
cmdplay.Caption = "Arreter"
ElseIf cmdplay.Caption = "Arreter" Then
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
cmdplay.Caption = "Démarrer"
End If
End Sub

Private Sub PlayHP(Frequence As Long, Durée As Long)
    Dim OctetBas    As Integer
    Dim OctetHaut   As Integer
    Dim Periode     As Integer
    Dim EtatHP      As Integer
    'Calcul des valeurs Haute et Basse du timer du HP
    Periode = CInt(1193280 / Frequence)
    OctetBas = Periode And &HFF
    OctetHaut = Periode \ 256
    'Prépare le timer du HP pour la réception de Data
    DlPortWritePortUchar 67, 182
    'Envoie les données au timer du HP
    DlPortWritePortUchar 66, OctetBas
    DlPortWritePortUchar 66, OctetHaut
    'Activation du Timer en activant le deux bits de poids faible
    EtatHP = DlPortReadPortUchar(97) Or &H3
    DlPortWritePortUchar 97, EtatHP
    'Gestion de la durée
    'Positionne le flag de contrôle d'état
    ActifSon = True
    'Active le timer
    TimerPlay.Interval = Durée
    TimerPlay.Enabled = True

    Do While ActifSon
        DoEvents
    Loop
    'Désactivation du Timer en désactivant le deux bits de poids faible        '
    EtatHP = DlPortReadPortUchar(97) And &HFC
    DlPortWritePortUchar 97, EtatHP
End Sub

Private Sub Command1_Click()
MsgBox "Anti-Moustic V1.0" & vbCrLf & "Ce programme chasse les moustics en émettant un ultrason." & vbCrLf & "Ce sont les femelles moustics qui piquent car elle veulent alimenter leur enfants de protéines, contenues dans votre sang. Pendant cette période, ces moustics femelles évitent les mâles, et comme tout insectes, les mâles émettent un ultrason au battement de leur ailes." & vbCrLf & "Anti-Moustic V1.0 va émettre l'ultrason que font les mâles pour faire fuires les femelles moustics." & vbCrLf & "L'ultrason émit démarre a 16 Khz, monte de 100 hz en 100 hz pendant 1 minute 26 secondes, pour finir a 20 khz, car certaines races de moustics réagissent avec un son différent." & vbCrLf & "Ensuite, le programme arretera l'émission d'ultrason pendant 3 minutes puis recommencera !" & vbCrLf & "Bonne sieste :)" & vbCrLf & "CodeFalse", vbOKOnly + vbInformation, "Information"
End Sub

Private Sub Command2_Click()
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
End
End Sub

Private Sub Form_Load()
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
Label1.Caption = "Anti-Moustic V1.0" & vbCrLf & "Ce programme chasse les moustics en émettant un ultrason." & vbCrLf & "Cliquez sur le bouton " & Chr(34) & "NFO" & Chr(34) & " pour plus d'info !"
End Sub


Private Sub Timer1_Timer()
freq = freq + 100
If freq < "20001" Then
PlayHP CDbl(freq), CDbl(2000)

ElseIf freq >= "20000" Then
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
     If freq = 18000 Then
     freq = 15900
     End If
End If

End Sub

Private Sub TimerPlay_Timer()
    ActifSon = False
    TimerPlay.Enabled = False
End Sub 

Télécharger le zip