سلام صبح بخیر
غرض از مزاحمت دوباره اینه که دیروز که آخرین پیامتون را خوندم شب یه پیشنهادی به زهنم رسید که براتون نوشتم
فقط با عرض شرمندگی چند تا پیشنهاد دیگه ای را هم داشتم
1) اگه لطف کنین برنامه اول تون را ابتدا برای فلش (H) بنویسین میتونم اول انو تست کنم و در صورتی که هیچ مشکلی در کارد کردش نبود زحمت مابقیش را هم از روی اولی بکشید .
2)زمانی که هر کدام از برنامه ها که اجرا شد تو قسمت گوشه سمت راست بالای دکستاب قرار بگیره.
3) پس از اینکه برنامه شروع به پاک کردن کرد و کارش تموم شد فلش را باز کنه و خودش (فرم گوشه سمت راست بالا)هم اتومات بسته بشود .
4) سایز فرم هم اگه امکانش باشه 110 پیکسل در 313 پیکسل باشه.
5) میتوانیید یک آیکون هم براش قرار بدین ؟ اگه جواب مثبت بود چطوری آیکونش را هم براتون ارسال کنم؟
" یک دنیا سپاس از کمک های بیدریغتان"
سلام
خوب هستین من پروژه دارم یه کم سرم شلوغه
برنامه ای که دیشب خواستید نوشتم هم با فایل exe هم با کد براتون اماده کردم.
یه فلش وصل کنید پسوند فایلهای از قبیل exe bat inf و .... پاک میکنه ( همون پسوندهای که گفتید :
سورس :
کد:
'CODER : Www.ParsiCoders.com By Amin Mansouri
Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Const DRIVE_CDROM = 5
Const DRIVE_FIXED = 3
Const DRIVE_RAMDISK = 6
Const DRIVE_REMOTE = 4
Const DRIVE_REMOVABLE = 2
Dim NameDrive As String
Public Function GetUsb() As String
Dim WMIService As Object, USBDrives As Object, USBFound As Object, USB As String, USBCount As String
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") 'Open WMIService
Set USBDrives = WMIService.ExecQuery("Select * from Win32_LogicalDisk") 'Look For Computer Drives drives
For Each USBFound In USBDrives 'Look for all our drives
If USBFound.drivetype = 2 Then 'If drivetype is USB
USB = USBFound.Name 'Set USB as New USB-name
USBCount = USBCount & " - " & USBFound.Name 'Add USB name to USB-count
End If
If USB = "" Then GoTo volgende 'If its not an USB-Drive then goto Next
volgende: 'Next
Next 'Search for more USB drives
GetUsb = USB
End Function
Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Public Function DeleteFile() As String
On Error Resume Next
File1.Path = GetUsb
File1.Refresh
For i = 0 To File1.ListCount - 1
Path = StripNulls(GetUsb + File1.List(i))
SetAttr Path, vbNormal
Kill Path
Next
End Function
Private Sub Drive1_Change()
File1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
File1.System = True
File1.Hidden = True
End Sub
Private Sub Timer1_Timer()
DeleteFile
End Sub
دانلود پروژه به همراه فایل اجرایی
[
attachment=85]
سلام خسته نباشید
از اینکه درخواست بنده را با اینکه سرتون شلوغ بود ، قبول کردین ممنون .
من فایل شما را گرفتم و بصورت زیر امتحان کردم ولی متاسفانه کار نکرد :
1) ابتدا یک فولدری داخل فلشم درست کردم ، بعد یکسری فایل های با پسوند درخواستی داخلش قرار دادم اما بعد از اجرای برنامه یک فرم خالی باز شد ولی هیچ کدام از فایلهای ساخته شده در داخل فولدر پاک نشدند.
2) اما بعداً همون فایلهای تست را مستقیما داخل فلش قرار دادم (بدون فولدر) که همه فایلها بجز فایلهای پسوند (com , ocx . pry) پاک شدند(یعنی فقط فایلهای با پسوند exe dll inf sys پاک شدند)
با احترام ، اشکالات برنامه :
1) بهتره به هنگام طراحی و اجرای برنامه ؛ یا برنامه فرم نداشته باشد یا در صورتی که خواستید دارای فرم باشد فرم خالی نباشد حدالامکان یک نواری سبز رنگ متحرک که خود ویندوز به هنگام کپی کردن یا دیلت کردن یا حتی نصب نرم افزار ایجاد می شه را داشته باشد.
2) اگر به دستور Bach فایلم توجه کنید ؛ خواهید دید که دستور آن بگونه ایست که اگر ویروس در داخل چندین هزار پوشۀ تو در تو هم باشد خواهد توانست آن را پاک کند ! اما این برنامه قادر به انجام اینکار نیست ! این مورد هم برایم خیلی اهمیت دارد !
و همچنین سرعت انجام پاک کردن هم باید خیلی بالا باشد تا کاربر به هنگام استفاده اصلاً معطل نشود که حداکثر زمان 2 ثانیه باشد که این زمان در این برنامه بیشتر از اجرای Bach فایل طول می کشد که حتماً باید برطرف شود .
3) این برنامه پس از اتمام کار خود (پاک کردن ویروسها) ، خود فلش را باز نمی کند که این ویژگی یکی از درخواستهای اصلی و مهم من بوده !
4) اگر خواستید فرم نداشته باشد که هیچ ؛ اما اگر خواستی از فرم استفاده کنید باید این ویژگی را هم برایش ایجاد کنید که بعد از اتمام کار پاک کردن ویروسها ، خود فرم ؛ اتوماتیک بسته شود و بجای کلمه Form1 (نام برنامه) نام کامل نرم افزار نوشته شود YA MAHDI Memory Application Remover
5) یک سوال ! آیا این برنامه قادر هست که هر چند تا فلش به USB وصل شد ویروسهاشون را پاک کنه یا فقط برای یک فلش کار می کنه ؟ و اگه قرار باشه که بعد از اتمام کار ویروس کشی ، خود فلش را هم باز کنه ؛ اون موقع برای مثال اگه ما 8 تا فلش را به کامپیوترمون وصل کرده باشیم هر 8 تاشون را باهم یکجا باز میکنه ؟ که اگه اینجور باشه یکی از نقاط ضعف برنامه محسوب خواهد شد !
البته این مطالبی را که عرض کردم به حساب به ادبی و ناسپاسی بنده نگذارید بلکه از روی دوستی و صمیمیت مون گفتم و در راستای همون هدف بزرگمون که قبلاً عرض کردم : ((کاری بکنیم که برنامه لایق نام بزرگ آقا صاحب الزمان (یا مهدی) باشد. انشاء الله .)) می باشد و باز هم از تمامی تلاشهای شما بی نهایت سپاسگذار و متشکرم .
! یک پیش نهاد خیلی مهم که حتماً نظرتون را درموردش برام بدین !
اگه لطف کنین در برنامه ای که می نویسید یک حالت شرطی هم براش تعریف کنین دیگه اونوقت برنامتون بی نظیر میشه !!
اون حالت شرطی اینه که شما ابتدا برای 8 تا فلش از F تا M ، برای هر فلش یک برنامه اجرائی جداگانه بنویسید مانند مثال زیر:
1) F.exe فقط برای فلش با نام F کار می کند و برای دیگر فلشها بی اثر است .
2)G.exe فقط برای فلش با نام G کار می کند و برای دیگر فلشها بی اثر است .
3)H.exe فقط برای فلش با نام H کار می کند و برای دیگر فلشها بی اثر است .
4)I.exe فقط برای فلش با نام I کار می کند و برای دیگر فلشها بی اثر است .
5)J.exe فقط برای فلش با نام J کار می کند و برای دیگر فلشها بی اثر است .
6)K.exe فقط برای فلش با نام K کار می کند و برای دیگر فلشها بی اثر است .
7)L.exe فقط برای فلش با نام L کار می کند و برای دیگر فلشها بی اثر است .
8)M.exe فقط برای فلش با نام M کار می کند و برای دیگر فلشها بی اثر است .
و حالت شرطی اینه که اگر هر کدام از فایلهای بالا اجرا شوند ، ابتدا برنامه چک کند که آیا فلشی به نام خودش برای مثال F وجود دارد (به کامپیوتر متصل است یا فعال است) ؟
اگر پاسخ مثبت بود ؛ شروع به اجرای بقیه فرامین کند و ویروسها را پاک کند و بعد از آن فلش را باز کند !
و اگر پاسخ منفی بود یعنی چنین فلشی با آن نام به کامپیوتر وصل نبود ؛ بقیه فرامین را اجرا نکند و هیچ اتفاقی نیافتد (چیزی را پاک نکند)!!!
که این ویژگی خیلی مهم و کیلیدی است که نمی خوام قسمتون بدم تا این ویژگی را هم در آن قرار بدین ولی نهایت تلاشتون را بکنید .
من خیلی عجله برای آماده شدن برنامه ندارم و فقط کیفیت برنامه برام مهمه (طبق اون هدف مون) پس از شما به عنوان یک برادر کوچکتر و دوست از شما تقاظا دارم حتما ویژگیهایی که در بالا براتون عرض کردم را در برنامه لحاظ کنین و من باز از زحماتی که کشیدین بی نهایت قدردان و سپاس گذارم..
با احترام " پنام "
سلام
ببخشید من یه مدت نبودم
اینترنت نداشتم
تا شب برنامه رو مینیویسم تا جایی که بتونم
موفق باشید
درود
من یه مدت اینترنت نداشتم بخاطر این نتونستم بیام پروژه ای که خواستید نوشته شد اما نه دقیقا همون (بقیشو باید زحمتشون خودتون بکشید چون وقت کافی ندارم )
البته براتون قسمت اینکه فلش رو اتومات باز کنه نوشتم
مشکل پسوند فایل ها حل کردم
فرم هم مخفی کردم
و اینکه گفتید اینکه همه فولدر ها بگرده داخلشون فایل های که گفتید پاک کنه خیلی طول میکشه و نیاز به کد نویسی داره که وقتشو ندارم و معمولا هم این جور پروژه ها با شکست مواجه میشن
یه فلش 32 گیگابایتی به صورت مثلا 8 گیگش پر اهنگ و تکست و .... باشه کاربرو کلافه میکنه !
سورس کد :
کد:
'CODER : Www.ParsiCoders.com By Amin Mansouri
'version 1.1
Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Const DRIVE_CDROM = 5
Const DRIVE_FIXED = 3
Const DRIVE_RAMDISK = 6
Const DRIVE_REMOTE = 4
Const DRIVE_REMOVABLE = 2
Dim NameDrive As String
Public Function GetUsb() As String
Dim WMIService As Object, USBDrives As Object, USBFound As Object, USB As String, USBCount As String
Set WMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") 'Open WMIService
Set USBDrives = WMIService.ExecQuery("Select * from Win32_LogicalDisk") 'Look For Computer Drives drives
For Each USBFound In USBDrives 'Look for all our drives
If USBFound.drivetype = 2 Then 'If drivetype is USB
USB = USBFound.Name 'Set USB as New USB-name
USBCount = USBCount & " - " & USBFound.Name 'Add USB name to USB-count
End If
If USB = "" Then GoTo volgende 'If its not an USB-Drive then goto Next
volgende: 'Next
Next 'Search for more USB drives
GetUsb = USB
End Function
Public Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Public Function DeleteFile()
On Error Resume Next
File1.Path = GetUsb
File1.Refresh
If GetDriveType(GetUsb) = 3 Then Exit Function
If File1.ListCount = "1" Then
For i = 0 To File1.ListCount - 1
Path = StripNulls(GetUsb + File1.List(i))
SetAttr Path, vbNormal
Kill Path
eXP.Enabled = True
Next
End If
End Function
Private Sub Drive1_Change()
File1.Path = Drive1.Drive
End Sub
Private Sub eXP_Timer()
eXP.Enabled = False
Shell ("explorer " + GetUsb), vbNormalFocus
End Sub
Private Sub Form_Load()
'Me.Hide
File1.Pattern = "*.dll;*.exe;*.pry;*.sys;*.inf;*.bat;*.sys;*.ovl*.com*.ocx"
File1.System = True
File1.Hidden = True
End Sub
Private Sub Timer1_Timer()
DeleteFile
End Sub
دانلود سورس به همراه فایل اجرایی :
[
attachment=86]
سلام و درود و هزاران آفرین به دوست عزیزم و سرباز سایبری مولا صاحب الزمان.
اجرت با امام زمان.
از شما بینهایت ممنون و سپاس گذارم .
اگه افتخار بدید و اجازه بدین که من ایمیل شما را هم داشته باشم تا بتونیم این دوستی مفید به فایده که جزء کمیاب ترین و مهمترین نوع دوستی های دنیا به حساب می آید ، حفظ کنیم .
خواهش می کنم به این درخواست من جواب مثبت بدین .
امتحان کردم ، البته اینبار هیچ کدام از پسوند ها را پاک نکرد ؟ نمی دونم چرا ؟ ولی فلش را باز کرد . ولی یک فلش را شناسایی و باز می کنه (من با دو فلش همزمان فعال امتحان کردم). با این حال همین که لطف کردین و برای جواب من وقت گذاشتین بینهایت ممنونم .
اگر اشکالات را براتون می نویسم نه بخاطر اینکه خدایی ناکرده فکر کنین که من بی ادبی می خوام بکنم بلکه می خواهم شما خودتون پیشرفت بکنین و اشکالات برنامه نویسی تون را بدونین و اونها را پیش خودتون برطرف کنین که امید وارم سوء برداشت و سوء تفاهمی پیش نیومده باشه ؟
اگه ممکنه به درخواست من جواب مثبت بدهید !
درود بر شما
به امید ظهور امام زمان (عج)
من امتحان کردم بدون مشکل پاک کرد.
رم موبایلمو وصل کردم راحت پاک کرد
ایمیل من رو میتونید داشته باشید پیغام خصوصی بفرستید در خدمتم
ممنونم از اینکه درخواست بنده را قبول کردید.
من چندین بار امتحان کردم با فلش ها و رم ریدر های مختلف !
حالا انشاء الله کی یه کم سر شما خلوت می شه ؟
حالا من چطوری پیغام خصوصی براتون بفرستم .
بلد نیستم .
ولی فکر کنم شما ایمیل بنده را داشته باشید ، چون موقع ثبت نام توی فرم ثبت نام نوشتم
سلام عذر می خوام الان جای پیام خصوصی را پیدا کردم.
آیا می شه با استفاده از بچ فایل ها یک فایل اجرایی را مثلا بابیلون را اجرا کرد . البته از مسیر(آدرس)خودش.
C:\Program Files\Babylon\Babylon-Pro\Babylon.exe
اگه می شه لطفا دستورش را بنویسید ممنون می شم !
از بابت زحمتهایی که به شما می دم ممنونم .
سلام توی ms dos اینطوری میشه
کد:
C:\Program Files\Babylon\Babylon-Pro\Babylon.exe
مسیر رو بدید میاره بالا
توی وی بی 6 هم اینطوری
کد:
Private Sub Form_Load()
Shell ("C:\Program Files\Babylon\Babylon-Pro\Babylon.exe"), vbNormalFocus
End Sub