Download speed vbfrance (v2)

Télécharger le projet
Commenter

Description

Hé oui déjà DownloadSpeeedVbfrance Version 2
Nouvelle option : enregistrer ses liens au format
GetRight (*.grx)

Un petit rappel :
Vbfrance stock tous ses fichiers zip on sait pas ou ? mais on connait leurs ID allant de 1 à 2100 (actuellement)!
Alors ce petit programme vous géneres un fichier HTML avec tous les liens et également la possibilité de générer des fichiers .grx (GetRight) pour downloder encore plus vite !!! (fo avoir le software GetRight biensure :o) ) et bientôt , également la possibilité d'exporter un fichier vers FlashGet ( *.lst)

et des nouvelles options vous permettent de choisir le type d'indexation !! soit complète soit partiels (fragement d'ID) sinon y'a qu'a prendre le zip y'a tout dedans !

Source / Exemple : 


' /!\ PRENEZ LE ZIP j'ai pas mis toutes les sources !!! /!\ 

'DownloadSpeeedVbfrance Version 2
' ####### par  N.A.D.I.U.M http://nadium.fr.st  #################
'                                ###
'                          ##   #####   ##
'                           ##  #####  ##
'                            ## ##### ##
'                             ## ### ##
'###    ##     ###     ####### ####### ##    ##   ##     ##
'####   ##    ####     ########   ##   ##    ##   ###    ##
'#####  ##    #####    ##   ####  ##   ##    ##   ####  ###
'###### ##   ### ###   ##    ###  ##   ##    ##   #########
'## ######   ##  ###   ##    ###  ##   ##    ##   ## ### ##
'##  #####  #########  ##   ###   ##   ##    ##   ## ### ##
'##   #### ###    ###  ########   ##   ########   ##  #  ## .FR.ST
' To be create The futur oOéCava :o)
'
' ###################   N.A.D.I.U.M http://nadium.fr.st  ##################
'oOéCaVa :o) m'enfin ! pas vrais ça !

'Alors j 'ai pas l'habitude de mettre des commentaires, mais là je me suis un peu forcer à le faire
'et ça rien que pour vous !
'vous-vous direz qu'il y'a moyen de reduire mon programme en quelques lignes, je dirais oui !
'mais j'ai pas chercher à optimiser, l'optimisation seras dans la version 3 ! héhé ça promet :o)
'en attendant la version 3, contentez-vous de cette version 2 qui fonctionne bien déjà :o)

'Pour info :  l'ID de fin ne cessent d'augmenter (actuellement à 2100 le 27/08/2001)
Option Explicit

'ici on ecrit les liens vers un fichiers *.grx  (GetRight)
Private Sub SaveToGRX(IDdebut, IDfin)
Dim id As Integer
Dim idNbr As Integer
Dim fileTosave As String
idNbr = 0
id = 0
 'on detecte si le type d'indexation est : tout les liens
    If ALL.Value = True Then
        IDdebut = 1
        IDfin = 2100 '<-------- valeur à modifié Car l'ID de fin ne cessent d'augmenter (actuellement à 2100 le 27/08/2001)
    End If
 'on detecte si le type d'indexation est patiels cad à (partir de)
    If ApartirDeID.Value = True Then
        IDdebut = IDpartir.Text
        IDfin = 2100 '<-------- valeur à modifié Car l'ID de fin ne cessent d'augmenter (actuellement à 2100 le 27/08/2001)
        id = IDpartir - 1
    End If

'indiquer le nom du fichier
fileTosave = "DownloadSpeed.grx"
    Open fileTosave For Output As #1
        Print #1, "//" & ID5
            For idNbr = IDdebut To IDfin
                id = id + 1
               'ici on cree l'url du type    URL : XXXX    avec XXX le lien
                Print #1, "URL: http://www.vbfrance.com/fichier.asp?Val=" & id & "&F=W'"
                Print #1, "file: " & chemingrx.Text  '<-------- ce chemin correspond au chemin ou vous allez enregister vos download sur GetRight
            Next idNbr
        Close #1
        'un petit aperçu du resultat
    MsgBox "Fichier " & fileTosave & " crée."
         ApercuFile fileTosave
    
End Sub
Private Sub SaveTotxt(IDdebut, IDfin)
Dim id As Integer
Dim idNbr As Integer
Dim fileTosave As String
idNbr = 0
id = 0

    If ALL.Value = True Then
        IDdebut = 1
        IDfin = 2100 '<-------- valeur à modifié Car l'ID de fin ne cessent d'augmenter (actuellement à 2100 le 27/08/2001)
    End If
    If ApartirDeID.Value = True Then
        IDdebut = IDpartir.Text
        IDfin = 2100 '<--------  valeur à modifié Car l'ID de fin ne cessent d'augmenter (actuellement à 2100 le 27/08/2001)
        id = IDpartir - 1
    End If

fileTosave = "DownloadSpeed.txt"
    Open fileTosave For Output As #1
         Print #1, ID5
           For idNbr = IDdebut To IDfin
              id = id + 1
           Print #1, "URL: http://www.vbfrance.com/fichier.asp?Val=" & id & "&F=W'"
            Next idNbr
    Close #1
   MsgBox "Fichier " & fileTosave & " crée."
    ApercuFile fileTosave
    
End Sub

'ecriture dans un fichier html ...

Private Sub SaveToHTML(IDdebut, IDfin, colonnes)
Dim id As Integer
Dim idNbr As Integer
Dim col As Integer
Dim color As String
Dim fileTosave As String
idNbr = 0
id = 1
col = 1

    If ALL.Value = True Then
        IDdebut = 1
        IDfin = 2100 '<---------- valeur à modifié Car l'ID de fin ne cessent d'augmenter (actuellement à 2100 le 27/08/2001)
    End If

    If ApartirDeID.Value = True Then
        IDdebut = IDpartir.Text
        IDfin = 2100 '<--------- valeur à modifié Car l'ID de fin ne cessent d'augmenter (actuellement à 2100 le 27/08/2001)
        id = IDpartir - 1
    End If

fileTosave = "DownloadSpeed.html"
    Open fileTosave For Output As #1
    ' le deBcut du code Html est stocké dans le textBox: DebutHTML ( il n'est pas visible à l'ecran )
        Print #1, DebutHTML.Text
    'Ecriture du début d'une table
    Print #1, "<a href='http://www.nadium.fr.st'>y'a plus qu'a cliquer sure les sources que vous voulez Télécharger !!  :o)</a>"
        Print #1, "<table border='0' cellpadding='5' cellspacing='1'>"
           'creations des lignes
           For idNbr = IDdebut To IDfin
           'un peu de jaune 'est jolie :o)
                                color = "yellow"
            'creation des colonnes
                Print #1, "<tr bgcolor='" & color & "'>"
                    For col = 1 To colonnes
                    id = id + 1
                    If id > IDfin Then
                         Print #1, "<td>"
                         Print #1, "<a href='http://www.nadium.fr.st'> et voili :o)</a>"
                         Print #1, "</td>"
                         GoTo fin
                     Else
                     
                         Print #1, "<td>"
                         Print #1, "<a href='http://www.vbfrance.com/fichier.asp?Val=" & id & "&F=W'>" & id & ".Zip</a>"
                         Print #1, "</td>"

                   
                    End If
                    Next col
                Print #1, "</tr>"
            Next idNbr
fin:
    
    ' ecriture du Html de fin et oui il fo bien fermé tout ça ! oOéCaVa :o)
        Print #1, "<table >"
        Print #1, "</body>"
        Print #1, "</html>"
    
    'fermeture du fichier
    Close #1
     MsgBox "Fichier " & fileTosave & " crée."
    ApercuFile fileTosave
    
End Sub

'et voila l'aperçu , bon j'explique pas :o)
Private Sub ApercuFile(fileTosave)
        
        If apercuOpt.Value = 1 Then
        Open fileTosave For Input As 1
              Apercu.txtText.TextRTF = Input$(LOF(1), 1)
        Close
            Apercu.Show
            End If
End Sub

Private Sub Command2_Click()
Aide.Show
End Sub

'Le bouton executer permet de valider les choix, et appele les fonctions selon le type d'indexation et le type de fichiers
Private Sub Executer_Click()
               
        If typeHTML.Value = True Then
        SaveToHTML IDdebut.Text, IDfin.Text, colonnes.Text
        End If
        
        If typegrx.Value = True Then
        SaveToGRX IDdebut.Text, IDfin.Text
        End If
        
        If typetxt.Value = True Then
        SaveTotxt IDdebut.Text, IDfin.Text
        End If
End Sub

' POUR TOUT LE RESTE en bas y'a rien de speciale à dire si c'nest que ben regardé et cé tout !! grrrrrrrr

Private Sub typegrx_Click()
chemingrx.Enabled = True
colonnes.Enabled = False
End Sub

Private Sub typeHTML_Click()
chemingrx.Enabled = False
colonnes.Enabled = True
End Sub

Private Sub typetxt_Click()
chemingrx.Enabled = False
colonnes.Enabled = False
End Sub

Private Sub ALL_Click()
IDpartir.Enabled = False
IDdebut.Enabled = False
IDfin.Enabled = False
End Sub

Private Sub ApartirDeID_Click()
IDpartir.Enabled = True
IDdebut.Enabled = False
IDfin.Enabled = False
End Sub

Private Sub DeIDaID_Click()
IDdebut.Enabled = True
IDfin.Enabled = True
End Sub
Private Sub Command1_Click()
Unload Apercu
Unload Me
End Sub

Conclusion :


Bon ben je crois que cette version est plus stable :o) en attendant la version 3 !!
SPEED oOéCaVa :o
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (NADIUM)