Как проверить существует ли файл // папка

@Антихакер32 · Регистрация: 06.01.2014

Студворк — интернет-сервис помощи студентам

Как проверить существует ли файл // папка

Раньше я использовал библиотеку Scripting
и классы FileSystemObject (FSO) и Dictionary (Dic)
так вот, можно обойтись без них )

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
 
Public Function FileExists(ByVal PathName$) As Boolean
    'Возврат утверждения наличия файла
    On Error Resume Next
    FileExists = GetAttr(PathName) And Err = 0
End Function
 
Public Function FolderExists(ByVal PathName$) As Boolean
    'Возврат утверждения наличия папки
    On Error Resume Next
    FolderExists = GetAttr(PathName) And Err = 0
End Function

Проверить можно так:

Visual Basic
1
2
3
4
5
6
 Private Sub Form_Load()
    Dim s$
    s = Environ("homepath")
    MsgBox FolderExists(s)
    End
End Sub

@The trick · 21.01.2014, 11:43

Сообщение от FelixMacintosh

Спасибо The Trick, тоесть заместо Dir я могу смело воспользоваться Вашей DirW ?

Да, только я ее не отлаживал, могут глюки быть. Для определения (Файл/Папка), можно так сделать

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long
Public Function IsFolder(ByVal Path As String) As Boolean
    Dim l As Long
    Path = Trim(Path)
    l = GetFileAttributes(StrPtr(Path))
    IsFolder = CBool(l And vbDirectory) And (l <> -1)
End Function
Public Function IsFile(ByVal Path As String) As Boolean
    Dim l As Long
    Path = Trim(Path)
    l = GetFileAttributes(StrPtr(Path))
    IsFile = Not CBool(l And vbDirectory) And (l <> -1)
End Function

@Антихакер32 · 21.01.2014, 11:53 **[ТС]**

собсно можно комбинировать, гдето использовать Dir, гдето DirW )

Добавлено через 6 минут
вот часть модуля туда я сейчас вкручу DirW
мне собсно все команды из FileSustemObject и не надо у себя реализовывать
а только необходимые, всё-равно они скрытыми будут

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Option Explicit
DefStr J, S: DefLng F, L, N: DefBool B
'
'
'       © FelixMacintosh
'
'
Const r$ = "\", t$ = "."
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, lpFilePart As String) As Long
 
 
Public Function GetExtensionName$(FileName$)
    'Возвращает тип файла
    Dim j()
    On Error Resume Next
    If (GetAttr(FileName) And vbDirectory) = 0 Then
        j = Split(FileName, r)
        GetExtensionName = Split(j(UBound(j)), t)(1)
    End If
End Function
 
Public Function FileExists(ByVal FileName$) As Boolean
    'Возвращает утверждение что по указанному пути
    'находиться этот файл
    Dim n
    On Error Resume Next
    n = GetAttr(FileName)
    FileExists = (n And vbDirectory) = 0 And n
End Function
 
 
Public Function FolderExists(ByVal FolderName$) As Boolean
    'Возвращает утверждение что по указанному пути
    'находиться эта папка
    Dim n
    On Error Resume Next
    n = GetAttr(FolderName)
    FolderExists = n And vbDirectory
End Function
 
Public Function GetAbsolutePathName$(ByVal Path$, Optional ByVal CurDir_$)
    'Возвращает абсолютный путь
    Dim numchar
    On Error Resume Next
    If Len(CurDir_) Then CurDir CurDir_
    GetAbsolutePathName = Space(255)  ' создаем место для приема строки
    numchar = GetFullPathName(Path, 255, GetAbsolutePathName, "") ' помещаем строку в буфер
    GetAbsolutePathName = Left(GetAbsolutePathName, numchar)  ' извлекаем имя файла
End Function
 
Public Function GetParentFolderName$(ByVal Path$)
    'Возвращает родительскую папку
    Dim j()
    j = Split(GetAbsolutePathName(Path), r)
    ReDim Preserve j(UBound(j) - 1)
    GetParentFolderName = Join(j, r)
End Function

@The trick · 21.01.2014, 12:03

Сообщение от FelixMacintosh

собсно можно комбинировать, гдето использовать Dir, гдето DirW )

