Форум программистов, компьютерный форум, киберфорум
Наши страницы

Visual Basic

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 2, средняя оценка - 5.00
Catstail
Модератор
22989 / 11355 / 1849
Регистрация: 12.02.2012
Сообщений: 18,592
08.12.2016, 15:38 #181
А вот мой вариант вычисления определителя и решения системы уравнений методом Крамера:

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
Private Sub CommandButton1_Click()
      Clear_All
End Sub
 
Private Sub CommandButton2_Click()
      Calc
End Sub
 
'::: Все стереть
 
Sub Clear_All()
 
    Range("C5:L14").Select
    Selection.ClearContents
    
    Range("N5:N14").Select
    Selection.ClearContents
     
    Range("P5:P14").Select
    Selection.ClearContents
     
    Range("C16:C28").Select
    Selection.ClearContents
     
    Range("C5").Select
 
End Sub
 
'::: Решить систему
 
Sub Calc()
 
Dim A() As Double
Dim Y() As Double
Dim R() As Double
Dim flg As Boolean
 
    n% = Range("A3")
    
    '::: Выделяем память
    
    ReDim A(1 To n%, 1 To n%) As Double
    ReDim Y(1 To n%) As Double
    ReDim R(1 To n%) As Double
 
    '::: Загружаем
    
    For i% = 1 To n%
        Y(i%) = Cells(4 + i%, 14).Value
        For j% = 1 To n%
            A(i%, j%) = Cells(4 + i%, 2 + j%).Value
        Next j%
    Next i%
 
    '::: Решаем
 
    Range("P5:P14").Select
    Selection.ClearContents
     
    Range("C16:C28").Select
    Selection.ClearContents
 
    Kramer A, Y, R, flg
 
    If flg Then
    
       For i% = 1 To n%
           Cells(i% + 4, 16).Value = R(i%)
       Next i%
        
    Else
    
       Cells(17, 3).Value = "Решений нет"
        
    End If
 
End Sub
 
Sub Kramer(A() As Double, Y() As Double, R() As Double, flgRes As Boolean)
 
Dim T() As Double
    
    ooo% = 16
    
    n% = UBound(Y, 1)
    D_Main# = Det(A)
    
    Cells(ooo%, 3).Value = "Det-0=" & Format$(D_Main, "0.00000E+")
    
    If Abs(D_Main) <= 0.0000000001 Then
       flgRes = False
       Exit Sub
    End If
    
    ReDim T(1 To n%, 1 To n%) As Double
    
    For ii% = 1 To n%
    
        For i% = 1 To n%
            For j% = 1 To n%
                T(i%, j%) = A(i%, j%)
            Next j%
        Next i%
        
        For j% = 1 To n%
            T(j%, ii%) = Y(j%)
        Next j%
        
        Z# = Det(T)
        
        R(ii%) = Z# / D_Main#
        
        ooo% = ooo% + 1
        Cells(ooo%, 3).Value = "Det-" & CStr(ii%) & "=" & Format$(Z#, "0.00000E+")
        
    Next ii%
    
    flgRes = True
    
End Sub
 
Function Det(A() As Double) As Double
     n% = UBound(A, 1)
     If n% = 2 Then
        Det = A(1, 1) * A(2, 2) - A(1, 2) * A(2, 1)
     Else
        S# = 1
        For j% = 1 To n%
            Det = Det + A(1, j%) * Det(Minor(A(), 1, j%)) * S#
            S# = -S#
        Next j%
     End If
End Function
 
Function Minor(A() As Double, m As Integer, k As Integer) As Double()
Dim B() As Double
    nn% = UBound(A, 1)
    ReDim B(1 To nn% - 1, 1 To nn% - 1) As Double
    ii% = 1
    jj% = 1
    For i% = 1 To nn%
        For j% = 1 To nn%
            If i% <> m And j% <> k Then
               B(ii%, jj%) = A(i%, j%)
               jj% = jj% + 1
               If jj% > nn% - 1 Then
                  ii% = ii% + 1
                  jj% = 1
               End If
            End If
        Next j%
     Next i%
     Minor = B
End Function
 
Sub Test()
 
Dim A(1 To 4, 1 To 4) As Double
Dim Y(1 To 4)         As Double
Dim R(1 To 4)         As Double
Dim flg               As Boolean
 
    A(1, 1) = 1
    A(1, 2) = 1
    A(1, 3) = 1
    A(1, 4) = 1
    
    A(2, 1) = 2
    A(2, 2) = 1
    A(2, 3) = 2
    A(2, 4) = 1
    
    A(3, 1) = 0
    A(3, 2) = 1
    A(3, 3) = 3
    A(3, 4) = -2
    
    A(4, 1) = 7
    A(4, 2) = 1
    A(4, 3) = -1
    A(4, 4) = 5
    
    Y(1) = 0
    Y(2) = 2
    Y(3) = 4
    Y(4) = 0
 
 
 
    Kramer A, Y, R, flg
    
    If flg Then
    
       For i% = 1 To 4
           Debug.Print R(i%)
       Next i%
       
    Else
    
       Debug.Print "Решений нет!"
       
    End If
    
End Sub
2
Миниатюры
Готовые решения и полезные коды на Visual Basic 6.0  
Вложения
Тип файла: zip vba-21.zip (16.3 Кб, 5 просмотров)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
08.12.2016, 15:38
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Готовые решения и полезные коды на Visual Basic 6.0 (VB):

Продам готовые коды и решения на Visual Basic за 400 рублей - Visual Basic
душу продаю:cry: Продам коды исходные на VB !!10 лет копил за 400р !!размер тока кодов 312метров там есть все ! мыло контакты удалены....

Коды на Visual Basic - Visual Basic
Ребята всем привет,я начел изучать &quot;Visual Basic&quot;! Очень буду благодарен за коды по этому языку, очень интиресный язык)))! Бросайте сюда...

Вывод решения вместо Immediate в textbox (visual basic 6.0) - Visual Basic
программа выводит решение в Immediate а я хочу разместить на форме text1 и что бы решение выводилось туда ,менял код менял не че не...

Вычисление значений функции двух переменных в Visual Basic - Visual Basic - Visual Basic
Помогите пожалуйста! В среде VB написать программу вычисления значений функции двух переменных. Ориентировочный вид окна программы и...

Где бесплатно скачать учебник по Visual Basic 6 и Visual Basic .Net ? - Visual Basic
Где бесплатно скачать учебник по Visual Basic 6 и Visual Basic .Net

Visual Basic Используя условный оператор if…then, if…then…else или if…then…elseif, разработайте проект для решения следующих заданий: - Visual Basic
Пройдет ли кирпич со сторонами а, b и с сквозь прямоугольное отверстие со сторонами p и q? Стороны отверстия должны быть параллельны граням...

223
Catstail
Модератор
22989 / 11355 / 1849
Регистрация: 12.02.2012
Сообщений: 18,592
08.12.2016, 15:40 #182
А в дополнение - вычисление обратной матрицы (неоптимально, через определители):
1
Вложения
Тип файла: zip VBa-22.zip (15.1 Кб, 2 просмотров)
fever brain
oh my god
920 / 471 / 89
Регистрация: 05.01.2016
Сообщений: 1,405
Записей в блоге: 7
08.12.2016, 16:54 #183
Сетки, шахматы и PictureBox

Всем привет, натолкнулся на интересные ответы по работе с PictureBox
и вдохновился идеей объеденить в одной небольшой программе для демонстрации.
Вдохновители: The trick и Alex77755

Код программы (для модуля пустой формы)
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
Option Explicit
'
'Сетки и шахматы на VB6
'
Const r = 90
Dim WithEvents cb As CommandButton, WithEvents pb As PictureBox
Dim i&, j&, l&, t&, w&, h&, v
 
Private Sub Grid(ByVal sz&)
    '
    'Сетка
    '
    pb.Cls
    pb.DrawMode = vbCopyPen 
    pb.Scale (0, sz)-(sz, 0)
    For j = 0 To sz
        pb.Line (0, j)-(sz, j)
        pb.Line (j, 0)-(j, sz)
    Next
End Sub
 
Private Sub Chess(ByVal sz&)
    '
    'Шахматы
    '
    pb.Cls
    pb.DrawMode = vbInvert
    pb.Scale
    j = sz * 2
    For i = 0 To j
        pb.Line (0, pb.ScaleHeight / sz * i)-Step(pb.ScaleWidth, pb.ScaleHeight / j), vbBlack, BF
        pb.Line (pb.ScaleWidth / sz * i, 0)-Step(pb.ScaleWidth / j, pb.ScaleHeight), vbBlack, BF
    Next
End Sub
 
 
Private Sub cb_Click()
    Debug.Print cb.Name
    Const cc = 3
    Select Case Mid$(cb.Name, 3)
    Case 1: Grid 3
    Case 2: Grid 8
    Case 3: Grid 50
    Case 4: Chess 8 \ 2
    End Select
End Sub
 
Private Sub Form_Load()
    With Controls.Add("vb.PictureBox", "pb")
        a l, r, t, r, w, .Width * 5, h, .Width * 5: .Move l, t, w, h
            .AutoRedraw = 1:   .Visible = 1
    End With
    a l, r, t, t + h, i, 1
    For Each v In Array("Сетка 3x3", "Сетка 8x8", "Сетка 50x50", "Шахматы 8x8")
        With Controls.Add("vb.CommandButton", "cb" & i)
            a w, .Width * 1.2, h, .Height: .Move l, t, w, h: a l, l + w + r, i, i + 1
            .Caption = v: .Visible = 1
        End With
    Next
    ApplyFinalProp "Сетки и шахматы", r, r
End Sub
 
Private Sub ApplyFinalProp(Optional ByVal Caption$, Optional ByVal Left& = -1, Optional ByVal Top& = -1): Dim w&, h&
    For Each v In Me.Controls
        If v.Left + v.Width > w Then w = v.Left + v.Width
        If v.Top + v.Height > h Then h = v.Top + v.Height
    Next
    With Me
        .Width = w + (.Width - .ScaleWidth) + r: .Height = h + (.Height - .ScaleHeight) + r
        If Caption <> "" Then .Caption = Caption
        If Left >= 0 Then .Left = Left
        If Top >= 0 Then .Top = Top
    End With
End Sub
 
Private Sub cb_LostFocus(): LostFocus: End Sub
Private Sub pb_LostFocus(): LostFocus: End Sub
Private Sub EnCtrl(ByVal val&, ParamArray e()): For Each v In e: Controls(v).Enabled = val: Next: End Sub
Private Sub a(ParamArray e()): Dim i&: For i = 1 To UBound(e) Step 2: e(i - 1) = e(i): Next: End Sub
Private Sub Form_Activate(): Set pb = Controls("pb"): pb.SetFocus: End Sub
Private Sub LostFocus(): On Error Resume Next: Set pb = ActiveControl: Set cb = ActiveControl: End Sub
2
Миниатюры
Готовые решения и полезные коды на Visual Basic 6.0   Готовые решения и полезные коды на Visual Basic 6.0  
Вложения
Тип файла: rar Сетки и шахматы.rar (115.7 Кб, 7 просмотров)
fever brain
oh my god
920 / 471 / 89
Регистрация: 05.01.2016
Сообщений: 1,405
Записей в блоге: 7
13.01.2017, 08:41 #184
Добрый.
Спешу поделиться новостью.
В прошлый раз програмер меня раскритиковал за то что я не использую пароли.
Так вот. Нашел наконец немного времени и сделал все хорошо

ВНИМАНИЕ - дочитайте!, Ни в коем случае не запускайте эту прогу
ЕСЛИ вы не использовали первую версию, и не в первой версии свои аки

Дело в том что мое новое детище не будет разбираться чья версия, а просто перепишет файл
или не поймет его..... новая версия будет записывать этот файл: ..\Application Data\Accounts\Accounts.dat

Сделайте бэкаб!

Вы уже потираете руки ?
ИТАК
в новой версии использован иной интерфейс ListView !
иной способ хранения инфы (безструктурный >байтовый )
3. Возможность использования паролей
4. Бэкаб !
максимум функционала в простом интерфейсе (разрабатывал для блондинок)
и просто приятное глазу картинка (обратите внимание на кнопочки)

вот часть исходника.. эта инфа некритична в ней нет основных знаний ))

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
Private Sub SaveAccounts()
    Dim i&, j&, s$, ff&
    With ListView1
        For i = 1 To .ListItems.Count
            With .ListItems(i)
                If i > 1 Then s = s & RowDel
                s = s & .Text
                For j = 1 To .ListSubItems.Count
                     s = s & ColDel
                     s = s & .ListSubItems(j).Text
                Next
            End With
        Next
        s = Me.Tag & RowDel & s
        ''
        '
        '
        For i = 1 To Len(s) 'шифруем заданный текст и сохраняем его в засекреченном виде
            j = Asc(Mid$(s, i, 1)) - GenB(i Mod genMax)
            If j < 0 Then j = (j + 512) Mod 256
            Mid$(s, i, 1) = Chr(j)
        Next
        If Dir(FolderAccouns, vbDirectory) = vbNullString Then MkDir FolderAccouns
        On Error Resume Next
        Kill FolderAccouns & FileAc: ff = FreeFile
        Open FolderAccouns & FileAc For Binary As #ff: Put #ff, 1, s: Close #ff
    End With
End Sub
Извините что не выложу весь исходник, думаю понятно почему..
и извините что покалякал фламастером на картинке
если будут вопросы пишите в личку (программеру можно писать здесь )

Запустить можно не извлекая из архива..
2
Миниатюры
Готовые решения и полезные коды на Visual Basic 6.0  
Вложения
Тип файла: rar Accounts2.rar (818.7 Кб, 8 просмотров)
fever brain
oh my god
920 / 471 / 89
Регистрация: 05.01.2016
Сообщений: 1,405
Записей в блоге: 7
13.01.2017, 09:06 #185
Если будут еще пожелания, возможно в третьей версии зделаю так:
1 Заполняем базу как это было сказанно выше..
2 Начинаются чудеса! любой браузер даже после переустановки
может предложить экспорт из акаунтов )) тоесть из моей программы
Представьте свою забывчивую жену (подругу) у которой памяти <1 kb
естественно вспомнить старый пароль гдето там в InternetExploer будет непреодолимая задача ))
так вот, ей нужно будет знать только свой один единственный пароль
и после чего все браузеры будут ее помнить ... ... круто же ?
1
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
16.01.2017, 00:22  [ТС] #186
Класс математики битовых сдвигов

Содрал где-то у The Trick.
Добавил:
  • IDE-Safe (не падает при оставе в IDE)
  • Dword2Long - Преобразование беззнакового int (UINT, DWORD) в знаковое (VB-Long).
  • Получение HIWORD и LOWORD.
Мож, тоже кому пригодится.
А по битам там:
  • Shl - Логический сдвиг влево
  • Sal - Арифметический сдвиг влево
  • Shr - Логический сдвиг вправо
  • Sar - Арифметический сдвиг вправо
Dword2Long полезно, например, если нужно допустим сложить 30-й и 31-й биты, используя, скажем, такую запись:
Visual Basic
1
Debug.Print cMath.Dword2Long(2 ^ 30) Or cMath.Dword2Long(2 ^ 31)
Класс

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
'Bitwise math class by The Trick
'Forked by Dragokas
 
Option Explicit
 
Private Declare Function HeapCreate Lib "kernel32" (ByVal flOptions As Long, ByVal dwInitialSize As Long, ByVal dwMaximumSize As Long) As Long
Private Declare Function HeapDestroy Lib "kernel32" (ByVal hHeap As Long) As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Function GetMem4 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long
Private Declare Function GetMem2 Lib "msvbvm60" (pSrc As Any, pDst As Any) As Long
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (arr() As Any) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal ptrFc As Long, ByVal P1 As Long, ByVal P2 As Long, ByVal P3 As Long, ByVal P4 As Long) As Long
 
Private Const HEAP_CREATE_ENABLE_EXECUTE = &H40000
Private Const HEAP_NO_SERIALIZE = &H1
 
Dim Code() As Long, hHeap As Long, lpFunc As Long, lpOldPt As Long, lpSA As Long, inIDE As Boolean, isInit As Boolean
 
Private Sub Class_Initialize()
    inIDE = (App.LogMode = 0)
    If Not inIDE Then
        InitSh
    End If
End Sub
 
Private Sub Class_Terminate()
    DeinitSh
End Sub
 
Sub InitSh()  ' Инициализация процедур
    ReDim Code(4)
    hHeap = HeapCreate(HEAP_CREATE_ENABLE_EXECUTE Or HEAP_NO_SERIALIZE, (UBound(Code) + 1) * 4, (UBound(Code) + 1) * 4)
    If hHeap = 0 Then MsgBox "Error creating heap", vbCritical: Exit Sub
    lpFunc = HeapAlloc(hHeap, HEAP_NO_SERIALIZE, (UBound(Code) + 1) * 4)
    If lpFunc = 0 Then MsgBox "HeapAlloc return NULL", vbCritical: Exit Sub
    GetMem4 ByVal ArrPtr(Code()), lpSA
    GetMem4 ByVal lpSA + 12, lpOldPt
    GetMem4 lpFunc, ByVal lpSA + 12
    Code(0) = &H53E58955: Code(1) = &H8B08458B: Code(2) = &HD30C4D: Code(3) = &H5DEC895B: Code(4) = &HC3
    isInit = True
End Sub
 
Public Function DeinitSh() As Boolean   ' Деинициализация
    If isInit Then
        GetMem4 lpOldPt, ByVal lpSA + 12
        If lpFunc Then HeapFree hHeap, HEAP_NO_SERIALIZE, ByVal lpFunc: lpFunc = 0
        If hHeap Then HeapDestroy hHeap: hHeap = 0
        isInit = False
    End If
End Function
 
Public Function Shl(ByVal Operand As Long, ByVal Count As Long) As Long     ' Логический сдвиг влево
    If inIDE Then InitSh
    Code(2) = &HE0D30C4D
    Shl = CallWindowProc(VarPtr(Code(0)), Operand, Count, 0, 0)
    If inIDE Then DeinitSh
End Function
 
Public Function Sal(ByVal Operand As Long, ByVal Count As Long) As Long     ' Арифметический сдвиг влево
    Sal = Shl(Operand, Count)
End Function
 
Public Function Shr(ByVal Operand As Long, ByVal Count As Long) As Long     ' Логический сдвиг вправо
    If inIDE Then InitSh
    Code(2) = &HE8D30C4D
    Shr = CallWindowProc(VarPtr(Code(0)), Operand, Count, 0, 0)
    If inIDE Then DeinitSh
End Function
 
Public Function Sar(ByVal Operand As Long, ByVal Count As Long) As Long     ' Арифметический сдвиг вправо
    If inIDE Then InitSh
    Code(2) = &HF8D30C4D
    Sar = CallWindowProc(VarPtr(Code(0)), Operand, Count, 0, 0)
    If inIDE Then DeinitSh
End Function
 
Public Function Dword2Long(dword As Double) As Long
    If dword > 2147483647 Then
        Dword2Long = dword - 4294967296#
    Else
        Dword2Long = CLng(dword)
    End If
End Function
 
Public Function LOWORD(dwNum As Long) As Long
    GetMem2 dwNum, LOWORD
End Function
 
Public Function HIWORD(dwNum As Long) As Long
    GetMem2 ByVal VarPtr(dwNum) + 2, HIWORD
End Function
4
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
16.01.2017, 00:45  [ТС] #187
Проверка текста на наличие кодировки UTF-8 (без BOM) (альтернатива MLang)

Известно (а может кому и нет), что MLang весьма уныло определяет кодировку файла UTF-8 (если нету BOM).
Проще сказать, что эта задача ему не по зубам.

Этот код вручную ведёт поиск допустимых последовательностей сиволов UTF-8.
И если находит, в конце высчитывает % вероятности = кол-во подтверждённых UTF-8 / общее кол-во символов.

Функция возвращает Percent == -1, если вероятность 10 % (порог срабатывания по умолчанию).
Вы можете всё сами отрегулировать по желанию.

Сами понимаете, что если в файле только 1 UTF-8 символ из 1000, то тут нужно вам самим решать, что вы хотите, большую вероятность нахождения UTF-8 кодировки или меньшую вероятность ложных срабатываний.

В одной из своих програм я ставил порог >= 1%, но в ней перед детектом на UTF-8 я использую предварительный анализ на наличие BOM, а также нескольких кодировок по данным MLang, например, 1200 (UTF-16).

Код с примером чтения текста из файла

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
Option Explicit
 
Private Sub Form_Load()
    Dim ff          As Integer
    Dim cpPercent   As Long
    Dim CodePage    As Long
    Dim aBuf()      As Byte
    Dim sBuf        As String
    
    ff = FreeFile()
    Open "c:\testfile.txt" For Binary Access Read As #ff
        sBuf = String(LOF(ff), 0&)
        Get #ff, , sBuf
    Close #ff
    
    aBuf() = StrConv(sBuf, vbFromUnicode, &H419&)
    
    'cpPercent - % кол-ва последовательностей UTF-8 по отношению к общему числу символов
    CodePage = GetEncoding_UTF8(aBuf, cpPercent)
    
    If (cpPercent = -1 Or cpPercent > 50) Then
        Debug.Print "It's UTF-8."
    End If
    
    'если нужна большая вероятность, что мы распознаем текст, как UTF-8, можем выставить например, >= 1%
    'If (cpPercent = -1 Or cpPercent >= 1) Then
    'но тогда и вероятность ложного срабатывания будет выше
End Sub
 
Function GetEncoding_UTF8(aBytes() As Byte, Optional Percent As Long) As Long
    On Error GoTo ErrorHandler
    
    Dim c As Long, n As Long, i As Long, bSuccess As Boolean, btc As Long 'bytes to check
    
    Do
        '2-bytes seq.: 110x xxxx, 10xx xxxx (0xC0, 0x80)
        '              110...= 0xC0, 10...= 0x80
        '              111...= 0xE0, 11...= 0xC0
        
        '3-bytes seq.: 1110 xxxx, 10xx xxxx, 10xx xxxx (0xE0, 0x80, 0x80)
        '              111... = 0xE0
        '              1111...= 0xF0
        
        '4-bytes seq.: 1111 0xxx, 10xx xxxx, 10xx xxxx, 10xx xxxx (0xF0, 0x80, 0x80, 0x80)
        '              1111...  = 0xF0
        '              1111 1...= 0xF8
        
        btc = 0
        If ((aBytes(c) Xor &HC0) And &HE0) = 0 Then
            btc = 1
        ElseIf ((aBytes(c) Xor &HE0) And &HF0) = 0 Then
            btc = 2
        ElseIf ((aBytes(c) Xor &HF0) And &HF8) = 0 Then
            btc = 3
        End If
        
        If (btc > 0) And ((c + btc) <= UBound(aBytes)) Then
            bSuccess = True
            For i = c + 1 To c + btc
                If ((aBytes(c + 1) Xor &H80) And &HC0) <> 0 Then bSuccess = False: Exit For
            Next
            If bSuccess Then n = n + 1
        End If
        
        c = c + 1 + btc
        
    Loop Until c >= UBound(aBytes)
    
    Percent = n / UBound(aBytes) * 100& ' n - кол-во совпавших последовательностей
    
    If Percent > 10 Then Percent = -1: GetEncoding_UTF8 = 65001 'порог срабатывания выставлен на 10%
    
    Exit Function
ErrorHandler:
    Debug.Print Err; "Parser.GetEncoding_UTF8"
End Function
5
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
17.01.2017, 21:25  [ТС] #188
DirW() - замена стандартному VB Dir() с поддержкой юникода и доп. атрибутов.

Прототип: Dir$(Путь с маской или слешэм на конце, опц. Маска разрешённых атрибутов, опц. Возвращать только каталоги )

Утянул оригинал у The Trick. Он когда-то, как я понял, транслировал напрямую с отладчика, унаследуя все багофичи оригинала - VB Dir().
Если есть желание вернуть дефолтовое поведение, оставив как фичу только поддержку юникода, то: замените константу &H417 на &H16 и удалите обработчик ошибок.

У меня же:
Добавлена правильная обработка атрибута:
- только для чтения (vbReadOnly)
Добавлены атрибуты:
- точка повторной обработки (симлинки / соединения) (vbReparse)
- все объекты (vbAll)
- vbFile (только файлы, без папок)

Enum VbFileAttribute "перегружен" своим, в нём удалены все лишние атрибуты, которые все равно не используются в оригинальной Dir(), оставил только значимые.

+ 3 опциональный аргумент (FoldersOnly); если true, фильтрует файлы, оставляя в выводе только каталоги.
Также функция автоматом фильтрует папки-алиасы "." и ".."

Модуль modDirWideChar

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
Option Explicit
 
Private Const MAX_PATH = 260
 
Public Enum VbFileAttributeExtended
    vbAll = -1&
    vbDirectory = 16& ' mean - include folders also
    vbFile = vbAll And Not vbDirectory
    vbSystem = 4&
    vbHidden = 2&
    vbReadOnly = 1
    vbNormal = 0&
    vbReparse = 1024& 'symlinks / junctions (not include hardlink to file; they reflect attributes of the target)
End Enum
#If False Then
    Dim vbAll, vbFile, vbReparse 'case sensitive protection against modification (for non-overloaded enum variables only)
#End If
 
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-1) As Integer
    lpszAlternate(13) As Integer
End Type
 
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const INVALID_HANDLE_VALUE As Long = -1
 
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
 
 
Public Function DirW( _
    Optional ByVal PathMaskOrFolderWithSlash As String, _
    Optional AllowedAttributes As VbFileAttributeExtended = vbNormal, _
    Optional FoldersOnly As Boolean) As String
    
    On Error GoTo ErrorHandler
    
    'WARNING note:
    'Original VB Dir$ contains bug: ReadOnly attribute incorrectly handled, so it always is in results
    'This sub properly handles 'RO' and also contains one extra flag: FILE_ATTRIBUTE_REPARSE_POINT (vbReparse)
    'Doesn't return "." and ".." folders.
    'Unicode aware
    
    Const MeaningfulBits As Long = &H417&   'D + H + R + S + Reparse
                                            '(to revert to default VB Dir behaviour, replace it by &H16 value)
    
    Dim fd      As WIN32_FIND_DATA
    Dim lpStr   As Long
    Dim lRet    As Long
    Dim Mask    As Long
    
    Static hFind        As Long
    Static lflags       As VbFileAttributeExtended
    Static bFoldersOnly As Boolean
    
    If hFind <> 0& And Len(PathMaskOrFolderWithSlash) = 0& Then
        If FindNextFile(hFind, fd) = 0& Then FindClose hFind: hFind = 0&: Exit Function
    Else
        If hFind Then FindClose hFind: hFind = 0&
        PathMaskOrFolderWithSlash = Trim(PathMaskOrFolderWithSlash)
        lflags = AllowedAttributes 'cache
        bFoldersOnly = FoldersOnly 'cache
        
        Select Case Right$(PathMaskOrFolderWithSlash, 1&)
        Case "", ":", "/"
            PathMaskOrFolderWithSlash = PathMaskOrFolderWithSlash & "*.*"
        End Select
        
        hFind = FindFirstFile(StrPtr(PathMaskOrFolderWithSlash), fd)
        
        If hFind = INVALID_HANDLE_VALUE Then
            If (Err.LastDllError) > 12& Then hFind = 0&: Err.Raise 52&
            Exit Function
        End If
    End If
    
    Do
        If fd.dwFileAttributes = FILE_ATTRIBUTE_NORMAL Then
            Mask = 0& 'found
        Else
            Mask = fd.dwFileAttributes And (Not lflags) And MeaningfulBits
        End If
        If bFoldersOnly Then
            If Not CBool(fd.dwFileAttributes And vbDirectory) Then
                Mask = 1 'continue enum
            End If
        End If
    
        If Mask = 0 Then
            lpStr = VarPtr(fd.lpszFileName(0))
            DirW = String$(lstrlen(lpStr), 0&)
            lstrcpy StrPtr(DirW), lpStr
            If fd.dwFileAttributes And vbDirectory Then
                If DirW <> "." And DirW <> ".." Then Exit Do 'exclude self and relative paths aliases
            Else
                Exit Do
            End If
        End If
    
        If FindNextFile(hFind, fd) = 0 Then FindClose hFind: hFind = 0: Exit Function
    Loop
    
    Exit Function
ErrorHandler:
    Debug.Print Err; Err.Description; "DirW"
End Function

Примеры использования с пояснением:


Собственно, синтаксис стандартный для Dir() + 3-й опциональный аргумент.

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
Option Explicit
 
