Akina
Вся программа
| Код |
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Const IDLE_PRIORITY_CLASS = &H40
Dim fso, otf, gf, otf2 As Object
Dim fso1 As New FileSystemObject
Dim sourceDir, FileTreeFileName As String
Dim msg
Dim ConfFile, ResultFile, ResultDir As String
Dim confFileExist As Boolean
Dim fold As Object
Dim vfile As Object
Dim vdir As Object
Dim dirListStatus As String
Dim permissionFile As Boolean
Dim retval As Integer
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As _
Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As _
Long) As Long
Public Enum Priority
IDLE_PRIORITY_CLASS = &H40
NORMAL_PRIORITY_CLASS = &H20
HIGH_PRIORITY_CLASS = &H80
REALTIME_PRIORITY_CLASS = &H100
End Enum
Public Sub SetPriority(pParam As Priority)
SetPriorityClass GetCurrentProcess(), pParam
End Sub
Private Sub Form_Load()
SetPriority (IDLE_PRIORITY_CLASS)
ConfFile = "filetree.ini"
confFileExist = ReadConfFile()
'ResultFile = ResultDir & "\" & FileTreeFileName
ResultFile = ResultDir & FileTreeFileName
On Error GoTo CheckError ' Turn on error handling.
If confFileExist And fso.FolderExists(ResultDir) Then
Set otf2 = fso.OpenTextFile(ResultFile, ForWriting, True)
WriteListDir
otf2.Close
Else
'msg = MsgBox("Файл resultDir" & fso.FolderExists(ResultDir) & " существует", vbInformation, "Результат")
End If
CheckError:
permissionFile = PermissionAccess()
End
End Sub
Public Function ReadConfFile() As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(ConfFile)) Then
Set otf = fso.OpenTextFile(ConfFile, ForReading, True)
Set gf = fso.GetFile(ConfFile)
If gf.Size > 0 Then
sourceDir = SelectString(otf, True)
ResultDir = SelectString(otf, True)
FileTreeFileName = SelectString(otf, False)
'FileTreeFileName = SelectString(9)
'otf.Skip (12)
'ResultDir = otf.ReadLine()
'otf.Skip (9)
'FileTreeFileName = otf.ReadLine()
'msg = MsgBox("Файл sFile" & ConfFile & " существует", vbInformation, "Результат")
ReadConfFile = True
'msg = MsgBox("Файл " & ConfFile & " нормальный", vbInformation, "Результат")
Else
'msg = MsgBox("Файл " & ConfFile & " пустой", vbInformation, "Результат")
ReadConfFile = False
End If
otf.Close
Else
'msg = MsgBox("Файл " & ConfFile & " не найден", vbInformation, "Результат")
End If
End Function
Public Sub WriteListDir()
If fso.FolderExists(sourceDir) Then
Set fold = fso.GetFolder(sourceDir)
otf2.Write "Файлы в " & sourceDir & vbCrLf
dirListStatus = FileTree(fold)
'otf2.Close
Else
'msg = MsgBox("Папка " & sFile & " не найдена", vbInformation, "Результат")
End If
End Sub
Public Function PermissionAccess() As Boolean
Const conErrPermissionDenied = 70
If (Err.Number = conErrPermissionDenied) Then
PermissionAccess = False
'msg = MsgBox("Файл " & ResultFile & " не доступен", vbInformation, "Результат")
Else
'msg = MsgBox("Файл " & ResultFile & " доступен", vbInformation, "Результат")
PermissionAccess = True
End If
End Function
Public Function ListFile(ByRef folder As Object) As String
For Each vfile In folder.Files
otf2.Write Chr(124) + String(6, 151) + Chr(62)
otf2.Write (vfile.Name) & vbCrLf
Next
End Function
Public Function FileTree(ByVal fold1 As folder) As String
'Public Function FileTree(ByVal fold1 As object) As String
For Each vdir In fold1.SubFolders
otf2.Write Chr(124) + String(3, 151) + Chr(62)
otf2.Write UCase(vdir.Name) & vbCrLf
FileTree = FileTree(vdir)
Next
msg = ListFile(fold1)
End Function
Public Function SelectString(ByVal openReadConf As Object, ByVal CheckSlash As Boolean) _
As String
Dim valTemp As String
Dim position As Integer
valTemp = openReadConf.ReadLine()
position = InStr(1, valTemp, "=", vbTextCompare)
valTemp = Right(valTemp, Len(valTemp) - position)
'MsgBox valTemp
If Right(valTemp, 1) <> "\" And CheckSlash Then
SelectString = valTemp + "\"
Else
SelectString = valTemp
End If
End Function
|
|
