Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre actif
    Profil pro
    Inscrit en
    février 2003
    Messages
    883
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2003
    Messages : 883
    Points : 262
    Points
    262

    Par défaut Téléchargement d'un fichier (pop up)

    Bonjour,

    je voudrais télécharger un fichier mais j'ai un pop up qui s'affiche (exécuter, enregistrer sous, annuler) et je ne sais pas comment le contrôler. Pourriez-vous m'aider svp?

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
       oIE.Navigate ("http://download.pdfforge.org/download/pdfcreator/PDFCreator-stable")
       oIE.visible = True 
       wscript.sleep 1000
    Nom : dowloadsVBC.png
Affichages : 75
Taille : 66,0 Ko

    Quand je tape :

    Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
       wscript.SendKeys "{TAB}", True  ' ou oIE.SendKeys "{TAB}", True
       wscript.SendKeys "{TAB}", True
       wscript.SendKeys "{ENTER}", True

    ça me répond que cet objet ne gère pas cette propriété ou cette méthode.

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 226
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 226
    Points : 5 218
    Points
    5 218

    Par défaut

    Il y a les avertissements de sécurité auxquels on ne peut rien(à moins de les désactiver, mais c'est fortement déconseillé).
    Pour avoir le minimum d'avertissement, on doit se servir de l'adresse complète du fichier à télécharger et là on peut faire le reste sans intervenir :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    Set WS = CreateObject("WScript.Shell")   
       Set oIE = CreateObject("InternetExplorer.Application")
       oIE.Navigate ("https://silver.download.pdfforge.org/pdfcreator/3.4.1/PDFCreator-3_4_1-Setup.exe")
       oIE.Visible = True 
       Wscript.Sleep 2000
       WS.AppActivate "Téléchargement de fichiers - Avertissement de sécurité" ' Titre de la fenêtre de téléchargement
       Wscript.Sleep 2000
       WS.SendKeys "{TAB}"
       Wscript.Sleep 1000
       WS.SendKeys "{TAB}"
       Wscript.Sleep 1000
       WS.SendKeys "{TAB}"
       Wscript.Sleep 1000
       WS.SendKeys "~"
       Wscript.Sleep 2000
       WS.SendKeys "~"
    Il y a aussi la possibilité de faire le téléchargement sans passer par Internet Explorer.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  3. #3
    Membre actif
    Profil pro
    Inscrit en
    février 2003
    Messages
    883
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2003
    Messages : 883
    Points : 262
    Points
    262

    Par défaut

    J'ai trouvé comment faire pour remettre le focus sur le navigateur.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    WS.AppActivate "Internet Explorer"
    Ensuite c'est :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
       WS.SendKeys "{TAB}"
       WS.SendKeys "{TAB}"
       WS.SendKeys "{ENTER}"

    Mon problème c'est que le deuxième bouton contient une flèche sur laquelle je voudrais bien cliquer pour pouvoir enregistrer le fichier que je télécharge sous un autre nom (Enregistrer sous).

    Je sais déjà faire le téléchargement automatique, mais je voudrais en plus pouvoir renommer le fichier que je télécharge.

  4. #4
    Membre actif
    Profil pro
    Inscrit en
    février 2003
    Messages
    883
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2003
    Messages : 883
    Points : 262
    Points
    262

    Par défaut

    Citation Envoyé par Arsene12 Voir le message
    je voudrais cliquer pour pouvoir enregistrer le fichier que je télécharge sous un autre nom (Enregistrer sous).

    Une fois que le curseur est sur le bouton Enregistrer, il faut appuyer 2 fois sur la flèche ↓ vers le bas et ensuite appuyer sur ENTER. Faut que je trouve la formule pour la flèche du bas :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
       WS.SendKeys "{TAB}"
       WS.SendKeys "{TAB}"
       WS.SendKeys "{↓}"
       WS.SendKeys "{↓}"
       WS.SendKeys "{ENTER}"

  5. #5
    Membre actif
    Profil pro
    Inscrit en
    février 2003
    Messages
    883
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2003
    Messages : 883
    Points : 262
    Points
    262

    Par défaut

    Citation Envoyé par Arsene12 Voir le message
    Faut que je trouve la formule pour la flèche du bas :
    WS.SendKeys "{↓}"
    La voici :

    Y'a plus qu'à envoyer le nom du fichier. Je vais chercher la formule à ajouter avant le

  6. #6
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 226
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 226
    Points : 5 218
    Points
    5 218

    Par défaut

    Peut-être ce
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
       Set WS = CreateObject("WScript.Shell")   Set oIE = CreateObject("InternetExplorer.Application")
       oIE.Navigate ("https://silver.download.pdfforge.org/pdfcreator/3.4.1/PDFCreator-3_4_1-Setup.exe")
       oIE.Visible = True 
       Wscript.Sleep 2000
       WS.AppActivate "Téléchargement de fichiers - Avertissement de sécurité"
       Wscript.Sleep 2000
       WS.SendKeys "{TAB}"
       Wscript.Sleep 1000
       WS.SendKeys "{TAB}"
       Wscript.Sleep 1000
       WS.SendKeys "{TAB}"
       Wscript.Sleep 1000
       WS.SendKeys "~"
       Wscript.Sleep 1000
       WS.SendKeys "NomFichier.exe"
       Wscript.Sleep 2000
       WS.SendKeys "~"
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  7. #7
    Membre actif
    Profil pro
    Inscrit en
    février 2003
    Messages
    883
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2003
    Messages : 883
    Points : 262
    Points
    262

    Par défaut

    Citation Envoyé par l_autodidacte Voir le message
    Peut-être ce
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
       WS.SendKeys "NomFichier.exe"
    Merci beaucoup. C'est ce qu'il me manquait. Mon problème est réglé. C'est vrai qu'il faut bien faire la synchronisation avec wscript.sleep X000 sinon ça plante.

  8. #8
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    février 2006
    Messages
    1 206
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2006
    Messages : 1 206
    Points : 3 288
    Points
    3 288

    Par défaut

    bonjour,

    j'arrive un peu tard mais le code me piquait tellement les yeux que j'ai dû aller chercher quelques litres de collyre
    plus sérieusement, comme l'a fait judicieusement remarquer l_autodidacte
    Il y a aussi la possibilité de faire le téléchargement sans passer par Internet Explorer.
    piloter IE à grand coup de sendkeys, c'est être à peu près assuré de finir dans le mur un jour ou l'autre...
    cela dit, je pensais trouver sur le net un exemple de code efficace et compact pour télécharger des fichiers à partir d'un site en mode "secure" et j'ai été très déçu
    donc j'ai écris quelque chose de plus carré que je mettrais ultérieurement dans les contribs
    ci-dessous le code pour télécharger tranquillement le fichier PDFCreator-3_4_1-Setup.exe

    deux observations :
    1. la technique utilisée outrepasse les fonctions d'authentification du serveur ce qui ne posera pas de réels problèmes dans 99,9% des cas
    2. cet exemple particulier met en lumière un comportement "non nominal" d'une fonction du code. essayez de trouver laquelle...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    '**************************************************************************
    '* https downloader - omen999 - april 2019 - https://omen999.developpez.com
    '**************************************************************************
    Const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
    Dim IsDone
    Dim FileName
     
    Function OnStateChange
      If oHttp.readyState=3 Then rep=CreateObject("WScript.Shell").Popup("Download in progress, please wait...",1,"Downloader by omen999 - https://omen999.developpez.com")
      If oHttp.readyState=4 Then IsDone = true
    End Function
     
    FileName="PDFCreator-3_4_1-Setup.exe"
    Set oHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    URL = "https://silver.download.pdfforge.org/pdfcreator/3.4.1/PDFCreator-3_4_1-Setup.exe"
    oHttp.onreadystatechange = GetRef("OnStateChange")
    oHttp.open "GET", URL,true  'async
    oHttp.setOption(2) = SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
    oHttp.setRequestHeader "Content-Type","text/xml"
    oHttp.send()
     
    While Not IsDone
     WScript.Sleep 500	
    Wend
     
    If oHttp.status = 200 Then 'OK
      With CreateObject("ADODB.Stream")
        .Open
        .Type = 1 'adTypeBinary
        .Write oHttp.responseBody
        .Position = 0
        .SaveToFile FileName ,2
        .Close
      End With
      MsgBox FileName & " downloaded",0,"Downloader by omen999 - https://omen999.developpez.com"
    End If
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

  9. #9
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 226
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 226
    Points : 5 218
    Points
    5 218

    Par défaut

    Citation Envoyé par omen999 Voir le message
    2. cet exemple particulier met en lumière un comportement "non nominal" d'une fonction du code. essayez de trouver laquelle...
    Normalement, MsgBox, PopUp et Echo sont des fonctions bloquantes.
    Mais quand il s'agit d'une opération asynchrone, elles ne le sont plus.

    Une seconde remarque pour quelque chose de bien bizarre : Dans le cas normal, setOption est déclarée ainsi : Sub setOption(option As SERVERXMLHTTP_OPTION, value).
    Mais l'utiliser comme ceci : oHttp.setOption(2) = SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS et qu'elle fonctionne là je n'en reviens pas.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  10. #10
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    février 2006
    Messages
    1 206
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2006
    Messages : 1 206
    Points : 3 288
    Points
    3 288

    Par défaut

    Normalement, MsgBox, PopUp et Echo sont des fonctions bloquantes.
    Mais quand il s'agit d'une opération asynchrone, elles ne le sont plus.
    presque ça mais dans l'autre sens et ça ne concerne que la fonction Popup...
    à la ligne 9, Popup qui devrait s'afficher brièvement pendant une seconde reste ouverte pendant toute la durée du téléchargement alors qu'on est justement en mode asynchrone...

    cela tient au fait que le composant MSXML2.ServerXMLHTTP.6.0 qui procède au téléchargement dans un thread séparé doit sans doute détourner le thread timer de WSH pour son usage personnel
    ce qui a pour effet de figer la fenêtre Popup en position ouverte malgré le timer défini à une seconde... ms considère qu'il est chez lui et qu'il a tous les droits

    Une seconde remarque pour quelque chose de bien bizarre : Dans le cas normal, setOption est déclarée ainsi : Sub setOption(option As SERVERXMLHTTP_OPTION, value).
    Mais l'utiliser comme ceci : oHttp.setOption(2) = SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS et qu'elle fonctionne là je n'en reviens pas.
    ça c'est encore une spécificité "made in redmond" : setOption et getOption sont en réalité les accesseurs de la propriété Option mais ce qui est beaucoup moins banal c'est que cette propriété est un tableau et non une valeur simple

    en conséquence, il est tout à fait possible de définir la valeur d'index 2 de cette façon même si une définition classique est également acceptée (oHttp.setOption 2,SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS)
    à noter d'ailleurs que cette ligne n'est là que par sécurité puisque c'est normalement la valeur par défaut

    ce code est parfaitement fiable mais a pour défaut de ne pas informer l'utilisateur de l'état courant du téléchargement ce qui peut poser problème pour les fichiers volumineux
    je suis en train de chercher une solution et je pense avoir une petite idée...stay tuned
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

  11. #11
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    2 226
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 63
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 2 226
    Points : 5 218
    Points
    5 218

    Par défaut

    presque ça mais dans l'autre sens et ça ne concerne que la fonction Popup...
    J'ai remarqué cela mais je ne l'ai pas mentionné.
    C'est la même chose pour MsgBox et Echo : Le téléchargement s'effectue correctement, mais le fichier (restant en mémoire) n'est enregistré que si la boîte de message disparaît, chose que seul PopUp fait auto.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  12. #12
    Rédacteur
    Avatar de omen999
    Profil pro
    Inscrit en
    février 2006
    Messages
    1 206
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2006
    Messages : 1 206
    Points : 3 288
    Points
    3 288

    Par défaut

    comme indiqué dans mon message précédent, j'ai greffé vite fait ma progressbar (cf les contribs)
    et mis en oeuvre l'astuce qui permet de suivre la progression du téléchargement
    (astuce un poil bancale car elle nécessite un coef d'ajustement arbitraire voir ligne 106 )
    la propriété wmi WriteTransferCount n'est maj qu'à la fin du transfert ce qui la rend inexploitable
    la propriété WorkingSetSize est en revanche maj pendant le transfert mais la corrélation avec le
    téléchargement n'est pas aussi précise d'où l'ajustement

    mais globalement le principe fonctionne sauf à remanier le code de la progressbar
    qui avait été écrit pour XP et IE6 avant d'en proposer une version définitive dans les contribs

    ci-dessous le code pour télécharger le fichier PDFCreator-3_4_1-Setup.exe on ne s'en lasse pas
    merci pour vos retours

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    '**************************************************************************
    '* https downloader - omen999 - may 2019 - https://omen999.developpez.com
    '**************************************************************************
     
    Const SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS = 13056
    Dim fileName
    Dim rep
    Dim child
    Dim method,fileSize,PID
    Dim wmi
    Dim memInit,memCur
     
    Class pgBar
      Private sScript,sAbout,bUserShft,lpShift,spTitle,oHta
      Public lRfRate,lSampling,lHeight,lWidth,lLeft,lTop
      Private Sub Class_Initialize()
        ' update default values
        lpShift=1
        lRfRate=5
        lHeight=98
        lWidth=670
        lLeft=0
        lTop=0
        spTitle=""
      End Sub
      Public Property Get lShift(lParam) 
        lpShift=lParam
        bUserShft=True
      End Property
      Public Default Function Display(sTitle,sMsg,bIsPgBar,bCan)	
        If sTitle<>"" Then spTitle=sTitle
        If bIsPgBar And Not(bUserShft) Then lpShift=1		
        sScript="var f=0,cOut,p;var aT=new Array();"&_
         "var aP=new Array();document.title='"&spTitle&"';resizeTo("&lWidth&","&lHeight&");moveTo("&lLeft&"+("&lLeft&"==0)*(screen.width-"&lWidth&")/2,"&lTop&"+("&lTop&"==0)*   (screen.height-"&lHeight&")/2);"&_
         "function window.onload(){bdy.style.filter=""progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#CFCFCF',EndColorStr='#E8E8E8')"";bdy.style.fontFamily='MS Sans Serif';"&_
         "bdy.style.fontSize='9pt';pgb.style.position='absolute';pgb.style.width='100%';pgb.style.bottom='10px';pgb.style.lineHeight='8px';pgb.style.borderWidth=1;pgb.style.borderStyle='inset';"&_
         "pgb.style.backgroundColor='#F5F5F5';lab.innerText='"&sMsg&"';bar.style.posWidth=0;if("&bCan&"){lab.style.width='80%';btn.style.position='absolute';btn.style.bottom='28px';btn.style.right='10px';"&_
         "btn.style.height='22px';btn.style.width='70px';btn.accessKey='a';btn.style.fontSize='8pt';btn.attachEvent('onclick',btn_onclick);cOut=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1);}else{btn.style.visibility='hidden';}"&_
         "if("&bIsPgBar&"){bar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#FFFFFF',EndColorStr='#00CC00')"";readIn();}"&_
         "else {bar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FFCCFFCC',EndColorStr='#FF00CC00')"";rgbar.style.position='absolute';rgbar.style.width=pgb.clientWidth;"&_
         "rgbar.style.posRight=0;rgbar.style.filter=""progid:DXImageTransform.Microsoft.Gradient(GradientType=1,StartColorStr='#FF00CC00',EndColorStr='#FFCCFFCC')"";setInterval(updBar,"&lRfRate&");}}"&_		
         "function updBar(){if(bar.style.posWidth<pgb.clientWidth-2){bar.style.posWidth+="&lpShift&";rgbar.style.posWidth-="&lpShift&";}else{bar.style.posWidth=0;rgbar.style.posWidth=pgb.clientWidth}}"&_
         "function updBarT(iPc,n){if(aP[n]<iPc*pgb.clientWidth/(100*"&lpShift&")){bar.style.posWidth+="&lpShift&";aP[n]++;}else{clearInterval(aT[n]);readIn();}}"&_
         "function updData(iPc,sM){var j;if(sM!=''){lab.innerText=sM;};j=aT.length;aP[j]=0;aT[j]=setInterval(function(){updBarT(iPc,j);},"&lRfRate&");}"&_
         "function readIn(){var b,h,c;if(f==0){b=parseInt(cIn.Read(3),10);if(!isNaN(b)){h=parseInt(cIn.Read(3),10);if(!isNaN(h)){c=cIn.Read(h);if(c=='#cls#'){close();}else{updData(b,c);}}}else f=1;} }"&_
         "function btn_onclick(){clearInterval(aT[aT.length-1]);cOut.Write(Math.round(bar.style.posWidth/pgb.clientWidth*100));close()}"
         'maxsize sAbout string : 508 octets   current : 350 octets 
         sAbout= "about:<SCRIPT>var cIn=new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(0);eval(cIn.Read("&Len(sScript)&"));</SCRIPT><HTA:APPLICATION SHOWINTASKBAR=""no"" SCROLL=""no"" BORDER=""dialog"" INNERBORDER=""no""><BODY ID=""bdy""><DIV ID=""lab""></DIV><DIV ID=""pgb""><SPAN ID=""bar""></SPAN><SPAN ID=""rgbar""></SPAN></DIV><BUTTON ID=""btn""><U>A</U>nnuler</BUTTON></BODY>"
         Set oShell=CreateObject("WScript.Shell")
         Set oHta=oShell.Exec("mshta.exe """ & sAbout & """")
         oHta.StdIn.Write sScript
         Set Display=oHta.StdOut
      End Function
      Public Function Change(lPerc,sMsg)
        ' improper value of lPerc will be ignored
        If (Not IsNumeric(lPerc)) Or (lPerc<0) Then lPerc=0
        If lPerc>100 Then lPerc=100
        On Error Resume Next
        oHta.StdIn.Write Right("00"&CStr(lPerc),3) & Right("00"&CStr(Len(sMsg)),3) & sMsg
        Change=Err.Number
        On Error GoTo 0
      End Function
      Public Sub Close()
        Change 0,"#cls#"
      End Sub
      Public Sub Kill()		
        oHta.Terminate
      End Sub
    End Class
     
    ' init http object
    Set oHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    ' oHttp.onreadystatechange = GetRef("OnStateChange") ' useless now
    oHttp.setOption(2) = SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
     
    ' init variables
    Set child=GetObject("winmgmts:Win32_process.Handle='" & CreateObject("WScript.Shell").Exec("rundll32 kernel32,Sleep").ProcessId & "'")
    PID = child.ParentProcessId
    child.Terminate
    FileName="PDFCreator-3_4_1-Setup.exe"
    URL = "https://silver.download.pdfforge.org/pdfcreator/3.4.1/PDFCreator-3_4_1-Setup.exe"
     
    ' get file size before downloading
    method = "HEAD"
    oHttp.open method,URL,False 'sync
    oHttp.send()
    fileSize = CDbl(oHttp.getResponseHeader("Content-Length"))
    Set wmi = GetObject("winmgmts:\\.\root\cimv2") 
    memInit = wmi.ExecQuery("SELECT * FROM Win32_Process WHERE ProcessId=" & PID).ItemIndex(0).WorkingSetSize
     
    ' start downnloading
    method = "GET" 
    oHttp.open method,URL,true  'async
    oHttp.setRequestHeader "Content-Type","text/xml"
    oHttp.send()
    ' display progressbar
    Set oPgb=New pgBar
    Set oStatut=oPgb.Display("Downloader by omen999 - https://omen999.developpez.com","Download " & fileName & " (" & fileSize & " octets) in progress, please wait",1,1)
    oPgb.Change 0,"" ' update display pgbar
    ' main loop
    Do Until oHttp.readyState = 4
      WScript.Sleep 100
      'downCount = wmi.ExecQuery("SELECT * FROM Win32_Process WHERE ProcessId=" & PID).ItemIndex(0).WriteTransferCount
      ' updated at the end of the download only, so useless
      memCur = CDbl(wmi.ExecQuery("SELECT * FROM Win32_Process WHERE ProcessId=" & PID).ItemIndex(0).WorkingSetSize)
      downCur = Int((memCur - memInit) * 102 / fileSize)     ' 102 : coef delta correlation 
      If downCur < 101 Then
        If oPgb.Change( 1,"Download " & fileName & " (" & fileSize & " octets) in progress, please wait - " & Cstr(downCur) & " %") < 0 Then
          oHttp.abort
          MsgBox "Download canceled",0,"Downloader by omen999 - https://omen999.developpez.com" 
          WScript.Quit
        End if
      End if
    Loop
    oPgb.Close
    ' save file downloaded    
    If oHttp.status = 200 Then 'OK
      With CreateObject("ADODB.Stream")
         .Open
         .Type = 1 'adTypeBinary
         .Write oHttp.responseBody
         .Position = 0
         .SaveToFile FileName ,2
         .Close
      End With
      MsgBox FileName & " downloaded",0,"Downloader by omen999 - https://omen999.developpez.com"
    End If
    nomen omen, nemo non omen - Consultez la FAQ VBScript et les cours et tutoriels VBScript
    le plus terrible lorsqu'une voiture renverse un piéton, c'est que ce sont les freins qui hurlent. (ramón)
    pas de questions techniques par mp

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 4
    Dernier message: 13/06/2007, 15h27
  2. Réponses: 2
    Dernier message: 30/05/2006, 15h07
  3. forcer le téléchargement - problème ouverture fichier
    Par grinder59 dans le forum Fichiers
    Réponses: 8
    Dernier message: 09/03/2006, 15h59
  4. permettre le téléchargement d'un fichier
    Par vincentweb dans le forum Fichiers
    Réponses: 1
    Dernier message: 23/02/2006, 23h50
  5. Réponses: 3
    Dernier message: 02/01/2006, 16h23

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo