begin process at 2012 05 27 06:19:54
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Fichier / Disque

 > CRÉATEUR DE LISTE EASYDCC

CRÉATEUR DE LISTE EASYDCC


 Information sur la source

Note :
Aucune note
Catégorie :Fichier / Disque Classé sous :easydcc, liste, fichiers, ajouter Niveau :Débutant Date de création :29/09/2004 Vu / téléchargé :4 376 / 249

Auteur : ranouf

Ecrire un message privé
Site perso
Commentaire sur cette source (2)
Ajouter un commentaire et/ou une note

 Description

Pour ceux qui connaissent EasyDcc (http://www.easydcc.fr.st/), logiciel aidant au téléchargement de fichiers sur des xdcc, ListeEasyDCC permet de faire ce que EasyDcc ne faisait pas, c'est à dire avoir la possibilité d'ajouter un fichier manuellement. En effet tous les xdcc n'affichent pas leur liste donc grace à ce logiciel vous pouvez :
- ajouter manuellement un fichier à la liste,
- puis sauvegarder la liste
- et enfin la charger sous easydcc
- vous avez ensuite la possibilité de charger une liste dans ListeEasyDCC

Source

  • '****************************************
  • '--- frMain
  • '****************************************
  • Private Sub Form_Load()
  • strAdr = "" '--- Adresse Fichier
  • StatusBar1.Panels(1).Width = frmMain.Width '--- Barre des statuts
  • End Sub
  • '---------------------------------------------------
  • '--- Chargement du fichier txt
  • '---------------------------------------------------
  • Private Sub m_Load_Click()
  • Dim fso As New FileSystemObject
  • Dim Fichier As TextStream
  • Dim ListItem As ListItem
  • Dim str As String
  • Dim ni As Integer
  • On Error GoTo ErrHandler
  • '--- Ouverture boite de dialogue
  • CommonDialog1.Filter = "Fichiers texte (*.txt)|*.txt|Tous les fichiers (*.*)|*.*"
  • CommonDialog1.ShowOpen
  • '--- Définition du fichier
  • Set Fichier = fso.OpenTextFile(CommonDialog1.FileName, ForReading, True)
  • '--- Test Validité
  • If Fichier.ReadLine <> "[liste]" Or Fichier.AtEndOfLine = True Then
  • MsgBox "Liste non valide", vbCritical, "ERREUR CHARGEMENT LISTE"
  • GoTo ErrHandler
  • End If
  • '--- RAZ de la liste
  • lwList.ListItems.Clear
  • '--- Listing
  • Do While Fichier.AtEndOfLine <> True
  • str = Fichier.ReadLine
  • Set ListItem = lwList.ListItems.Add(, , TranscripteurTxtList(str, 1))
  • For ni = 2 To 6
  • ListItem.SubItems(ni - 1) = TranscripteurTxtList(str, ni)
  • Next
  • Loop
  • '--- Présentation
  • frmMain.Caption = "Gestion Liste EasyDCC - " & CommonDialog1.FileName
  • strAdr = CommonDialog1.FileName
  • lblAdresse.Caption = CommonDialog1.FileName
  • lblTaille.Caption = FileLen(CommonDialog1.FileName) & " ko"
  • txtIRC.Text = ""
  • txtTaille.Text = ""
  • txtNom.Text = ""
  • txtChan.Text = ""
  • txtServ.Text = ""
  • Action "Liste """ & CommonDialog1.FileName & """ chargée"
  • '--- Destruction des objets
  • Fichier.Close
  • Set fso = Nothing
  • Set Fichier = Nothing
  • Exit Sub
  • ErrHandler:
  • '--- L'utilisateur a sélectionné le bouton Annuler.
  • Action "Chargement annulé"
  • '--- Destruction des objets
  • Set fso = Nothing
  • Set Fichier = Nothing
  • Exit Sub
  • End Sub
  • '---------------------------------------------------
  • '--- Sauvegarde de la liste
  • '---------------------------------------------------
  • Private Sub m_Save_Click()
  • Dim fso As New FileSystemObject
  • Dim Fichier As TextStream
  • Dim strTxt As String
  • Dim ni As Integer
  • Dim nEl As Integer
  • Dim strPart As String '--- Partie de chaine à renvoyer
  • Dim nDeb As Integer '--- Début de la chaine renvoyée
  • Dim nFin As Integer '--- Fin de la chaine renvoyée
  • Dim nLong As Integer '--- Longueur de la chaine renvoyée
  • On Error GoTo Erreur ' Prise en charge des erreurs
  • ' Verifie si le fichier existe déjà
  • If (fso.FileExists(strAdr)) Then
  • ' Si oui, enregistre les nouvelles
  • ' données dans le fichier texte existant
  • Set Fichier = fso.OpenTextFile(strAdr, ForWriting, False)
  • '--- Pour que le fichier soit reconnu
  • Fichier.WriteLine "[liste]"
  • nEl = lwList.ListItems.Count
  • For ni = 1 To nEl
  • '--- Préparation ligne list -> txt
  • '--- Nick
  • strTxt = ""
  • strTxt = lwList.ListItems(ni).Text
  • strTxt = Replace(strTxt, "[", "~")
  • strTxt = Replace(strTxt, "]", "")
  • '--- N°
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(1) & "="
  • '--- Taille - 1
  • strPart = ""
  • strPart = lwList.ListItems(ni).SubItems(2)
  • nDeb = 1
  • nFin = InStr(1, strPart, "K")
  • If nFin = 0 Then
  • nFin = InStr(1, strPart, "M")
  • End If
  • nLong = nFin - nDeb
  • strPart = Mid(strPart, nDeb, nLong)
  • strTxt = strTxt & strPart & ";"
  • '--- Taille - 2
  • strPart = ""
  • strPart = lwList.ListItems(ni).SubItems(2)
  • nFin = InStr(1, strPart, "K")
  • If nFin = 0 Then
  • strTxt = strTxt & "MB" & ";"
  • Else
  • strTxt = strTxt & "KB" & ";"
  • End If
  • '--- Nom
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(3) & ";"
  • '--- Channel
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(4) & ";"
  • '--- Serveur
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(5) & ";0"
  • '--- écriture dans le fichier
  • Fichier.WriteLine strTxt
  • Next
  • ' Si le fichier texte n'existe pas, le créer
  • Else
  • ' Ouverture du CommonDialog pour enregistrer le fichier
  • CommonDialog1.Filter = "Fichier Texte (*.txt)|*.txt;|"
  • CommonDialog1.ShowSave
  • If CommonDialog1.FileName <> "" Then
  • With fso
  • ' Crée le nouveau fichier
  • strAdr = .BuildPath(.GetParentFolderName(CommonDialog1.FileName), _
  • CommonDialog1.FileTitle)
  • Set Fichier = .CreateTextFile(strAdr, True)
  • End With
  • '--- Pour que le fichier soit reconnu
  • Fichier.WriteLine "[liste]"
  • nEl = lwList.ListItems.Count
  • For ni = 1 To nEl
  • '--- Préparation ligne list -> txt
  • '--- Nick
  • strTxt = ""
  • strTxt = lwList.ListItems(ni).Text
  • strTxt = Replace(strTxt, "[", "~")
  • strTxt = Replace(strTxt, "]", "")
  • '--- N°
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(1) & "="
  • '--- Taille - 1
  • strPart = ""
  • strPart = lwList.ListItems(ni).SubItems(2)
  • nDeb = 1
  • nFin = InStr(1, strPart, "K")
  • If nFin = 0 Then
  • nFin = InStr(1, strPart, "M")
  • End If
  • nLong = nFin - nDeb
  • strPart = Mid(strPart, nDeb, nLong)
  • strTxt = strTxt & strPart & ";"
  • '--- Taille - 2
  • strPart = ""
  • strPart = lwList.ListItems(ni).SubItems(2)
  • nFin = InStr(1, strPart, "K")
  • If nFin = 0 Then
  • strTxt = strTxt & "MB" & ";"
  • Else
  • strTxt = strTxt & "KB" & ";"
  • End If
  • '--- Nom
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(3) & ";"
  • '--- Channel
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(4) & ";"
  • '--- Serveur
  • strTxt = strTxt & lwList.ListItems(ni).SubItems(5) & ";0"
  • '--- écriture dans le fichier
  • Fichier.WriteLine strTxt
  • Next
  • ' Modifie le Caption de la fenetre, par le nom du fichier
  • frmMain.Caption = "Gestion Liste EasyDCC - " & CommonDialog1.FileName
  • strAdr = CommonDialog1.FileName
  • lblAdresse.Caption = CommonDialog1.FileName
  • lblTaille.Caption = FileLen(CommonDialog1.FileName) & " ko"
  • Action "Liste """ & CommonDialog1.FileName & """ chargée"
  • End If
  • End If
  • Action strAdr & " a bien été enregistrer"
  • Exit Sub ' Aucune erreur, donc sortie
  • Erreur:
  • '--- L'utilisateur a sélectionné le bouton Annuler.
  • Action "Sauvegarde annulée"
  • End Sub
  • '---------------------------------------------------
  • '--- Crédits
  • '---------------------------------------------------
  • Private Sub m_Cred_Click()
  • Action "Logiciel réalisé par Ranouf, ranouf@hotmail.com"
  • End Sub
  • '---------------------------------------------------
  • '--- Nouvelle Liste
  • '---------------------------------------------------
  • Private Sub m_New_Click()
  • '--- RAZ Fichier
  • strAdr = ""
  • lblAdresse.Caption = "[Aucun]"
  • lblTaille.Caption = "[Aucun]"
  • txtIRC.Text = ""
  • frmMain.Caption = "Gestion Liste EasyDCC - Nouvelle Liste"
  • '--- RAZ de la liste
  • lwList.ListItems.Clear
  • End Sub
  • '---------------------------------------------------
  • '--- Click sur la liste
  • '---------------------------------------------------
  • Private Sub lwList_Click()
  • If lwList.ListItems.Count <> 0 Then
  • Cmd_Mode (1)
  • nIndexSelectionne = lwList.SelectedItem.Index
  • txtIRC.Text = TranscripteurListIRC(lwList.ListItems(nIndexSelectionne))
  • txtTaille.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(2)
  • txtNom.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(3)
  • txtChan.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(4)
  • txtServ.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(5)
  • End If
  • End Sub
  • Private Sub lwList_ItemClick(ByVal Item As MSComctlLib.ListItem)
  • lwList_Click
  • End Sub
  • '---------------------------------------------------
  • '--- Changement texte IRC
  • '---------------------------------------------------
  • Private Sub txtIRC_KeyUp(KeyCode As Integer, Shift As Integer)
  • If nIndexSelectionne <> 0 Then
  • If TranscripteurListIRC(lwList.ListItems(nIndexSelectionne)) = txtIRC.Text Then
  • Cmd_Mode (1)
  • Else
  • Cmd_Mode (0)
  • End If
  • End If
  • End Sub
  • '---------------------------------------------------
  • '--- Actions Bouton cmd
  • '---------------------------------------------------
  • Private Sub cmd_Click(Index As Integer)
  • Dim ni As Integer
  • Dim ListItem As ListItem
  • Dim bErr As Boolean
  • Select Case (Index)
  • '--- Bouton Ajouter
  • Case 0:
  • bErr = False
  • If txtIRC.Text = "" Then
  • lblErr.Visible = True
  • lblInfoIrc.ForeColor = &HC0&
  • bErr = True
  • Else
  • lblInfoIrc.ForeColor = &H80000012
  • End If
  • If txtTaille.Text = "" Then
  • lblErr.Visible = True
  • lblInfoTaille.ForeColor = &HC0&
  • bErr = True
  • Else
  • lblInfoTaille.ForeColor = &H80000012
  • End If
  • If txtNom.Text = "" Then
  • lblErr.Visible = True
  • lblInfoNom.ForeColor = &HC0&
  • bErr = True
  • Else
  • lblInfoNom.ForeColor = &H80000012
  • End If
  • If txtChan.Text = "" Or InStr(1, txtChan.Text, "#") = 0 Then
  • lblErr.Visible = True
  • lblInfoChan.ForeColor = &HC0&
  • bErr = True
  • Else
  • lblInfoChan.ForeColor = &H80000012
  • End If
  • If txtServ.Text = "" Then
  • lblErr.Visible = True
  • lblInfoServ.ForeColor = &HC0&
  • bErr = True
  • Else
  • lblInfoServ.ForeColor = &H80000012
  • End If
  • If bErr = True Then
  • Exit Sub
  • End If
  • Action txtIRC.Text & " a bien été ajouté"
  • '--- Ajout dans la liste
  • Set ListItem = lwList.ListItems.Add(, , TranscripteurIRCList(txtIRC.Text, 1))
  • ListItem.SubItems(1) = TranscripteurIRCList(txtIRC.Text, 2)
  • ListItem.SubItems(2) = txtTaille.Text
  • ListItem.SubItems(3) = txtNom.Text
  • ListItem.SubItems(4) = txtChan.Text
  • ListItem.SubItems(5) = txtServ.Text
  • 'nOcc = InStr(nOcc + 1, str, ";")
  • 'TranscripteurIRCList( txtirc.Text, txttaille.Text, txtnom.Text, txtchan.Text, txtserv.Text)
  • '--- Bouton Supprimer
  • Case 1:
  • Action txtIRC.Text & " a bien été supprimé"
  • '--- RAZ informations
  • txtIRC.Text = ""
  • txtTaille.Text = ""
  • txtNom.Text = ""
  • txtChan.Text = ""
  • txtServ.Text = ""
  • Cmd_Mode (0)
  • '--- suppression de l'élément
  • lwList.ListItems.Remove lwList.SelectedItem.Index
  • nIndexSelectionne = 0
  • '--- Bouton Nouveau
  • Case 2:
  • Action "Nouveau téléchargement"
  • '--- RAZ informations
  • txtIRC.Text = "/ctcp [NomXDCC] xdcc send #[N°]"
  • txtTaille.Text = ""
  • txtNom.Text = ""
  • txtChan.Text = "#"
  • txtServ.Text = ""
  • Cmd_Mode (0)
  • nIndexSelectionne = 0
  • End Select
  • End Sub
  • '***************************************************
  • '*** module************ *****************************
  • '***************************************************
  • Option Explicit
  • Public strAdr As String '--- Adresse fichier en cours
  • Public nCmd_Mode As Integer '--- Mode Ajout et Supprimer
  • Public nIndexSelectionne As Integer '--- Index de l'élément sélectionné dans la liste
  • '***************************************************
  • '*** APPLICATIONS DIVERSES *************************
  • '***************************************************
  • '---------------------------------------------------
  • '--- Affiche dans la barre de statut str ----------
  • '---------------------------------------------------
  • Public Sub Action(str As String)
  • frmMain.StatusBar1.Panels(1).Text = str
  • End Sub
  • '---------------------------------------------------
  • '--- Passe cmd en mode Ajout ou Supprimer ----------
  • '---------------------------------------------------
  • Public Sub Cmd_Mode(nb As Integer)
  • If nb = 1 Then
  • '--- Supp
  • frmMain.cmd(1).Enabled = True
  • frmMain.cmd(0).Enabled = False
  • Else
  • '--- Ajout
  • frmMain.cmd(0).Enabled = True
  • frmMain.cmd(1).Enabled = False
  • End If
  • frmMain.lblInfoIrc.ForeColor = &H80000012
  • frmMain.lblInfoTaille.ForeColor = &H80000012
  • frmMain.lblInfoNom.ForeColor = &H80000012
  • frmMain.lblInfoChan.ForeColor = &H80000012
  • frmMain.lblInfoServ.ForeColor = &H80000012
  • frmMain.lblErr.Visible = False
  • nCmd_Mode = nb
  • End Sub
  • '---------------------------------------------------
  • '--- Transcrire Txt => List ------------------------
  • '--- str = chaine EasyDcc --------------------------
  • '--- nb = colonne désirée --------------------------
  • '---------------------------------------------------
  • Public Function TranscripteurTxtList(str As String, nb As Integer) As String
  • '--- Fonctions a se servir :
  • 'InStr , fonction
  • 'Renvoie une valeur de type Variant (Long) indiquant la position de la première
  • 'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
  • 'Syntaxe
  • 'InStr([start, ]string1, string2[, compare])
  • 'Len, fonction
  • 'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
  • 'ou le nombre d'octets requis pour stocker unevariable.
  • 'Syntaxe
  • 'Len(string)
  • 'Right , fonction
  • 'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
  • 'caractères d'une chaîne en partant de la droite.
  • 'Syntaxe
  • 'Right(string, length)
  • 'Left , fonction
  • 'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
  • 'caractères d'une chaîne en partant de la gauche.
  • 'Mid, fonction
  • 'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
  • 'caractères extraits d'une chaîne de caractères.
  • 'Syntaxe
  • 'Mid(string, start[, length])
  • Dim strPart As String '--- Partie de chaine à renvoyer
  • Dim nDeb As Integer '--- Début de la chaine renvoyée
  • Dim nFin As Integer '--- Fin de la chaine renvoyée
  • Dim nLong As Integer '--- Longueur de la chaine renvoyée
  • Dim nOcc As Integer '--- Nb d'occurences
  • Select Case (nb)
  • Case 1:
  • '--- Partie recherché 1 à #
  • nDeb = 0
  • nFin = InStr(1, str, "#")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • strPart = Replace(strPart, "~", "[")
  • strPart = Replace(strPart, "", "]")
  • Case 2:
  • '--- Partie recherché # à =
  • nDeb = InStr(1, str, "#")
  • nFin = InStr(1, str, "=")
  • nLong = nFin - nDeb
  • strPart = "#" & Mid(str, nDeb + 1, nLong - 1)
  • Case 3:
  • '--- Partie recherché = à ; et de ; à ;
  • nDeb = InStr(1, str, "=")
  • nFin = InStr(1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • nDeb = InStr(1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = strPart & Mid(str, nDeb + 1, nLong - 1)
  • Case 4:
  • '--- Partie recherché ; à ;
  • '--- 1e occurence
  • nOcc = InStr(1, str, ";")
  • nDeb = InStr(nOcc + 1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • Case 5:
  • '--- Partie recherché ; à ;
  • '--- 1e occurence
  • nOcc = InStr(1, str, ";")
  • '--- 2e occurence
  • nOcc = InStr(nOcc + 1, str, ";")
  • nDeb = InStr(nOcc + 1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • Case 6:
  • '--- Partie recherché ; à ;
  • '--- 1e occurence
  • nOcc = InStr(1, str, ";")
  • '--- 2e occurence
  • nOcc = InStr(nOcc + 1, str, ";")
  • '--- 3e occurence
  • nOcc = InStr(nOcc + 1, str, ";")
  • nDeb = InStr(nOcc + 1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • End Select
  • TranscripteurTxtList = strPart
  • End Function
  • '---------------------------------------------------
  • '--- Transcrire IRC => List ------------------------
  • '---------------------------------------------------
  • '---------------------------------------------------
  • '--- Transcrire Txt => List ------------------------
  • '--- str = chaine EasyDcc --------------------------
  • '--- nb = colonne désirée --------------------------
  • '---------------------------------------------------
  • Public Function TranscripteurIRCList(str As String, nb As Integer) As String
  • '--- Fonctions a se servir :
  • 'InStr , fonction
  • 'Renvoie une valeur de type Variant (Long) indiquant la position de la première
  • 'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
  • 'Syntaxe
  • 'InStr([start, ]string1, string2[, compare])
  • 'Len, fonction
  • 'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
  • 'ou le nombre d'octets requis pour stocker unevariable.
  • 'Syntaxe
  • 'Len(string)
  • 'Right , fonction
  • 'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
  • 'caractères d'une chaîne en partant de la droite.
  • 'Syntaxe
  • 'Right(string, length)
  • 'Left , fonction
  • 'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
  • 'caractères d'une chaîne en partant de la gauche.
  • 'Mid, fonction
  • 'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
  • 'caractères extraits d'une chaîne de caractères.
  • 'Syntaxe
  • 'Mid(string, start[, length])
  • Dim strPart As String '--- Partie de chaine à renvoyer
  • Dim nDeb As Integer '--- Début de la chaine renvoyée
  • Dim nFin As Integer '--- Fin de la chaine renvoyée
  • Dim nLong As Integer '--- Longueur de la chaine renvoyée
  • Dim nOcc As Integer '--- Nb d'occurences
  • Select Case (nb)
  • Case 1:
  • '--- Partie recherché 7 à xdcc send
  • nDeb = 6
  • nFin = InStr(1, str, "xdcc send")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 2)
  • Case 2:
  • '--- Partie recherché xdcc send à end
  • nDeb = InStr(7, str, "#")
  • strPart = "#" & Mid(str, nDeb + 1)
  • End Select
  • TranscripteurIRCList = strPart
  • End Function
  • '---------------------------------------------------
  • '--- Transcrire List => IRC ------------------------
  • '---------------------------------------------------
  • '---------------------------------------------------
  • '--- Transcrire Txt => List ------------------------
  • '--- str = chaine EasyDcc --------------------------
  • '--- nb = colonne désirée --------------------------
  • '---------------------------------------------------
  • Public Function TranscripteurListIRC(ListItem As ListItem) As String
  • 'sur l'exemple de easydcc : /ctcp Xdcc`Midori xdcc send #20
  • TranscripteurListIRC = "/ctcp " & ListItem.Text & " xdcc send " & ListItem.SubItems(1)
  • End Function
  • '---------------------------------------------------
  • '--- Transcrire List => Txt ------------------------
  • '--- str = chaine EasyDcc --------------------------
  • '--- nb = colonne désirée --------------------------
  • '---------------------------------------------------
  • Public Function TranscripteurListTxt(str As String, nb As Integer) As String
  • '--- Fonctions a se servir :
  • 'InStr , fonction
  • 'Renvoie une valeur de type Variant (Long) indiquant la position de la première
  • 'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
  • 'Syntaxe
  • 'InStr([start, ]string1, string2[, compare])
  • 'Len, fonction
  • 'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
  • 'ou le nombre d'octets requis pour stocker unevariable.
  • 'Syntaxe
  • 'Len(string)
  • 'Right , fonction
  • 'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
  • 'caractères d'une chaîne en partant de la droite.
  • 'Syntaxe
  • 'Right(string, length)
  • 'Left , fonction
  • 'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
  • 'caractères d'une chaîne en partant de la gauche.
  • 'Mid, fonction
  • 'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
  • 'caractères extraits d'une chaîne de caractères.
  • 'Syntaxe
  • 'Mid(string, start[, length])
  • Dim strPart As String '--- Partie de chaine à renvoyer
  • Dim nDeb As Integer '--- Début de la chaine renvoyée
  • Dim nFin As Integer '--- Fin de la chaine renvoyée
  • Dim nLong As Integer '--- Longueur de la chaine renvoyée
  • Dim nOcc As Integer '--- Nb d'occurences
  • Select Case (nb)
  • Case 1:
  • '--- Partie recherché 1 à #
  • strPart = Replace(strPart, "~", "[")
  • strPart = Replace(strPart, "", "]")
  • Case 2:
  • '--- Partie recherché # à =
  • nDeb = InStr(1, str, "#")
  • nFin = InStr(1, str, "=")
  • nLong = nFin - nDeb
  • strPart = "#" & Mid(str, nDeb + 1, nLong - 1)
  • Case 3:
  • '--- Partie recherché = à ; et de ; à ;
  • nDeb = InStr(1, str, "=")
  • nFin = InStr(1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • nDeb = InStr(1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = strPart & Mid(str, nDeb + 1, nLong - 1)
  • Case 4:
  • '--- Partie recherché ; à ;
  • '--- 1e occurence
  • nOcc = InStr(1, str, ";")
  • nDeb = InStr(nOcc + 1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • Case 5:
  • '--- Partie recherché ; à ;
  • '--- 1e occurence
  • nOcc = InStr(1, str, ";")
  • '--- 2e occurence
  • nOcc = InStr(nOcc + 1, str, ";")
  • nDeb = InStr(nOcc + 1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • Case 6:
  • '--- Partie recherché ; à ;
  • '--- 1e occurence
  • nOcc = InStr(1, str, ";")
  • '--- 2e occurence
  • nOcc = InStr(nOcc + 1, str, ";")
  • '--- 3e occurence
  • nOcc = InStr(nOcc + 1, str, ";")
  • nDeb = InStr(nOcc + 1, str, ";")
  • nFin = InStr(nDeb + 1, str, ";")
  • nLong = nFin - nDeb
  • strPart = Mid(str, nDeb + 1, nLong - 1)
  • End Select
  • TranscripteurListTxt = strPart
  • End Function
'****************************************
'--- frMain
'****************************************


Private Sub Form_Load()

    strAdr = ""                                                 '--- Adresse Fichier
    StatusBar1.Panels(1).Width = frmMain.Width                  '--- Barre des statuts

End Sub



'---------------------------------------------------
'--- Chargement du fichier txt
'---------------------------------------------------
Private Sub m_Load_Click()

    Dim fso As New FileSystemObject
    Dim Fichier As TextStream
    Dim ListItem As ListItem
    Dim str As String
    Dim ni As Integer
    
On Error GoTo ErrHandler
    
    '--- Ouverture boite de dialogue
    CommonDialog1.Filter = "Fichiers texte (*.txt)|*.txt|Tous les fichiers (*.*)|*.*"
    CommonDialog1.ShowOpen
    
    '--- Définition du fichier
    Set Fichier = fso.OpenTextFile(CommonDialog1.FileName, ForReading, True)
    
    '--- Test Validité
    If Fichier.ReadLine <> "[liste]" Or Fichier.AtEndOfLine = True Then
        MsgBox "Liste non valide", vbCritical, "ERREUR CHARGEMENT LISTE"
        GoTo ErrHandler
    End If
    
    '--- RAZ de la liste
    lwList.ListItems.Clear
    
    '--- Listing
    Do While Fichier.AtEndOfLine <> True
    
        str = Fichier.ReadLine
        Set ListItem = lwList.ListItems.Add(, , TranscripteurTxtList(str, 1))
        For ni = 2 To 6
            ListItem.SubItems(ni - 1) = TranscripteurTxtList(str, ni)
        Next
    Loop
    
    '--- Présentation
    frmMain.Caption = "Gestion Liste EasyDCC - " & CommonDialog1.FileName
    strAdr = CommonDialog1.FileName
    lblAdresse.Caption = CommonDialog1.FileName
    lblTaille.Caption = FileLen(CommonDialog1.FileName) & " ko"
    txtIRC.Text = ""
    txtTaille.Text = ""
    txtNom.Text = ""
    txtChan.Text = ""
    txtServ.Text = ""
    Action "Liste """ & CommonDialog1.FileName & """ chargée"
    
    '--- Destruction des objets
    Fichier.Close
    Set fso = Nothing
    Set Fichier = Nothing
    
    Exit Sub

ErrHandler:

    '--- L'utilisateur a sélectionné le bouton Annuler.
    Action "Chargement annulé"
    
    '--- Destruction des objets
    Set fso = Nothing
    Set Fichier = Nothing
    
    Exit Sub

End Sub



'---------------------------------------------------
'--- Sauvegarde de la liste
'---------------------------------------------------
Private Sub m_Save_Click()


    Dim fso As New FileSystemObject
    Dim Fichier As TextStream
    Dim strTxt As String
    Dim ni As Integer
    Dim nEl As Integer
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    
On Error GoTo Erreur ' Prise en charge des erreurs
    
    ' Verifie si le fichier existe déjà
    If (fso.FileExists(strAdr)) Then
    
        ' Si oui, enregistre les nouvelles
        ' données dans le fichier texte existant
        Set Fichier = fso.OpenTextFile(strAdr, ForWriting, False)
        
        '--- Pour que le fichier soit reconnu
        Fichier.WriteLine "[liste]"
        
        nEl = lwList.ListItems.Count
        For ni = 1 To nEl
            '--- Préparation ligne list -> txt
            
            '--- Nick
            strTxt = ""
            strTxt = lwList.ListItems(ni).Text
            strTxt = Replace(strTxt, "[", "~")
            strTxt = Replace(strTxt, "]", "")
            
            '--- N°
            strTxt = strTxt & lwList.ListItems(ni).SubItems(1) & "="
            
            '--- Taille - 1
            strPart = ""
            strPart = lwList.ListItems(ni).SubItems(2)
            nDeb = 1
            nFin = InStr(1, strPart, "K")
            If nFin = 0 Then
                nFin = InStr(1, strPart, "M")
            End If
            nLong = nFin - nDeb
            strPart = Mid(strPart, nDeb, nLong)
            strTxt = strTxt & strPart & ";"
            
            '--- Taille - 2
            strPart = ""
            strPart = lwList.ListItems(ni).SubItems(2)
            nFin = InStr(1, strPart, "K")
            If nFin = 0 Then
                strTxt = strTxt & "MB" & ";"
            Else
                strTxt = strTxt & "KB" & ";"
            End If
            
            '--- Nom
            strTxt = strTxt & lwList.ListItems(ni).SubItems(3) & ";"
            
            '--- Channel
            strTxt = strTxt & lwList.ListItems(ni).SubItems(4) & ";"
            
            '--- Serveur
            strTxt = strTxt & lwList.ListItems(ni).SubItems(5) & ";0"

            '--- écriture dans le fichier
            Fichier.WriteLine strTxt
        Next
    
    ' Si le fichier texte n'existe pas, le créer
    Else
        ' Ouverture du CommonDialog pour enregistrer le fichier
        CommonDialog1.Filter = "Fichier Texte (*.txt)|*.txt;|"
        CommonDialog1.ShowSave
        
        If CommonDialog1.FileName <> "" Then
            With fso
                ' Crée le nouveau fichier
                strAdr = .BuildPath(.GetParentFolderName(CommonDialog1.FileName), _
                CommonDialog1.FileTitle)
                Set Fichier = .CreateTextFile(strAdr, True)
            End With
            
            '--- Pour que le fichier soit reconnu
            Fichier.WriteLine "[liste]"
            
            nEl = lwList.ListItems.Count
            For ni = 1 To nEl
                '--- Préparation ligne list -> txt
                
                '--- Nick
                strTxt = ""
                strTxt = lwList.ListItems(ni).Text
                strTxt = Replace(strTxt, "[", "~")
                strTxt = Replace(strTxt, "]", "")
                
                '--- N°
                strTxt = strTxt & lwList.ListItems(ni).SubItems(1) & "="
                
                '--- Taille - 1
                strPart = ""
                strPart = lwList.ListItems(ni).SubItems(2)
                nDeb = 1
                nFin = InStr(1, strPart, "K")
                If nFin = 0 Then
                    nFin = InStr(1, strPart, "M")
                End If
                nLong = nFin - nDeb
                strPart = Mid(strPart, nDeb, nLong)
                strTxt = strTxt & strPart & ";"
                
                '--- Taille - 2
                strPart = ""
                strPart = lwList.ListItems(ni).SubItems(2)
                nFin = InStr(1, strPart, "K")
                If nFin = 0 Then
                    strTxt = strTxt & "MB" & ";"
                Else
                    strTxt = strTxt & "KB" & ";"
                End If
                
                '--- Nom
                strTxt = strTxt & lwList.ListItems(ni).SubItems(3) & ";"
                
                '--- Channel
                strTxt = strTxt & lwList.ListItems(ni).SubItems(4) & ";"
                
                '--- Serveur
                strTxt = strTxt & lwList.ListItems(ni).SubItems(5) & ";0"
    
                '--- écriture dans le fichier
                Fichier.WriteLine strTxt
            Next
            
            ' Modifie le Caption de la fenetre, par le nom du fichier
            frmMain.Caption = "Gestion Liste EasyDCC - " & CommonDialog1.FileName
            strAdr = CommonDialog1.FileName
            lblAdresse.Caption = CommonDialog1.FileName
            lblTaille.Caption = FileLen(CommonDialog1.FileName) & " ko"
            Action "Liste """ & CommonDialog1.FileName & """ chargée"
            
        End If
    End If
    Action strAdr & " a bien été enregistrer"
    
    Exit Sub ' Aucune erreur, donc sortie
    
Erreur:
    '--- L'utilisateur a sélectionné le bouton Annuler.
    Action "Sauvegarde annulée"
    
End Sub



'---------------------------------------------------
'--- Crédits
'---------------------------------------------------
Private Sub m_Cred_Click()

    Action "Logiciel réalisé par Ranouf, ranouf@hotmail.com"

End Sub



'---------------------------------------------------
'--- Nouvelle Liste
'---------------------------------------------------
Private Sub m_New_Click()
    
    '--- RAZ Fichier
    strAdr = ""
    lblAdresse.Caption = "[Aucun]"
    lblTaille.Caption = "[Aucun]"
    txtIRC.Text = ""
    frmMain.Caption = "Gestion Liste EasyDCC - Nouvelle Liste"
    
    '--- RAZ de la liste
    lwList.ListItems.Clear
    
    
End Sub



'---------------------------------------------------
'--- Click sur la liste
'---------------------------------------------------
Private Sub lwList_Click()
    
    If lwList.ListItems.Count <> 0 Then
        Cmd_Mode (1)
        nIndexSelectionne = lwList.SelectedItem.Index
        txtIRC.Text = TranscripteurListIRC(lwList.ListItems(nIndexSelectionne))
        txtTaille.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(2)
        txtNom.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(3)
        txtChan.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(4)
        txtServ.Text = lwList.ListItems(nIndexSelectionne).ListSubItems(5)
    End If

End Sub



Private Sub lwList_ItemClick(ByVal Item As MSComctlLib.ListItem)

    lwList_Click
    
End Sub



'---------------------------------------------------
'--- Changement texte IRC
'---------------------------------------------------
Private Sub txtIRC_KeyUp(KeyCode As Integer, Shift As Integer)
    If nIndexSelectionne <> 0 Then
        If TranscripteurListIRC(lwList.ListItems(nIndexSelectionne)) = txtIRC.Text Then
            Cmd_Mode (1)
        Else
            Cmd_Mode (0)
        End If
    End If
End Sub



'---------------------------------------------------
'--- Actions Bouton cmd
'---------------------------------------------------
Private Sub cmd_Click(Index As Integer)

    Dim ni As Integer
    Dim ListItem As ListItem
    Dim bErr As Boolean
    
    Select Case (Index)
        
        '--- Bouton Ajouter
        Case 0:
            bErr = False
            If txtIRC.Text = "" Then
                lblErr.Visible = True
                lblInfoIrc.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoIrc.ForeColor = &H80000012
            End If
            
            If txtTaille.Text = "" Then
                lblErr.Visible = True
                lblInfoTaille.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoTaille.ForeColor = &H80000012
            End If
            
            If txtNom.Text = "" Then
                lblErr.Visible = True
                lblInfoNom.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoNom.ForeColor = &H80000012
            End If
            
            If txtChan.Text = "" Or InStr(1, txtChan.Text, "#") = 0 Then
                lblErr.Visible = True
                lblInfoChan.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoChan.ForeColor = &H80000012
            End If
            
            If txtServ.Text = "" Then
                lblErr.Visible = True
                lblInfoServ.ForeColor = &HC0&
                bErr = True
            Else
                lblInfoServ.ForeColor = &H80000012
            End If
            
            If bErr = True Then
                Exit Sub
            End If
            
            Action txtIRC.Text & " a bien été ajouté"
            
            '--- Ajout dans la liste
            Set ListItem = lwList.ListItems.Add(, , TranscripteurIRCList(txtIRC.Text, 1))
            ListItem.SubItems(1) = TranscripteurIRCList(txtIRC.Text, 2)
            ListItem.SubItems(2) = txtTaille.Text
            ListItem.SubItems(3) = txtNom.Text
            ListItem.SubItems(4) = txtChan.Text
            ListItem.SubItems(5) = txtServ.Text
            'nOcc = InStr(nOcc + 1, str, ";")
            'TranscripteurIRCList( txtirc.Text, txttaille.Text, txtnom.Text, txtchan.Text, txtserv.Text)
            
            
            
        
        '--- Bouton Supprimer
        Case 1:
        
            Action txtIRC.Text & " a bien été supprimé"
            
            '--- RAZ informations
            txtIRC.Text = ""
            txtTaille.Text = ""
            txtNom.Text = ""
            txtChan.Text = ""
            txtServ.Text = ""
            Cmd_Mode (0)
            
            '--- suppression de l'élément
            lwList.ListItems.Remove lwList.SelectedItem.Index
            
            nIndexSelectionne = 0
         
        '--- Bouton Nouveau
        Case 2:
            
            Action "Nouveau téléchargement"
            
            '--- RAZ informations
            txtIRC.Text = "/ctcp [NomXDCC] xdcc send #[N°]"
            txtTaille.Text = ""
            txtNom.Text = ""
            txtChan.Text = "#"
            txtServ.Text = ""
            Cmd_Mode (0)
            
            nIndexSelectionne = 0
            
    End Select


End Sub











'***************************************************
'*** module************ *****************************
'***************************************************




Option Explicit
Public strAdr As String                     '--- Adresse fichier en cours
Public nCmd_Mode As Integer                 '--- Mode Ajout et Supprimer
Public nIndexSelectionne As Integer         '--- Index de l'élément sélectionné dans la liste


'***************************************************
'*** APPLICATIONS DIVERSES *************************
'***************************************************

'---------------------------------------------------
'--- Affiche dans la barre de statut str ----------
'---------------------------------------------------
Public Sub Action(str As String)

    frmMain.StatusBar1.Panels(1).Text = str
    
End Sub



'---------------------------------------------------
'--- Passe cmd en mode Ajout ou Supprimer  ----------
'---------------------------------------------------
Public Sub Cmd_Mode(nb As Integer)
    
    
    If nb = 1 Then
        '--- Supp
        frmMain.cmd(1).Enabled = True
        frmMain.cmd(0).Enabled = False
    Else
        '--- Ajout
        frmMain.cmd(0).Enabled = True
        frmMain.cmd(1).Enabled = False
    End If
    frmMain.lblInfoIrc.ForeColor = &H80000012
    frmMain.lblInfoTaille.ForeColor = &H80000012
    frmMain.lblInfoNom.ForeColor = &H80000012
    frmMain.lblInfoChan.ForeColor = &H80000012
    frmMain.lblInfoServ.ForeColor = &H80000012
    frmMain.lblErr.Visible = False
    nCmd_Mode = nb
    
End Sub



'---------------------------------------------------
'--- Transcrire Txt => List ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurTxtList(str As String, nb As Integer) As String

'--- Fonctions a se servir :

'InStr , fonction
'Renvoie une valeur de type Variant (Long) indiquant la position de la première
'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
'Syntaxe
'InStr([start, ]string1, string2[, compare])

'Len, fonction
'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
'ou le nombre d'octets requis pour stocker unevariable.
'Syntaxe
'Len(string)

'Right , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la droite.
'Syntaxe
'Right(string, length)

'Left , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la gauche.

'Mid, fonction
'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
'caractères extraits d'une chaîne de caractères.
'Syntaxe
'Mid(string, start[, length])

    
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    Dim nOcc As Integer                     '--- Nb d'occurences
    
    Select Case (nb)
    
        Case 1:
            '--- Partie recherché 1 à #
            nDeb = 0
            nFin = InStr(1, str, "#")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            strPart = Mid(str, nDeb + 1, nLong - 1)
            strPart = Replace(strPart, "~", "[")
            strPart = Replace(strPart, "", "]")

        Case 2:
            '--- Partie recherché # à =
            nDeb = InStr(1, str, "#")
            nFin = InStr(1, str, "=")
            nLong = nFin - nDeb
            strPart = "#" & Mid(str, nDeb + 1, nLong - 1)
            
        Case 3:
            '--- Partie recherché = à ; et de ; à ;
            nDeb = InStr(1, str, "=")
            nFin = InStr(1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
            nDeb = InStr(1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = strPart & Mid(str, nDeb + 1, nLong - 1)
            
        Case 4:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 5:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 6:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            '--- 3e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
    End Select
    
    TranscripteurTxtList = strPart

End Function



'---------------------------------------------------
'--- Transcrire IRC => List ------------------------
'---------------------------------------------------
'---------------------------------------------------
'--- Transcrire Txt => List ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurIRCList(str As String, nb As Integer) As String

'--- Fonctions a se servir :

'InStr , fonction
'Renvoie une valeur de type Variant (Long) indiquant la position de la première
'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
'Syntaxe
'InStr([start, ]string1, string2[, compare])

'Len, fonction
'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
'ou le nombre d'octets requis pour stocker unevariable.
'Syntaxe
'Len(string)

'Right , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la droite.
'Syntaxe
'Right(string, length)

'Left , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la gauche.

'Mid, fonction
'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
'caractères extraits d'une chaîne de caractères.
'Syntaxe
'Mid(string, start[, length])

    
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    Dim nOcc As Integer                     '--- Nb d'occurences
    
    Select Case (nb)
    
        Case 1:
            '--- Partie recherché 7 à xdcc send
            nDeb = 6
            nFin = InStr(1, str, "xdcc send")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 2)

        Case 2:
            '--- Partie recherché xdcc send à end
            nDeb = InStr(7, str, "#")
            strPart = "#" & Mid(str, nDeb + 1)
            
    End Select
    
    TranscripteurIRCList = strPart

End Function

'---------------------------------------------------
'--- Transcrire List => IRC ------------------------
'---------------------------------------------------
'---------------------------------------------------
'--- Transcrire Txt => List ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurListIRC(ListItem As ListItem) As String
    
    'sur l'exemple de easydcc : /ctcp Xdcc`Midori xdcc send #20
    TranscripteurListIRC = "/ctcp " & ListItem.Text & " xdcc send " & ListItem.SubItems(1)

End Function



'---------------------------------------------------
'--- Transcrire List => Txt ------------------------
'--- str = chaine EasyDcc --------------------------
'--- nb = colonne désirée --------------------------
'---------------------------------------------------
Public Function TranscripteurListTxt(str As String, nb As Integer) As String

'--- Fonctions a se servir :

'InStr , fonction
'Renvoie une valeur de type Variant (Long) indiquant la position de la première
'occurrence d'une chaîne à l'intérieur d'une autre chaîne.
'Syntaxe
'InStr([start, ]string1, string2[, compare])

'Len, fonction
'Renvoie une valeur de typeLong contenant le nombre de caractères d'une chaîne
'ou le nombre d'octets requis pour stocker unevariable.
'Syntaxe
'Len(string)

'Right , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la droite.
'Syntaxe
'Right(string, length)

'Left , fonction
'Renvoie une valeur de type Variant (String) contenant le nombre indiqué de
'caractères d'une chaîne en partant de la gauche.

'Mid, fonction
'Renvoie une valeur de type Variant (String) contenant un nombre indiqué de
'caractères extraits d'une chaîne de caractères.
'Syntaxe
'Mid(string, start[, length])

    
    Dim strPart As String                   '--- Partie de chaine à renvoyer
    Dim nDeb As Integer                     '--- Début de la chaine renvoyée
    Dim nFin As Integer                     '--- Fin de la chaine renvoyée
    Dim nLong As Integer                    '--- Longueur de la chaine renvoyée
    Dim nOcc As Integer                     '--- Nb d'occurences
    
    Select Case (nb)
    
        Case 1:
            '--- Partie recherché 1 à #
            strPart = Replace(strPart, "~", "[")
            strPart = Replace(strPart, "", "]")

        Case 2:
            '--- Partie recherché # à =
            nDeb = InStr(1, str, "#")
            nFin = InStr(1, str, "=")
            nLong = nFin - nDeb
            strPart = "#" & Mid(str, nDeb + 1, nLong - 1)
            
        Case 3:
            '--- Partie recherché = à ; et de ; à ;
            nDeb = InStr(1, str, "=")
            nFin = InStr(1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
            nDeb = InStr(1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = strPart & Mid(str, nDeb + 1, nLong - 1)
            
        Case 4:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 5:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
        Case 6:
            '--- Partie recherché ; à ;
            '--- 1e occurence
            nOcc = InStr(1, str, ";")
            '--- 2e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            '--- 3e occurence
            nOcc = InStr(nOcc + 1, str, ";")
            
            nDeb = InStr(nOcc + 1, str, ";")
            nFin = InStr(nDeb + 1, str, ";")
            nLong = nFin - nDeb
            strPart = Mid(str, nDeb + 1, nLong - 1)
            
    End Select
    
    TranscripteurListTxt = strPart

End Function















 Conclusion

J'espere que ça vous plaira !!

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources de la même categorie

ECLATER UN CLASSEUR EXCEL EN AUTANT DE FICHIERS QUE DE FEUIL... par GMY
Source avec Zip Source avec une capture Source .NET (Dotnet) MAGIC FILE NAME : RENOMMEZ VOS FICHIERS AUTOMAGIQUEMENT ! par Erudix
Source avec Zip Source .NET (Dotnet) MODIFIER LES EXTENSION DES FICHIERS par okosa
ROUTINE DIR RÉCURSIVE POUR OBTENIR LA LISTE DE TOUS LES FICH... par kerisolde
Source avec Zip Source avec une capture FILE,SECURITY,FICHIER par okosa

 Sources en rapport avec celle ci

Source avec Zip Source .NET (Dotnet) CALCULER LA TAILLE D'UN DOSSIER ET SER SOU_RÉPÉRTOIRES VERSI... par 310
ECLATER UN CLASSEUR EXCEL EN AUTANT DE FICHIERS QUE DE FEUIL... par GMY
Source .NET (Dotnet) CALCULER LA TAILLE D'UN DOSSIER ET SER SOU_RÉPÉRTOIRES par 310
ROUTINE DIR RÉCURSIVE POUR OBTENIR LA LISTE DE TOUS LES FICH... par kerisolde
Source avec Zip Source avec une capture RENOMMER/REMPLACER/SUPPRIMER UN OU PLUSIEURS CARACTÈRES DANS... par KaFarD

Commentaires et avis

Commentaire de Kineas le 28/07/2005 13:27:59

Ce programme m'interesse beaucoup mais je n'arrive pas a le lancer (pourtant j'ai bien installé les biblioteques dlls de VB !)
Si quelqu'un a reussi s'il pouvait me donner un coup de main...

Commentaire de the_sannin le 31/03/2007 02:57:45

Ce programme m'interesse beaucoup mais je n'arrive pas a le faire marcher
Si une personne a reussi il pourait me dire comment le faire marcher  
Merci d'avance

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Liste des fichiers sélectionnées dans une boite de dialogue [ par the man ] Bonjour, J'utilise le control "Common dialog"version 6 de microsoft. J'aimerais savoir comment obtenir la liste des fichiers sélectionnés dans la boi Ajouter les noms et extensions des fichiers d'un répertoire à une Textbox [ par Nico ] Comment faire pour ajouter les fichiers contenus dans un repertoire donné, dans une Textbox ,tout ca parce que je ne veux pas utiliser la FileListBox script d'installation - ajout de fichiers [ par Georef ] Bonjour,lors de la génération d'un pgm d'installation, je dois ajouterde nombreux fichiers de données. La manipulation"ajouter", choix du fichier... e Comment avoir la liste de tous les fichiers d'un CD dans une base de données [ par latour ] Oui je débute...J'amerai savoir comment faire pour avoir une liste complétedes fichiers dans plusieurs répértoire ainsi que leur chemin...(dans un mêm Récupérer la liste des fichiers .gif dans un répertoire [ par hub ] Salut à tous,Comment récupérer la liste des fichiers d'un répertoire (en les filtrant).En effet, je souhaiterais récupérer dans un tableau tous les no Serveur HTTP -Winsock-liste de fichiers comment ? [ par Spylover ] Bonjour,je viens de faire un serveur HTTp avec winsock tout fonctionne bien avec le fichier index.htm cependant je souhaiterais voir la liste de mes f Upload de fichiers [ par Pat ] Je souhaite ajouter la fonction, upload de fichier sur mon site pour permettre aux visiteurs de poster des fichier zip.Mon site est hébergé sur un ser Comment envoyer 1 liste de fichiers à la corbeille ? [ par ActiveZ ] SalutJe voudrais envoyer en 1 fois 1 selection multiple de fichiers à la corbeille (api), mais je ne trouve pas la syntaxe pour pfromQuelqu'un a 1 idé ajouter null à une requête [ par kFar ] je souhaite permettre à l'utilisateur de choisir une valeur à travers une liste déroulante.le contenu de cette liste est le résultat d'une requete SQL Affichage dans treeview et listview de la liste des fichiers d'une adresse ftp [ par Anthomicro ] Bonjour,j'aimerais savoir si il existe un code me permettant de recevoir la liste des répertoires et des fichiers qui sont dans une adresse ftp et d'a


Nos sponsors


Sondage...

CalendriCode

Mai 2012
LMMJVSD
 123456
78910111213
14151617181920
21222324252627
28293031   

Consulter la suite du CalendriCode

A découvrir



 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 2,465 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales