Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

begin process at 2009 07 06 15:13:57

SILVERLIGHT 3 : COMMUNICATION ET MULTICAST par KooKiz

[PERSO] DéCOUVERTES ESTIVALES : LINUX (PART I) par FREMYCOMPANY

[REFACTORING] RESHARPER POUR VISUAL STUDIO 2010 (PREVIEW) par tja

[REFACTORING] ANALYSER VOS EXCEPTIONS AVEC RESHARPER EXCEPTIONAL par tja

SHAREPOINT 2007 : PATTERNS & PRACTICES SHAREPOINT GUIDANCE par phil

RE : OBJET SORT, MéTHODE APPLY, ERREUR 1004 par kardiss

RE : PROBLEME DANS BASE DE DONNéES par Tursiop60

RE : LIRE DANS UN FICHIER CSV DE 170MO AVEC ACCESS par mmmxtina

RE : PROBLEME DANS BASE DE DONNéES par PCPT

RE : PROBLEME DANS BASE DE DONNéES par Tursiop60

+ de logiciels à télécharger

1 465 265 membres
317 nouveaux aujourd'hui
15 046 membres club

Trouver une ressource

Trouvez une ressource parmi 40 095 codes, 1 303 260 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

ANNONYM MAIL V3.0.0 [BETA]

Information sur la source

Catégorie :Réseau & Internet Classé sous : anonyme, email, envoyer, smtp, mail Niveau : Expert Date de création : 24/12/2001 Date de mise à jour : 25/12/2001 12:42:53 Vu : 8 218

Auteur : aKheNathOn

Site perso

Ecrire un message privé

Note :

7,25 / 10

Commentaire sur cette source (16)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Ho ho ho ! Le pére noël est passé les petits gars :-) ...

Bon depuis 3 mois je fais que de bosser dessus et voilà enfin j'ai finit ....

C'est un prog de mails , on peut tout envoyer , à n'importequi avec n'importe quelle mise en page ... bréf le réve ... Fichier joints ... et annonymat .

Les codes-source ne sont pas celles de tout le prog car ça serait trop lourd ... et bon je garde quelques secrets mais les principales fonction y sont ...

Pour bientôt je les mettrais sur mon site dans les tutoriaux ...

>>http://www.multimania.com/myhackerside/show.htm

Et pour aller télécharger tout le prog :

>>http://www.multimania.com/myhackerside/progs/ann3.htm

Pour télécharger diréct le zip ...

>>http://www.multimania.com/myhackerside/progs/annonymV3.zip

Sinon les options seront plus détaillées sur le site ...

Bonne prog à tous ...

PS : Nix enléves pas cette source ...

Source

