Ouvertue d'une Socket Client VB6

Question

Bonjour à tous , Voila je suis débutant sur VB6 et je travaille actuellement sur une interface graphique qui me permettra de gérer différents capteurs (IR pour la détéction de mouvement et Magnétique pour l'ouverture d'une porte), afin de déterminer leur états. Pour y arriver j'utilise un récépteur RFxcom (433Mhz), que je connecte via ethernet sur un réseau local, j'ai ensuite ouvert une socket client sur VB6 avec une fenêtre qui me permet de rentrer le nom et l'adresse IP de ma socket. Pour le moment j'ai réussi à décoder puis traiter les infos envoyer par mes capteurs afin de savoir quant un capteur est en état d'alerte ou pas. J'ai donc créer une fenêtre de supervision qui me permet sur une image de savoir a quel endroit se situe mon capteur. Le petit problème que je rencontre aujourd'hui c'est que je voudrais forcer la connexion à ma socket quant je charge ma fenêtre de supervision...car autrement je ne reçoit pas mes infos capteurs. Ce travail est dans le cadre de mon stage, je vous remercie pour toutes vos réponses. Code Fenêtre de Supervision : Private flagtimer As Boolean Public capteurdir As String Private Type EnrCapteur cType As String * 1 cUser As String * 5 cAlive As String * 1 cStatus As String * 1 X As String * 5 Y As String * 5 TStamp As String * 15 End Type Dim SensorSprite(1000) As TextBox Private Declare Function GetTickCount Lib "kernel32" () As Long Public Sub xWait2(ByVal MilsecToWait As Long) Dim lngEndingTime As Long lngEndingTime = GetTickCount() + (MilsecToWait) Do While GetTickCount() < lngEndingTime DoEvents Loop End Sub Private Sub Effacer_Click() message.Text = "" End Sub Private Sub Enr_Click() frmEnrsous.Show End Sub Private Sub form_activate() If flagtimer = False Then flagtimer = True Call Timer2_Timer End If End Sub Private Sub Form_load() frmSuper.Refresh Picture1.Picture = LoadPicture(App.Path & "\image\St-Just.bmp") flagtimer = False For I = 0 To 999 Set SensorSprite(I) = Controls.Add("VB.Textbox", "SensorSprite" + Format(I)) SensorSprite(I).Height = 135 SensorSprite(I).width = 135 SensorSprite(I).Top = 0 SensorSprite(I).Left = 0 SensorSprite(I).ZOrder 1 SensorSprite(I).forecolor = &HFFFFFF SensorSprite(I).Visible = True SensorSprite(I).Enabled = False SensorSprite(I).BorderStyle = none Next End Sub Private Sub Form_Unload(Cancel As Integer) flagtimer = False End Sub Private Sub message_Change() If Len(message.Text) > 6000 Then message.Text = Left$(message, 4000) End If End Sub Private Sub Timer2_Timer() Dim fsensor As String Dim sensordata As EnrCapteur Dim snum As Integer Dim ffsensor As String Dim nbsensor As Integer nbsensor = 0 While flagtimer = True fsensor = Dir(capteurdir + "*.txt") snum = 0 Do While fsensor <> "" ffsensor = capteurdir + fsensor Open ffsensor For Random Access Read As #6 Len = Len(sensordata) Get #6, 1, sensordata Close #6 If Trim(sensordata.cUser) <> "" Then SensorSprite(snum).Top = Val(sensordata.Y) SensorSprite(snum).Left = Val(sensordata.X) SensorSprite(snum).ZOrder 0 If sensordata.cStatus = "A" Then SensorSprite(snum).BackColor = &H3479CC Else If sensordata.cStatus = "D" Then SensorSprite(snum).BackColor = &H11FF00 Else If sensordata.cStatus = "R" Then SensorSprite(snum).BackColor = &H1000FF message.Text = Format(Now) + " ALERTE UTILISATEUR " + sensordata.cUser + vbCrLf + message.Text End If End If End If If Val(Format(Now, "yyyyMMddHHmmss")) - Val(sensordata.TStamp) > 7200 Then sensordata.cAlive = "N" message.Text = Format(Now) + " capteur " + Left(fsensor, 6) + " INACTIF" + vbCrLf + message.Text Open ffsensor For Random Access Write As #6 Len = Len(sensordata) Put #6, 1, sensordata Close #6 End If If sensordata.cAlive = "A" Then SensorSprite(snum).Text = "A" Else SensorSprite(snum).BackColor = &H1FFFF SensorSprite(snum).Text = sensordata.cStatus End If snum = snum + 1 End If fsensor = Dir() ' Get next sensor entry. Loop If snum < nbsensor Then For I = snum To nbsensor SensorSprite(I).Top = 0 SensorSprite(I).Left = 0 SensorSprite(I).ZOrder 1 Next End If nbsensor = snum Call xWait2(5000) Wend End Sub Code Socket Client : Public fesbridge As String Public capteurdir As String Private Type EnrEsbridge Num As String * 5 label As String * 40 AdresseIp As String * 36 End Type Private Function find_first_free_num() As Integer 'permet de chercher un numéro disponible pour l'utilisateur Dim esb As EnrEsbridge Dim I As Integer esb.Num = "" esb.AdresseIp = "" If Dir(fesbridge) <> "" Then Open fesbridge For Random Access Read As #3 Len = Len(esb) For I = 1 To Int(LOF(3) / Len(esb)) Get #3, I, esb If (esb.Num <> "" And Trim(esb.AdresseIp) = "") Then find_first_free_num = I Close #3 Exit Function End If Next I find_first_free_num = I Close #3 Exit Function End If find_first_free_num = -1 End Function Private Sub Creer_Click() Dim esb As EnrEsbridge Dim fnum As Integer esb.label = label.Text esb.AdresseIp = AdresseIp.Text fnum = find_first_free_num() If fnum = -1 Then esb.Num = "1" Else esb.Num = Format(fnum) End If Open fesbridge For Random Access Write As #3 Len = Len(esb) Put #3, Val(esb.Num), esb Close #3 Unload Me End Sub Private Sub Form_load() Dim I As Integer Dim esb As EnrEsbridge If Dir(fesbridge) <> "" Then Open fesbridge For Random Access Read As #3 Len = Len(esb) Let I = 1 Do While Not EOF(3) Get #3, I, esb I = I + 1 List1.AddItem (esb.Num + " " + esb.AdresseIp + " " + esb.label) Loop Close #3 End If Creer.Enabled = False supprimer.Enabled = False esbStart.Enabled = False esbStop.Enabled = False If List1.ListCount = 0 Then Creer.Enabled = True End If End Sub Private Sub List1_Click() Dim esb As EnrEsbridge Dim lnum As Integer Dim esbw As String If (List1.Text <> "") Then Creer.Enabled = False supprimer.Enabled = True lnum = Format(Left$(List1.Text, 5)) Open fesbridge For Random Access Read As #3 Len = Len(esb) Get #3, lnum, esb Close #3 label.Text = Trim(esb.label) AdresseIp.Text = Trim(esb.AdresseIp) For I = Forms.Count - 1 To 1 Step -1 esbw = Trim(Forms(I).Caption) If esbw = "EsbridgeRuntime_" + Trim(AdresseIp.Text) Then esbStart.Enabled = False esbStop.Enabled = True Creer.Enabled = False supprimer.Enabled = False GoTo suite Else esbStart.Enabled = True esbStop.Enabled = False End If Next I suite: Else Creer.Enabled = True supprimer.Enabled = False esbStart.Enabled = False esbStop.Enabled = False label.Text = "" AdresseIp.Text = "" End If End Sub Private Sub esbStart_Click() Dim EsbR As New EsbRuntime Dim esb As EnrEsbridge Dim ipaddr As String Dim lnum As Integer If (List1.Text <> "") Then lnum = Format(Left$(List1.Text, 5)) esb.Num = lnum esb.AdresseIp = "" esb.label = "" If Dir(fesbridge) <> "" Then Open fesbridge For Random Access Read As #3 Len = Len(esb) Get #3, Val(esb.Num), esb Close #3 End If EsbR.Show vbModeless, Me EsbR.Caption = "EsbridgeRuntime_" + Trim(esb.AdresseIp) EsbR.capteurdir = capteurdir esbStart.Enabled = False esbStop.Enabled = True End If End Sub Private Sub esbStop_Click() Dim EsbR As New EsbRuntime Dim esb As EnrEsbridge Dim ipaddr As String Dim lnum As Integer Dim esbw As String If (List1.Text <> "") Then lnum = Format(Left$(List1.Text, 5)) esb.Num = lnum esb.AdresseIp = "" esb.label = "" If Dir(fesbridge) <> "" Then Open fesbridge For Random Access Read As #3 Len = Len(esb) Get #3, Val(esb.Num), esb Close #3 End If For I = Forms.Count - 1 To 1 Step -1 esbw = Trim(Forms(I).Caption) If esbw = "EsbridgeRuntime_" + Trim(esb.AdresseIp) Then Unload Forms(I) esbStart.Enabled = True esbStop.Enabled = False GoTo suite_esbstop End If Next I suite_esbstop: ' EsbR.Show vbModeless, Me ' EsbR.Caption = "EsbridgeRuntime_" + Trim(esb.label) End If End Sub Private Sub Supprimer_Click() Dim esb As EnrEsbridge Dim lnum As Integer If (List1.Text <> "") Then lnum = Format(Left$(List1.Text, 5)) esb.Num = lnum esb.AdresseIp = "" esb.label = "" If Dir(fesbridge) <> "" Then Open fesbridge For Random Access Read Write As #3 Len = Len(esb) Put #3, Val(esb.Num), esb Close #3 End If Unload Me End If End Sub

cs_Jack · Answer

Salut
Problème pas assez détaillé.
Sur quoi buttes-tu ?

Tu parles de Socket dans ton titre, mais je ne vois nulle part de Winsock ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Makia42 · Answer

En faite je voudrais forcer la connexion de ma socket lorsque je démarre ma supervision car sans sa , je ne reçoit pas mes infos capteurs. Et pour le code de ma socket Winsock le voila :Private AdresseIp As String Private connected As Boolean Private connectError As Boolean Private WithEvents evt As Winsock Private DataArray(2048) As Byte Private CapteurData(5) As Byte Private WriteIdx As Integer Private ReadIdx As Integer Private CapteurDataIdx As Integer Private flagtimer As Boolean Private oldsensor As String Public capteurdir As String Private Type EnrCapteur cType As String * 1 cUser As String * 5 cAlive As String * 1 cStatus As String * 1 X As String * 5 Y As String * 5 TStamp As String * 15 End Type Private Declare Function GetTickCount Lib "kernel32" () As Long Public Sub xWait(ByVal MilsecToWait As Long) Dim lngEndingTime As Long lngEndingTime = GetTickCount() + (MilsecToWait) Do While GetTickCount() < lngEndingTime DoEvents Loop End Sub Sub ProcessSensorData(ByVal sens As String) Dim capteurpath As String Dim captdata As EnrCapteur Dim alert As String If Trim(sens) <> "" Then capteurpath = capteurdir + Left$(sens, 6) + ".txt" ' alert = Mid$(sens, 9, 1) bug I.Lovric sur codification Visonic alert = Mid$(sens, 7, 1) ' kamel correction bug I.Lovric sur codification Visonic If Dir(capteurpath) <> "" Then Open capteurpath For Random Access Read Write As #4 Len = Len(captdata) Get #4, 1, captdata captdata.cAlive = "A" ' If captdata.cStatus "A" And alert "F" Then bug I.Lovric sur codification Visonic If captdata.cStatus "A" And alert "4" Then ' kamel correction bug I.Lovric sur codification Visonic captdata.cStatus = "R" End If captdata.TStamp = Format(Now, "yyyyMMddHHmmss") Put #4, 1, captdata Close #4 End If End If End Sub Function getcapteurdata() As String Dim curbyte As Byte Dim sensor As String Dim hexbyte As String Do While Not ReadIdx = WriteIdx curbyte = DataArray(ReadIdx) ReadIdx = ReadIdx + 1 If ReadIdx = 2048 Then ReadIdx = 0 End If If curbyte = &H24 Then For I = 0 To 5 CapteurData(I) = 0 Next CapteurDataIdx = 0 getcapteurdata = "" End If CapteurData(CapteurDataIdx) = curbyte If CapteurDataIdx = 5 Then sensor = "" For I = 1 To 5 hexbyte = Hex(CapteurData(I)) If Len(hexbyte) = 1 Then hexbyte = "0" + hexbyte End If sensor = sensor + hexbyte Next getcapteurdata = sensor CapteurDataIdx = 0 Exit Function End If CapteurDataIdx = CapteurDataIdx + 1 Loop getcapteurdata = "" End Function Private Sub form_activate() Dim titre As String On Error GoTo err AdresseIp = Mid$(Me.Caption, Len("esbridgeruntime_") + 1) Text1.Text = AdresseIp + " still not connected" + vbCrLf + Text1.Text Set evt = Winsock1 If connected = False Then If connectError = False Then Winsock1.Connect AdresseIp, 10001 End If ' While Winsock1.State <> sckConnected ' DoEvents ' Wend ' connectError = False ' Text1.Text = "connected" + vbCrLf + Text1.Text ' connected = True If flagtimer = False Then oldsensor = "" flagtimer = True ' Call Timer1_Timer Timer1.Interval = 30 Timer1.Enabled = True End If Vison_Click Else ' Text1.Text = "connected" + vbCrLf + Text1.Text End If Exit Sub err: I = 0 End Sub Private Sub Form_load() flagtimer = False connected = False connectError = False Winsock1.close Winsock1.LocalPort = 0 WriteIdx = 0 ReadIdx = 0 End Sub Private Sub Form_Unload(Cancel As Integer) flagtimer = False connected = False Timer1.Interval = 0 Timer1.Enabled = False Winsock1.close Winsock1.LocalPort = 0 End Sub Private Sub Timer1_Timer() Dim sensor As String If flagtimer = True Then sensor = getcapteurdata() If sensor <> "" Then If sensor <> oldsensor Then Text1.Text = "-" + sensor + Text1.Text If Len(Text1.Text) > 1000 Then Text1.Text = Left(Text1.Text, 300) End If oldsensor = sensor End If Call ProcessSensorData(sensor) End If ' Call xWait(1000) ' Text1.Text = Text1.Text + "#" End If End Sub Private Sub Vison_Click() Dim sdData(2) As Byte sdData(0) = &HF0 sdData(1) = &H40 If Winsock1.State sckClosed Or Winsock1.State sckClosing Then Exit Sub Winsock1.SendData (sdData) End Sub Private Sub Winsock1_Connect() Text1.Text = "Socket connected " + Format(Now) + vbCrLf + Text1.Text connected = True connectError = False End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim tmp As String Dim rcvData As Byte If Winsock1.State sckClosed Or Winsock1.State sckClosing Then Exit Sub 'Text1.Text = Text1.Text + "bt= " + Format(bytesTotal) + ":" For I = 1 To bytesTotal Winsock1.GetData rcvData, vbByte DataArray(WriteIdx) = rcvData WriteIdx = WriteIdx + 1 If WriteIdx = 2048 Then WriteIdx = 0 End If Next End Sub Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) On Error Resume Next If Number = 10053 Then Text1.Text = "Socket disconnected, trying to reconnect..." + Format(Now) + vbCrLf + Text1.Text Winsock1.close Winsock1.LocalPort = 0 connected = False connectError = True 'Call xWait(3000) Winsock1.Connect AdresseIp, 10001 Exit Sub End If If Number = 10060 Then Text1.Text = "Socket connect timeout, trying to reconnect..." + Format(Now) + vbCrLf + Text1.Text Winsock1.close Winsock1.LocalPort = 0 connected = False connectError = True 'Call xWait(3000) Winsock1.Connect AdresseIp, 10001 Exit Sub End If If Number = 10061 Then Text1.Text = "Socket not free, trying to reconnect..." + Format(Now) + vbCrLf + Text1.Text Winsock1.close Winsock1.LocalPort = 0 connected = False connectError = True 'Call xWait(3000) Winsock1.Connect AdresseIp, 10001 Exit Sub End If Text1.Text = "Socket error " + Format(Number) + " " + Description + vbCrLf + Text1.Text End Sub