Private Sub Form_Load()
    Dim sFile$
    
    'Перечислить все файлы и папки (не-рекурсивно)
    sFile = DirW("c:\temp\test\", vbAll)
 
    Do While sFile <> ""
        Debug.Print sFile
        sFile = DirW$()
    Loop
    
    Stop: End
    ' перечислить только файлы (без каталогов)
    sFile = DirW("c:\temp\test\", vbFile)
    ' do ... loop
 
    ' перечислить только каталоги, исключить точки повторной обработки (символьные ссылки и соединения)
    ' это полезно, например, если вы строите рекурсию (защита от зацикливания на симлинках)
    sFile = DirW("c:\temp\test\", Not vbReparse, FoldersOnly:=True)
    ' do ... loop
 
    ' перечислить всё, кроме объектов с атрибутами "каталог", "только для чтения", "точка повторной обработки"
    sFile = DirW("c:\temp\test\", vbHidden Or vbSystem)
End Sub
4
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
17.01.2017, 21:53  [ТС] #189
MkDirW() - замена VB MkDir() с поддержкой юникода и созданием всей структуры подкаталогов, если промежуточные папки отсутствуют
IsFile, IsFolder - проверка, существует ли файл / папка, с поддержкой юникодных путей


Использование простое.
У MkDirW() есть доп. опциональный параметр. Всё должно быть ясно из комментариев.
Все функции поддерживают относительные пути.

Код

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
Option Explicit
 
Private Const MAX_PATH = 260
 
Private Const INVALID_HANDLE_VALUE As Long = -1
 
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryW" (ByVal lpPathName As Long, lpSecurityAttributes As Any) As Long
Private Declare Function GetCurrentDirectory Lib "kernel32" Alias "GetCurrentDirectoryW" (ByVal nBufferLength As Long, ByVal lpBuffer 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 <> INVALID_HANDLE_VALUE)
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 <> INVALID_HANDLE_VALUE)
End Function
 
Function MkDirW(ByVal Path As String, Optional ByVal LastComponentIsFile As Boolean = False) As Long
    ' Создает структуру каталогов
    ' LastComponentIsFile - является ли последний компонент указанного пути файлом ?
    ' Возвращаемое значение: true, если успех
    Dim FC As String, lr As Long, pos As Long
    If LastComponentIsFile Then Path = Left(Path, InStrRev(Path, "\") - 1) ' урезаю имя файла
    If InStr(Path, ":") = 0 Then 'относительный путь
        Dim sCurDir$, nChar As Long
        sCurDir = String$(MAX_PATH, 0&)
        nChar = GetCurrentDirectory(MAX_PATH + 1, StrPtr(sCurDir))
        sCurDir = Left$(sCurDir, nChar)
        If Right$(sCurDir, 1) <> "\" Then sCurDir = sCurDir & "\"
        Path = sCurDir & Path
    End If
    Do
        pos = pos + 1
        pos = InStr(pos, Path, "\")
        If pos Then FC = Left(Path, pos - 1) Else FC = Path
        lr = 1
        If Not IsFolder(FC) Then lr = CreateDirectory(StrPtr(FC), ByVal 0&)
    Loop While (pos <> 0) And (lr <> 0)
    MkDirW = lr
End Function
3
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
17.01.2017, 22:31  [ТС] #190
AppPathW(), AppExeNameW() - замена VB App.Path и App.Exename с поддержкой юникодных путей / имени файла.

Собсвенно, многие любят хранить рядом с программой всякие интересные вещи.
Но если юзеръ положит эту программу куда-то в папку, где есть хоть один символ за пределами ASCII, то будет долго кричать "не работает!!!", т.к. вы использовали у себя App.Path, а он с юникодом не работает.

Вообщем, кода под спойлером я написал дофига, но оно того стоит от чего и работает по-человечески на всех ОС (читай, соответствует VB-шному оригиналу).

В дополнение там есть функции GetWindowsDir() - здесь и так понятно, и GetDOSFilename() преобразует путь 8.3 в полный и в обратную сторону.
Пользуйтесь на здоровье

Синтаксис с доп. опциональным параметром-фичей:

'получить путь к исполняемому образу программы:
AppPathW( опц. добавлять к пути имя исполняемого файла? )

'получить имя исполняемого образа программы:
AppExeNameW( опц. дописывать к имени файла его расширение? )

Функции умеют корректно отображать расширение имени образа, если оно отличается от .exe.

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

Модуль
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
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
Option Explicit
 
Const MAX_PATH      As Long = 260&
Const MAX_PATH_W    As Long = 32767&
 
Private Type OSVERSIONINFOEX
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion(255) As Byte
    wServicePackMajor As Integer
    wServicePackMinor As Integer
    wSuiteMask As Integer
    wProductType As Byte
    wReserved As Byte
End Type
 
Private Declare Function GetModuleFileName Lib "kernel32.dll" Alias "GetModuleFileNameW" (ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleW" (ByVal lpModuleName As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryW" (ByVal lpBuffer As Long, ByVal uSize As Long) As Long
Private Declare Function GetLongPathName Lib "kernel32.dll" Alias "GetLongPathNameW" (ByVal lpszShortPath As Long, ByVal lpszLongPath As Long, ByVal cchBuffer As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameW" (ByVal lpszLongPath As Long, ByVal lpszShortPath As Long, ByVal cchBuffer As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExW" (lpVersionInformation As OSVERSIONINFOEX) As Long
 
Private Const VER_NT_WORKSTATION        As Long = 1&
 
Public Function AppPathW(Optional bGetFullPath As Boolean) As String
    On Error GoTo ErrorHandler
 
    Static ProcPathFull  As String
    Static ProcPathShort As String
    Dim ProcPath As String
    Dim Cnt      As Long
    Dim hProc    As Long
    Dim pos      As Long
    Dim inIDE    As Boolean
    
    'Cache
    If bGetFullPath Then
        If Len(ProcPathFull) <> 0 Then
            AppPathW = ProcPathFull
            Exit Function
        End If
    Else
        If Len(ProcPathShort) <> 0 Then
            AppPathW = ProcPathShort
            Exit Function
        End If
    End If
 
    inIDE = (App.LogMode = 0)
 
    If inIDE Then
        AppPathW = GetDOSFilename(App.Path, bReverse:=True)
        'bGetFullPath does not supported in IDE
        Exit Function
    End If
 
    hProc = GetModuleHandle(0&)
    If hProc < 0 Then hProc = 0
 
    ProcPath = String$(MAX_PATH, vbNullChar)
    Cnt = GetModuleFileName(hProc, StrPtr(ProcPath), Len(ProcPath)) 'hproc can be 0 (mean - current process)
    
    If Cnt = MAX_PATH Then 'Path > MAX_PATH -> realloc
        ProcPath = Space$(MAX_PATH_W)
        Cnt = GetModuleFileName(hProc, StrPtr(ProcPath), Len(ProcPath))
    End If
    
    If Cnt = 0 Then                          'clear path
        ProcPath = App.Path
    Else
        ProcPath = Left$(ProcPath, Cnt)
        If StrComp("\SystemRoot\", Left$(ProcPath, 12), 1) = 0 Then ProcPath = GetWindowsDir() & Mid$(ProcPath, 12)
        If "\??\" = Left$(ProcPath, 4) Then ProcPath = Mid$(ProcPath, 5)
        
        If Not bGetFullPath Then
            ' trim to path
            pos = InStrRev(ProcPath, "\")
            If pos <> 0 Then ProcPath = Left$(ProcPath, pos - 1)
        End If
    End If
    
    ProcPath = GetDOSFilename(ProcPath, bReverse:=True)     '8.3 -> to Full
    
    AppPathW = ProcPath
    
    If bGetFullPath Then
        ProcPathFull = ProcPath
    Else
        ProcPathShort = ProcPath
    End If
    Exit Function
ErrorHandler:
    Debug.Print Err; "Parser.AppPath"; "ProcPath:"; ProcPath
    'If inIDE Then Stop: Resume Next
End Function
 
Public Function AppExeNameW(Optional WithExtension As Boolean) As String
    On Error GoTo ErrorHandler
 
    Static ProcPathShort As String
    Static ProcPathFull  As String
    Dim ProcPath As String
    Dim Cnt      As Long
    Dim hProc    As Long
    Dim pos      As Long
    Dim inIDE    As Boolean
 
    'Cache
    If WithExtension Then
        If Len(ProcPathFull) <> 0 Then
            AppExeNameW = ProcPathFull
            Exit Function
        End If
    Else
        If Len(ProcPathShort) <> 0 Then
            AppExeNameW = ProcPathShort
            Exit Function
        End If
    End If
 
    inIDE = (App.LogMode = 0)
 
    If inIDE Then
        AppExeNameW = App.EXEName & IIf(WithExtension, ".exe", "")
        Exit Function
    End If
 
    hProc = GetModuleHandle(0&)
    If hProc < 0 Then hProc = 0
 
    ProcPath = String$(MAX_PATH, vbNullChar)
    Cnt = GetModuleFileName(hProc, StrPtr(ProcPath), Len(ProcPath)) 'hproc can be 0 (mean - current process)
    
    If Cnt = MAX_PATH Then 'Path > MAX_PATH -> realloc
        ProcPath = Space$(MAX_PATH_W)
        Cnt = GetModuleFileName(hProc, StrPtr(ProcPath), Len(ProcPath))
    End If
    
    If Cnt = 0 Then                          'clear path
        ProcPath = App.EXEName & IIf(WithExtension, ".exe", "")
    Else
        ProcPath = Left$(ProcPath, Cnt)
        
        pos = InStrRev(ProcPath, "\")
        If pos <> 0 Then ProcPath = Mid$(ProcPath, pos + 1)
        
        If Not WithExtension Then
            ProcPath = GetFileName(ProcPath)
        End If
    End If
    
    AppExeNameW = ProcPath
    
    If WithExtension Then
        ProcPathFull = ProcPath
    Else
        ProcPathShort = ProcPath
    End If
    
    Exit Function
ErrorHandler:
    Debug.Print Err; "Parser.AppExeName"; "ProcPath:"; ProcPath
    'If inIDE Then Stop: Resume Next
End Function
 
'if short name is unavailable, it returns source string anyway
Public Function GetDOSFilename$(sFile$, Optional bReverse As Boolean = False)
    'works for folders too btw
    Dim Cnt&, sBuffer$
    If bReverse Then
        sBuffer = Space$(MAX_PATH_W)
        Cnt = GetLongPathName(StrPtr(sFile), StrPtr(sBuffer), Len(sBuffer))
        If Cnt Then
            GetDOSFilename = Left$(sBuffer, Cnt)
        Else
            GetDOSFilename = sFile
        End If
    Else
        sBuffer = Space$(MAX_PATH)
        Cnt = GetShortPathName(StrPtr(sFile), StrPtr(sBuffer), Len(sBuffer))
        If Cnt Then
            GetDOSFilename = Left$(sBuffer, Cnt)
        Else
            GetDOSFilename = sFile
        End If
    End If
End Function
 
Public Function GetWindowsDir() As String
    Static SysRoot As String
    Static IsInit As Boolean
    Dim lr As Long
    Dim osi As OSVERSIONINFOEX
    
    If IsInit Then
        GetWindowsDir = SysRoot
        Exit Function
    End If
    
    IsInit = True
    GetVersionEx osi
    
    If osi.wProductType = VER_NT_WORKSTATION Then
        SysRoot = String$(MAX_PATH, 0&)
        lr = GetWindowsDirectory(StrPtr(SysRoot), MAX_PATH)
        If lr Then
            SysRoot = Left$(SysRoot, lr)
        Else
            SysRoot = Environ$("SystemRoot")
        End If
    Else
        SysRoot = Environ$("SystemRoot") 'avoid path virtualization on Windows Server with Terminal Services
    End If
    GetWindowsDir = SysRoot
End Function
 
' Получить только имя файла (без расширения имени)
Public Function GetFileName(Path As String) As String
    Dim posDot      As Long
    Dim posSl       As Long
    
    posSl = InStrRev(Path, "\")
    If posSl <> 0 Then
        posDot = InStrRev(Path, ".")
        If posDot < posSl Then posDot = 0
    Else
        posDot = InStrRev(Path, ".")
    End If
    If posDot = 0 Then posDot = Len(Path) + 1
    
    GetFileName = Mid$(Path, posSl + 1, posDot - posSl - 1)
End Function
Пример использования:
Visual Basic
1
2
3
4
5
6
Private Sub Form_Load()
    Debug.Print AppPathW()
    Debug.Print AppPathW(bGetFullPath:=True)
    Debug.Print AppExeNameW()
    Debug.Print AppExeNameW(WithExtension:=True)
End Sub
3
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
17.01.2017, 23:53  [ТС] #191
File System Redirector, или как правильно его отключать / включать

Если вы взаимодействуете с одной из этих папок:
  • %windir%\system32\catroot
  • %windir%\system32\catroot2
  • %windir%\system32\driverstore
  • %windir%\system32\drivers\etc
  • %windir%\system32\logfiles
  • %windir%\system32\spool

на 64-битной ОСи, запуская свою 32-битную программу, иначе говоря работая через подсистему WoW64,
то должны знать, что доступ к этим папкам для файловых операций, проводимых вами, ограничен,
и все ваши попытки будут перенаправлены в папку %SystemRoot%\SysWOW64.

Чтобы всё-таки получить доступ к объектам в этих папках, нужно сперва отключить переадресатор.
Детальнее см. MSDN.

Выключать вы должны его точечно для каждой функции, которой это нужно, после чего сразу же включать,
иначе рискуете обрушить программу, как максимум, ну или спровоцировать undefined behavior. Для некоторых программ такие операции вообще противопоказаны. Если Ваша программа состоит из нескольких потоков, работающих параллельно, пока редиректор отключен, все функции в этих потоках будут вызываться из 64-разрядных библиотек, что вполне гарантированно приведёт к нестандартному поведению или обрушению потока.

За всё время я наломал немало дров, пока нормально не вкурил маны и не переписал корректно обёртку над Wow64RevertWow64FsRedirection / Wow64DisableWow64FsRedirection.
Дело в том, что, например, если вы подадите в функцию вместо глобальной переменной статическую, то можете не заметить особых проблем. Через месяц ваша программа может сойти с ума (у меня так и было), и вы даже не поймёте в чём причина. Согласно докам, переменная исходно должна быть неинициализирована и в процессе работы неизменна.

Вот корректно составленная обёртка и пример её использования.
Не поленитесь почитать комменты в примере использования. Там всё подробно разжёвано.

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


Пример использования:
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
Option Explicit
 
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long
 
Private Sub Form_Load()
    On Error GoTo ErrorHandler
 
    Dim sFilePath As String
    Dim RedirResult As Boolean
 
    'redirector OFF
    
        '2-й аргумент показывает, для какого пути отключаем переадресатор.
        'Если функция определит, что этот путь не нуждается в отключении переадресатора,
        'то она вернёт управление, ничего не сделав
        
        'если 2-й аргумент опустить, переадресатор будет отключен принудительно (если только у вас не x32 битная ОС)
        
        'в 3-й аргумент (если указать) вернётся предыдущее состояние переадресатора
    
    sFilePath = "c:\windows\system32\c_1251.nls"
    
    RedirResult = ToggleWow64FSRedirection(False, sFilePath)
    
    'выполним функцию, для которой потребовалось отключение переадресатора
    
    'полный список путей, на которые влияет File System Redirector смотрите на MSDN:
    'https://msdn.microsoft.com/en-us/library/windows/desktop/aa384187(v=vs.85).aspx
    
    Debug.Print IsFile(sFilePath)
    
    ' если прошлая операция отключения была успешной, включим переадресатор
    If RedirResult Then ToggleWow64FSRedirection True
    
    ' вы должны отключать переадресатор точечно - только для той функции, которой это требуется,
    ' после чего сразу же его включать.
    Exit Sub
ErrorHandler:
    'если что-то пошло не так, не забываем принудительно включить обратно переадресатор
    ToggleWow64FSRedirection True
End Sub
 
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
Модуль modRedirector:
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
Option Explicit
 
Const MAX_PATH      As Long = 260&
 
Private Type OSVERSIONINFOEX
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion(255) As Byte
    wServicePackMajor As Integer
    wServicePackMinor As Integer
    wSuiteMask As Integer
    wProductType As Byte
    wReserved As Byte
End Type
 
Private Declare Sub GetNativeSystemInfo Lib "kernel32.dll" (ByVal lpSystemInfo As Long)
Private Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryW" (ByVal lpBuffer As Long, ByVal uSize As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExW" (lpVersionInformation As OSVERSIONINFOEX) As Long
Private Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" (OldValue As Long) As Long
Private Declare Function Wow64RevertWow64FsRedirection Lib "kernel32.dll" (ByVal OldValue As Long) As Long
 
Private Const VER_NT_WORKSTATION        As Long = 1&
 
Private lWow64Old As Long ' IMPORTANT !!! Do not touch!
 
Public Function ToggleWow64FSRedirection(bEnable As Boolean, Optional PathNecessity As String, Optional OldStatus As Boolean) As Boolean
    'Static lWow64Old        As Long    'Warning: do not use initialized variables for this API !
                                        'Static variables are not allowed !
                                        'lWow64Old is now declared globally
    'True - enable redirector
    'False - disable redirector
 
    'OldStatus: current state of redirection
    'True - redirector was enabled
    'False - redirector was disabled
 
    'Return value is:
    'true if success: specified state has been set.
    'false on failure, or specified state has already set.
 
    Static IsNotRedirected  As Boolean
    Static IsInit           As Boolean
    Static bIsWin64         As Boolean
    Static sWinDir          As String
    Dim lr                  As Long
 
    OldStatus = Not IsNotRedirected
 
    If Not IsInit Then
        IsInit = True
        bIsWin64 = IsWin64()
        sWinDir = GetWindowsDir()
    End If
 
    If Not bIsWin64 Then Exit Function
 
    If Len(PathNecessity) <> 0 Then
        If StrComp(Left$(PathNecessity, Len(sWinDir)), sWinDir, vbTextCompare) <> 0 Then Exit Function
    End If
 
    If bEnable Then
        If IsNotRedirected Then
            lr = Wow64RevertWow64FsRedirection(lWow64Old)
            ToggleWow64FSRedirection = (lr <> 0)
            IsNotRedirected = False
        End If
    Else
        If Not IsNotRedirected Then
            lr = Wow64DisableWow64FsRedirection(lWow64Old)
            ToggleWow64FSRedirection = (lr <> 0)
            IsNotRedirected = True
        End If
    End If
End Function
 
Public Function GetWindowsDir() As String
    Static SysRoot As String
    Static IsInit As Boolean
    Dim lr As Long
    Dim osi As OSVERSIONINFOEX
    
    If IsInit Then
        GetWindowsDir = SysRoot
        Exit Function
    End If
    
    IsInit = True
    GetVersionEx osi
    
    If osi.wProductType = VER_NT_WORKSTATION Then
        SysRoot = String$(MAX_PATH, 0&)
        lr = GetWindowsDirectory(StrPtr(SysRoot), MAX_PATH)
        If lr Then
            SysRoot = Left$(SysRoot, lr)
        Else
            SysRoot = Environ$("SystemRoot")
        End If
    Else
        SysRoot = Environ$("SystemRoot") 'avoid path virtualization on Windows Server with Terminal Services
    End If
    GetWindowsDir = SysRoot
End Function
 
Public Function IsWin64() As Boolean
    Const PROCESSOR_ARCHITECTURE_AMD64 As Long = 9&
    Static IsInit As Boolean
    Static bWin64 As Boolean
    If IsInit Then
        IsWin64 = bWin64
        Exit Function
    End If
    Dim si(35) As Byte
    GetNativeSystemInfo VarPtr(si(0))
    If si(0) And PROCESSOR_ARCHITECTURE_AMD64 Then IsWin64 = True
    bWin64 = IsWin64
    IsInit = True
End Function
3
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
18.01.2017, 00:08  [ТС] #192
Поиск файла по путям PATH так, как это делает интерпретатор CMD

Многим знакома API функция PathFindOnPath. Но она ведёт поиск не так, как CMD.
CMD кроме переменной окружения PATH, ещё смотрит в переменную PathExt
Если по точному совпадению имени файл найти не удалось, то подбирает расширения перебором из %PathExt%.

Кроме того, файл не обязательно должен быть исполняемым.
Например, CMD-шная утилита WHERE умеет находить по путям PATH любой тип файла.

Именно так работает код, приведённый ниже.
Требование/зависимости: наличие модуля modRedirector (см. выше).

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

Пример использования:
Visual Basic
1
2
3
4
5
Option Explicit
 
Private Sub Form_Load()
    Debug.Print FindOnPath("cmd")
End Sub
Модуль modFindOnPath
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
Option Explicit
 
Const MAX_PATH As Long = 260&
 
Private Declare Function PathFindOnPath Lib "Shlwapi" Alias "PathFindOnPathW" (ByVal pszFile As Long, ppszOtherDirs As Any) As Boolean
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long
 
Function FindOnPath(sAppName As String) As String
    On Error GoTo ErrorHandler:
 
    Static Exts
    Static IsInit As Boolean
    Dim ProcPath$
    Dim sFile As String
    Dim sFolder As String
    Dim pos As Long
    Dim i As Long
    Dim FoundFile As Boolean
    Dim sFileTry As String
    
    If Not IsInit Then
        IsInit = True
        Exts = Split(Environ("PathExt"), ";")
        For i = 0 To UBound(Exts)
            Exts(i) = LCase(Exts(i))
        Next
    End If
    
    If IsFile(sAppName) Then
        FindOnPath = sAppName
        Exit Function
    End If
    
    pos = InStrRev(sAppName, "\")
    
    If pos <> 0 Then
        sFolder = Left$(sAppName, pos - 1)
        sFile = Mid$(sAppName, pos + 1)
        
        For i = 0 To UBound(Exts)
            sFileTry = sFolder & "\" & sFile & Exts(i)
            
            If IsFile(sFileTry) Then
                FindOnPath = sFileTry
                Exit Function
            End If
        Next
    Else
        ToggleWow64FSRedirection False
    
        ProcPath = Space$(MAX_PATH)
        LSet ProcPath = sAppName & vbNullChar
        
        If CBool(PathFindOnPath(StrPtr(ProcPath), 0&)) Then
            FindOnPath = TrimNull(ProcPath)
        Else
            'go through the extensions list
            
            For i = 0 To UBound(Exts)
                sFileTry = sAppName & Exts(i)
            
                ProcPath = Space$(MAX_PATH)
                LSet ProcPath = sFileTry & vbNullChar
            
                If CBool(PathFindOnPath(StrPtr(ProcPath), 0&)) Then
                    FindOnPath = TrimNull(ProcPath)
                    Exit For
                End If
            
            Next
            
        End If
        
        ToggleWow64FSRedirection True
    End If
    
    Exit Function
ErrorHandler:
    Debug.Print Err; "FindOnPath"; "AppName: "; sAppName
    ToggleWow64FSRedirection True
    'If inIDE Then Stop: Resume Next
End Function
 
Public Function TrimNull(s$) As String
    TrimNull = Left$(s, lstrlen(StrPtr(s)))
End Function
 
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
3
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
18.01.2017, 01:24  [ТС] #193
EnvironW() - замена VB Environ() с поддержкой юникода, нескольких переменных в строке и коррекцией под WOW64

Важное замечание: в отличие от родного Environ(), мой требует подачи на вход переменных окружения, обрамлённых символами %%, например:

Visual Basic
1
2
    Debug.Print EnvironW("%UserName% - %UserDomain%")
    Debug.Print EnvironW("%PROGRAMFILES%\My program")
т.к. родной Environ не поддерживает указание нескольких переменных в одной строке.

Также, EnvironW() позволяет скорректировать и "правильно" (в том смысле, что если бы мы хотели это сделать из-под 64-битного приложения) раскрыть под WOW64 такие переменные, как:
  • %PROGRAMFILES%
  • %COMMONPROGRAMFILES%
Получив на 64-битной ОС, соответственно:
C:\Program Files, а не C:\Program Files (x86)
C:\Program Files\Common Files, а не C:\Program Files (x86)\Common Files

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

Модуль modEnviron
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
Option Explicit
 
Const MAX_PATH As Long = 260&
 
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExW" (lpVersionInformation As Any) As Long
Private Declare Function ExpandEnvironmentStrings Lib "kernel32.dll" Alias "ExpandEnvironmentStringsW" (ByVal lpSrc As Long, ByVal lpDst As Long, ByVal nSize As Long) As Long
 
Public Function EnvironW(ByVal SrcEnv As String) As String
    Dim lr As Long
    Dim buf As String
    Dim SysDisk As String
    Static PF_64 As String, PF_64_Common As String
    Static IsInit As Boolean
 
    If Len(SrcEnv) = 0 Then Exit Function
 
    If InStr(SrcEnv, "%") = 0 Then
        EnvironW = SrcEnv
    Else
        'redirector correction
        If IsWin64() Then
            If InStr(1, SrcEnv, "%PROGRAMFILES%", 1) <> 0 _
              Or InStr(1, SrcEnv, "%COMMONPROGRAMFILES%", 1) <> 0 Then
                If Not IsInit Then
                    IsInit = True
                    If OSverMajorMinor() >= 6.1 Then     'Win 7 and later
                        PF_64 = EnvironW("%ProgramW6432%") 'recur
                    Else
                        SysDisk = EnvironW("%SystemDrive%")
                        PF_64 = SysDisk & "\Program Files" 'Older systems are not supported %ProgramW6432%
                    End If
                    PF_64_Common = PF_64 & "\Common Files"
                End If
 
                If InStr(1, SrcEnv, "%PROGRAMFILES%", 1) <> 0 Then
                    SrcEnv = Replace$(SrcEnv, "%PROGRAMFILES%", PF_64, 1, 1, 1)
                End If
                If InStr(1, SrcEnv, "%COMMONPROGRAMFILES%", 1) <> 0 Then
                    SrcEnv = Replace$(SrcEnv, "%COMMONPROGRAMFILES%", PF_64_Common, 1, 1, 1)
                End If
            End If
        End If
        buf = String$(MAX_PATH, 0&)
        lr = ExpandEnvironmentStrings(StrPtr(SrcEnv), StrPtr(buf), MAX_PATH + 1)
 
        If lr Then
            EnvironW = Left$(buf, lr - 1)
        Else
            EnvironW = SrcEnv
        End If
 
        If InStr(EnvironW, "%") <> 0 Then 'still not expanded ?
            If OSverMajorMinor() <= 6 Then
                If InStr(1, EnvironW, "%ProgramW6432%", 1) <> 0 Then
                    SysDisk = EnvironW("%SystemDrive%") 'recur
                    EnvironW = Replace$(EnvironW, "%ProgramW6432%", SysDisk & "\Program Files", 1, -1, 1)
                End If
            End If
        End If
    End If
End Function
 
Function OSverMajorMinor() As Single
    Dim inf(68) As Long
    Dim dec As Single
    inf(0) = 276
    GetVersionEx inf(0)
    dec = inf(2)
    If dec <> 0 Then Do: dec = dec / 10: Loop Until dec < 1
    OSverMajorMinor = inf(1) + dec
End Function
2
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
19.01.2017, 00:46  [ТС] #194
AppVersionW - корректное получение версии Вашей программы, запущенной в папке с юникодными символами

Кому-то юникод может и нафиг не нужен, но вот не задача,
Вам вдруг захотелось написать в окне "О программе" версию вашей программы. Первая мысль:
  • App.Major
  • App.Minor
  • App.Revision
И тут так совпало, что юзеръ скинул вашу программу в папку, где есть хоть один символ
за пределами ASCII в пути. Он будет долго кричать - "не работает !!!",
потому что программа выбросит Runtime Error. И по правде говоря, здесь Вас обработчик
ошибок тоже особо не спасёт, ведь весь код после App.Major будет пропущен
(если конечно вы заранее не знали об этом баге) (On Error Resume Next не беру в рассчёт).
Готовые решения и полезные коды на Visual Basic 6.0

Итак, код ниже извлекает версию, используя юникодные Win API вызовы:
Кликните здесь для просмотра всего текста

Вызов:
Visual Basic
1
2
3
4
Private Sub Form_Load()
    MsgBox AppVersionW(AppPathW(True))
    'MsgBox AppVersionW(App.Path & "\" & App.EXEName & ".exe")
End Sub
Модуль AppVersion:
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
Option Explicit
 
Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer
    dwStrucVersionh As Integer
    dwFileVersionMSl As Integer
    dwFileVersionMSh As Integer
    dwFileVersionLSl As Integer
    dwFileVersionLSh As Integer
    dwProductVersionMSl As Integer
    dwProductVersionMSh As Integer
    dwProductVersionLSl As Integer
    dwProductVersionLSh As Integer
    dwFileFlagsMask As Long
    dwFileFlags As Long
    dwFileOS As Long
    dwFileType As Long
    dwFileSubtype As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type
 
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoW" (ByVal lptstrFilename As Long, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeW" (ByVal lptstrFilename As Long, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueW" (pBlock As Any, ByVal lpSubBlock As Long, lplpBuffer As Long, puLen As Long) As Long
Private Declare Function memcpy Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) As Long
Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesW" (ByVal lpFileName As Long) As Long
 
Const FILE_ATTRIBUTE_DIRECTORY  As Long = &H10&
Const INVALID_HANDLE_VALUE      As Long = &HFFFFFFFF
 
Public Function AppVersionW(sImagePath As String) As String
    On Error GoTo ErrorHandler:
    Dim hData&, lDataLen&, uBuf() As Byte, uCodePage(0 To 3) As Byte
    Dim sCodePage$, sCompanyName$, uVFFI As VS_FIXEDFILEINFO, sVersion$
    
    If Not FileExists(sImagePath) Then Exit Function
    
    lDataLen = GetFileVersionInfoSize(StrPtr(sImagePath), ByVal 0&)
    If lDataLen = 0 Then Exit Function
    
    ReDim uBuf(0 To lDataLen - 1)
    If 0 <> GetFileVersionInfo(StrPtr(sImagePath), 0&, lDataLen, uBuf(0)) Then
    
        If 0 <> VerQueryValue(uBuf(0), StrPtr("\"), hData, lDataLen) Then
        
            If hData <> 0 Then
        
                memcpy uVFFI, ByVal hData, Len(uVFFI)
    
                With uVFFI
                    sVersion = .dwFileVersionMSh & "." & _
                        .dwFileVersionMSl & "." & _
                        .dwFileVersionLSh & "." & _
                        .dwFileVersionLSl
                End With
            End If
        End If
    End If
    AppVersionW = sVersion
    Exit Function
ErrorHandler:
    Debug.Print Err; "AppVersionW"; sImagePath
End Function
 
Public Function FileExists(ByVal sFile$) As Boolean
    Dim ret As Long
    ret = GetFileAttributes(StrPtr(sFile))
    If ret <> INVALID_HANDLE_VALUE And (0 = (ret And FILE_ATTRIBUTE_DIRECTORY)) Then FileExists = True
End Function


Зависимость / требования: наличие модуля с AppPathW().
2
Dragokas
Эксперт WindowsАвтор FAQ
16100 / 6919 / 832
Регистрация: 25.12.2011
Сообщений: 10,686
Записей в блоге: 16
19.01.2017, 01:07  [ТС] #195
Класс получения информации об ОС

Обновлённая версия этого класса.

Добавлены свойства:
  • OS SuiteMask
  • OS ProductType
  • OEM CodepageOEM (identifier)
  • OEM CodepageOEM (path to .nls)
  • ANSI CodepageANSI (identifier)
  • ANSI CodepageANSI (path to .nls)

В режиме IDE возвращается правильная версия системы (Major / Minor / Build) вне зависимости, подключен манифест или нет.
Используется запрос к WMI. Это нужно для нормальной отладки программ под IDE.

В релизе подсистема WMI не ипользуется, поэтому Вам все равно обязательно нужно подключать манифест. См. детали по ссылке выше.

Перед использованием класса, замените все обработчики ошибок AppendErrorLogFormat на свои или закомментируйте автозаменой.

24.03.17 файл перезалит. Убрана критическая ошибка, могла привести к падению программы.
4
Вложения
Тип файла: zip clsOSInfo.zip (8.5 Кб, 3 просмотров)
19.01.2017, 01:07
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
19.01.2017, 01:07
Привет! Вот еще темы с ответами:

Visual Basic 6 и Visual Basic .NET - в чем различия? - Visual Basic
Visual Basic и Visual studio это не одно и тоже? если нет то в чём разница, по мимо оформления?

Отличия версий Visual Basic 6.0 от Visual Basic 6.5? - Visual Basic
У меня 3 вопроса: 1.Чем отличается версия Visual Basic 6.0 от Visual Basic 6.5? 2.Можно ли запустить проект созданный раннее в Visual...

Кто пишет программы в Visual Studio 2010 на Visual Basic? - Visual Basic
Кто пишет программы в Visual Studio 2010 на Visual Basic?

Проблема с установкой Visual Studio вообще и Visual Basic - Visual Basic
Точнее, с установкой Visual Studio вообще и Visual Basic в частности. В самом конце установки, при setup is updating your system,...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
195
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.