ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

TELECHARGER+INFOS+PROGRESSBAR (part2)   



L'auteur

ybenam
Algérie Algérie
Membre Simple
# 0000002080
enregistré le 21/04/2008


Fiche personnelle


Note des membres
pas de note

Contributions > 13 - Web

TELECHARGER+INFOS+PROGRESSBAR (part2)
# 0000000613
ajouté le 11/06/2008 00:41:54 et modifié le 06/07/2008
consulté 4613 fois
Niveau initié

Version(s) Foxpro :
VFP 6.0

Description
-Suite et fin (?) de ma série sur les téléchargements (j'ai bien appris avec cela) :
ydownload4.prg est un programme de téléchargement avec visualisation des informations sur un form avec progressbar.
c'est une version modifiée de ydownload3.prg (mon article précédent)
-Télécharger une page web sans les objets,des zip,des images,des vidéos/audio....
-l'URL et le fichier de destination sont passés comme paramètres.
-Exécuter :do with yURL,lcdest
-ex:do ydownload3 with "http://www.awitness.org/software/download_zip_files/dlzip.exe","c:\ydownload.exe"
-Iexplore doit être installé sur la station même s'il n'est pas visible.Internet doit être connecté.
NB: A propos de concaténation de texte dans ce composant,il faut mettre des BR entre brackets comme retours de charriot !
25 juin 2008: rajouté la vitesse de transfert en ko/s dans le progressbar ,omise.
Code source :
*B.YOUSFI EL BAYADH -32000-Algérie-le 10 JUIN 2008      benameuryousfi1@gmail.com
*Télécharger une page web sans les objets,des zip,des images,des vidéos/audio....
*l'URl et le fichier de destination sont passés comme paramètres
*do <program> with yURL,lcdest
*ex:do ydownload3 with "http://www.awitness.org/software/download_zip_files/dlzip.exe","c:\ydownload.exe"
*Iexplore doit être installé sur la station même s'il n'est pas visible.Internet doit être connecté.
***************************************************************************
lparameters yUrl,lcDest
if parameters() # 2
messagebox("Vous devez passer 2 paramètres ,yURl et fichier destinataire lcDest",0+16,"Erreur")
return
endi

_screen.visible=.f.
**********************
t0=seconds()
nsize=0
clea
*Déclarations des Constantes pour API
#DEFINE INTERNET_OPEN_TYPE_PRECONFIG  0
#DEFINE INTERNET_FLAG_RELOAD 2147483648
*#DEFINE INTERNET_FLAG_RELOAD       0x80000000   &&idem
#define HTTP_QUERY_CONTENT_LENGTH     5
*******************
do yDECLARATIONS        &&Charger en mémoire les déclarations des API
*******************
yhRequest  = 0
yHandle = InternetOpen("Visual Foxpro", INTERNET_OPEN_TYPE_PRECONFIG,0, 0, 0)
If yHandle # 0
  yhRequest = InternetOpenUrl(yHandle, yURL, '', 0, INTERNET_FLAG_RELOAD, 0 )
endI
if yhRequest=0   &&Echec connection
  =InternetCloseHandle(yHandle)
endi
*******************************
cBuf = REPLICATE(' ',40)
nBufLen = 40
nVoid  = 0
nQryRet = HttpQueryInfo(yhRequest, HTTP_QUERY_CONTENT_LENGTH,  @cBuf, @nBufLen, @nVoid )

IF nQryRet=1
  nSize = VAL(cBuf)
ENDIF
=InternetCloseHandle(yHandle)  &&fermer le handle ouvert
=InternetCloseHandle(yhRequest)
********************************
do case
case nSize<=1023  &&octets
ysize=allt(str(nsize))+" Octets."

case nSize>=1024 and nsize<=1024*1024-1    && ko
ysize=allt(str(nsize/1024,12,3))+" Koctets."

case nSize>=1024*1024 and nsize<=1024*1024*1024-1  &&mo
ysize=allt(str(nsize/(1024*1024),12,3))+" Moctets."

case nsize>1024*1024*1024    &&Goctest
ysize=allt(str(nsize/(1024*1024*1024),12,3))+" Goctets."
endcase
*******************************
#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE SYNCHRONOUS 0

local lsAgent, lhInternetSession, lhUrlFile, llOk, lnOk, ystring, lcReadBuffer, lnBytesRead
lsAgent = "Visual Foxpro"
lhInternetSession = InternetOpen( lsAgent, INTERNET_OPEN_TYPE_PRECONFIG, '''', SYNCHRONOUS )

IF lhInternetSession = 0
   WAIT WINDOW "La session Internet n'a pu être établie !" TIME 2
   RETURN .null.
ENDIF
lhUrlFile = InternetOpenUrl(lhInternetSession, yURl, '', 0, INTERNET_FLAG_RELOAD, 0 )

IF lhUrlFile = 0
   * l'URL ne peut être ouverte
   messagebox(" URL ne peut être ouverte !")
   RETURN .null.
ENDIF

ystring = ""
llOk = .t.
x=0
cr=chr(13)
deb=.t.
DO WHILE llOK
   *Mettre en place un tampon assez grand de mémoire
   lsReadBuffer = SPACE(32767)
   lnBytesRead = 0   && initialiser le nbre de bytes à lire
   lnOK = InternetReadFile( lhUrlFile, @lsReadBuffer, LEN(lsReadBuffer), @lnBytesRead)
   x=x+lnbytesRead
   pourc=allt( str(100*x/nsize,7,2))+" %"   &&pourcentage des bytes obtenus
*********************************
&&vitesse de transfert en ko/s
ww=(x/(seconds()-t0))/1024
vtr=allt(str(ww,8,2))+" ko/s "
*********************************
   tt=(seconds()-t0)*(nsize/x -1)     &&temps restant estimé
   do case
   case tt<=59
   TR=allt(str(tt) )+" sec."
   case tt>=60 and tt<3600
   TR=allt( str(tt/60,5,2) )+" mn"
   case tt>=3600
   TR=allt(str(tt/3600,5,2))+" h"
   endcase
 **************************************************************
&&progressbar
if deb=.t.
yform=createobject("yprogressbar")
yform.show
deb=.f.
endi
***********************************************************
_screen.activeform.label1.caption="URl="+allt(yUrl)
_screen.activeform.label2.caption=  "Taille= " + ysize
_screen.activeform.label3.caption="Fichier destinataire ="+lcDest
_screen.activeform.ylab.caption=pourc
_screen.activeform.ytr.caption="Temps restant estimé="+TR+" Vitesse transfert="+vtr
_screen.activeform.ylab.width=(x/nsize)*_screen.activeform.ylab0.width
************************************************************
   if ( lnBytesRead > 0 )
      ystring = ystring + left( lsReadBuffer, lnBytesRead )
   endif
   * error trap - either a read failure or read past eof()
   llOk = ( lnOK = 1 ) and ( lnBytesRead > 0 )
ENDDO

_screen.activeform.release   &&fermer le progressbar

messagebox("uRL="+allt(yURl)+cr+"Taille "+allt(str(x))+" Octets"+cr+;
"Fichier destinataire="+lcdest+cr+;
"Temps du téléchargement="+allt(str(seconds()-t0))+" sec"+cr+cr+;
"Ce fichier sera visualisé." ,0+32,"Informations du téléchargement")

*fermer tous les  handles ouverts (important)
InternetCloseHandle( lhUrlFile )
InternetCloseHandle( lhInternetSession )
**************************
&&sauvegarde du téléchargement reçu sous forme de chaîne de caractères.
=strtofile(ystring,lcDest)  &&extension à respecter ou renommer convenablement
**************************
&&Visualiserr le téléchargement obtenu (l'extension a son importance ici)
DECLARE INTEGER ShellExecute IN shell32.dll ;
  INTEGER hndWin, STRING cAction, STRING cFileName, ;
  STRING cParams, STRING cDir, INTEGER nShowWin
ShellExecute(0,"open",lcDest,"","",1)
_screen.visible=.t.
**********************************************************
*Création du progressbar
DEFINE CLASS yprogressbar AS form
  Height = 132
  Width = 366
  ShowWindow = 2
  DoCreate = .T.
  AutoCenter = .T.
  BorderStyle = 3
  Caption = "Form1"
  AlwaysOnTop = .T.
  Name = "Form1"

  ADD OBJECT label1 AS label WITH ;
    BackStyle = 0, ;
    Caption = "", ;
    Height = 17, ;
    Left = 0, ;
    Top = 5, ;
    Width = 340, ;
    forecolor=255, ;
    Name = "Label1"

  ADD OBJECT label2 AS label WITH ;
    AutoSize = .T., ;
    BackStyle = 0, ;
    Caption = "", ;
    Height = 17, ;
    Left = 2, ;
    Top = 27, ;
    Width = 2, ;
    Name = "Label2"

  ADD OBJECT label3 AS label WITH ;
    AutoSize = .T., ;
    BackStyle = 0, ;
    Caption = "", ;
    Height = 17, ;
    Left = 3, ;
    Top = 47, ;
    Width = 2, ;
    Name = "Label3"

  ADD OBJECT ylab0 AS label WITH ;
    BorderStyle = 1, ;
    Caption = "", ;
    Height = 25, ;
    Left = 2, ;
    Top = 69, ;
    Width = 360, ;
    BackColor = RGB(0,0,255), ;
    Name = "yLab0"

  ADD OBJECT ylab AS label WITH ;
      Borderstyle=1, ;
    Alignment = 2, ;
    Caption = "", ;
    Height = 25, ;
    Left = 24, ;
    Top = 75, ;
    Width = 1, ;
    BackColor = RGB(0,255,0), ;
    Name = "ylab"

  ADD OBJECT ytr AS label WITH ;
    Caption = "", ;
    Height = 20, ;
    Left = 38, ;
    Top = 102, ;
    Width = 295, ;
    Name = "yTR"

  ADD OBJECT label4 AS label WITH ;
    AutoSize = .T., ;
    FontBold = .T., ;
    FontSize = 14, ;
    Caption = "X", ;
    Height = 25, ;
    Left = 348, ;
    Top = 0, ;
    Width = 15, ;
    ForeColor = RGB(255,0,0), ;
    Name = "Label4"

  PROCEDURE Init
    this.titlebar=0
    this.ylab.height=this.ylab0.height-1
    this.maxbutton=.f.
    this.borderstyle=2

    this.label1.top=0
    this.label2.top=this.label1.height
    this.label3.top=this.label1.height+this.label2.height

    this.ylab0.top=this.label3.top+this.label3.height+2
    this.ylab.top=this.ylab0.top
    this.ylab0.left=1

    this.label1.left=0
    this.label2.left=0
    this.label3.left=0

    this.ylab.width=0
    this.ylab.left=this.ylab0.left
    this.ylab.top=this.ylab0.top
    this.ylab.height=this.ylab0.height

    this.ytr.top=this.ylab0.top+this.ylab0.height+1

    this.label1.fontsize=8
    this.label2.fontsize=8
    this.label3.fontsize=8
    this.ylab.fontsize=8
    this.ytr.fontsize=8
    thisform.height=this.ytr.top+this.ytr.height+1
  ENDPROC

  PROCEDURE label4.Click
    clea
    thisform.release
  ENDPROC

ENDDEFINE
*
*-- EndDefine: yprogressbar
************************************************************
procedure yDECLARATIONS

Declare integer InternetOpen in wininet;
  string  sAgent,;
    integer lAccessType,;
    string sProxyName,;
    string sProxyBypass,;
    string lFlags
DECLARE INTEGER InternetOpenUrl IN wininet;
    INTEGER hInternet,;
    STRING   lpszUrl,;
    STRING   lpszHeaders,;
    INTEGER dwHeadersLength,;
    INTEGER dwFlags,;
    INTEGER dwContext
DECLARE INTEGER InternetCloseHandle IN wininet  INTEGER hInet

DECLARE INTEGER HttpQueryInfo IN wininet;
  INTEGER  hRequest,;
  LONG     dwInfoLevel,;
  STRING @ lpvBuffer,;
  LONG   @ lpdwBufferLength,;
  LONG   @ lpdwIndex


DECLARE INTEGER InternetReadFile IN wininet.DLL INTEGER hfile, ;
   STRING @sBuffer, INTEGER lNumberofBytesToRead, INTEGER @lBytesRead

***************************************************************


Commentaires
Aucun commentaire enregistré ...

Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2019.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3