' Fontion de conversion du RTF en HTML ....
' Cette source est déjà sur le site mais je l'ait changé pour l'incruster dans mon prog
Public Function convertRTFtoHTML() As String
Dim a
Dim IsBold As Boolean
Dim IsUnderline As Boolean
Dim IsItalic As Boolean
Dim vlStr As String
Dim Coul As Long
Dim Prop As String
Dim Taille As Integer
Dim FontN As String
Dim Algn As Integer
On Error Resume Next
Main.Temp.TextRTF = Main.Text5.TextRTF
Main.Temp.BackColor = Main.Text5.BackColor
If Not Right(Main.Temp.Text, 1) = "" Then
Main.Temp.SelStart = Len(Main.Temp.Text)
Main.Temp.SelText = " "
End If
Main.ProgressBar1.Min = 0
Main.ProgressBar1.Max = Len(Main.Text5.Text)
Main.ProgressBar1.Value = 0
Main.Label48.Caption = "Conversion RTF ---> HTML en cours ..."
Main.Label49.Caption = "Progression : 0 %"
Main.Picture6.Visible = True
IsItalic = False
IsUnderline = False
IsBold = False
vlStr = vlStr & vbCrLf & "<HTML><body bgcolor=" & Chr(34) & Reg_Colors(Main.Temp.BackColor) & Chr(34) & ">" & vbCrLf
Prop = Prop & "<FONT "
Taille = Main.Temp.SelFontSize
Coul = Main.Temp.SelColor
FontN = Main.Temp.SelFontName
If Main.Temp.SelFontSize = 8 Then Prop = Prop & "SIZE=1"
If Main.Temp.SelFontSize = 10 Then Prop = Prop & "SIZE=2"
If Main.Temp.SelFontSize = 12 Then Prop = Prop & "SIZE=3"
If Main.Temp.SelFontSize = 14 Then Prop = Prop & "SIZE=4"
If Main.Temp.SelFontSize = 16 Then Prop = Prop & "SIZE=5"
If Main.Temp.SelFontSize = 22 Then Prop = Prop & "SIZE=6"
If Main.Temp.SelFontSize = 36 Then Prop = Prop & "SIZE=7"
Prop = Prop & " COLOR=" & Chr(34) & Reg_Colors(Coul) & Chr(34)
Prop = Prop & " FAMILY=" & Chr(34) & "SERIF" & Chr(34) & " FACE=" & Chr(34) & FontN & Chr(34)
Prop = Prop & " LANG=" & Chr(34) & "1" & Chr(34) & ">"
vlStr = vlStr & Prop
For a = 0 To Len(Main.Temp.Text)
Main.ProgressBar1.Value = a
Main.Label49.Caption = "Progression :" & Str(Int((a * 100) / Len(Main.Temp.Text))) & " %"
Prop = ""
Main.Temp.SelStart = a
Main.Temp.SelLength = 1
'---- la progra incrustée ----
If Format(Mid(Main.Temp.Text, a + 1, 10), "<") = "<--prog-->" Then
For i = a + 10 To Len(Main.Temp.Text)
If Format(Mid(Main.Temp.Text, i, 13), "<") = "<--endprog-->" Then Exit For
Next i
' on met l'incrustation du texte dans le fichier HTM
vlStr = vlStr & Mid(Main.Temp.Text, a + 11, i - (a + 11))
a = i + 13
GoTo Suite
End If
Props:
'----- C'est la reconnaissance de caractére gras -----
If Main.Temp.SelBold = True And IsBold = False Then
Prop = Prop & ""
IsBold = True
End If
If Main.Temp.SelBold = False And IsBold = True Then
Prop = Prop & ""
IsBold = False
End If
'----- C'est la reconnaissance de caractére italique -----
If Main.Temp.SelItalic = True And IsItalic = False Then
Prop = Prop & ""
IsItalic = True
End If
If Main.Temp.SelItalic = False And IsItalic = True Then
Prop = Prop & ""
IsItalic = False
End If
'----- C'est la reconnaissance de caractére souligné -----
If Main.Temp.SelUnderline = True And IsUnderline = False Then
Prop = Prop & ""
IsUnderline = True
End If
If Main.Temp.SelUnderline = False And IsUnderline = True Then
Prop = Prop & ""
IsUnderline = False
End If
'----- C'est la reconnaissance des tailles -----
'----- C'est la reconnaissance des fonts -----
'----- C'est la reconnaissance des couleurs -----
If Not Main.Temp.SelFontSize = Taille Or Not Main.Temp.SelColor = Coul Or Not Main.Temp.SelFontName = FontN Then
Prop = Prop & "<FONT "
Taille = Main.Temp.SelFontSize
Coul = Main.Temp.SelColor
FontN = Main.Temp.SelFontName
If Main.Temp.SelFontSize = 8 Then Prop = Prop & "SIZE=1"
If Main.Temp.SelFontSize = 10 Then Prop = Prop & "SIZE=2"
If Main.Temp.SelFontSize = 12 Then Prop = Prop & "SIZE=3"
If Main.Temp.SelFontSize = 14 Then Prop = Prop & "SIZE=4"
If Main.Temp.SelFontSize = 16 Then Prop = Prop & "SIZE=5"
If Main.Temp.SelFontSize = 22 Then Prop = Prop & "SIZE=6"
If Main.Temp.SelFontSize = 36 Then Prop = Prop & "SIZE=7"
Prop = Prop & " COLOR=" & Chr(34) & Reg_Colors(Coul) & Chr(34)
Colortt = Reg_Colors(Coul)
Prop = Prop & " FAMILY=" & Chr(34) & "SERIF" & Chr(34) & " FACE=" & Chr(34) & FontN & Chr(34)
Prop = Prop & " LANG=" & Chr(34) & "1" & Chr(34) & ">"
End If
'----- C'est la reconnaissance des allignements -----
If Not Main.Temp.SelAlignment = Algn Then
Algn = Main.Temp.SelAlignment
If Algn = 0 Then Prop = Prop & ""
If Algn = 1 Then Prop = Prop & ""
If Algn = 2 Then Prop = Prop & ""
End If
'----- C'est la reconnaissance des sauts de ligne -----
If Mid(Main.Temp.Text, a + 1, 2) = vbCrLf Then
If a > 0 Then Prop = Prop & " " & vbCrLf
End If
vlStr = vlStr & Prop & Main.Temp.SelText
Suite:
DoEvents
Next ' <<< lire une nouvelle lettre
vlStr = vlStr & "</HTML>"
convertRTFtoHTML = vlStr
Main.Picture6.Visible = False
End Function
' Alors quelques explications :
' Main.text5 -> c'est le texte RTF visible
' Je travaille sur un Main.Temp pour que l'utilisateur ne vois pas la lecture
' Picture6 c'est la boîte noire que vous verez apparaître pour vous dire les progressions en cours ...
'----- Ici quelques fonctions qui me serven,t à changer les couleurs
Function Reg_Colors(Col As Long) As String
Dim ValO, ValI As String
' juste convertisseur de couleurs normales en
' coulleurs d'internet
ValO = "000000" & Hex(Col)
ValI = Right(ValO, 2) & Mid(ValO, Len(ValO) - 3, 2) & Mid(ValO, Len(ValO) - 5, 2)
Reg_Colors = "#" & ValI
End Function
Function HexToInt(H As String) As Long
Dim H1, H2 As String
H1 = Left(H, 1)
H2 = Right(H, 1)
Dim I1, I2 As Integer
I1 = Val(H1)
I2 = Val(H2)
If H1 = "A" Then I1 = 10
If H1 = "B" Then I1 = 11
If H1 = "C" Then I1 = 12
If H1 = "D" Then I1 = 13
If H1 = "E" Then I1 = 14
If H1 = "F" Then I1 = 15
If H2 = "A" Then I2 = 10
If H2 = "B" Then I2 = 11
If H2 = "C" Then I2 = 12
If H2 = "D" Then I2 = 13
If H2 = "E" Then I2 = 14
If H2 = "F" Then I2 = 15
HexToInt = (I1 * 16) + I2
End Function
' Voilà c'est juste une conversion Integer ---> Hexa
' Qui peuvent surement être amméliorées ...
' <<------ Je me demandais comment faire pour le fichiers joints ...
' alors j'ai trouvé une source qui met en place ça .... donc c'est niquel ...
Public Function UUEncodeFile(strFilePath As String) As String
Dim intFile As Integer 'file handler
Dim intTempFile As Integer 'temp file
Dim lFileSize As Long 'size of the file
Dim strFileName As String 'name of the file
Dim strFileData As String 'file data chunk
Dim lEncodedLines As Long 'number of encoded lines
Dim strTempLine As String 'temporary string
Dim i As Long 'loop counter
Dim j As Integer 'loop counter
Dim strResult As String
strFileName = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)
strResult = "begin 664 " + strFileName + vbLf
lFileSize = FileLen(strFilePath)
lEncodedLines = lFileSize \ 45 + 1
Main.ProgressBar1.Min = 0
Main.ProgressBar1.Max = lEncodedLines
Main.ProgressBar1.Value = 0
Main.Label48.Caption = "Transfert de " & strFilePath & " ..."
Main.Label49.Caption = "Progression : 0 %"
Main.Picture6.Visible = True
strFileData = Space(45)
intFile = FreeFile
Open strFilePath For Binary As intFile
For i = 1 To lEncodedLines
Main.ProgressBar1.Value = i
Main.Label49.Caption = "Progression :" & Str(Int((i * 100) / lEncodedLines)) & " %"
DoEvents
If i = lEncodedLines Then
strFileData = Space(lFileSize Mod 45)
End If
Get intFile, , strFileData
strTempLine = Chr(Len(strFileData) + 32)
If i = lEncodedLines And (Len(strFileData) Mod 3) Then
strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
End If
For j = 1 To Len(strFileData) Step 3
DoEvents
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
+ Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
+ Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
Next j
strTempLine = Replace(strTempLine, " ", "`")
strResult = strResult + strTempLine + vbLf
strTempLine = ""
Next i
Close intFile
strResult = strResult & "`" & vbLf + "end" + vbLf
UUEncodeFile = strResult
Main.Picture6.Visible = False
End Function
' Donc la c'est simple appellez cette fonction avec le fichier à insérer ...
' <<<-------- ca serait super flateur si y'en as qui se demandent comment j'ai fait l'intro avec du rtf ... style sub 7
' mais je suis sur que la plus part s'en tappe ... mais je la donne comme - même car c'est trop simple :-)
' Alors vous avez besoin de deu richtext box et d'un timer ...
' Mettez ça dans le timer ....
Text18.SelStart = Len(Text18.Text) + 1
TmpRich.SelStart = Text18.SelStart
TmpRich.SelLength = 1
Text18.SelFontName = TmpRich.SelFontName
Text18.SelFontSize = TmpRich.SelFontSize
Text18.SelItalic = TmpRich.SelItalic
Text18.SelAlignment = TmpRich.SelAlignment
Text18.SelBold = TmpRich.SelBold
Text18.SelColor = TmpRich.SelColor
Text18.SelText = Mid(TmpRich.Text, Text18.SelStart + 1, 1)
If Len(Text18.Text) = Len(TmpRich.Text) Then Timer1.Enabled = False
' TmpRich c'est un richbox qui contient le texte que vous voulez afficher ... vous le mettez en visible = False
' Text18 c'est aussi un richtext sauf que lui il est vide au début ... et c'est dedans que les infos vont s'afficher ...

' Fontion de conversion du RTF en HTML ....
' Cette source est déjà sur le site mais je l'ait changé pour l'incruster dans mon prog

Public Function convertRTFtoHTML() As String
    
    Dim a
    Dim IsBold As Boolean
    Dim IsUnderline As Boolean
    Dim IsItalic As Boolean
    Dim vlStr As String
    Dim Coul As Long
    Dim Prop As String
    Dim Taille As Integer
    Dim FontN As String
    Dim Algn As Integer

 On Error Resume Next

Main.Temp.TextRTF = Main.Text5.TextRTF
Main.Temp.BackColor = Main.Text5.BackColor

If Not Right(Main.Temp.Text, 1) = "" Then
Main.Temp.SelStart = Len(Main.Temp.Text)
Main.Temp.SelText = " "
End If

Main.ProgressBar1.Min = 0
Main.ProgressBar1.Max = Len(Main.Text5.Text)
Main.ProgressBar1.Value = 0
Main.Label48.Caption = "Conversion RTF ---> HTML en cours ..."
Main.Label49.Caption = "Progression : 0 %"
Main.Picture6.Visible = True

IsItalic = False
IsUnderline = False
IsBold = False

vlStr = vlStr & vbCrLf & "<HTML><body bgcolor=" & Chr(34) & Reg_Colors(Main.Temp.BackColor) & Chr(34) & ">" & vbCrLf
Prop = Prop & "<FONT "

Taille = Main.Temp.SelFontSize
Coul = Main.Temp.SelColor
FontN = Main.Temp.SelFontName

If Main.Temp.SelFontSize = 8 Then Prop = Prop & "SIZE=1"
If Main.Temp.SelFontSize = 10 Then Prop = Prop & "SIZE=2"
If Main.Temp.SelFontSize = 12 Then Prop = Prop & "SIZE=3"
If Main.Temp.SelFontSize = 14 Then Prop = Prop & "SIZE=4"
If Main.Temp.SelFontSize = 16 Then Prop = Prop & "SIZE=5"
If Main.Temp.SelFontSize = 22 Then Prop = Prop & "SIZE=6"
If Main.Temp.SelFontSize = 36 Then Prop = Prop & "SIZE=7"
Prop = Prop & " COLOR=" & Chr(34) & Reg_Colors(Coul) & Chr(34)
Prop = Prop & " FAMILY=" & Chr(34) & "SERIF" & Chr(34) & " FACE=" & Chr(34) & FontN & Chr(34)
Prop = Prop & " LANG=" & Chr(34) & "1" & Chr(34) & ">"
    
vlStr = vlStr & Prop

    For a = 0 To Len(Main.Temp.Text)
 
 Main.ProgressBar1.Value = a
Main.Label49.Caption = "Progression :" & Str(Int((a * 100) / Len(Main.Temp.Text))) & " %"
        Prop = ""
        Main.Temp.SelStart = a
        Main.Temp.SelLength = 1

'---- la progra incrustée ----
If Format(Mid(Main.Temp.Text, a + 1, 10), "<") = "<--prog-->" Then
For i = a + 10 To Len(Main.Temp.Text)
If Format(Mid(Main.Temp.Text, i, 13), "<") = "<--endprog-->" Then Exit For
Next i
' on met l'incrustation du texte dans le fichier HTM
vlStr = vlStr & Mid(Main.Temp.Text, a + 11, i - (a + 11))
a = i + 13
GoTo Suite
End If
Props:
'----- C'est la reconnaissance de caractére gras -----
If Main.Temp.SelBold = True And IsBold = False Then
Prop = Prop & "<B>"
IsBold = True
End If
If Main.Temp.SelBold = False And IsBold = True Then
Prop = Prop & "</B>"
IsBold = False
End If

'----- C'est la reconnaissance de caractére italique -----
If Main.Temp.SelItalic = True And IsItalic = False Then
Prop = Prop & "<I>"
IsItalic = True
End If
If Main.Temp.SelItalic = False And IsItalic = True Then
Prop = Prop & "</I>"
IsItalic = False
End If

'----- C'est la reconnaissance de caractére souligné -----
If Main.Temp.SelUnderline = True And IsUnderline = False Then
Prop = Prop & "<U>"
IsUnderline = True
End If
If Main.Temp.SelUnderline = False And IsUnderline = True Then
Prop = Prop & "</U>"
IsUnderline = False
End If

