Erreur runtime -2147417843 lors d un second appel de wmi

Version imprimable

21/11/2014, 16h41
atc666

Erreur runtime -2147417843 lors d un second appel de wmi
j ai une procedure que j appelle plusieurs fois avec une requete wmi
lors du premier appel aucun soucis tous se passent parfaitement
mais quand j ai besoin de refaire appel a cette procedure , la ca coince au moment de donner l instruction du set de l objet
Code:

1 2 set svc = GetObject("winmgmts:root\cimv2")
j ai, apres un premier appel sans soucis, a chaque nouvel appel l erreur suivante :

Run-time error '-2147417843 (8001010d)': Automation error

j ai tenter de "fermer" l objet avec l instruction suivante:
Code:

1 2 set svc = Nothing
a la fin de la procedure , mais cela ne change rien
premier appel parfait , second et suivant >>> la meme erreur a chaque tentative
21/11/2014, 18h51
ProgElecT

Salut

Il manque le code précédant et suivant des 2 lignes que tu nous as mis.
Se type d'erreur arrive souvent pour ce cas, a savoir que si tu utilises svc pour créer un/des autres objets (objets enfants donc), il faut les passer à Nothing avant de le faire pour svc.

Voici le reste du code de la procedure
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Dim svc As Object Dim sQuery As String Dim oproc 'On Error GoTo Command1_Click_Error 'On Error Resume Next Set svc = GetObject("winmgmts:root\cimv2") Text1.Text = Err sQuery = "select * from win32_DiskDrive where InterfaceType='USB'" For Each oproc In svc.execquery(sQuery) 'Stop info = oproc.Model If info = "SMI USB DISK USB Device" Then access = 1 Else access = 0 End If Next Set oproc = Nothing Set svc = Nothing
je viens d inverser les deux dernieres lignes mais cela plante toujours avec la meme erreur
j ai mis en com les deux solutions de gestion d erreu etant donne que si la premiere erreur a lieu elle provoque d autre erreur si je la "saute"

Je viens de vérifier en copier/coller de ton code en déclenchant (plusieurs fois) par un CommandButton, pas de problème pour moi, cela me laisse penser que l'erreur vient de l'appel de ta procédure.
Essais comme moi de mettre le code sous un CommandButton
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Private Sub Command1_Click() Dim aCCess As Integer Dim InfO Dim svc As Object Dim sQuery As String Dim oproc 'On Error GoTo Command1_Click_Error 'On Error Resume Next Set svc = GetObject("winmgmts:root\cimv2") Text1.Text = Err sQuery = "select * from win32_DiskDrive where InterfaceType='USB'" For Each oproc In svc.execquery(sQuery) 'Stop InfO = oproc.Model If InfO = "SMI USB DISK USB Device" Then aCCess = 1 Else aCCess = 0 End If Next Set oproc = Nothing Set svc = Nothing End Sub
Toujours la même erreur ?

21/11/2014, 19h30
atc666

ben non pas d erreur ...
la je pige pas du tout
je l appelle normalement par le nom de la proc et la ca marche avec le bouton
je vais tenter de mettre un appel vers ma proc en lieu et place du code dans le bouton
mais je suis perdu de chez perdu la
21/11/2014, 19h34
atc666

ben voila , ca marche toujours en appelant la procedure depuis le bouton mais quand l appel vient de la procedure de detection d introduction d une cle ca rate
pourtant je verifie que la cle porte un certain nom avant de lancer la proc
la recherche du nom se fait elle par un simple fso

je ne vois pas ce qui change quand je l appelle en direct ou pas ... mais apparemment il y a un problème avec la détection de connexion de la clé par le sysinfo
j ai réécrit la partie du code séparément pour tester si cela ne serai pas venu d'un objet ou je ne sais quoi qui aurai été ouvert ailleurs
mais rien n'y fait , dès que cela passe par la détection d'arrivée d'une clé par le sysinfo ,cette erreur reviens

j'ai juste le sysinfo , un textbox et un label sur ma page en plus du bouton

j'en ai même rajouter un second pour appeler la procédure click du premier, mais la je n'ai pas l'erreur
je n'ai l erreur qu'en utilisant le devicearrival du sysinfo
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 Private Sub Command1_Click() verikey End Sub Private Sub Form_Load() verikey End Sub Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long) Stop Command1_Click End Sub Private Sub SysInfo1_DeviceRemoveComplete(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long) Stop 'Command1_Click End Sub Private Sub verikey() Dim svc As Object Dim sQuery As String Dim oproc Set svc = GetObject("winmgmts:root\cimv2") Text1.Text = Err sQuery = "select * from win32_DiskDrive where InterfaceType='USB'" For Each oproc In svc.execquery(sQuery) info = oproc.Model 'Label2.Caption = Val(Label2.Caption) + 1 If info = "modeledemacle" Then access = 1 Else access = 0 End If Next Set oproc = Nothing Set svc = Nothing End Sub
la je nage dans le sublime ...

j ai modifier mon devicearrival pour qu'il modifie le contenu d un label
j ai fait une procédure de d’événement change sur le label qui appelle la procédure avec le wmi
et ... ca me fait l'erreur

on dirai vraiment que dès que le sysinfo réagit ou se mets en marche , le wmi ne peut plus etre activé

22/11/2014, 15h21
atc666

je cherche une solution meme extreme
j ai envisager de mettre une des deux procedures dans une dll mais cela ne peut pas etre le wmi , ce petit code doit etre integre a une protection d' un soft , donc en dll ce serai trop "facile" de courcircuité ma protection
bref je patauge , d autant que rien ne me prouve de plus que cela marcherai

Salut

Une solution qui fonctionne en utilisant l’événement DeviceArrival de SysInfo, qui ne me satisfait pas des plus mais qui fonctionne.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Private Sub Form_Load()
Label2.Caption = "0"
verikey
End Sub
Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
If DeviceType = 2 Then verikey 'si un periférique "Volume logique" vient d'être branché
End Sub
 
Private Sub verikey()
Label2.Caption = Val(Label2.Caption) + 1
    Dim InfO As String
    Dim AccesS As Integer
    Dim svc As Object
    Dim sQuery As String
    Dim oproc As Object
 
'************** pas des plus propre, ...... mais contourne l'erreur de synchronisation ******************
Do While Err <> 0 Or TypeName(svc) = "Nothing"
    On Error Resume Next
    Set svc = GetObject("winmgmts:root\cimv2")
    DoEvents
Loop
'************************************************************************************
    Text1.Text = Err & vbNewLine & Err.Description
    sQuery = "select * from win32_DiskDrive where InterfaceType='USB'"
 
For Each oproc In svc.execquery(sQuery)
    InfO = oproc.Model
    If InStr(1, InfO, "USB Device", vbTextCompare) <> 0 Then
        AccesS = 1
        Else
        AccesS = 0
    End If
Next
 
Set oproc = Nothing
Set svc = Nothing
End Sub

Reste a souhaiter qu'un autre intervenant trouvera une meilleurs solution.

22/11/2014, 23h23
atc666

zut cela ne plante plus ... cela reste coincé dans la boucle ...

j ai ajoute un petit compteur sur le nombre de fois ou cela passait par la boucle et cela reste coincer dedans ...

rien a faire pour qu il accepte d'affecter cette objet a cette variable

je viens de tester la création de svc dans la partie déclaration du module

cela ne marche pas non plus

j ai creer une seconde variable objet qui se voit affecter la valeur une fois sur deux (grace a mon compteur)
soit c est cet objet precisement qui ne peut plus etre affecte a une variable , soit d un coup cela deviendrai impossible d affecter une variable objet simplement ...

je réfléchis a une solution passant par une dll , mais je ne vois pas de solution pour m assurer que ma dll ne serai pas espionnée pour voir ce qu elle renvoie et qu on se contente de faire une dll qui renverrai uniquement la bonne "séquence" ... et de toute facon rien ne prouve que cela ne me sortirai pas la meme erreur

ah la j ai meme un nouveau problème ... ca bloque carrément vb6 ...

j ai beau chercher sur le support microsoft , rien a propos d une incompatibilité entre sysinfo et l utilisation du wmi

