| |
|
|
| |
Dim D
Dim Dc As Object
Dim s As String
On Error Resume Next
Dim fs As New FileSystemObject
Set Dc = fs.Drives
For Each D In Dc
's = D.DriveType & " " & D
'MsgBox s
If D.DriveType <> 3 And D.DriveType <> 4 And D.DriveType <> 1 Then
End If
Next
|
D.DriveType - на разных компах выдаёт разные номера для накопителей.
То 1 - это дисковод дискеток, а если его нет - тада это флэшка.
Можэ есть другия способы? | |
| |
| |
| |
|
|
| | хз, но сетевой или нет я так определял :)
Public Function fnDriveType(strDrive As String) As String
Dim objFSO As Object, drive As Object
On Error GoTo err123
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set drive = objFSO.GetDrive(strDrive)
fnDriveType = drive.RootFolder.Type
err123:
Set objFSO = Nothing
End Function
|
dt = LCase(fnDriveType(Left(CurrentDb.Properties(0), 3)))
If Not dt Like "*локальный*" And Not dt Like "*local*" Then '-- если запускается не с локального диска
MsgBox "Запуск приложения возможен только с локального диска" & vbNewLine & iDevelop, , "Ошибка"
Cancel = -1
Exit Sub
End If
|
может и тебя натолкнет? :) | |
| |
| |
|
|
| |
|
|
| | есть такой вариант
Dim obj, objs
Set objs = GetObject("winmgmts:").InstancesOf("Win32_DiskDrive")
For Each obj In objs
If obj.InterfaceType = "USB" Then
' тока не понятно как теперь определить имя\путь к этому накоплятелю
End If
Next
|
| |
| |
| |
| |
|
|
| | ещё вот чё нашёл, но синтаксис какой то не понятный......
Кто нибудь может перевести?
var
Drive: Char;
DriveLetter: String[4];
begin
for Drive := 'A' to 'Z' do
begin
DriveLetter := Drive + ':\';
case GetDriveType(PChar(Drive + ':\')) of
DRIVE_REMOVABLE:
Memo1.Lines.Add(DriveLetter + ' Флеш');
DRIVE_FIXED:
Memo1.Lines.Add(DriveLetter + ' Локальный');
DRIVE_REMOTE:
Memo1.Lines.Add(DriveLetter + ' Сетевой');
DRIVE_CDROM:
Memo1.Lines.Add(DriveLetter + ' CD-ROM ');
end;
end;
end;
|
| |
| |
| |
| |
|
|
| | это паскаль
практически то, что я тебе дал :) | |
| |
| |
| |
|
|
| | Паскаль, я его за ... таскаль.
Ничё не понятно.
Private Sub Form_Load()
Me.AutoRedraw = True
Set objSWbemService = GetObject("winmgmts:\\.\ROOT\CIMV2")
Set wmiDiskDrives = objSWbemService.ExecQuery("SELECT * FROM Win32_DiskDrive")
For Each wmiDiskDrive In wmiDiskDrives
If wmiDiskDrive.InterfaceType = "USB" Then 'IDE
Print "USB диск:", wmiDiskDrive.Model
Print "Size:", wmiDiskDrive.Size & " Байт"
PnPID = wmiDiskDrive.PnPDeviceID
Print "Заводской номер:", Replace(Mid(PnPID, InStrRev(PnPID, "\") + 1), "&0", "")
strEscapedDeviceID = Replace(wmiDiskDrive.DeviceID, "\", "\\", 1, -1, vbTextCompare)
Set wmiDiskPartitions = objSWbemService.ExecQuery _
("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & _
strEscapedDeviceID & """} WHERE AssocClass = " & _
"Win32_DiskDriveToDiskPartition")
For Each wmiDiskPartition In wmiDiskPartitions
Set wmiLogicalDisks = objSWbemService.ExecQuery _
("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _
wmiDiskPartition.DeviceID & """} WHERE AssocClass = " & _
"Win32_LogicalDiskToPartition")
For Each wmiLogicalDisk In wmiLogicalDisks
Print "Логический диск:", wmiLogicalDisk.DeviceID
Next
Next
End If
Next
End Sub
|
| |
| |
| |
| |
|
|
| | Определить флэшку - самый простой способ
Dim obj, objs, s
Set objs = GetObject("winmgmts:").InstancesOf("Win32_DiskDrive")
For Each obj In objs
If obj.InterfaceType = "USB" Then
s = obj.InterfaceType & " " & obj.PnPDeviceID & " " & obj.Name & " " & obj.Type
MsgBox s
End If
Next
|
А как в этом коде определить имя тома илли букву флэшки?  | |
| |
| |
| |
|
|
| | http://bit.pirit.info/forum/viewtopic.php?t=18150 вот тут поройся -= там есть и ф-я GetDriveLetter | |
| |
| |
|
|
| |
|
|
| | Взял самое просте из хелпа:
Sub ShowDriveType(drvpath)
Dim fs, d, s, t
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(drvpath)
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
s = "Drive " & d.DriveLetter & ": - " & t
MsgBox s
End Sub
Все работает. Стало быть дело за малым - либо прописать устройство жестко, либо посмотреть устройство, на котором расположена программулина - CurrentProject.Path (естественно выделив только буковку, которую заключаем в кавычки. "c:\" ) | |
| |
| |
| |
|
|
| | Спасибо!
Программулина на компе на диске "D:\"
А как определить букву флэшки? | |
| |
| |
| |
|
|
| | Вы ведь заранее знаете куда будете обращаться, поэтому надо ввести переменную, или еще что-то.
У меня, например при работе клиента, предусмотрена работа как с диска, так и с флешки (база малюсенькая и применяется в данном случае только для вспомогательных расчетов). Проблема в файловой структуре - на флешке нет директорий, там все у него в куче, а обращается программка к разным файлам. Поэтому, чтобы не прописывать всякий раз пути, я просто определяю место, откуда стартует программка. Left(CurrentProject.Path,3) | |
| |
| |
|
|
| |
|
|
| | Ясно. У меня была другая задача. | |
| |
| |
|
|
| |
|
|
| | Может это поможет.
Перечисление локальных и сетевых дисков.
'
************ Code Start **************
'This code was originally written by Terry Kreft
'and Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
' Original Code by Terry Kreft
' Modified by Dev Ashish
'
'Drive Types
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
' returns errors for UNC Path
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Function fGetDrives() As String
'Returns all mapped drives
Dim lngRet As Long
Dim strDrives As String * 255
Dim lngTmp As Long
lngTmp = Len(strDrives)
lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
fGetDrives = Left(strDrives, lngRet)
End Function
Private Function fGetUNCPath(strDriveLetter As String) As String
On Local Error GoTo fGetUNCPath_Err
Dim Msg As String, lngReturn As Long
Dim lpszLocalName As String
Dim lpszRemoteName As String
Dim cbRemoteName As Long
lpszLocalName = strDriveLetter
lpszRemoteName = String$(255, Chr$(32))
cbRemoteName = Len(lpszRemoteName)
lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _
cbRemoteName)
Select Case lngReturn
Case ERROR_BAD_DEVICE
Msg = "Error: Bad Device"
Case ERROR_CONNECTION_UNAVAIL
Msg = "Error: Connection Un-Available"
Case ERROR_EXTENDED_ERROR
Msg = "Error: Extended Error"
Case ERROR_MORE_DATA
Msg = "Error: More Data"
Case ERROR_NOT_SUPPORTED
Msg = "Error: Feature not Supported"
Case ERROR_NO_NET_OR_BAD_PATH
Msg = "Error: No Network Available or Bad Path"
Case ERROR_NO_NETWORK
Msg = "Error: No Network Available"
Case ERROR_NOT_CONNECTED
Msg = "Error: Not Connected"
Case NO_ERROR
' all is successful...
End Select
If Len(Msg) Then
MsgBox Msg, vbInformation
Else
fGetUNCPath = Left$(lpszRemoteName, cbRemoteName)
End If
fGetUNCPath_End:
Exit Function
fGetUNCPath_Err:
MsgBox Err.Description, vbInformation
Resume fGetUNCPath_End
End Function
Private Function fDriveType(strDriveName As String) As String
Dim lngRet As Long
Dim strDrive As String
lngRet = GetDriveType(strDriveName)
Select Case lngRet
Case DRIVE_UNKNOWN 'The drive type cannot be determined.
strDrive = "Unknown Drive Type"
Case DRIVE_ABSENT 'The root directory does not exist.
strDrive = "Drive does not exist"
Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
strDrive = "Removable Media"
Case DRIVE_FIXED 'The disk cannot be removed from the drive.
strDrive = "Fixed Drive"
Case DRIVE_REMOTE 'The drive is a remote (network) drive.
strDrive = "Network Drive"
Case DRIVE_CDROM 'The drive is a CD-ROM drive.
strDrive = "CD Rom"
Case DRIVE_RAMDISK 'The drive is a RAM disk.
strDrive = "Ram Disk"
End Select
fDriveType = strDrive
End Function
Sub sListAllDrives()
Dim strAllDrives As String
Dim strTmp As String
strAllDrives = fGetDrives
If strAllDrives <> "" Then
Do
strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
Select Case fDriveType(strTmp)
Case "Removable Media":
Debug.Print "Removable drive : " & strTmp
Case "CD ROM":
Debug.Print " CD Rom drive : " & strTmp
Case "Fixed Drive":
Debug.Print " Local drive : " & strTmp
Case "Network Drive":
Debug.Print " Network drive : " & strTmp
Debug.Print " UNC Path : " & _
fGetUNCPath(Left$(strTmp, Len(strTmp) - 1))
End Select
Loop While strAllDrives <> ""
End If
End Sub
'**************** Code End ****************** | |
| |
| |
| |
|
|
| | Спасибо!
щас - попробую
====================
Помогло! 
=======================
Надо же как всё засекречено - не так то просто букву флэшки найти. | |
| |
| |
| |
|
|
| |
Option Compare Database
Option Explicit
Function r() As String 'by David Zakaryan (ddi)
Dim f As New FileSystemObject
Dim drv As Drive
'drv может иметь значения
'drv.AvailableSpace
'drv.DriveLetter
'drv.DriveType
'drv.FileSystem
'drv.FreeSpace
'drv.IsReady
'drv.Path
'drv.RootFolder
'drv.SerialNumber
'drv.ShareName
'drv.TotalSize
'drv.VolumeName так скозать что душе угодно
Dim i As Integer
For Each drv In f.Drives
If drv.DriveType = Removable Then
If fe(drv & "\1.txt") = True Then
r = drv & "\1.txt"
MsgBox (r)
Else
End If
End If
Next
If r = "" Then
MsgBox ("Нет флешки")
End If
End Function
Function fe(Path As String) As Boolean
Dim i As Integer
On Error Resume Next
i = GetAttr(Path)
Select Case Err.Number
Case Is = 0
fe = True
Case Else
fe = False
End Select
On Error GoTo 0
End Function
|
| |
| |
| |
| |
|
|
| |
Option Compare Database
Option Explicit
Function r(filename As String) As String 'by David Zakaryan (ddi)
Dim f As New FileSystemObject
Dim drv As Drive
'drv может иметь значения
'drv.AvailableSpace
'drv.DriveLetter
'drv.DriveType
'drv.FileSystem
'drv.FreeSpace
'drv.IsReady
'drv.Path
'drv.RootFolder
'drv.SerialNumber
'drv.ShareName
'drv.TotalSize
'drv.VolumeName так скозать что душе угодно
For Each drv In f.Drives
If drv.DriveType = Removable Then
If fe(drv & "\" & filename) = True Then
r = drv & "\" & filename
Else
End If
End If
Next
If r = "" Then
MsgBox ("Нет флешки")
End If
End Function
Function fe(Path As String) As Boolean
Dim i As Integer
On Error Resume Next
i = GetAttr(Path)
Select Case Err.Number
Case Is = 0
fe = True
Case Else
fe = False
End Select
On Error GoTo 0
End Function
|
| |
| |
| |
| |
|
|
| | Тестил на 4 компах win 7 win xp работает | |
| |
| |
|
|
|
|
| |
|
|
| | Мне надо определять букву флэшки.
Этот код не делает задачу. | |
| |
| |
| |
|
|
| | А если это не флешка, а винт-потаскун
или будет установлен картридер или воткнуто 2 флешки
Что-то автоматическое определение при таких раскладах меня настораживает
может предложить последовательность действий по указанию носителя
типа вставьте носитель в гнездо и нажмите кнопку далее
укажите носитель или папку куда сохранить (откуда читать данные)
и радуйтесь прелестями проги | |
| |
| |
|
|
| |
|
|
| |
А если это не флешка, а винт-потаскун
или будет установлен картридер или воткнуто 2 флешки
Что-то автоматическое определение при таких раскладах меня настораживает
может предложить последовательность действий по указанию носителя
типа вставьте носитель в гнездо и нажмите кнопку далее
укажите носитель или папку куда сохранить (откуда читать данные)
и радуйтесь прелестями проги
|
Я исползывал такой код у меня во флешке лежал ключ к проге не зовисемо что компу потклёчено 1 2 ... 8 флешек он искал в них мой файл в котором найдёт там же и останавливолся
а для винды не имеет значения как флешка потключена главное что бы вида знала что это флешка | |
| |
| |
| |
|
|
| | а винт-потаскун для винды HDD | |
| |
| |
|
|
|
|
|
|
|
|
| |
|
|
| |
Пример кода, описанные в этом разделе содержится реальный пример, который демонстрирует многие возможности, доступные в FileSystemObject объектной модели. Этот код показывает, как все возможности объектной модели работают вместе, и как использовать эти функции эффективно в вашем собственном коде.
Как использовать кодекс
Обратите внимание, что поскольку этот код достаточно общий характер, дополнительный код и небольшой настройки необходимы, чтобы сделать этот код на самом деле работает на вашей машине. Эти изменения необходимы из-за различных способов вход и выход для пользователя обрабатывается между страницы Active Server Pages и хост Windows Scripting.
Для выполнения этого кода на активной серверной страницы, выполните следующие действия:
Создайте стандартные веб-страницы с расширением. Жерех.
Скопируйте следующий код в этот файл между <BODY> BODY ...</> теги.
Заключите весь код в <%...%> теги.
Перемещение Option Explicit заявление от текущей позиции в коде, чтобы самой верхней части HTML-страницы, позиционирование его еще до открытия <HTML> тега.
Место <%...%> теги Option Explicit заявление, чтобы это работает на стороне сервера.
Добавьте следующий код в конец пример кода:
VBScript
Sub печати (х)
Response.Write "<PRE> & ltFONT FACE =" "Courier New" "SIZE =" "1" ">"
Response.Write х
Response.Write "</ FONT> </ PRE>"
End Sub
Главная
Предыдущий код добавляет печати процедура, которая будет работать на стороне сервера, но отображать результаты на стороне клиента.
Для выполнения этого кода на хост Windows Scripting, используйте следующие шаги:
Закомментируйте все <A теги привязки name=""> </ A>
Добавьте следующий код в конец пример кода:
VBScript
Sub печати (х)
WScript.Echo х
End Sub
Главная
Код содержится в следующем разделе:
VBScript
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''
"FileSystemObject Пример кода
Copyright '1998 Microsoft Corporation. Все права защищены.
'''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''
Option Explicit
'''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''
Что касается кода "качества :
"1) Следующий код делает много работы со строками на
"объединения коротких строк вместе с" & "оператора.
" Так как объединение строк стоит дорого, это очень
"неэффективный способ написания кода. Тем не менее, это очень
"в сопровождении способ написания кода, и используется здесь, потому что это
"программа выполняет обширные операции диска, и из-за
"диска намного медленнее, чем операции с памятью, необходимые для
«объединения строк. Имейте в виду, что это демонстрация
"код, а не рабочий код.
'
'2) "Option Explicit" используется, потому что объявленная переменная доступа
"немного быстрее, чем необъявленная переменная доступа. Оно также предотвращает
"ошибок от ползучего в код, например, когда вы опечатки
"DriveTypeCDROM как DriveTypeCDORM.
'
'3) обработка ошибок отсутствует этот код, чтобы сделать код более
читабельным. Хотя меры предосторожности были приняты для того, чтобы
"код не будет ошибки в общих случаях, файловые системы могут быть
"непредсказуемыми. В рабочем коде, использование On Error Resume Next и
"Err объекта в ловушку возможно
Некоторые удобные глобальные переменные
'''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''
Dim TabStop
Dim NewLine
Const TestDrive = "C"
Const TestFilePath = "C: \ Test"
''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''
Константы "возвращается Drive.DriveType
'''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''
Const DriveTypeRemovable = 1
Const DriveTypeFixed = 2
Const DriveTypeNetwork = 3
Const DriveTypeCDROM = 4
Const DriveTypeRAMDisk = 5
'''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''
Константы "возвращается File.Attributes
''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''
Const FileAttrNormal = 0
Const FileAttrReadOnly = 1
Const FileAttrHidden = 2
Const FileAttrSystem = 4
Const FileAttrVolume = 8
Const FileAttrDirectory = 16
Const FileAttrArchive = 32
Const FileAttrAlias ​​= 1024
Const FileAttrCompressed = 2048
''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''
'Константы для открытия файлов
'''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''
Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''
"ShowDriveType
Цель ':
'Создает строку, описывающую типом привода данного диска объекта.
" Демонстрирует следующие
'- Drive.DriveType
'''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''
Функция ShowDriveType (Drive)
Dim S
Select Case Drive.DriveType
Дело DriveTypeRemovable
S = "Съемный"
Дело DriveTypeFixed
S = "Фиксированный"
Дело DriveTypeNetwork
S = "Сеть"
Дело DriveTypeCDROM
S = "CD-ROM"
Дело DriveTypeRAMDisk
S = "RAM Disk"
Case Else
S = "Неизвестный"
End Select
ShowDriveType = S
End Function
'''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''
"ShowFileAttr
Цель ':
'генерирует строку с описанием атрибутов файла или папки.
" Демонстрирует следующие
'- File.Attributes
'- Folder.Attributes
''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''
файла Функция ShowFileAttr (File) 'может быть файл или папку,
Dim S
Dim Attr
Attr = File.Attributes
Если Attr = 0 Then
ShowFileAttr = "Обычный"
Exit Function
End If
Если Attr И FileAttrDirectory Тогда S = S & "Справочник"
Если Attr И FileAttrReadOnly Тогда S = S & "только для чтения"
Если Attr И тогда FileAttrHidden S = S & "Hidden"
Если Attr И FileAttrSystem Тогда S = S & "Система"
Если Attr И FileAttrVolume Тогда S = S & "Volume"
Если Attr И FileAttrArchive Тогда S = S & "Архив"
Если Attr И FileAttrAlias ​​Тогда S = S & "Alias"
Если Attr И FileAttrCompressed Тогда S = S & "Сжатый"
ShowFileAttr = S
End Function
'''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''
"GenerateDriveInformation
Цель ':
'Генерирует строки, описывающей текущее состояние
"доступных дисков.
" Демонстрирует следующие
'- FileSystemObject.Drives
'- Итерация диски коллекции
'- Drives.Count
'- Drive.AvailableSpace
'- Drive.DriveLetter
'- Drive.DriveType
'- Drive.FileSystem
'- Drive.FreeSpace
'- Drive.IsReady
" - Drive.Path
'- Drive.SerialNumber
'- Drive.ShareName
'- Drive.TotalSize
'- Drive.VolumeName
'''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''
Функция GenerateDriveInformation (FSO)
Dim Диски
Диск Dim
Dim S
Диски комплект = FSO.Drives
S = "Количество дисков:" & & TabStop Drives.Count & & NewLine NewLine
'Построить первую линию отчета.
S = S & String (2, TabStop) и "Драйв"
S = S & String (3, TabStop) и "Файл"
S = S & TabStop и "Total"
S = S & TabStop и "Свободный"
S = S & TabStop и "Доступный"
S = S & TabStop и "Сериал" & NewLine
'Построить вторую линию отчета.
S = S & "Письмо"
S = S & TabStop и «Путь»
S = S & TabStop и "Тип"
S = S & TabStop и "Готов?"
S = S & TabStop & "Имя"
S = S & TabStop и "Система"
S = S & TabStop и "Космос"
S = S & TabStop и "Космос"
S = S & TabStop и "Космос"
S = S & TabStop и "Количество" и NewLine
"Разделительная линия.
S = S & String (105, "-") & NewLine
для каждого диска в приводах
S = S & Drive.DriveLetter
S = S & TabStop & Drive.Path
S = S & TabStop & ShowDriveType (Drive),
S = S & TabStop & Drive.IsReady
Если Drive.IsReady Затем
Если DriveTypeNetwork = Drive.DriveType Тогда
S = S & TabStop & Drive.ShareName
остальное
S = S & TabStop & Drive.VolumeName
End If
S = S & TabStop & Drive.FileSystem
S = S & TabStop & Drive.TotalSize
S = S & TabStop & Drive.FreeSpace
S = S & TabStop & Drive.AvailableSpace
S = S & TabStop & Hex (Drive.SerialNumber)
End If
S = S & NewLine
Следующая
GenerateDriveInformation = S
End Function
'''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
"GenerateFileInformation
Цель ':
'Создает строку, описывающую текущее состояние файла.
" Демонстрирует следующие
'- File.Path
'- File.Name
'- File.Type
'- File.DateCreated
'- File.DateLastAccessed
'- File.DateLastModified
'- File.Size
'''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''
Функция GenerateFileInformation (Файл)
Dim S
= S & NewLine "Путь:" & & TabStop File.Path
S = S & NewLine и "Name:" & & TabStop File.Name
S = S & NewLine и "Тип:" & & TabStop File.Type
S = S & NewLine и "Attribs:" & & TabStop ShowFileAttr (Файл)
S = S & NewLine и "Создано:" & & TabStop File.DateCreated
S = S & NewLine & "доступ:" & & TabStop File.DateLastAccessed
S = S & NewLine и "изменения:" & & TabStop File.DateLastModified
S = S & NewLine и "Размер" & & TabStop File.Size & NewLine
GenerateFileInformation = S
End Function
'' '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''
"GenerateFolderInformation
Цель ':
'Создает строку, описывающую текущее состояние папки.
" Демонстрирует следующие
'- Folder.Path
'- Folder.Name
'- Folder.DateCreated
'- Folder.DateLastAccessed
'- Folder.DateLastModified
'- Folder.Size
''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''
Функция GenerateFolderInformation (Folder)
Dim S
S = "Путь:" & & TabStop Folder.Path
S = S & NewLine и "Name:" & & TabStop Folder.Name
S = S & NewLine и "Attribs:" & TabStop И ShowFileAttr (Папка)
S = S & NewLine и "Создано:" & & TabStop Folder.DateCreated
S = S & NewLine и "доступ:" & & TabStop Folder.DateLastAccessed
S = S & NewLine и "изменения:" & & TabStop Folder.DateLastModified
S = S & NewLine и "Размер:" & & TabStop Folder.Size & NewLine
GenerateFolderInformation = S
End Function
'''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''
"GenerateAllFolderInformation
"Цель :
'генерирует строку, описывающую текущее состояние
"папку и все файлы и подпапки.
' Демонстрирует следующие
'- Folder.Path
'- Folder.SubFolders
'- Folders.Count
'''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''
Функция GenerateAllFolderInformation (Folder)
Dim S
Dim вложенные
подпапки Dim
Dim Файлы
Dim файла
S = "Папка:" & & TabStop Folder.Path & & NewLine NewLine
Установить Files = Folder.Files
Если 1 = Files.Count Тогда
S = S & "Существует один файл" & NewLine
остальное
S = S & " Есть "& & Files.Count" файлы "& NewLine
End If
Если Files.Count <> 0 Then
для каждого файла в файлы
S = S & GenerateFileInformation (Файл)
Следующая
End If
Установить Вложенные = Folder.SubFolders
Если 1 = подпапки. Затем граф
S = S & NewLine & "Существует 1 подпапку" & & NewLine NewLine
остальное
S = S & NewLine и "Есть" и SubFolders.Count и "подпапки" & & NewLine NewLine
End If
Если SubFolders.Count < > 0 Then
для каждой вложенной папки в подпапках
S = S & GenerateFolderInformation (подпапки)
Следующая
S = S & NewLine
для каждой вложенной папки в подпапках
S = S & GenerateAllFolderInformation (подпапки)
Следующая
End If
GenerateAllFolderInformation = S
End Function
''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''
"GenerateTestInformation
Цель ':
'Создает строку, описывающую текущее состояние C: \ Test
. папку и все файлы и подпапки
" Демонстрирует следующие
'- FileSystemObject.DriveExists
'- FileSystemObject.FolderExists
'-
GenerateTestInformation (FSO)
Dim TestFolder
Dim S
Если не FSO.DriveExists (TestDrive) Затем Exit Function
If Not FSO.FolderExists (TestFilePath) Затем Exit Function
TestFolder комплект = FSO.GetFolder (TestFilePath)
GenerateTestInformation = GenerateAllFolderInformation (TestFolder)
End Function
''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
"DeleteTestDirectory
'Цель:
'Очищает тест каталог.
" Демонстрирует следующие
'- FileSystemObject.GetFolder
'- FileSystemObject.DeleteFile
'- FileSystemObject.DeleteFolder
'- Folder.Delete
'- File.Delete
'''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''
Sub DeleteTestDirectory (FSO)
Dim TestFolder
Dim подпапку
Dim файлов
<A NAME="driveinfo"> </ A>
"Два способа удаления файла:
FSO.DeleteFile (TestFilePath & "\ LoremIpsum \ Paragraph1.txt")
Установить Файл = FSO.GetFile (TestFilePath & "\ LoremIpsum \ Paragraph2.txt")
File.Delete
"Два способа удалить папку:
FSO.DeleteFolder (TestFilePath & "\ LoremIpsum")
FSO.DeleteFile (TestFilePath & "\ ReadMe.txt")
Установить TestFolder = FSO.GetFolder (TestFilePath)
TestFolder.Delete
End Sub
''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''
"CreateLyrics
Цель ':
'строит пару текстовых файлов в папке.
" Демонстрирует следующие
'- FileSystemObject.CreateTextFile
'- TextStream.WriteLine
'- TextStream.Write
'- TextStream.WriteBlankLines
'- TextStream.Close
'''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateLyrics (Folder)
Dim TextStream
<A NAME="deletefile"> </ A>
Установить TextStream = Folder.CreateTextFile ("Paragraph1.txt")
<A NAME="createtextfilewritetofile"> </ A>
"Обратите внимание, что это не добавляет строки в файл.
TextStream.Write ("Lorem Ipsum - Пункт 1")
TextStream.WriteBlankLines (1)
TextStream.WriteLine (".. Lorem Ipsum боль сидеть Амет, consectetuer adipiscing элит Меценат сем")
TextStream.WriteLine ("Донец ... анте Nulla facilisi Phasellus interdum Nulla пипс Morbi laoreet пипс ").
TextStream.WriteBlankLines (2)
TextStream.Close
Установить TextStream = Folder.CreateTextFile ("Paragraph2.txt")
TextStream.WriteLine ("Lorem Ipsum - пункт 2" )
TextStream.WriteBlankLines (1)
TextStream.WriteLine ("Nullam Nulla quam, sollicitudin ут, lobortis ornare, tristique, augue").
TextStream.WriteLine ("преддверия сем Felis, fermentum ЕС, volutpat ЕС, vulputate eget, Элит". )
TextStream.WriteBlankLines (2)
TextStream.Close
Sub End
'''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''
"GetLyrics
Цель ':
'Отображение содержимого песни файлы.
' Демонстрирует следующие
'- FileSystemObject.OpenTextFile
'- FileSystemObject.GetFile
'- TextStream.ReadAll
'- TextStream.Close
'- File.OpenAsTextStream
'- TextStream.AtEndOfStream
'- TextStream.ReadLine
'''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''
Функция GetLyrics (FSO)
Dim TextStream
Dim S
Dim Файл
"Есть несколько способов открыть текстовый файл, а несколько
"способов чтения данных из файла. Вот два пути
", чтобы сделать каждый:
Установить TextStream = FSO.OpenTextFile (TestFilePath & "\ LoremIpsum \ Paragraph1.txt", OpenFileForReading)
<A NAME="closereadfromfile"> </ A>
S = TextStream.ReadAll & & NewLine NewLine
TextStream . Закрыть
Установить Файл = FSO.GetFile (TestFilePath & "\ LoremIpsum \ Paragraph2.txt")
Установить TextStream = File.OpenAsTextStream (OpenFileForReading)
Do While Not TextStream.AtEndOfStream
S = S & TextStream.ReadLine & NewLine
Loop
TextStream.Close
GetLyrics = S
End Function
''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''
"BuildTestDirectory
'Цель:
'Построение иерархии каталогов для демонстрации FileSystemObject.
' Мы будем строить иерархию в следующем порядке:
'C: \ Test
'C: \ Test \ ReadMe.txt
'C: \ Test \ LoremIpsum
'C: \ Test \ LoremIpsum \ Paragraph1.txt
'C: \ Test \ LoremIpsum \ Paragraph2.txt
'Демонстрирует следующие
'- FileSystemObject.DriveExists
'- FileSystemObject.FolderExists
'- FileSystemObject.CreateFolder
'- FileSystemObject.CreateTextFile
'- Folders.Add
'- Folder.CreateTextFile
'- TextStream.WriteLine
'- TextStream.Close
''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''
Функция BuildTestDirectory (FSO)
Dim TestFolder
Dim вложенные
подпапки Dim
Dim TextStream
"выручить, если (а) диск не существует, или если (б) каталог строится
'уже существует.
Если не FSO.DriveExists (TestDrive) Затем
BuildTestDirectory = False
Exit Функция
End If
Если FSO.FolderExists (TestFilePath) Затем
BuildTestDirectory = False
Exit Функция
End If
Установить TestFolder = FSO.CreateFolder (TestFilePath)
Установить TextStream = FSO.CreateTextFile (TestFilePath & "\ ReadMe.txt")
TextStream.WriteLine ("Мой образец текста коллекция")
TextStream.Close
Установить Вложенные = TestFolder.SubFolders
Установить подпапку = SubFolders.Add ("LoremIpsum")
CreateLyrics подпапку
BuildTestDirectory = True
End Функция
''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''
"основной программе
на первом месте ", он создает тестовый каталог, а также некоторые вложенные папки
и файлы. Затем, он сбрасывает информацию о доступных
"дисков, так и о тесте каталог, а затем очищает
"все снова.
'''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''
Sub Main
Dim FSO
"Настройка глобальных данных.
TabStop = Chr (9)
NewLine = Chr (10)
<A NAME="folderinfo"> </ A>
Установить FSO = CreateObject ("Scripting.FileSystemObject")
If Not BuildTestDirectory (FSO) Затем
Печать " Испытание каталог уже существует или не может быть создан. продолжаться не может. "
Exit Sub
End If
печати GenerateDriveInformation (FSO) & NewLine & NewLine
печати GenerateTestInformation (FSO) & NewLine & NewLine
печати GetLyrics (FSO) & NewLine & NewLine
DeleteTestDirectory (FSO)
End Sub
|
| |
| |
| |
| |
|
|
| | Так же по флешкам, много полезной ингформации тут + есть проги по восстановлению накопителей. | |
| |
| |