'----- C'est la reconnaissance des tailles -----
'----- C'est la reconnaissance des fonts -----
'----- C'est la reconnaissance des couleurs -----
If Not Main.Temp.SelFontSize = Taille Or Not Main.Temp.SelColor = Coul Or Not Main.Temp.SelFontName = FontN Then
Prop = Prop & "</FONT><FONT "
Taille = Main.Temp.SelFontSize
Coul = Main.Temp.SelColor
FontN = Main.Temp.SelFontName
If Main.Temp.SelFontSize = 8 Then Prop = Prop & "SIZE=1"
If Main.Temp.SelFontSize = 10 Then Prop = Prop & "SIZE=2"
If Main.Temp.SelFontSize = 12 Then Prop = Prop & "SIZE=3"
If Main.Temp.SelFontSize = 14 Then Prop = Prop & "SIZE=4"
If Main.Temp.SelFontSize = 16 Then Prop = Prop & "SIZE=5"
If Main.Temp.SelFontSize = 22 Then Prop = Prop & "SIZE=6"
If Main.Temp.SelFontSize = 36 Then Prop = Prop & "SIZE=7"
Prop = Prop & " COLOR=" & Chr(34) & Reg_Colors(Coul) & Chr(34)
Colortt = Reg_Colors(Coul)
Prop = Prop & " FAMILY=" & Chr(34) & "SERIF" & Chr(34) & " FACE=" & Chr(34) & FontN & Chr(34)
Prop = Prop & " LANG=" & Chr(34) & "1" & Chr(34) & ">"
End If

'----- C'est la reconnaissance des allignements -----
If Not Main.Temp.SelAlignment = Algn Then
Algn = Main.Temp.SelAlignment
If Algn = 0 Then Prop = Prop & "<P ALIGN=LEFT>"
If Algn = 1 Then Prop = Prop & "<P ALIGN=RIGHT>"
If Algn = 2 Then Prop = Prop & "<P ALIGN=CENTER>"
End If

'----- C'est la reconnaissance des sauts de ligne -----
If Mid(Main.Temp.Text, a + 1, 2) = vbCrLf Then
If a > 0 Then Prop = Prop & "<Br>" & vbCrLf
End If
  
   vlStr = vlStr & Prop & Main.Temp.SelText

Suite:
DoEvents
    
    Next  ' <<< lire une nouvelle lettre
    
    vlStr = vlStr & "</B></I></U></FONT></HTML>"
    convertRTFtoHTML = vlStr
    
Main.Picture6.Visible = False
End Function

' Alors quelques explications :
' Main.text5 -> c'est le texte RTF visible
' Je travaille sur un Main.Temp pour que l'utilisateur ne vois pas la lecture
' Picture6 c'est la boîte noire que vous verez apparaître pour vous dire les progressions en cours ...

'----- Ici quelques fonctions qui me serven,t à changer les couleurs 

Function Reg_Colors(Col As Long) As String
Dim ValO, ValI As String
' juste convertisseur de couleurs normales en
' coulleurs d'internet
ValO = "000000" & Hex(Col)
ValI = Right(ValO, 2) & Mid(ValO, Len(ValO) - 3, 2) & Mid(ValO, Len(ValO) - 5, 2)
Reg_Colors = "#" & ValI
End Function

Function HexToInt(H As String) As Long
Dim H1, H2 As String
H1 = Left(H, 1)
H2 = Right(H, 1)
Dim I1, I2 As Integer
I1 = Val(H1)
I2 = Val(H2)
If H1 = "A" Then I1 = 10
If H1 = "B" Then I1 = 11
If H1 = "C" Then I1 = 12
If H1 = "D" Then I1 = 13
If H1 = "E" Then I1 = 14
If H1 = "F" Then I1 = 15
If H2 = "A" Then I2 = 10
If H2 = "B" Then I2 = 11
If H2 = "C" Then I2 = 12
If H2 = "D" Then I2 = 13
If H2 = "E" Then I2 = 14
If H2 = "F" Then I2 = 15
HexToInt = (I1 * 16) + I2
End Function

' Voilà c'est juste une conversion Integer --->  Hexa
' Qui peuvent surement être amméliorées ...

' <<------ Je me demandais comment faire pour le fichiers joints ...
' alors j'ai trouvé une source qui met en place ça .... donc c'est niquel ...


Public Function UUEncodeFile(strFilePath As String) As String

    Dim intFile         As Integer      'file handler
    Dim intTempFile     As Integer      'temp file
    Dim lFileSize       As Long         'size of the file
    Dim strFileName     As String       'name of the file
    Dim strFileData     As String       'file data chunk
    Dim lEncodedLines   As Long         'number of encoded lines
    Dim strTempLine     As String       'temporary string
    Dim i               As Long         'loop counter
    Dim j               As Integer      'loop counter
    
    Dim strResult       As String
    
    strFileName = Mid$(strFilePath, InStrRev(strFilePath, "\") + 1)
    
    strResult = "begin 664 " + strFileName + vbLf
    
    lFileSize = FileLen(strFilePath)
    lEncodedLines = lFileSize \ 45 + 1
    
Main.ProgressBar1.Min = 0
Main.ProgressBar1.Max = lEncodedLines
Main.ProgressBar1.Value = 0
Main.Label48.Caption = "Transfert de " & strFilePath & " ..."
Main.Label49.Caption = "Progression : 0 %"
Main.Picture6.Visible = True
    
    strFileData = Space(45)
    
    intFile = FreeFile
    
    Open strFilePath For Binary As intFile
        
        For i = 1 To lEncodedLines
         Main.ProgressBar1.Value = i
         Main.Label49.Caption = "Progression :" & Str(Int((i * 100) / lEncodedLines)) & " %"
          DoEvents
            If i = lEncodedLines Then
                
                strFileData = Space(lFileSize Mod 45)
            End If
            
            Get intFile, , strFileData
            
            strTempLine = Chr(Len(strFileData) + 32)
            
            If i = lEncodedLines And (Len(strFileData) Mod 3) Then
                
                
                strFileData = strFileData + Space(3 - (Len(strFileData) Mod 3))
            End If
            
            For j = 1 To Len(strFileData) Step 3
            DoEvents
                strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j, 1)) \ 4 + 32)
                
                strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j, 1)) Mod 4) * 16 _
                               + Asc(Mid(strFileData, j + 1, 1)) \ 16 + 32)
                
                strTempLine = strTempLine + Chr((Asc(Mid(strFileData, j + 1, 1)) Mod 16) * 4 _
                               + Asc(Mid(strFileData, j + 2, 1)) \ 64 + 32)
                
                strTempLine = strTempLine + Chr(Asc(Mid(strFileData, j + 2, 1)) Mod 64 + 32)
            Next j
            
            strTempLine = Replace(strTempLine, " ", "`")
            
            strResult = strResult + strTempLine + vbLf
            
            strTempLine = ""
        Next i
    
    Close intFile


    strResult = strResult & "`" & vbLf + "end" + vbLf

    UUEncodeFile = strResult
Main.Picture6.Visible = False
End Function

' Donc la c'est simple appellez cette fonction avec le fichier à insérer ...

'  <<<-------- ca serait super flateur si y'en as qui se demandent comment j'ai fait l'intro avec du rtf ... style sub 7 
' mais je suis sur que la plus part s'en tappe ... mais je la donne comme - même car c'est trop simple :-)

' Alors vous avez besoin de deu richtext box et d'un timer ...

' Mettez ça dans le timer ....
Text18.SelStart = Len(Text18.Text) + 1

TmpRich.SelStart = Text18.SelStart
TmpRich.SelLength = 1

Text18.SelFontName = TmpRich.SelFontName
Text18.SelFontSize = TmpRich.SelFontSize
Text18.SelItalic = TmpRich.SelItalic
Text18.SelAlignment = TmpRich.SelAlignment
Text18.SelBold = TmpRich.SelBold
Text18.SelColor = TmpRich.SelColor

Text18.SelText = Mid(TmpRich.Text, Text18.SelStart + 1, 1)

If Len(Text18.Text) = Len(TmpRich.Text) Then Timer1.Enabled = False

' TmpRich c'est un richbox qui contient le texte que vous voulez afficher ... vous le mettez en visible = False
' Text18 c'est aussi un richtext sauf que lui il est vide au début ... et c'est dedans que les infos vont s'afficher ...

Conclusion

Donc je sait que c'est long mais si vous cherchez des bouts de codes c'est mieux de venir sur le site et prendre juste le bout qu'il vous faut ...

Je veux pas filer les sources mais vous n'avez qu'à me dire ce qui vous intéresse si jamais j'aurais oublié une fonction interressante ...

Je vous donne quelques liens sur mon site :

Page Principale :
www.multimania.com/myhackerside/show.htm

Page des Progs de Hack:
www.multimania.com/myhackerside/progs/crack.htm

Bon surf et bonne prog ...

PS : Si vous avez des bugs n'hesitez pas à me le dire ... j'ai envie de bien régler cette version ... donc c'est un peu comme si vous seriez les premiers testeurs ... et c'est pour ça que c'est la version beta ...

Sources du même auteur

VB WAP SERVER - ACTIVE SCRIPT PAGE INTERPRETÉ - OPEN SOURCE ...

SPLITTER AX - PERMET DE SPLITTER (REDIMENSIONNER) DES ZONES ...

MOUSE HOOK AX - GÉRER LE HOOK COMPLET DE SOURIS PAR AX - PER...

JEU D'ÉCHEC EN RÉSEAU - CONTROLE ACTIVEX

MANIPULEZ VOTRE PC AVEC VOTRE TELEPHONE - REMOTE PC WAP - IN...

Toutes les sources de aKheNathOn

Sources de la même categorie

LIGHT CODES-SOURCES par thebigboss3

STORMDATACENTER - DÉMO DE WEBBROWSER MULTIFONCTION VB9 par LightningStrike

TRADUCTEUR GOOGLE : INTERFACE WINFORM POUR LE SERVICE DE TRA... par Patrice99

COMMENT CONTRÔLER TOTALEMENT LES PROCESSUS D'UN PC DISTANT (... par violent_ken

MINI CACHE DNS par XelectroX

Toutes les sources de la catégorie Réseau & Internet

Sources en rapport avec celle ci

PROTOCOLE SMTP par EvildarkEurope

ENVOIE D'UN MAIL VIA LE SERVEUR SMTP DE YAHOO par keaoner

ENVOI D'UN MAIL ( VORTMAIL) par sitemo

ENVOI SIMPLE DE MAIL EN VB.NET par Senynium X

ENVOIE D'UN MESSAGE E-MAIL À PARTIR DE VOTRE APPLICATION VB.... par michelsto

Commentaires et avis

Commentaire de aKheNathOn le 25/12/2001 00:07:55

>Désole pour le zip .... le site me met le message time out ... et je peux pas uploader la source pourtant elle fait juste 196 Mo , je viens de maperçevoir que le fichier normal.mail contient des petites erreurs ... mais ce n'est pas grave ... mettez un mail avec les options par défault ... et enregistrez-le sous le nom de normal.mail bréf il sera niquel ensuite ...

Mettez des commentaires pour des conséils , questions , améliorations, bugs et autres merci ...

Commentaire de AnAcOnDa le 25/12/2001 02:02:54

mouhahaha
juste 196 MO ????

MDRRRRRRRRRRRRRRR

Commentaire de max12 le 25/12/2001 09:19:33 administrateur CS

Il voulais plutot dire Ko de je pense, et le code de RTF -> HTML est-il inspirer du miens ??? Sinon je t'en blâme pas

PS : Anaconda, mon PC fonctionne pas alors se sera pas demain que tu vas me revoir

Commentaire de aKheNathOn le 25/12/2001 11:37:43

oui au début j'ai pris ton code mais le tien fesait juste les alignement et les styles ... là je l'ait rendu plus complet , des couleurs , des tailles , des fonts et aussi une programmation incrustée ... pour mettre des liens par exemple :^)

Commentaire de Clem le 25/12/2001 18:04:46

Yahoo ! Mon modem à résussit a télécharger 196 Mo en 30 secondes !
N'on, sérieusement ce prog est super. Véréfiez vos pièces jointes maintenant car le virus peuvent se balader !

9/10 car ça aurait été mieux si il y avais une interface outlook express !

Commentaire de armand44 le 25/12/2001 20:47:41

Super ce prog le meilleur de ce genre a mon gout car accesible a tous

Commentaire de shaoni le 25/12/2001 21:32:07

il me marque erreur d'execution 53 fichier introuvable !!
pas de gestion des erreurs ?

Commentaire de aKheNathOn le 26/12/2001 12:28:44

Ok , je pense que je vais rajoutter tout un module exprés pour chaque boutton ou événement je vais faire une gestion d'erreurs ... Ben oui pas con , j'y ait pas pensé ... J'en ait fait une mais le stricte minimum ...

Si t'as un fichier introuvable c'est bizare ... Il te faut donc :
normal.mail
infos.txt
nc.cur
types.txt
et tous ces fichiers dans le même répertoire ... que le prog

Si ils te disent une erreur est arrivée ... fichier qui manque... regardes si c'est l'étape de la Vérification ... et si c'est le cas , c'est que t'as windows Xp et quand j'ai fait la protection de mon logiciel j'ai pas pensé à ça ... Donc je vais bientôt changer mon systéme de protection .. mais dis-moi si c'est bien à cette étape que ça plante =) ...

Commentaire de aKheNathOn le 26/12/2001 13:52:21

Bon ben chouette mon logiciel n'est pas protégé sur windows Xp ... vous pouvez ne pas respecter les clauses du contract ... et le lelogviciel n'en prendra pas compte ... sauf sur les autres systémes ... Sinon sur les autres systémes il marche niquel ! Et de plus toute la lignée des annonymes mails ne marcheront plus sur l'ordi en question donc je vous le déconséille .... Sinon là c'est bon ... le gestionnaire d'erreurs est en place ... je mettrais un petit fichier d'aide pour expliquer les codes d'erreurs .. 0-1-2-3-4-5 et expliquer comment les éviter ...

Y'à quelques appels de dlls en plus ... donc gdi32.dll, ole32.dll, advapi32.dll, user32.dll, kernel32.dll, oleaut32.dll et msvbvm60.dll ... bréf les truc clasiques mais faudrais que ça soit compatibles avec tous les systémes windows ...

A vous de me le dire ... Merci

Commentaire de aKheNathOn le 27/12/2001 15:02:46

Je viens juste de faire quelques modifs indispensables ... sur mon pc le logiciel tourne niquel mais par contre sur d'autres pc ( Plus puissant en + ! ) il plante à cause du frmsplash .. le chargement du prog est trop lent ... Bréf j'ai fouttu en l'air la sécu , plus d'écriture sur des registres plus rien qui fais des appels aux dlls ... ou du moins possible ... J'espére qu'il tournera mieux sinon j'enléve l'intro qui fais style sub7 avec un dialogue PC ---> Server ...

Faut vraiment que vous disiez ce qui va pas ... si c'est lent ou si ça plante ... même un peu ....

Merci d'avant

Commentaire de aKheNathOn le 28/12/2001 13:56:05

PS : les gars arrétez de mettre des noms d'expéditeurs trop cons car les serveur même s'ils ne vérifient l'adresse de l'expéditeur vas comme même voir parfois si le domain choisit existe ... ou autres ... Bréf pas tous mais la plus part ....; (aol en autres ) Donc finit les nom@pedofiles.org aol refusera ... mais sur ifrance ou autres même nom@hackers.hack passe =) ! Tout dépend du serveur donc si une erreur est signalés avec un message contenant DNS ... faut vérifier votre adresse expediteur insérée ... étape 2 qui plante dans ce cas ... si c'est létape 3 qui plante c'est que c'est le reçeveur qui nexiste plus ou que vous avez fait une erreur en choisisant son pseudo ... PS : Ne mettez ou laissez jamais d'espaces ...

Commentaire de Krach le 24/05/2003 09:55:21

put1 il existe plus ton site?!
ré-upload plz!!!
ça a l'air intéréssant comme prog.

Commentaire de crocohinos le 26/09/2003 11:30:43

Hello,

ce source est excellent, bravo.
Le seul petit point qui m'ennui c'est qu'il y a apparemment une taille limite pour les fichiers attachés. Mais j'avoue que dans le code je n'arrive pas à faire en sorte d'obtenir plus d'espace...ou de sequencer l'envoi...Une idée ?

merci

@++

Commentaire de CyberP le 21/11/2003 21:28:04

super sauf que le site pour télécharger le code entier n'existe plus

Commentaire de GUIDARK le 10/02/2007 00:09:45

un autre parmi tant d'autre...

Commentaire de pompier2a le 17/12/2008 20:33:07

dsl mais ton site marche pas

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

Mail anonyme [ par Apophis ] slt,Comment faire pour envoyer un mail de manière autonome de préférence (sans outlook) ou l'on peut mettre le nom que l'on veut? (le code présent sur ENVOYER UN MAIL ANONYME [ par omnikod ] envoyer des mails anonymes ? www.omnikod.fr.fm Mail SMTP par WINSOCK [ par mcroteau ] J'ai présentement un problème. J'utilise Winsock pour envoyer des mails. Si j'envoie le mail par un serveur Exchange, la date d'envoie n'est pas la bo envoyer mail smtp avec fichier attaché [ par vlej3008 ] Tout est dans le titre..Ce que je souhaiterai, c'est envoyer un mail en smtp (ça je sais séjà le faire), mais avec un fichier attaché (format texte, p authentification SMTP [ par PatDeLaYaute ] Bonjour,je suis en train de faire un formulaire d'envoi de mail à partir de mon projet.Le problème pour envoyer le mail j'utilise le serveur de l'hebe Envoyer Email avec SMTP en VBA [ par algo69 ] Salut tt le mondePourriez vous me dire comment envoyer un email en utilisantSMTP avec vba.Merci Envoyer un email via VBA [ par Appolon ] Bonjour,Voici mon code:Dim myOlApp As New Outlook.ApplicationDim myItem As Outlook.MailItemSet myItem = myOlApp.CreateItem(olMailItem)'tu crée l'objet Envoyer un email via VBA [HELP] [ par Appolon ] Bonsoir,Voici mon code:Dim myOlApp As New Outlook.ApplicationDim myItem As Outlook.MailItemSet myItem = myOlApp.CreateItem(olMailItem)'tu crée l'objet Envoyer un email en choisissant l'expéditeur [ par GigaCool ] Bonjour à tous , J'ai un ptit souci . J'ai developpé une application d'envoi de message aux agent d'une banque , messages relatif à leur conso télépho emailing vb2005 [ par medclubiste ] salut tout le mondeSOS SOS , j'ai vraiment besoin de votre aide c'est une question de vie ou de mort pour moi, en fait je developpe une application po