Смысл комбинировать? Dir вызывает все теже функции, что и DirW, только с суффиксом A (ANSI). Я тебе писал уже, что все ANSI версии вызывают юникодные версии функций, только преобразуют ANSI строки в юникод. В случае с VB получается вообще куча лишних действий Unicode->ANSI, потом внутри функции ANSI->Unicode, потом вызов функции с суффиксом W, потом заполнение WIN32_FIND_DATA юникодными значениями, потом перекодировка UNICODE->ANSI, возврат в VB, перекодировка ANSI-> Unicode. Не имеет смысл делать столько лишнего, когда можно сразу в юникоде работать, тем более это родной строковой формат VB6. Если делаешь программу, которая поддерживает юникод (любая нормальная программа), то работай с юникодом всегда.

Добавлено через 8 минут
Зачем использовать тяжелые (тяжеленные) функции Split, Join, когда можно сделать все элементарно? Это тоже самое что подключать DirectX для того чтобы сложить два числа. Твой модуль не работает с юникодом, уж тогда используй FSO, он работает с юникодом.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Public Function GetFileTitle(Path As String, Optional UseExtension As Boolean = False) As String
    Dim L As Long, P As Long
    L = InStrRev(Path, "\")
    If UseExtension Then P = Len(Path) + 1 Else P = InStrRev(Path, ".")
    If P > L Then
        L =  L + 1
        GetFileTitle = Mid$(Path, L, P - L)
    ElseIf P = L Then
        GetFileTitle = Path
    Else
        GetFileTitle = Mid$(Path, L + 1)
    End If
End Function
Public Function GetFilePath(Path As String) As String
    Dim L As Long, P As Long
    L = InStrRev(Path, "\")
    If L = Len(Path) Or L = 0 Then GetFilePath = Path: Exit Function
    GetFilePath = Mid$(Path, 1, L)
End Function

GetFullPathName принимает строку MAX_PATH символов, а не 255

@Антихакер32 · 21.01.2014, 12:07 **[ТС]**

Сообщение от The trick

то работай с юникодом всегда.

...Постараюсь )
тут такое дело, что в моём мененджере API, не отображаются
некоторые юникодные команды с суфиксом W тоесть, поэтому я и не знаю
некоторых тонкостей...

@The trick · 21.01.2014, 12:09

Сообщение от FelixMacintosh

некоторые юникодные команды с суфиксом W тоесть, поэтому я и не знаю

Они у тебя отображаются с суффиксом A, меняй на W и меняй типы данных, как - я тебе писал уже.

@Антихакер32 · 21.01.2014, 12:12 **[ТС]**

текст у меня тут
C:\Program Files\Microsoft Visual Studio\Common\Tools\Winapi\WIN32API.TXT

возможно у вас новее

@The trick · 21.01.2014, 12:22

Сообщение от FelixMacintosh

текст у меня тут C:\Program Files\Microsoft Visual Studio\Common\Tools\Winapi\WIN32API.TXT возможно у вас новее

Это не имеет значения

@Антихакер32 · 21.01.2014, 20:39 **[ТС]**

длина 653 kb

Добавлено через 1 минуту

Сообщение от The trick

Это не имеет значения

тогда буду вручную менять, только бы не заглючило....

Добавлено через 7 часов 46 минут
Зацени The Trick всё ли правильно сделал ?
не опазорюсь ли ?

Модул.bas

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
Option Explicit
DefStr J, S: DefLng F, L, N: DefBool B
'
'   Файловый модуль (© FelixMacintosh)
'
 '--------------------------[Константы]
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const MAX_PATH = 260
Public Enum F_ReCod
    [Binary To Unicode] = 1
    [Unicode To Binary] = 2
    [Char To Oem] = 4
    [Oem To Char] = 8
End Enum
Private Const r$ = "\", t$ = "."
 '--------------------------[Типы]
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    lpszFileName(MAX_PATH) As Integer
    lpszAlternate(14) As Integer
End Type
 
 '--------------------------[Api Функции]
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" (ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, lpFilePart As String) As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
 
Public Function GetParentFolderName$(ByVal Path$)
    'Возвращает родительскую папку
    Dim L As Long, P As Long
    L = InStrRev(Path, r)
    If L = Len(Path) Or L = 0 Then GetParentFolderName = Path: Exit Function
    GetParentFolderName = Mid$(Path, 1, L - 1)
End Function
 
Public Function FolderExists(ByVal FolderName$) As Boolean
    'Возвращает утверждение что по указанному пути
    'находиться эта папка
    On Error Resume Next
    FolderExists = Len(DirW(FolderName)) = 0 And Len(DirW(FolderName, vbDirectory))
End Function
 
Public Function GetAbsolutePathName$(ByVal Path$, Optional ByVal CurDir_$) '***
    'Возвращает абсолютный путь
    Dim numchar
    On Error Resume Next
    If Len(CurDir_) Then CurDir CurDir_
    GetAbsolutePathName = Space(MAX_PATH)  ' создаем место для приема строки
    numchar = GetFullPathName(Path, MAX_PATH, GetAbsolutePathName, "") ' помещаем строку в буфер
    GetAbsolutePathName = Left(GetAbsolutePathName, numchar)  ' извлекаем имя файла
End Function
 
Public Function FileExists(ByVal FileName$) As Boolean '***
    'Возвращает утверждение что по указанному пути
    'находиться этот файл
    On Error Resume Next
    FileExists = Len(DirW(FileName))
End Function
 
Public Function GetExtensionName$(FileName$) '***
    'Возвращает тип файла
    Dim s
    On Error Resume Next
    If Len(DirW(FileName)) Then
        If Err = 52 Then
            GetExtensionName = Mid$(FileName, InStrRev(FileName, t) + 1)
            Exit Function
        End If
        s = DirW(FileName, vbDirectory)
        GetExtensionName = Mid$(s, InStrRev(s, t) + 1)
    End If
End Function
 
Public Function DirW(Optional ByVal Path As String, Optional Flags As VbFileAttribute = vbNormal) As String
    '
    '   Диссасемблированная DIR + поддержка юникода (© The Trick)
    '
    Dim fd As WIN32_FIND_DATA, lpStr As Long, lRet As Long, L As Long
    Static hFind As Long, lFlags As VbFileAttribute
    
    If hFind <> 0 And Len(Path) = 0 Then
        If FindNextFile(hFind, fd) = 0 Then FindClose hFind: hFind = 0: Exit Function
    Else
        If hFind Then FindClose hFind: hFind = 0
        Path = Trim(Path)
        lFlags = Flags
        lpStr = StrPtr(Path)
        Select Case Right$(Path, 1)
        Case r, ":", "/"
            Path = Path & "*.*"
        End Select
        hFind = FindFirstFile(StrPtr(Path), fd)
        If hFind = INVALID_HANDLE_VALUE Then hFind = 0: Err.Raise 52: Exit Function
    End If
 
    L = ((fd.dwFileAttributes = FILE_ATTRIBUTE_NORMAL) + 1) * fd.dwFileAttributes
    L = L And (Not lFlags)
    L = L And &H16&
    
    Do While L
        If FindNextFile(hFind, fd) = 0 Then FindClose hFind: hFind = 0: Exit Function
        L = ((fd.dwFileAttributes = FILE_ATTRIBUTE_NORMAL) + 1) * fd.dwFileAttributes
        L = L And (Not lFlags)
        L = L And &H16&
    Loop
    
    lpStr = VarPtr(fd.dwReserved1) + 4
    L = lstrlen(lpStr)
    DirW = String$(L, vbNullChar)
    lRet = StrPtr(DirW)
    lstrcpy lRet, lpStr
End Function
 
Public Function GetFileTitle(Path As String, Optional UseExtension As Boolean = False) As String
    '
    ' Возврат базового имени
    '
    Dim L As Long, P As Long
    L = InStrRev(Path, r)
    If UseExtension Then P = Len(Path) + 1 Else P = InStrRev(Path, t)
    If P > L Then
        L = L + 1
        GetFileTitle = Mid$(Path, L, P - L)
    ElseIf P = L Then
        GetFileTitle = Path
    Else
        GetFileTitle = Mid$(Path, L + 1)
    End If
End Function
 
Public Function ReCod(ByVal Bytes As String, Optional ByVal Flag As F_ReCod) As Byte()
    'Перекодирование текста стандартами Windows
    'Bytes: Массив байт (Или текст)
    'Flag: Комбинируемые команды: [DOS to Windows] + [Binary to Unicode] ...
    While Flag > 0
        Select Case Flag
        Case Is >= [Oem To Char]
            Flag = Flag - [Oem To Char]
            Call OemToChar(Bytes, Bytes)
        Case Is >= [Char To Oem]
            Flag = Flag - [Char To Oem]
            Call CharToOem(Bytes, Bytes)
        Case Is >= [Unicode To Binary]
            Flag = Flag - [Unicode To Binary]
            Bytes = StrConv(Bytes, vbFromUnicode)
        Case Is >= [Binary To Unicode]
            Flag = Flag - [Binary To Unicode]
            Bytes = StrConv(Bytes, vbUnicode)
        End Select
    Wend
    ReCod = Bytes
End Function
 
Public Function WriteBytes&(Path$, ByVal Bytes As String, Optional ByVal Flag As F_ReCod, Optional ByVal Start& = 1, Optional Overwrite As Boolean)
    'Запись байт в файл
    'Арг: Путь // Массив байт (Или текст) // Флаг кодировки // Старт // Флаг перезаписи
    'Возврат: Следующая позиция записи (при успешном выполнении)
    Dim Byt() As Byte
    On Error GoTo ErrFile: If Overwrite Then Call Kill(Path)
ErrFile:
    Open Path For Binary As #1
    If Flag Then Byt = ReCod(Bytes, Flag) Else Byt = Bytes
    If Start Then Else Start = 1
    Put #1, Start, Byt
    WriteBytes = Start + UBound(Byt) + 1
    Close #1
End Function
 
Public Function ReadBytes(Path$, Optional ByVal Flag As F_ReCod, Optional ByRef Start&, Optional ByVal Dln&) As Byte()
    'Чтение байт из файла
    'Арг: Путь // Флаг кодировки // Старт // Длина
    'Возврат: Массив байт
    Dim n&
    Open Path For Binary As #1
    On Error Resume Next
    If Start Then Else Start = 1
    n = LOF(1) - Start + 1
    If Dln = 0 Or Dln > n Then Dln = n
    ReDim Preserve ReadBytes(Dln - 1)
    Get #1, Start, ReadBytes
    If Flag Then ReadBytes = ReCod(ReadBytes, Flag)
    Start = Start + UBound(ReadBytes) + 1
    Close #1
End Function

@The trick · 21.01.2014, 20:48

GetFullPathNameA, OemToCharA, CharToOemA
FolderExists - вообще непонятно как работает? Она будет и при файле возвращать True
В GetAbsolutePathName по-хорошему надо назад вернуть путь и исправить на юникод.
Кстати в DirW надо пофиксить генерацию исключения

Visual Basic
1
2
3
4
        If hFind = INVALID_HANDLE_VALUE Then
            If (Err.LastDllError - 2) > 10 Then hFind = 0: Err.Raise 52
            Exit Function
        End If

GetExtensionName - может возвратить неверный результат, если в названии папки будет точка, а в файле не будет расширения.
Вместо #1, надо писать свободный номер. Вдруг у меня уже открыт файл?

@Антихакер32 · 22.01.2014, 16:24 **[ТС]**

Сообщение от The trick

GetExtensionName - может возвратить неверный результат

я как-раз на папку с точкой тоже проверял всё норм ...создал папку Te.mp

переделал всё что мог

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
Option Explicit
DefStr J, S: DefLng F, I, L, N: DefBool B
'
'   Файловый модуль (© FelixMacintosh)
'
 '--------------------------[Константы]
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const MAX_PATH = 260
Public Enum F_ReCod
    [Binary To Unicode] = 1
    [Unicode To Binary] = 2
    [Char To Oem] = 4
    [Oem To Char] = 8
End Enum
Private Const r$ = "\", t$ = "."
 '--------------------------[Типы]
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    lpszFileName(MAX_PATH) As Integer
    lpszAlternate(14) As Integer
End Type
 
 '--------------------------[Api Функции]
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
'Юникодные
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" (ByVal lpFileName As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameW" (ByVal lpFileName As Long, ByVal nBufferLength As Long, ByVal lpBuffer As Long, lpFilePart As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long
 
Public Function GetExtensionName$(ByVal FileName$) '***
    'Возвращает тип файла (расширение)
    Dim n
    n = GetFileAttributes(StrPtr(FileName))
    If n < 0 Or (n And vbDirectory) = 0 Then
        FileName = Mid$(FileName, InStrRev(FileName, r) + 1)
        n = InStrRev(FileName, t)
        If n Then GetExtensionName = Mid$(FileName, n + 1)
    End If
End Function
 
Public Function GetAbsolutePathName$(ByVal Path$, Optional ByVal ChD$) '***
    'Возвращает абсолютный путь
    'Арг: Путь // Относительная папка
    Dim n, s, l
    ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' '''    On Error Resume Next
    l = Len(ChD)
    If l Then
        s = CurDir$:  ChDir ChD: GoSub GetAPN: ChDir s
    Else
GetAPN:
        GetAbsolutePathName = Space(MAX_PATH)  ' создаем место для приема строки
        n = GetFullPathName(StrPtr(Path), MAX_PATH, StrPtr(GetAbsolutePathName), 0) ' помещаем строку в буфер
        GetAbsolutePathName = Left(GetAbsolutePathName, n)  ' извлекаем имя файла
        If l Then Return
    End If
End Function
 
Public Function GetParentFolderName$(ByVal Path$)
    'Возвращает родительскую папку
    Dim l As Long, P As Long
    l = InStrRev(Path, r)
    If l = Len(Path) Or l = 0 Then GetParentFolderName = Path: Exit Function
    GetParentFolderName = Mid$(Path, 1, l - 1)
End Function
 
Public Function FolderExists(ByVal FolderName$) As Boolean
    'Возвращает утверждение что по указанному пути
    'находиться эта папка
    Dim n
    n = GetFileAttributes(StrPtr(FolderName))
    If n >= 0 Then FolderExists = n And vbDirectory
End Function
 
Public Function FileExists(ByVal FileName$) As Boolean '***
    'Возвращает утверждение что по указанному пути
    'находиться этот файл
    Dim n
    n = GetFileAttributes(StrPtr(FileExists))
    If n >= 0 Then FileExists = (n And vbDirectory = 0) And n
End Function
 
Public Function DirW(Optional ByVal Path As String, Optional Flags As VbFileAttribute = vbNormal) As String
    '
    '   DIR + поддержка юникода (© The Trick)
    '
    Dim fd As WIN32_FIND_DATA, lpStr As Long, lRet As Long, l As Long
    Static hFind As Long, lFlags As VbFileAttribute
 
 
    If hFind <> 0 And Len(Path) = 0 Then
        If FindNextFile(hFind, fd) = 0 Then FindClose hFind: hFind = 0: Exit Function
    Else
        If hFind Then FindClose hFind: hFind = 0
        Path = Trim(Path)
        lFlags = Flags
        lpStr = StrPtr(Path)
        Select Case Right$(Path, 1)
        Case r, ":", "/"
            Path = Path & "*.*"
        End Select
        hFind = FindFirstFile(StrPtr(Path), fd)
        If hFind = INVALID_HANDLE_VALUE Then
            If (Err.LastDllError - 2) > 10 Then hFind = 0: Err.Raise 52
            Exit Function
        End If
    End If
 
    l = ((fd.dwFileAttributes = FILE_ATTRIBUTE_NORMAL) + 1) * fd.dwFileAttributes
    l = l And (Not lFlags)
    l = l And &H16&
 
    Do While l
        If FindNextFile(hFind, fd) = 0 Then FindClose hFind: hFind = 0: Exit Function
        l = ((fd.dwFileAttributes = FILE_ATTRIBUTE_NORMAL) + 1) * fd.dwFileAttributes
        l = l And (Not lFlags)
        l = l And &H16&
    Loop
 
    lpStr = VarPtr(fd.dwReserved1) + 4
    l = lstrlen(lpStr)
    DirW = String$(l, vbNullChar)
    lRet = StrPtr(DirW)
    lstrcpy lRet, lpStr
End Function
 
Public Function GetFileTitle(Path As String, Optional UseExtension As Boolean = False) As String
    '
    ' Возврат базового имени
    '
    Dim l As Long, P As Long
    l = InStrRev(Path, r)
    If UseExtension Then P = Len(Path) + 1 Else P = InStrRev(Path, t)
    If P > l Then
        l = l + 1
        GetFileTitle = Mid$(Path, l, P - l)
    ElseIf P = l Then
        GetFileTitle = Path
    Else
        GetFileTitle = Mid$(Path, l + 1)
    End If
End Function
 
Public Function WriteBytes&(ByVal Path$, ByVal Bytes As String, Optional ByVal Flag As F_ReCod = [Unicode To Binary], Optional ByVal Start& = 1, Optional Overwrite As Boolean)
    'Запись байт в файл
    'Арг: Путь // Массив байт (Или текст) // Флаг кодировки // Старт // Флаг перезаписи
    'Возврат: Следующая позиция записи (при успешном выполнении)
    Dim Byt() As Byte, ff
    Path = Trim(Path$)
    On Error GoTo ErrFile: If Overwrite Then Call Kill(Path)
    ff = FreeFile
    Open Path For Binary As #ff
    If Flag Then Byt = ReCod(Bytes, Flag) Else Byt = Bytes
    If Start Then Else Start = 1
    Put #ff, Start, Byt
    WriteBytes = Start + UBound(Byt) + 1
    Close #ff
    Exit Function
ErrFile:
    If Err = 53 Then Resume Next
    Err.Raise Err.Number
End Function
 
Public Function ReadBytes(Path$, Optional ByVal Flag As F_ReCod = [Binary To Unicode], Optional ByRef Start&, Optional ByVal Dln&) As Byte()
    'Чтение байт из файла
    'Арг: Путь // Флаг кодировки // Старт // Длина
    'Возврат: Массив байт
    Dim n, ff
    ff = FreeFile
    ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' '''    On Error Resume Next
    Open Path For Binary As #ff
    If Start Then Else Start = 1
    n = LOF(ff) - Start + 1
    If Dln = 0 Or Dln > n Then Dln = n
    ReDim Preserve ReadBytes(Dln - 1)
    Get #ff, Start, ReadBytes
    If Flag Then ReadBytes = ReCod(ReadBytes, Flag)
    Start = Start + UBound(ReadBytes) + 1
    Close #ff
End Function
 
Public Function ReCod(ByVal Bytes As String, Optional ByVal Flag As F_ReCod) As Byte()
    'Перекодирование текста стандартами Windows
    'Bytes: Массив байт (Или текст)
    'Flag: Комбинируемые команды: [Oem To Char] + [Binary to Unicode] ...
    While Flag > 0
        Select Case Flag
        Case Is >= [Oem To Char]
            Flag = Flag - [Oem To Char]
            Call OemToChar(Bytes, Bytes)
        Case Is >= [Char To Oem]
            Flag = Flag - [Char To Oem]
            Call CharToOem(Bytes, Bytes)
        Case Is >= [Unicode To Binary]
            Flag = Flag - [Unicode To Binary]
            Bytes = StrConv(Bytes, vbFromUnicode)
        Case Is >= [Binary To Unicode]
            Flag = Flag - [Binary To Unicode]
            Bytes = StrConv(Bytes, vbUnicode)
        End Select
    Wend
    ReCod = Bytes
End Function

Добавлено через 35 минут

Visual Basic
1
2
3
4
5
6
7
8
9
10
Private Sub Form_Load()
    '
    '   Проверочная запись и чтение
    '
    Dim s$
    s = Environ("homedrive") & Environ("homepath") & "\Рабочий стол\текст.txt"
    WriteBytes s, "Привет люди !"
    MsgBox ReadBytes(s)
    End
End Sub

Новые блоги и статьи Все статьи Все блоги /
ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .
Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .

@Антихакер32 1201 / 473 / 46 Регистрация: 06.01.2014 Сообщений: 1,797 Записей в блоге: 19
	21.01.2014, 12:12 [ТС]
	текст у меня тут C:\Program Files\Microsoft Visual Studio\Common\Tools\Winapi\WIN32API.TXT возможно у вас новее 0

Как проверить существует ли файл // папка

Решение