Accueil > > > CRÉATEUR DE LISTE EASYDCC
CRÉATEUR DE LISTE EASYDCC
Information sur la source
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 !!
Sources de la même categorie
Commentaires et avis
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
|
Derniers Blogs
IMAGINE CUP 2012, MAKE A SIGN EN FINALEIMAGINE CUP 2012, MAKE A SIGN EN FINALE par junarnoalg
Voilà qui est fait, la nouvelle est officielle ! L'équipe belge "Make a Sign" va au pays des kangourous défendre son projet dans la catégorie Software Design. http://www.imaginecup.com/CompetitionsContent/Competition/WorldwideFinalists.aspx V...
Cliquez pour lire la suite de l'article par junarnoalg KINECT 1.5 IS OUT !KINECT 1.5 IS OUT ! par Vko
La version 1.5 du Kinect For Microsoft vient tout juste de sortir ! Plein de nouveautés: Tracking de squelette en Near Mode Détection en position assise Détection faciale avec un SDK dédié Documentation et des guideline (enfin) Un out...
Cliquez pour lire la suite de l'article par Vko LES ACTUALITéS DE LA SEMAINE SUR C2I.FR (14 MAI - 20 MAI) LES ACTUALITéS DE LA SEMAINE SUR C2I.FR (14 MAI - 20 MAI) par richardc
Mise à jour des Web API du 14 Mai
Réservez dès maintenant votre journée du 20 juin pour le Windows Azure Dev Camp 2012 à Paris
Mise à jour de Team Foundation Service
MechCommander 2 sur Windows 8
Entity Framework 5 Release Candidate e...
Cliquez pour lire la suite de l'article par richardc REACTIVE EXTENSIONS : CONSOMMER DES SERVICES AVEC RX PARTIE 3, LES PIèGES à éVITERREACTIVE EXTENSIONS : CONSOMMER DES SERVICES AVEC RX PARTIE 3, LES PIèGES à éVITER par Groc
Une mauvaise utilisation de rx lors de l'écriture d'une couche d'accès à des services peut conduire à des cas embarassants avec des erreurs mal gérées, des appels qui ne partent lorsqu'ils le devraient, et même des résultats incorrects . le tout nuis...
Cliquez pour lire la suite de l'article par Groc SHAREPOINT BLOG SITE, PROBLèME D'ARCHIVESSHAREPOINT BLOG SITE, PROBLèME D'ARCHIVES par junarnoalg
Dernièrement, nous avons migré le site
myTIC
vers un nouveau serveur SharePoint 2010. Dans les contenus que nous vouloins récupérer, nous avions un certain nombre de blogs.
Nous avons utilisé les commandes Power...
Cliquez pour lire la suite de l'article par junarnoalg
Logiciels
sDEVIS-FACTURES vlPRO (8.1.0.3)SDEVIS-FACTURES VLPRO (8.1.0.3)sDEVIS-FACTURES vlPRO a été mis au point pour les particuliers, créateurs, entrepreneurs, artisa... Cliquez pour télécharger sDEVIS-FACTURES vlPRO 974 Application Server (12.2.4.6)974 APPLICATION SERVER (12.2.4.6)Développez de puissantes applications dans un environnement de 'cloud computing', clusterisé, séc... Cliquez pour télécharger 974 Application Server vPicture (1.4.2.1)VPICTURE (1.4.2.1)Avec vPicture, hébergez vos images facilement et rapidement.
vPicture est un utilitaire simple, ... Cliquez pour télécharger vPicture Easy-Planning (2.2.1.6)EASY-PLANNING (2.2.1.6)Easy-Planning permet de créer des plannings sous la représentation de diagrammes et est adapté au... Cliquez pour télécharger Easy-Planning COM-BACKUP (2.0)COM-BACKUP (2.0)
COM-BACKUP est un logiciel de sauvegarde qui permet de planifier les sauvegardes de vos dossiers ...
Cliquez pour télécharger COM-BACKUP
|