Visual Basic 6 ile virtual disk drive oluşturmak
Burda dosyaya gösteren virtuell bir DiskDrive yapilir. |
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long)
Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, ByVal _
lpszShortPath As String, ByVal cchBuffer As Long) As Long
Dim strShell, strPath, sbstfn(25) As String
Dim sbstf, l1, l2 As Long
Private Sub Command1_Click()
'Virtl. DiskDrive yapilmasi
Dim strDosPath As String
Dim Result As Long
strDosPath = Space(255)
Result = GetShortPathName(strPath, strDosPath, Len(strDosPath))
strDosPath = Mid$(strDosPath, 1, Result)
strShell = "subst " & List1.List(l1) & " " & strDosPath
'Ergänzung ende
List2.AddItem List1.List(l1)
List1.RemoveItem (l1)
sbstf = sbstf + 1
sbstfn(sbstf) = strPath
Shell strShell
Command2.Enabled = True
End Sub
Private Sub Command2_Click()
'Virtl. DiskDrive Silme
Dim i As Long
If sbstf > -1 Then
strShell = "subst " & List2.List(l2) & " /D"
List1.AddItem List2.List(l2)
List2.RemoveItem (l2)
Shell strShell
For i = l2 + 1 To sbstf
sbstfn(i - 1) = sbstfn(i)
Next i
sbstf = sbstf - 1
End If
If sbstf = -1 Then Command2.Enabled = False
End Sub
Private Sub Dir1_Change()
strPath = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
Dim i As Long
Dim ff As Long
ff = FreeFile
Command2.Enabled = False
sbstf = -1
strShell = App.Path & "\subs.bat"
Open strShell For Output As #ff
Print #ff, "subst > subst.txt"
Close #ff
Sleep (100)
Shell strShell
Sleep (100)
Form1.Show
If Len(Dir(CurDir$ & "\subst.txt")) > 0 Then
Open CurDir$ & "\subst.txt" For Input As #ff
While Not EOF(ff)
Line Input #ff, strShell
List2.AddItem (Left$(strShell, 2))
sbstf = sbstf + 1
sbstfn(sbstf) = Right$(strShell, Len(strShell) - 6)
Wend
Command2.Enabled = True
Close #ff
Sleep 100
Kill (CurDir$ & "\subst.txt")
End If
For i = 65 To 90
List1.AddItem Chr$(i) & ":"
Next i
Call Dir1_Change
End Sub
Private Sub List1_Click()
If List1.ListIndex <> -1 Then
l1 = List1.ListIndex
End If
End Sub
Private Sub List2_Click()
If List2.ListIndex <> -1 Then
l2 = List2.ListIndex
Dir1.Path = sbstfn(l2)
End If
End Sub
Son yorumlar