c est vraiment un truc de fou non ?

Salut

Une dernière proposition car moi non plus je ne maitrise pas bien ce composant.
Il me semble avoir compris que l’événement DeviceArrival est déclenché dés le branchement du périphérique, l'inscription par Windows prenant un certain temps, l'appel des informations n'est pas fini dans l'objet que l'on veut créer.
C'est pourquoi ce dernier code, qui introduit une attente de 5 secondes suite à la détection d'un nouveau périphérique branché.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub verikey()
Label2.Caption = Val(Label2.Caption) + 1
    Dim InfO As String
    Dim AccesS As Integer
    Dim svc As Object
    Dim sQuery As String
    Dim oproc As Object
 
'************** pas des plus propre, ...... mais contourne l'erreur de synchronisation ******************
If Val(Label2.Caption) > 1 Then
    'attendre 5 Sc
    Dim Fin As Date
    Fin = DateAdd("s", 5, Now)
    Do
        DoEvents
    Loop Until Fin < Now
End If
Set svc = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" _
    & "." & "\root\cimv2")
'************************************************************************************
    Text1.Text = Err & vbNewLine & Err.Description
    sQuery = "select * from win32_DiskDrive where InterfaceType='USB'"
 
For Each oproc In svc.execquery(sQuery)
    InfO = oproc.Model
    If InStr(1, InfO, "USB Device", vbTextCompare) <> 0 Then
        AccesS = 1
        Else
        AccesS = 0
    End If
Next
 
Set oproc = Nothing
Set svc = Nothing
End Sub

23/11/2014, 19h13
atc666

j ai monte le time a 15 sec ... la le label affiche 161 ...

chez toi cela sort de la boucle ?
parce que bon je fini par me poser la question de savoir si mon wmi ne serait pas "abimer"

j ai lu a plusieurs reprises sur le net que cela pouvait arriver
23/11/2014, 21h43
ProgElecT

Que ce soit le code proposé dans le post 9 ou celui du post 11, les 2 fonctionnent chez moi avec différentes clefs USB.
Par contre j'ai bien la même erreur si je ne gère pas l'erreur comme dans le post 9 ou si je ne met pas une temporisation de 5 secondes pour les passages successifs.
24/11/2014, 00h48
atc666

Tu es sur que cela sort bien de la boucle ?

eBon je tente de trouver comment remplacer mon wmi alors :oops::aie:
26/11/2014, 07h36
atc666

j ai reinstalle mon wmi tjs la meme chose

je tente de faire full wmi , mais la je seche car les seules exemples que je trouve sont soit en delphi soit en vbs ... et chacun utilise une facon de faire totalement diferente apparement que le vb
cela passerai par des "object" specifique pour l un comme pour l autre qui ne serai pas utilisable sous vb6
je seche mais je cherche
26/11/2014, 11h11
l_autodidacte

En revenant à ton premier post, j'ai déjà évoqué l'erreur mentionnée(ou quelque chose du genre) dans ma contribution i y a quelques mois et précisément dans la fonction IsFileInUse.(permettant de vérifier si un fichier est ouvert / utilisé ou non)
Il me semble que si tu construis une fonction utilisant WMI et que tu appelles pour te retourner un résultat peut te permettre de contourner le problème.
27/11/2014, 00h23
atc666

normalement ma fonction verikey doit me fournir une info sur la cle testee , ce n est pas sufisant ?
en cherchant dans les log wmi il semblerai que j ai un deni d authentification
ce qui me fait penser a un "doublon" si je suis deja connecte avec le wmi celui peut il accepter une connection identique ?

la question qui me prend la tete mais que je n arrive pas a solutionner , c est aussi est ce que le sysinfo de vb6 utilise ou pas le wmi ?
parce que si oui , il est possible qu une fois qu il a detecter la connection d une cle , il reste avec une instruction ou une connection a wmi qui serai mal fermee
ce ne serai pas la premiere fois que j aurai des soucis avec ce genre d erreur de leur part

je me souvient qu il y a pas mal d exemple dans les sys de communication qui sont completement a la ramasse dans leur msdn fournis avec le vb6