cs_Jack · Answer

Comment fais-tu actuellement pour 'lancer' la connexion ?
Tu passes par un bouton ?
... est-ce que cela fonctionne actuellement si tu le lances à la main ?

Quel évènement se déclenche au démarrage de ta supervision ?
Le paramétrage est-il initialisé au moment de cet évènement ?
Il faut se méfier des _Activated car ces évènements arrivent parfois avant l'initialisation graphique et peuvent poser problème.

La seule chose intéressante dans toute cette profusion de code est :
Private Sub form_activate()
Dim titre As String
On Error GoTo err

    AdresseIp = Mid$(Me.Caption, Len("esbridgeruntime_") + 1)
    Text1.Text = AdresseIp + " still not connected" + vbCrLf + Text1.Text
    Set evt = Winsock1
    If connected = False Then
        If connectError = False Then
          Winsock1.Connect AdresseIp, 10001
        End If
'       While Winsock1.State <> sckConnected
 '      DoEvents
  '     Wend
   '    connectError = False
    '   Text1.Text = "connected" + vbCrLf + Text1.Text
     '  connected = True
        If flagtimer = False Then
          oldsensor = ""
          flagtimer = True
    '      Call Timer1_Timer
          Timer1.Interval = 30
          Timer1.Enabled = True
        End If
        Vison_Click
    Else
      ' Text1.Text = "connected" + vbCrLf + Text1.Text
    End If
    Exit Sub
err:
    I = 0
End Sub
Première chose à faire : Gérer efficacement les erreurs.
Ton On Error Goto renvoie actuellement en fin de Sub mais il ne te fournit aucune info : Impossible de savoir ce qui s'est mal passé --> Voir Err.Number et Err.Description

Ensuite, si pas d'erreur, suivre pas-à-pas le programme pour savoir ce qui se passe :
F9 pour poser un point d'arrêt
F8 pour exécuter instruction par instruction
Visualiser le contenu des variables/propriétés en les survolant la souris
F5 pour relancer normalement

Tant qu'on ne sait pas ce qui cloche, difficile de te dire que faire ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Makia42 · Answer

Effectivement pour lancer la connexion j'appuie sur un bouton start , ensuite je lance la supervision qui m'affiche l'état des capteurs dans un textbox.

Auparavant j'active dans une fenêtre les capteurs que je veut superviser.*

Jusque la tout marche !!

Mon soucis est que je suis contraint de me connecter à ma socket avant de lancer ma fenêtre de supervision sinon j'affiche capteur inactif , ce qu'il faudrait c'est donc forcer la connexion a la socket dans ma fenêtre de supervision.

Or je ne sait pas si il existe une méthode qui permet d'intervenir ou de frocer l'éxécution d'un programme d'une fenêtre à partir d'une autre.

En gros je cherche a contrôler l'éxécution de ma fenêtre de connexion socket a partir de ma fenêtre de supervision !

^^' voila merci pour tes réponses concernant le traitement des erreurs !

Ouvertue d'une Socket Client VB6

4 réponses

Votre réponse

Discussions similaires