Форум программистов, компьютерный форум CyberForum.ru

Visual Basic

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 2, средняя оценка - 5.00
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
01.01.2015, 00:35  [ТС] #136
EnumDeskVB: Динамическое создание treeview и listview без использования Comctl32.ocx
Автор: Nancy Cluts. Портировано Brad Martinez.

В примере демонстрируется:
  • перечисление объектов пространства имен Shell (аналогично, как это делается в проводнике Windows)
  • сабклассинг контролов
  • использование интерфейсов IShellFolder, и доступа к дочерним объектам, IEnumIDList для перечесления объектов.
  • преобразование PIDL в имена и отображение иконок объектов;
  • использование контекстного меню с помощью интерфейса IContextMenu

Также внутри есть:
  • дебаггер от Майкрософт для отлова ошибок в CallBack функциях
  • IShellFolder Extended Type Library v1.2

Код хорошо закомментирован.
Источник.
Миниатюры
Готовые решения и полезные коды на Visual Basic 6.0  
Вложения
Тип файла: zip edeskvb2.zip (148.0 Кб, 39 просмотров)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
01.01.2015, 00:35
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Готовые решения и полезные коды на Visual Basic 6.0 (Visual Basic):

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

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

Вывод решения вместо 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? Стороны отверстия должны быть параллельны граням...

Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
03.01.2015, 02:15  [ТС] #137
Построение графика функции по введенной формуле.
The trick
Модератор
7185 / 2417 / 741
Регистрация: 22.02.2013
Сообщений: 3,473
Записей в блоге: 74
04.01.2015, 16:41 #138
3D елка на рабочий стол.

Я как-то уже делал такую, но в этот раз я добавил возможность регулировки параметров создания.
Для работы нужна dx8vb.dll. Выход по двойному клику. С новым годом!

Ссылка.
The trick
Модератор
7185 / 2417 / 741
Регистрация: 22.02.2013
Сообщений: 3,473
Записей в блоге: 74
26.04.2015, 22:11 #139
Класс - MP3 проигрыватель из памяти.

Всем привет. Я разработал класс для асинхронного воспроизведения MP3 файлов в памяти. Например это может пригодится для воспроизведения фоновой музыки из ресурсов или из сети минуя запись в файл. Воспроизводить можно несколько файлов одновременно, но некоторые параметры воспроизведения (громкость, панорама) для всех проигрывателей будут общими. Класс разработан так, что корректно обрабатывает ситуации остановки среды кнопками "стоп", "пауза" и выхода по End. По тегам, корректно обрабатываются только ID3v1 и ID3v2 теги, другие не распознаются и файл скорее всего не будет играться.

Ссылка.
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
17.05.2015, 21:46  [ТС] #140
  • Получение типа учетной записи, под которой запущен процесс (Administrator, Power user, Limited User, Guest)
  • Проверка, запущен ли процесс в режиме повышенных привилегий
  • Получение уровня целостности процесса (Integrity Level)

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

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
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
Option Explicit
 
Private Type SID_IDENTIFIER_AUTHORITY
    value(0 To 5) As Byte
End Type
 
Private Type SID_AND_ATTRIBUTES
    Sid As Long
    Attributes As Long
End Type
 
Private Type TOKEN_GROUPS
    GroupCount As Long
    Groups(20) As SID_AND_ATTRIBUTES
End Type
 
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExW" (lpVersionInformation As Any) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function OpenThreadToken Lib "advapi32" (ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, ByVal OpenAsSelf As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal lSize As Long)
Private Declare Function GetMem4 Lib "msvbvm60.dll" (Src As Any, Dst As Any) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub FreeSid Lib "advapi32.dll" (ByVal pSid As Long)
Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" (pIdentifierAuthority As Any, ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Function IsValidSid Lib "advapi32" (ByVal pSid As Long) As Long
Private Declare Function GetSidSubAuthority Lib "advapi32.dll" (ByVal pSid As Long, ByVal nSubAuthority As Long) As Long
Private Declare Function GetSidSubAuthorityCount Lib "advapi32.dll" (ByVal pSid As Long) As Long
Private Declare Function EqualSid Lib "advapi32.dll" (pSid1 As Any, pSid2 As Any) As Long
'Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenW" (ByVal lpString As Long) As Long
'Private Declare Function ConvertStringSidToSid Lib "advapi32.dll" Alias "ConvertStringSidToSidW" (ByVal StringSid As Long, Sid As Long) As Long
'Private Declare Function ConvertSidToStringSid Lib "advapi32.dll" Alias "ConvertSidToStringSidW" (ByVal Sid As Long, StringSid As Long) As Long
'Private Declare Function CheckTokenMembership Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal SidToCheck As Long, IsMember As Long) As Long
 
Private Sub Form_Load()
    Dim sLog$
    sLog = sLog & "UserType:        " & GetUserType() & vbCrLf
    sLog = sLog & "UAC Elevated:    " & IsElevated() & vbCrLf
    sLog = sLog & "Integrity Level: " & GetIntegrityLevel() & vbCrLf
    Debug.Print sLog
    MsgBox sLog
    End
End Sub
 
Function IsElevated(Optional hProcess As Long) As Boolean
    On Error GoTo ErrorHandler
    
    Const TOKEN_QUERY           As Long = &H8&
    Const TokenElevation        As Long = 20&
    
    Dim hToken           As Long
    Dim dwLengthNeeded   As Long
    Dim dwIsElevated     As Long
    
    ' < Win Vista. Устанавливаем true, если пользователь состоит в группе "Администраторы"
    Dim inf(68) As Long: inf(0) = 276: GetVersionEx inf(0): If inf(1) < 6 Then IsElevated = (GetUserType = "Administrator"): Exit Function
 
    If hProcess = 0 Then hProcess = GetCurrentProcess()
    
    If OpenProcessToken(hProcess, TOKEN_QUERY, hToken) Then
 
        If 0 <> GetTokenInformation(hToken, TokenElevation, dwIsElevated, 4&, dwLengthNeeded) Then
            IsElevated = (dwIsElevated <> 0)
        End If
        
        CloseHandle hToken
    End If
    Exit Function
ErrorHandler:
    Debug.Print Err; Now; "clsOSInfo.IsElevated"
End Function
 
Public Function GetUserType(Optional hProcess As Long) As String
    On Error GoTo ErrorHandler
 
    Const TOKEN_QUERY                   As Long = &H8&
    Const SECURITY_NT_AUTHORITY         As Long = 5&
    Const TokenGroups                   As Long = 2&
    Const SECURITY_BUILTIN_DOMAIN_RID   As Long = &H20&
    Const DOMAIN_ALIAS_RID_ADMINS       As Long = &H220&
    Const DOMAIN_ALIAS_RID_USERS        As Long = &H221&
    Const DOMAIN_ALIAS_RID_GUESTS       As Long = &H222&
    Const DOMAIN_ALIAS_RID_POWER_USERS  As Long = &H223&
 
    Dim hProcessToken   As Long
    Dim BufferSize      As Long
    Dim psidAdmin       As Long
    Dim psidPower       As Long
    Dim psidUser        As Long
    Dim psidGuest       As Long
    Dim lResult         As Long
    Dim i               As Long
    Dim tpTokens        As TOKEN_GROUPS
    Dim tpSidAuth       As SID_IDENTIFIER_AUTHORITY
    
    GetUserType = "Unknown"
    tpSidAuth.value(5) = SECURITY_NT_AUTHORITY
    
    ' в идеале, сначала нужно проверять токен, полученный от потока
    ' If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hProcessToken) Then
    ' ограничимся токеном процесса, т.к. пока не планируем более 1 потока
    
    If hProcess = 0 Then hProcess = GetCurrentProcess()
    If 0 = OpenProcessToken(hProcess, TOKEN_QUERY, hProcessToken) Then Exit Function
    
    If hProcessToken Then
 
        ' Определяем требуемый размер буфера
        GetTokenInformation hProcessToken, ByVal TokenGroups, 0&, 0&, BufferSize
        
        If BufferSize Then
            ReDim InfoBuffer((BufferSize \ 4) - 1) As Long  ' Переводим размер byte -> Long
            
            ' Получаем информацию о SID-ах групп, ассоциированных с этим токеном
            If 0 <> GetTokenInformation(hProcessToken, ByVal TokenGroups, InfoBuffer(0), BufferSize, BufferSize) Then
            
                ' Заполняем структуру из буфера
                Call CopyMemory(tpTokens, InfoBuffer(0), Len(tpTokens))
            
                ' Получаем SID-ы каждого типа пользователей
                lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0&, 0&, 0&, 0&, 0&, 0&, psidAdmin)
                lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_POWER_USERS, 0&, 0&, 0&, 0&, 0&, 0&, psidPower)
                lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_USERS, 0&, 0&, 0&, 0&, 0&, 0&, psidUser)
                lResult = AllocateAndInitializeSid(tpSidAuth, 2&, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_GUESTS, 0&, 0&, 0&, 0&, 0&, 0&, psidGuest)
            
                If IsValidSid(psidAdmin) And IsValidSid(psidPower) And IsValidSid(psidUser) And IsValidSid(psidGuest) Then
                  
                    For i = 0 To tpTokens.GroupCount
                        ' Берем SID каждой из ассоциированных групп
                        If IsValidSid(tpTokens.Groups(i).Sid) Then
                            ' Проверяем на соответствие
                            If EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidAdmin) Then
                                GetUserType = "Administrator":  Exit For
                            ElseIf EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidPower) Then
                                GetUserType = "Power User":     Exit For
                            ElseIf EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidUser) Then
                                GetUserType = "Limited User":   Exit For
                            ElseIf EqualSid(ByVal tpTokens.Groups(i).Sid, ByVal psidGuest) Then
                                GetUserType = "Guest":          Exit For
                            End If
                        End If
                    Next
                End If
                If psidAdmin Then FreeSid psidAdmin
                If psidPower Then FreeSid psidPower
                If psidUser Then FreeSid psidUser
                If psidGuest Then FreeSid psidGuest
            End If
        End If
        CloseHandle hProcessToken
    End If
    Exit Function
ErrorHandler:
    Debug.Print Err; Now; "clsOSInfo.GetUserType"
End Function
 
'Function SID_2_String(pSid As Long) As String
'    Dim lpString As Long
'    Dim sSid     As String
'    If ConvertSidToStringSid(pSid, lpString) Then
'        sSid = Space$(lstrlen(lpString) \ 2)
'        CopyMemory ByVal StrPtr(sSid), ByVal lpString, Len(sSid) * 2
'        LocalFree lpString
'        SID_2_String = sSid
'    End If
'End Function
 
Function GetIntegrityLevel(Optional hProcess As Long) As String       'https://msdn.microsoft.com/en-us/library/bb625966.aspx?f=255
    On Error GoTo ErrorHandler
    
    Const SECURITY_MANDATORY_UNTRUSTED_RID          As Long = 0&
    Const SECURITY_MANDATORY_LOW_RID                As Long = &H1000&
    Const SECURITY_MANDATORY_MEDIUM_RID             As Long = &H2000&
    Const SECURITY_MANDATORY_HIGH_RID               As Long = &H3000&
    Const SECURITY_MANDATORY_SYSTEM_RID             As Long = &H4000&
    Const SECURITY_MANDATORY_PROTECTED_PROCESS_RID  As Long = &H5000&
    
    Const TokenIntegrityLevel       As Long = 25&
    Const TOKEN_QUERY               As Long = &H8&
    Const ERROR_INSUFFICIENT_BUFFER As Long = &H7A&
    
    Dim hToken           As Long
    Dim dwLengthNeeded   As Long
    Dim bTIL()           As Byte
    Dim pSidSub          As Long
    Dim dwIntegrityLevel As Long
    Dim pSidAuthCnt      As Long
    Dim SidAuthCnt       As Long
    Dim pILSid           As Long
    Dim ILevel           As String
    
    Dim inf(68) As Long: inf(0) = 276: GetVersionEx inf(0): If inf(1) < 6 Then GetIntegrityLevel = "Not supported": Exit Function ' < Win Vista
    
    ILevel = "Unknown"
    
    If hProcess = 0 Then hProcess = GetCurrentProcess()
    
    If OpenProcessToken(hProcess, TOKEN_QUERY, hToken) Then
    
        GetTokenInformation hToken, TokenIntegrityLevel, 0&, 0&, dwLengthNeeded
        
        If ERROR_INSUFFICIENT_BUFFER = Err.LastDllError Then
        
            ReDim bTIL(dwLengthNeeded - 1)
        
            If 0 <> GetTokenInformation(hToken, TokenIntegrityLevel, bTIL(0), dwLengthNeeded, dwLengthNeeded) Then
        
                GetMem4 bTIL(0), pILSid
                
                If IsValidSid(pILSid) Then
 
                    pSidAuthCnt = GetSidSubAuthorityCount(pILSid)
                    
                    If pSidAuthCnt Then
                    
                        GetMem4 ByVal pSidAuthCnt, SidAuthCnt
                        
                        If SidAuthCnt Then
                        
                            pSidSub = GetSidSubAuthority(pILSid, SidAuthCnt - 1)
                    
                            If pSidSub Then GetMem4 ByVal pSidSub, dwIntegrityLevel
                    
                            Select Case dwIntegrityLevel
                            
                                Case Is < SECURITY_MANDATORY_UNTRUSTED_RID
                                    ILevel = "Unknown"
                                Case Is < SECURITY_MANDATORY_LOW_RID
                                    ILevel = "Untrusted"
                                Case Is < SECURITY_MANDATORY_MEDIUM_RID
                                    ILevel = "Low"
                                Case Is < SECURITY_MANDATORY_HIGH_RID
                                    ILevel = "Medium"
                                Case Is < SECURITY_MANDATORY_SYSTEM_RID
                                    ILevel = "High"
                                Case Is < SECURITY_MANDATORY_PROTECTED_PROCESS_RID
                                    ILevel = "System"
                                Case Else
                                    ILevel = "ProtectedProcess"
                            End Select
                        End If
                    End If
                    FreeSid pILSid
                End If
            End If
        End If
        CloseHandle hToken
    End If
    GetIntegrityLevel = ILevel
    Exit Function
ErrorHandler:
    Debug.Print Err; Now; "clsOSInfo.GetIntegrityLevel"
End Function
Вложения
Тип файла: zip AdminCheck.zip (9.8 Кб, 42 просмотров)
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
18.05.2015, 10:16  [ТС] #141
Расчет хешей:
  • MD5
  • SHA-256 (SHA-2)
Шифрование по алгоритмам:
  • RC2, RC4
  • Rijndael AES Block Cipher
Автор порта: Phil Fresle
http://www.frez.co.uk/free/vb6code
Вложения
Тип файла: zip md5.zip (16.0 Кб, 35 просмотров)
Тип файла: zip frezcrypto.zip (17.9 Кб, 29 просмотров)
Тип файла: zip rijndaelvb.zip (13.3 Кб, 30 просмотров)
Тип файла: zip sha.zip (13.3 Кб, 28 просмотров)
Night Ranger
Заблокирован
21.06.2015, 18:20 #142
Фрейм, который дружит с манифестом

Разработал фрэйм который полностью имитирует оригинальный

Но при этом дружит с манифестом, не вызывает глюков как в режиме проектирования,
так и в режиме выполнения

Целиком код модуля UserControl
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
Option Explicit
'Property Variables:
Dim LbSize As Label
 
Private Sub UserControl_Initialize()
    Dim i&
    For i = 1 To 4
        With Controls.Add("vb.PictureBox", "Pic" & i)
            .Visible = 1
            If i = 1 Then
                 Set Frm1.Container = Controls("Pic" & i)
            Else
                With Controls.Add("vb.Frame", "Frm" & i)
                    Set .Container = Controls("Pic" & i)
                    .Visible = 1
                End With
            End If
            .BorderStyle = 0
        End With
    Next
    Set LbSize = Controls.Add("vb.Label", "LbSize")
    With LbSize
        .AutoSize = True
    End With
    
 
End Sub
 
Private Sub UserControl_InitProperties()
    Frm1.Caption = Extender.Name
End Sub
 
Private Sub UserControl_Resize()
    Const minSize = 75
    Dim maxSize&
    Set LbSize.Font = Frm1.Font
    LbSize.Caption = Frm1.Caption
    maxSize = LbSize.Height
    '''----
    Controls("Pic" & 1).Move 0, 0, Width, maxSize
    Controls("Frm" & 1).Move 0, 0, Width, Height
    '''----
    Controls("Pic" & 2).Move Width - minSize, 0, minSize, Height
    Controls("Frm" & 2).Move -Width + minSize, 0, Width, Height
    '''----
    Controls("Pic" & 3).Move 0, Height - minSize, Width, minSize
    Controls("Frm" & 3).Move 0, -Height + minSize, Width, Height
    '''----
    Controls("Pic" & 4).Move 0, 0, minSize, Height
    Controls("Frm" & 4).Move 0, 0, Width, Height
End Sub
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Frame1,Frm1,-1,Caption
Public Property Get Caption() As String
    Caption = Frm1.Caption
End Property
 
Public Property Let Caption(ByVal New_Caption As String)
    Frm1.Caption() = New_Caption
    PropertyChanged "Caption"
End Property
 
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Frm1.Caption = PropBag.ReadProperty("Caption", "Frm1")
    Set Frm1.Font = PropBag.ReadProperty("Font", Ambient.Font)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
End Sub
 
Private Sub UserControl_Show()
    BackColor = UserControl.BackColor
End Sub
 
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Caption", Frm1.Caption, "Frm1")
    Call PropBag.WriteProperty("Font", Frm1.Font, Ambient.Font)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
End Sub
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=Frame1,Frm1,-1,Font
Public Property Get Font() As Font
    Set Font = Frm1.Font
End Property
 
Public Property Set Font(ByVal New_Font As Font)
    Set Frm1.Font = New_Font
    UserControl_Resize
    PropertyChanged "Font"
End Property
 
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property
 
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    Dim i&
    For i = 1 To 4
        Controls("Frm" & i).BackColor = New_BackColor
    Next
    UserControl.BackColor() = New_BackColor
    Refresh
    PropertyChanged "BackColor"
End Property



Картинки !





В архиве тэстовый проект
Миниатюры
Готовые решения и полезные коды на Visual Basic 6.0   Готовые решения и полезные коды на Visual Basic 6.0  
Вложения
Тип файла: rar NewFrame.rar (28.3 Кб, 26 просмотров)
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
29.06.2015, 13:07  [ТС] #143
Функция sTrimU (аналог Trim для обрезания произвольных букв)

1 аргумент - строка, из которой будут вырезаны символы слева и справа.
2 аргумент - символ или набор символов, которые нужно урезать.

Trim$, обрезка пробелов, табуляций и прочего
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
29.06.2015, 20:19  [ТС] #144
Получение списка процессов / информации о потоках процессов

Показывает:
- имя процесса,
- путь к образу,
- PID
- да и любые другие данные полей структуры SYSTEM_PROCESS_INFORMATION

Данному коду не нужны права Администратора. Используется функция NtQuerySystemInformation.

Тем не менее, для получения полного пути к образу нужны повышенные привилегии,
чтобы открыть процессы, запущенные с правами выше предоставленных группе "Ограниченный пользователь".

Путь получаем разными функциями в зависимости от версии ОС:
- Windows XP - GetModuleFileNameEx,
- а для x64 битных процессов - GetProcessImageFileName с преобразованием имен в стиле объектов ядра (\Device\HarddiskVolumeX) в стиль имен разделов диска.
- Windows Vista и выше - QueryFullProcessImageName, если ошибка, то функциями, описанными выше.

Для процессов, открытых от LOCAL SERVICES, путь не всегда будет получен по причине отказа в доступе для открытия процесса на чтение. Диспетчер задач такие данные берет скорее всего из таблицы хендлов smss.exe (как например, это делается в "Process manipulator" (взял у одного китайца, м.б. кому то будет интересно посмотреть (в учебных целях), код прилагаю / не проверял) ).

В коде также предоставляются привилегии отладчика. Это в принципе лишнее. Upd... Фига, таки нужны. В скомпилированном виде без них не может получить пути. Видимо среда IDE VB6 автоматически получает права отладчика процесса.

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

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
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
' Process List by Alex Dragokas
 
Option Explicit
 
Const MAX_PATH As Long = 260&
 
Private Declare Function NtQuerySystemInformation Lib "ntdll.dll" (ByVal infoClass As Long, Buffer As Any, ByVal BufferSize As Long, ret As Long) As Long
Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExW" (lpVersionInformation As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExW" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
Private Declare Function GetProcessImageFileName Lib "psapi.dll" Alias "GetProcessImageFileNameW" (ByVal hProcess As Long, ByVal lpImageFileName As Long, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryW" (ByVal lpBuffer As Long, ByVal nSize As Long) As Long
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsW" (ByVal lpSrc As Long, ByVal lpDst As Long, ByVal nSize As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueW" (ByVal lpSystemName As Long, ByVal lpName As Long, lpLuid As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByVal PreviousState As Long, ByVal ReturnLength As Long) As Long
Private Declare Function GetFullPathName Lib "kernel32.dll" Alias "GetFullPathNameW" (ByVal lpFileName As Long, ByVal nBufferLength As Long, ByVal lpBuffer As Long, lpFilePart As Long) As Long
Private Declare Function QueryFullProcessImageName Lib "kernel32.dll" Alias "QueryFullProcessImageNameW" (ByVal hProcess As Long, ByVal dwFlags As Long, ByVal lpExeName As Long, ByVal lpdwSize As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32.dll" Alias "GetLogicalDriveStringsW" (ByVal nBufferLength As Long, ByVal lpBuffer As Long) As Long
Private Declare Function QueryDosDevice Lib "kernel32.dll" Alias "QueryDosDeviceW" (ByVal lpDeviceName As Long, ByVal lpTargetPath As Long, ByVal ucchMax As Long) As Long
 
Private Type TOKEN_PRIVILEGES
    PrivilegeCount  As Long
    LuidLowPart     As Long
    LuidHighPart    As Long
    Attributes      As Long
End Type
 
Private Type LARGE_INTEGER
    LowPart     As Long
    HighPart    As Long
End Type
 
Private Type CLIENT_ID
    UniqueProcess   As Long  ' HANDLE
    UniqueThread    As Long  ' HANDLE
End Type
 
Private Type UNICODE_STRING
    Length      As Integer
    MaxLength   As Integer
    lpBuffer    As Long
End Type
 
Private Type VM_COUNTERS
    PeakVirtualSize             As Long
    VirtualSize                 As Long
    PageFaultCount              As Long
    PeakWorkingSetSize          As Long
    WorkingSetSize              As Long
    QuotaPeakPagedPoolUsage     As Long
    QuotaPagedPoolUsage         As Long
    QuotaPeakNonPagedPoolUsage  As Long
    QuotaNonPagedPoolUsage      As Long
    PagefileUsage               As Long
    PeakPagefileUsage           As Long
End Type
 
Private Type IO_COUNTERS
    ReadOperationCount      As Currency 'ULONGLONG
    WriteOperationCount     As Currency
    OtherOperationCount     As Currency
    ReadTransferCount       As Currency
    WriteTransferCount      As Currency
    OtherTransferCount      As Currency
End Type
 
Private Type SYSTEM_THREAD
    KernelTime          As LARGE_INTEGER
    UserTime            As LARGE_INTEGER
    CreateTime          As LARGE_INTEGER
    WaitTime            As Long
    StartAddress        As Long
    ClientId            As CLIENT_ID
    Priority            As Long
    BasePriority        As Long
    ContextSwitchCount  As Long
    State               As Long 'enum KTHREAD_STATE
    WaitReason          As Long 'enum KWAIT_REASON
    dReserved01         As Long
End Type
 
Private Type SYSTEM_PROCESS_INFORMATION
    NextEntryOffset         As Long
    NumberOfThreads         As Long
    SpareLi1                As LARGE_INTEGER
    SpareLi2                As LARGE_INTEGER
    SpareLi3                As LARGE_INTEGER
    CreateTime              As LARGE_INTEGER
    UserTime                As LARGE_INTEGER
    KernelTime              As LARGE_INTEGER
    ImageName               As UNICODE_STRING
    BasePriority            As Long
    ProcessId               As Long
    InheritedFromProcessId  As Long
    HandleCount             As Long
    SessionId               As Long
    pPageDirectoryBase      As Long '_PTR
    VirtualMemoryCounters   As VM_COUNTERS
    PrivatePageCount        As Long
    IoCounters              As IO_COUNTERS
    Threads()               As SYSTEM_THREAD
End Type
 
Const SystemProcessInformation      As Long = &H5&
Const STATUS_INFO_LENGTH_MISMATCH   As Long = &HC0000004
Const STATUS_SUCCESS                As Long = 0&
Const ERROR_PARTIAL_COPY            As Long = 299&
 
Dim sWinDir             As String
Dim bIsWinVistaOrLater  As Boolean
 
 
Private Sub Form_Load()
    Const SPI_SIZE      As Long = &HB8&
    Const THREAD_SIZE   As Long = &H40&
    
    Dim i           As Long
    Dim ret         As Long
    Dim buf()       As Byte
    Dim Offset      As Long
    Dim Process     As SYSTEM_PROCESS_INFORMATION
    Dim ProcName    As String
    Dim ProcPath    As String
    
    Dim inf(68) As Long
    inf(0) = 276: GetVersionEx inf(0): bIsWinVistaOrLater = (inf(1) >= 6)
    sWinDir = GetWinDir()
    
    SetCurrentProcessPrivileges "SeDebugPrivilege"
    
    If NtQuerySystemInformation(SystemProcessInformation, ByVal 0&, 0&, ret) = STATUS_INFO_LENGTH_MISMATCH Then
    
        ReDim buf(ret - 1)
        
        If NtQuerySystemInformation(SystemProcessInformation, buf(0), ret, ret) = STATUS_SUCCESS Then
        
            With Process
            
                Do
                    memcpy Process, buf(Offset), SPI_SIZE
                    
                    ReDim .Threads(0 To .NumberOfThreads - 1)
                    
                    For i = 0 To .NumberOfThreads - 1
                        memcpy .Threads(i), buf(Offset + SPI_SIZE + i * THREAD_SIZE), THREAD_SIZE
                    Next
                    
                    If .ProcessId = 0 Then
                        ProcName = "System Idle Process"
                    Else
                        ProcName = Space$(.ImageName.Length \ 2)
                        memcpy ByVal StrPtr(ProcName), ByVal .ImageName.lpBuffer, .ImageName.Length
                        ProcPath = GetFilePathByPID(.ProcessId)
                    End If
                    
                    Debug.Print Right$("00000" & .ProcessId, 6) & " - " & ProcName & " - " & ProcPath
                    
                    Offset = Offset + .NextEntryOffset
                    
                Loop While .NextEntryOffset
                
            End With
            
        End If
        
    End If
    
    End
    
End Sub
 
Function GetFilePathByPID(PID As Long) As String
    Const MAX_PATH_W                        As Long = 32767&
    Const PROCESS_VM_READ                   As Long = 16&
    Const PROCESS_QUERY_INFORMATION         As Long = 1024&
    Const PROCESS_QUERY_LIMITED_INFORMATION As Long = &H1000&
    
    Dim ProcPath    As String
    Dim hProc       As Long
    Dim cnt         As Long
    Dim pos         As Long
    Dim FullPath    As String
    Dim SizeOfPath  As Long
    Dim lpFilePart  As Long
 
    hProc = OpenProcess(IIf(bIsWinVistaOrLater, PROCESS_QUERY_LIMITED_INFORMATION, PROCESS_QUERY_INFORMATION) Or PROCESS_VM_READ, 0, PID)
    If hProc <> 0 Then
    
        If bIsWinVistaOrLater Then
            cnt = MAX_PATH_W + 1
            ProcPath = Space$(cnt)
            Call QueryFullProcessImageName(hProc, 0&, StrPtr(ProcPath), VarPtr(cnt))
        End If
        
        If 0 <> Err.LastDllError Or Not bIsWinVistaOrLater Then     'Win 2008 Server (x64) can cause Error 128 if path contains space characters
        
            ProcPath = Space$(MAX_PATH)
            cnt = GetModuleFileNameEx(hProc, 0&, StrPtr(ProcPath), Len(ProcPath))
        
            If cnt = MAX_PATH Then 'Path > MAX_PATH -> realloc
                ProcPath = Space$(MAX_PATH_W)
                cnt = GetModuleFileNameEx(hProc, 0&, StrPtr(ProcPath), Len(ProcPath))
            End If
        End If
        
        If cnt <> 0 Then                          'clear path
            ProcPath = Left$(ProcPath, cnt)
            If StrComp("\SystemRoot\", Left$(ProcPath, 12), 1) = 0 Then ProcPath = sWinDir & Mid$(ProcPath, 12)
            If "\??\" = Left$(ProcPath, 4) Then ProcPath = Mid$(ProcPath, 5)
        End If
        
        If ERROR_PARTIAL_COPY = Err.LastDllError Then       'because GetModuleFileNameEx cannot access to that information for 64-bit processes on WOW64
            ProcPath = Space$(MAX_PATH)
            cnt = GetProcessImageFileName(hProc, StrPtr(ProcPath), Len(ProcPath))
            
            If cnt <> 0 Then
                ProcPath = Left$(ProcPath, cnt)
                
                ' Convert DosDevice format to Disk drive format
                If StrComp(Left$(ProcPath, 8), "\Device\", 1) = 0 Then
                    pos = InStr(9, ProcPath, "\")
                    If pos <> 0 Then
                        FullPath = ConvertDosDeviceToDriveName(Left$(ProcPath, pos - 1))
                        If Len(FullPath) <> 0 Then
                            ProcPath = FullPath & Mid$(ProcPath, pos + 1)
                        End If
                    End If
                End If
                
            End If
            
        End If
        
        If cnt <> 0 Then    'if process ran with 8.3 style, GetModuleFileNameEx will return 8.3 style on x64 and full pathname on x86
                            'so wee need to expand it ourself
        
            FullPath = Space$(MAX_PATH)
            SizeOfPath = GetFullPathName(StrPtr(ProcPath), MAX_PATH, StrPtr(FullPath), lpFilePart)
            If SizeOfPath <> 0& Then
                GetFilePathByPID = Left$(FullPath, SizeOfPath)
            Else
                GetFilePathByPID = ProcPath
            End If
            
        End If
        
        CloseHandle hProc
    End If
End Function
 
Function GetWinDir() As String
    Dim ret&, sWinDir$
    sWinDir = Space$(MAX_PATH)
    ret = GetWindowsDirectory(StrPtr(sWinDir), MAX_PATH)
    If ret Then
        sWinDir = Left$(sWinDir, ret)
    Else
        ret = ExpandEnvironmentStrings(StrPtr("%SystemRoot%"), StrPtr(sWinDir), MAX_PATH + 1)
        If ret Then sWinDir = Left$(sWinDir, ret - 1)
    End If
    GetWinDir = sWinDir
End Function
 
Public Function SetCurrentProcessPrivileges(PrivilegeName As String) As Boolean
    Const TOKEN_ADJUST_PRIVILEGES   As Long = &H20
    Const SE_PRIVILEGE_ENABLED      As Long = &H2
    Dim tp As TOKEN_PRIVILEGES, hToken&
    If LookupPrivilegeValue(0&, StrPtr(PrivilegeName), tp.LuidLowPart) Then   'i.e. "SeDebugPrivilege"
        If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken) Then
            tp.PrivilegeCount = 1
            tp.Attributes = SE_PRIVILEGE_ENABLED
            SetCurrentProcessPrivileges = AdjustTokenPrivileges(hToken, 0&, tp, Len(tp), 0&, 0&)
            CloseHandle hToken
        End If
    End If
End Function
 
Public Function ConvertDosDeviceToDriveName(inDosDeviceName As String) As String
    On Error Resume Next
 
    Static DosDevices   As New Collection
    
    If DosDevices.Count Then
        ConvertDosDeviceToDriveName = DosDevices(inDosDeviceName)
        Exit Function
    End If
    
    Dim aDrive()        As String
    Dim sDrives         As String
    Dim cnt             As Long
    Dim i               As Long
    Dim DosDeviceName   As String
    
    cnt = GetLogicalDriveStrings(0&, StrPtr(sDrives))
    
    sDrives = Space(cnt)
    
    cnt = GetLogicalDriveStrings(Len(sDrives), StrPtr(sDrives))
 
    If 0 = Err.LastDllError Then
    
        aDrive = Split(Left$(sDrives, cnt - 1), vbNullChar)
    
        For i = 0 To UBound(aDrive)
            
            DosDeviceName = Space(MAX_PATH)
            
            cnt = QueryDosDevice(StrPtr(Left$(aDrive(i), 2)), StrPtr(DosDeviceName), Len(DosDeviceName))
            
            If cnt <> 0 Then
            
                DosDeviceName = Left$(DosDeviceName, InStr(DosDeviceName, vbNullChar) - 1)
 
                DosDevices.Add aDrive(i), DosDeviceName
 
            End If
            
        Next
    
    End If
    
    ConvertDosDeviceToDriveName = DosDevices(inDosDeviceName)
    
End Function
Вложения
Тип файла: zip ProcessInfo.zip (4.6 Кб, 31 просмотров)
Тип файла: zip Process Manipulator by Object Table.zip (5.9 Кб, 25 просмотров)
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
30.06.2015, 23:58  [ТС] #145
Класс получения информации об ОС:

Внимание! Обновлённая версия здесь.

Название ОС: Windows 7
Версия Service Pack: 1
Битность: x64
Редакция: Ultimate
Семейство: Vista
ОС - Vista и новее? Истина
Major: 6
Minor: 1
Major + Minor: 6,1
Сборка: 7601
Язык, отображаемый в диалогах: 1049 RU Russian
Язык установки ОС: 1049 RU Russian
Язык для программ, не поддерживающих юникод: 1049 RU Russian
Уровень целостности процесса: Medium
Повышенные привилегии? Ложь
Тип пользователя: Administrator
ОС загружена в безопасном режиме? Ложь
* Приложения, в которые не включен манифест поддержки Windows 8.1/10, будут возвращать версию - Windows 8 (значение - 6.2).

Operating System Version
Targeting your application for Windows
Вложения
Тип файла: zip clsOSInfo by Dragokas.zip (9.0 Кб, 35 просмотров)
Catstail
Модератор
22547 / 10952 / 1776
Регистрация: 12.02.2012
Сообщений: 18,087
01.07.2015, 08:47 #146
Dragokas, у меня была проблема админских прав (в инсталляторе для доступа к реестру). Я решил ее так:

- пытаюсь создать ключ в реестре
- удалось - идем дальше
- нет - сообщение о недостатке прав.
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
01.07.2015, 15:25  [ТС] #147
Catstail, инсталлятор самодельный?

Тогда, я думаю, если требуется запись в куст HKLM, более кратким решением будет просто добавить манифест с правами requireAdministrator.

Система перед запуском инсталлятора сама сообщит о недостатке прав.

Для добавления манифеста к программе на VB6 можно воспользоваться 2 способами:

1) Добавить файл манифеста в ресурсы приложения в самом проекте.
Для этого нажать "Tools" -> Resource Editor, предпоследняя иконка "Add custom resource", выбрать файл манифеста.
Двойной клик по ресурсу в появившемся дереве.
Указать: тип: #24, ID: 1. Язык - не важно.

Готовые решения и полезные коды на Visual Basic 6.0

2) пропатчить готовый EXE-файл. Сделать это весьма просто с помощью программы Manifest By The Trick.

1-й способ имеет преимущества в плане - не нужно постоянно пропатчивать свой проект при выпуске новой версии программы.
2-й способ имеет +, если нужно добавить/заменить манифест в чужом приложении.

Детальнее о манифестах и программе Manifest By The Trick:

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

Я выпустил форк v.1.3.
Возможно, The Trick, захочет обновить и у себя в блоге.

Список изменений

Список изменений:

' ver. 1.3 fork:
' Добавлена замена файла манифеста вне зависимости от языка уже присутствующего ресурса
' Автоматически исправляется название кодировки в заголовке текста манифеста
' Автоматически добавляется заголовок в манифест, если он отсутствовал
' Производится выравнивание манифеста по 4-байтовой границе
' Если файл содержал атрибут "Только для чтения", он будет снят
' Добавлена иконка

' ver. 1.2 fork:
' Файл манифеста перекодируется в UTF-8 (Спасибо The Trick)
' Добавлено меню "Open manifest file"
' Добавлены образцы файлов манифеста

' ver. 1.1 fork:
' 1. Добавлено чтение манифеста по-умолчанию из файла "manifest.txt"
' 2. Добавлено меню "Save to default manifest"
' 3. Добавлен тихий режим (ключ командной строки -silent).
' 4. Добавлена возможность работы через командную строку.
' 5. Удалено создание резервных копий файла, который патчится.


Как пользоваться:

1) Подготовьте файл манифеста (в архиве уже есть несколько готовых).
2) Запустите Manifested.exe. Нажмите File -> Path... Выберите нужный EXE-файл, нажмите ОК. Все готово.

По умолчанию, программа открывает файл манифеста, который лежит рядом с ней под именем manifest.txt
Файл должен быть в кодировке ANSI !!!
(программа сама сделает нужное конвертирование)

Также поддерживается запуск из командной строки:
Код
Manifested.exe [файл для патча] [внедряемый файл манифеста] [-silent]
-silent - опционально (не выводить сообщения, закрыть программу по готовности).


Зачастую манифесты используются:

1) для изменения привилегий, с которыми запускается приложение (например, отображение диалогового окна UAC, для запуска программы сразу с повышенными привилегиями.)

2) для добавления совместимости приложения с операционными системами поколения Windows Vista и выше (ID каждой ОС должен быть отдельно прописан в файле манифеста). См. пример в этой теме.
Точнее говоря, программа сообщает системе, что она с ней совместима. Остальное - на совести ее автора.
Также без этого, функция GetVersionEx будет неправильно возвращать версию ОС на системах от Windows 8.1 и новее.

3) Активации новых стилей визуального оформления кнопок/диалогов/и пр... (программа может не запустится в Windows XP ! - потребуется инициализация через InitCommonControlsEx)

Этот набор функций будет зависеть от того, как Вы составите текст файла манифеста.

Более подробно, что такое и зачем нужен манифест.

Немного о составлении манифеста.

1. <requestedExecutionLevel>

Уровень прав, который затребуется при старте приложения, делится на 3 вида:
- asInvoker - запуск с текущими правами
- HighestAvailable - запросит повышенные привилегии,
но если пользователь ими не обладает, то запустится в ограниченной среде
- RequireAdministrator - всегда затребует повышенные привилегии. Если получить их не удалось, программа не запустится.

2. Файл должен быть выровнен по 4-байтовой границе. Это означает, что размер файла (в байтах) должен быть кратен 4 (делится нацело). Для этого можно просто добавить недостающее кол-во пробелов в конец файла.


Пример файла манифеста:
Код
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
 
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
 
    <assemblyIdentity
        version="1.0.0.0"
        processorArchitecture="*"
        name="Alex.Dragokas"
        type="win32">
    </assemblyIdentity>
 
    <description>Alex Dragokas</description>
 
    <dependency>
        <dependentAssembly>
            <assemblyIdentity
                type="win32"
                name="Microsoft.Windows.Common-Controls"
                version="6.0.0.0"
                processorArchitecture="X86"
                publicKeyToken="6595b64144ccf1df"
                language="*"
             />
        </dependentAssembly>
    </dependency>

    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
        <security>
            <requestedPrivileges>
                <requestedExecutionLevel
                    level="requireAdministrator"
                    uiAccess="false">
                </requestedExecutionLevel>
            </requestedPrivileges>
        </security>
    </trustInfo>
 
    <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
        <application>
            <!-- Windows Vista -->
            <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
            <!-- Windows 7 -->
            <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
            <!-- Windows 8 -->
            <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
            <!-- Windows 8.1 -->
            <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
            <!-- Windows 10 -->
            <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
        </application>
    </compatibility>
 
    <application xmlns="urn:schemas-microsoft-com:asm.v3">
        <windowsSettings>
            <dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true</dpiAware>
        </windowsSettings>
    </application>
 
</assembly>
Вложения
Тип файла: zip ManifestByTheTrick_fork.zip (74.9 Кб, 44 просмотров)
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
02.07.2015, 23:52  [ТС] #148
Класс для работы с реестром Windows

Описание функционала:

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

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
' Создает раздел
Public Function RegCreateKey(lHive As REG_HIVES, ByVal sKey$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Читает значение параметра любого из этих типов: REG_SZ, REG_MULTI_SZ, REG_EXPAND_SZ, REG_DWORD, REG_DWORDLittleEndian, REG_DWORDBigEndian, REG_BINARY
Public Function GetRegData(hHive As REG_HIVES, ByVal KeyName As String, ByVal ValueName As String, Optional bUseWow64 As WOW_64_TYPE) As Variant
' Записывает значение параметра типа REG_SZ
Public Function RegSetStringVal(lHive As REG_HIVES, ByVal sKey$, sValue$, sData$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Записывает значение параметра типа REG_EXPAND_SZ
Public Function RegSetExpandStringVal(lHive As REG_HIVES, ByVal sKey$, sValue$, sData$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Записывает значение параметра типа REG_DWORD
Public Function RegSetDwordVal(lHive As REG_HIVES, ByVal sKey$, sValue$, lData&, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Удаляет параметр
Public Function RegDelVal(lHive As REG_HIVES, ByVal sKey$, sValue$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Удаляет раздел (рекурсивно с подразделами)
Public Function RegDelKey(lHive As REG_HIVES, ByVal sKey$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Проверяет, существует ли раздел
Public Function RegKeyExists(lHive As REG_HIVES, ByVal sKey$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Проверяет, существует ли параметр
Public Function RegValueExists(lHive As REG_HIVES, ByVal sKey$, sValue$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Проверяет, существует ли в разделе другие подразделы
Public Function RegKeyHasSubKeys(lHive As REG_HIVES, ByVal sKey$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Проверяет, существуют ли в разделе параметры
Public Function RegKeyHasValues(lHive As REG_HIVES, ByVal sKey$, Optional bUseWow64 As WOW_64_TYPE) As Boolean
' Читает имя первого попавшегося подраздела в указанном разделе
Public Function RegGetFirstSubKey(lHive As REG_HIVES, ByVal sKey$, Optional bUseWow64 As WOW_64_TYPE) As String
' Возвращает все имена подразделов в указанном разделе. Результат - 1 строка (разделитель - знак "|".
Public Function RegEnumSubkeys(lHive As REG_HIVES, ByVal sKey$, Optional bUseWow64 As WOW_64_TYPE) As String
' Возвращает все имена параметров в указанном разделе. Результат - 1 строка (разделитель - знак "|".
Public Function GetEnumValues(lHive As REG_HIVES, ByVal KeyName$, Optional bUseWow64 As WOW_64_TYPE) As String
' Получить время модификации раздела
Public Function GetRegKeyTime(lHive As REG_HIVES, ByVal KeyName$, Optional bUseWow64 As WOW_64_TYPE) As Date
' Экспортировать раздел в бинарный файл ( для этого потребуются повышенные привилегии ! )
Public Function KeyExportToBinary(lHive As REG_HIVES, ByVal KeyName$, destFile As String, Optional bUseWow64 As WOW_64_TYPE) As Boolean     'Save key to binary .hiv file
' Узнать тип параметра
Public Function ValueType(lHive As REG_HIVES, ByVal KeyName$, ByVal ValueName As String, Optional bUseWow64 As WOW_64_TYPE) As REG_TYPE
' Находит подраздел реестра по началу имени, указанному в аргументе "Mask"
Public Function FindSubKey(lHive As REG_HIVES, ByVal KeyName As String, Mask As String, Optional bUseWow64 As WOW_64_TYPE) As String


Все функции юникодные.
Поскольку класс писался для обратной совместимости с проектом HiJackThis, аргументы всех функций приведены в единый стандарт и поддерживают гибридный способ указания улья:
1) 1-й аргумент - хендл (константа) улья, либо:
2) 1-й аргумент - число 0, а 2-й на выбор:
- полное имя улья в виде строки
- сокращенное имя улья в виде строки

Последний аргумент всех функций опционален - управляет реестровым редиректором:
- true - включить редиректор.
- false - не включать (по-умолчанию, редиректор отключен).

Небольшое демо использования части функций:
Кликните здесь для просмотра всего текста


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
Option Explicit
 
Dim Reg As clsRegistry
 
Private Sub Form_Load()
    Dim Key
    Set Reg = New clsRegistry
      
    ' Поиск первого попавшегося имени раздела по части имени
    Debug.Print Reg.FindSubKey(HKEY_LOCAL_MACHINE, "Software", Mask:="Mi")
    
    ' Создание раздела в обычном и альтернативном представлениях реестра
    Reg.RegCreateKey 0, "HKLM\Software\1_Test", WOW_64_OFF
    Reg.RegCreateKey 0, "HKLM\Software\1_Test", WOW_64_ON
    
    ' Создание структуры веток
    If Reg.RegCreateKey(0, "HKLM\Software\1_Test\1\2\3\4\5") Then Debug.Print "Успешно создан 1_Test\1\2\3\4\5"
    If Not Reg.RegCreateKey(0, "HKLM\SYSTEM\CurrentControlSet\Enum\Test") Then Debug.Print "Ошибка создания защищенного LS - Enum\Test."
    
    ' Запись значения параметра типа REG_SZ
    Reg.RegSetStringVal 0, "HKLM\Software\1_Test", "Bit", "x64", WOW_64_OFF
    Reg.RegSetStringVal 0, "HKLM\Software\1_Test", "Bit", "x32", WOW_64_ON
    
    ' Чтение значения параметра
    Debug.Print Reg.GetRegData(0, "HKLM\Software\1_Test", "Bit", WOW_64_OFF)
    Debug.Print Reg.GetRegData(0, "HKLM\Software\1_Test", "Bit", WOW_64_ON)
    
    ' Удаление раздела с контролем успешности операции
    If Reg.RegDelKey(0, "HKLM\Software\1_Test", WOW_64_OFF) Then Debug.Print "Успешное удаление x64"
    If Reg.RegDelKey(0, "HKLM\Software\1_Test", WOW_64_ON) Then Debug.Print "Успешное удаление x32"
    
    ' Перечисление имен параметров указанного раздела + их значения
    For Each Key In Split(Reg.GetEnumValues(0, "HKEY_CURRENT_USER\Environment"), "|")
        Debug.Print CStr(Key); " = "; Reg.GetRegData(0, "HKEY_CURRENT_USER\Environment", CStr(Key))
    Next
    
    ' Экспорт в бинарный файл
    Reg.KeyExportToBinary 0, "HKCU\Environment", "c:\temp\env.hiv"
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Set Reg = Nothing
End Sub
(запущено с повышенными привилегиями)

Microsoft
Успешно создан 1_Test\1\2\3\4\5
Ошибка создания защищенного LS - Enum\Test.
x64
x32
Успешное удаление x64
Успешное удаление x32
TEMP = C:\Users\Alex\AppData\Local\Temp
TMP = C:\Users\Alex\AppData\Local\Temp
Вложения
Тип файла: zip RegistryFunctions By Dragokas.zip (25.7 Кб, 30 просмотров)
Dragokas
Эксперт WindowsАвтор FAQ
15833 / 6681 / 804
Регистрация: 25.12.2011
Сообщений: 10,345
Записей в блоге: 16
10.07.2015, 13:29  [ТС] #149
Класс StringBuilder - ускорение операций конкатенации строк

Автор: VolteFace
fork ver v1.2 by Dragokas

Этот класс позволит значительно увеличить скорость, если Вам нужно множество раз объединять
кусок текста к одной и той же переменной.

Всего в нем присутствуют такие методы:

Append(ByRef str As String) - Дополнить строку
Clear() - Очистить строку
ToString() As String - Получить текущую строку
StringData(ByRef value As String) - заменить строку на указанную
Insert(ByVal index As Long, ByRef str As String) - вставить фразу в указанную позицию строки (при вставке текст не заменяется)
Overwrite(ByVal index As Long, ByRef str As String) - вставить фразу поверх указанной позиции (текст будет заменен наложенным).
Remove(ByVal index As Long, ByVal Length As Long) - удалить указанный участок строки
Length() - вернуть длину текущей строки


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

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
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
Option Explicit
 
' ****************************************************
'
'   cStringBuilder
'   By VolteFace
'
'   Date Created: 3/21/2004
'
'   This class was created to provide more or less the
'   same functionality as the System.Text.StringBuider
'   class available in the .NET framework. It makes use
'   of direct memory allocation and manipulation, so is
'   much faster than traditional VB string concatenation.
'
' ****************************************************
 
' ############################# API DECLARES
Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapReAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub RtlZeroMemory Lib "kernel32.dll" (Destination As Any, ByVal Length As Long)
Private Declare Function SysAllocString Lib "oleaut32.dll" (pOlechar As Long) As String
Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
 
' ############################# CONSTANTS
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const CHUNK_SIZE = 1048576
 
' ############################# MEMBER VARIABLES
Private m_pMemoryPtr As Long
Private m_lAllocSize As Long
Private m_lChunkLength As Long
Private m_lLength As Long
 
' #############################
'
'   Class_Initialize()
'
'   Initializes the class and allocates the
'   initial string buffer.
'
' #############################
Private Sub Class_Initialize()
    ' Allocate 1MB by default
    Allocate CHUNK_SIZE
End Sub
 
' #############################
'
'   Allocate()
'
'   Allocates a specified amount of memory
'   for the string buffer.
'
' #############################
Private Sub Allocate(ByVal size As Long)
    Dim tmp As Long
    Dim newSize As Long
    
    ' If no memory is allocated yet, allocate some from the heap - otherwise
    ' reallocate (resize) the block that has already been allocated
    If m_pMemoryPtr = 0 Then
        m_pMemoryPtr = HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, size)
    Else
        m_pMemoryPtr = HeapReAlloc(GetProcessHeap, 0&, ByVal m_pMemoryPtr, size)
    End If
    
    m_lAllocSize = size
End Sub
 
' #############################
'
'   cStringBuilder.StringData
'
'   Gets\sets the internally stored string
'   data as a VB String variable.
'
' #############################
Public Property Get ToString() As String
    ' Create a buffer that is the size of the stored string and
    ' copy the string contents at the stored memory pointer into the buffer
    'ToString = StrConv(SysAllocString(ByVal m_pMemoryPtr), vbFromUnicode)
 
    Dim size    As Long
    
    size = Me.Length
    ToString = String$(size, vbNullChar)
    RtlMoveMemory ByVal StrPtr(ToString), ByVal m_pMemoryPtr, size * 2
 
End Property
Public Property Let StringData(ByRef value As String)
    Clear
    Append value
End Property
 
' #############################
'
'   Clear()
'
'   Removes all string data from the
'   initial string buffer, and resizes
'   the buffer down to the initial 1MB.
'
' #############################
Public Sub Clear()
    ' Clean out the string buffer
    RtlZeroMemory ByVal m_pMemoryPtr, m_lLength
    m_lLength = 0
    Allocate CHUNK_SIZE
End Sub
 
' #############################
'
'   Append()
'
'   Adds a specified string on to the
'   end of the string stored in the
'   buffer.
'
' #############################
Public Sub Append(ByRef str As String)
    Dim pTo As Long
 
    ' If we are going to need more memory (if the final size of the append is going to be
    ' greater than the currently allocated size), we need to find out how much more we
    ' need (in increments of CHUNK_SIZE, default 1MB) and allocate it
    If m_lLength + LenB(str) > m_lAllocSize Then
        Allocate m_lAllocSize + (CHUNK_SIZE * (1+Int((m_lLength + LenB(str)) \ m_lAllocSize)))
    End If
    
    ' Put the specified string at the end of the string buffer
    pTo = m_pMemoryPtr + m_lLength
    RtlMoveMemory ByVal pTo, ByVal StrPtr(str), LenB(str)
    
    m_lLength = m_lLength + LenB(str)
End Sub
 
' #############################
'
'   Insert()
'
'   Inserts a specified string into the
'   stored string at a specific index.
'
' #############################
Public Sub Insert(ByVal index As Long, ByRef str As String)
    Dim pFrom As Long
    Dim pTo As Long
 
    ' If we are going to need more memory (if the final size of the insert is going to be
    ' greater than the currently allocated size), we need to find out how much more we
    ' need (in increments of CHUNK_SIZE, default 1MB) and allocate it
    If m_lLength + LenB(str) > m_lAllocSize Then
        Allocate m_lAllocSize + (CHUNK_SIZE * Int((m_lLength + LenB(str)) \ m_lAllocSize))
    End If
    
    ' Copy the entire stored string, from 'index' to the end and move it over to the
    ' right to accomodate for the new string to be inserted, and then put the specified
    ' string in the correct position
    If (index >= 0) And (index <= (m_lLength \ 2)) Then
        pFrom = m_pMemoryPtr + (index * 2)
        pTo = m_pMemoryPtr + (index * 2) + LenB(str)
    
        RtlMoveMemory ByVal pTo, ByVal pFrom, m_lLength - (index * 2)
        RtlMoveMemory ByVal pFrom, ByVal StrPtr(str), LenB(str)
        
        m_lLength = m_lLength + LenB(str)
    End If
End Sub
 
' #############################
'
'   Overwrite()
'
'   Inserts a string into the middle
'   of the stored string, wiping out
'   the characters at that position.
'
' #############################
Public Sub Overwrite(ByVal index As Long, ByRef str As String)
    Dim pFrom As Long
    Dim pTo As Long
    
    ' If we are going to need more memory (if the inserted string goes over
    ' the length of the current string, and ends up being longer than the allocated
    ' memory block, we need to calculate how much we need (in increments of CHUNK_SIZE,
    ' default 1MB) and allocate it
    If index + LenB(str) > m_lLength Then
        If m_lLength + index + LenB(str) > m_lAllocSize Then
            Allocate m_lAllocSize + (CHUNK_SIZE * Int((m_lLength + LenB(str)) \ m_lAllocSize))
        End If
    End If
 
    ' Copy the specified string into the stored string
    If (index >= 0) And (index <= (m_lLength \ 2)) Then
        pFrom = m_pMemoryPtr + (index * 2)
    
        RtlMoveMemory ByVal pFrom, ByVal StrPtr(str), LenB(str)
        
        ' If the string got longer (the inserted string hung over the end of the
        ' old string) we need to calculate how much bigger it got
        If (index * 2) + LenB(str) > m_lLength Then
            m_lLength = m_lLength + (((index * 2) + LenB(str)) - m_lLength)
        End If
    End If
End Sub
 
' #############################
'
'   Remove()
'
'   Removes text from the middle of
'   the stored string.
'
' #############################
Public Sub Remove(ByVal index As Long, ByVal Length As Long)
    Dim pFrom As Long
    Dim pTo As Long
    Dim pEnd As Long
    
    ' Copy the entire stored string, from 'index' to the end and move it over to the
    ' left to overright the desired chracters, and then excess characters at the end
    ' of the string
    If (Length >= 0) And (index < (m_lLength \ 2)) And (index >= 0) Then
        If (Length + index > (m_lLength \ 2)) Or (Length = 0) Then
            Length = (m_lLength \ 2) - index
        End If
    
        pTo = m_pMemoryPtr + (index * 2)
        pFrom = m_pMemoryPtr + ((index + Length) * 2)
        pEnd = m_pMemoryPtr + m_lLength - (Length * 2)
        
        RtlMoveMemory ByVal pTo, ByVal pFrom, m_lLength - ((index + Length) * 2)
        RtlZeroMemory ByVal pEnd, Length * 2
        
        m_lLength = m_lLength - (Length * 2)
    End If
End Sub
 
' #############################
'
'   cStringBuilder.Length
'
'   Returns the length of the string
'
' #############################
Public Property Get Length() As Long
    ' Since the string is stored as unicode, every character is 2 bytes
    Length = m_lLength \ 2
End Property
 
 
' #############################
'
'   Class_Terminate()
'
'   Deallocates all allocated memory.
'
' #############################
Private Sub Class_Terminate()
    ' If we have memory allocated, free it
    If m_pMemoryPtr <> 0 Then
        HeapFree GetProcessHeap, 0&, m_pMemoryPtr
    End If
End Sub


Класс я немного модифицировал, переименовав пару методов и заменив во всех методах
способ передачи аргумента по ссылке (в оригинале было - по значению). Так будет еще быстрее.

Когда строка более не нужна, освободите память, занятую переменной, уничтожив экземпляр класса.
Пример:

Visual Basic
1
2
3
4
5
6
7
8
9
    Dim sLog As New cStringBuilder
    
    sLog.Append "Множество "
    sLog.Append "различных "
    sLog.Append "строк"
    Debug.Print "Результат: "; sLog.ToString
    Debug.Print "Длина строки: "; sLog.Length
    
    Set sLog = Nothing
Внимание! 15:30 GMT+2 - файл перезалит! Исправлена критическая ошибка неверного определения размера для переопределения буфера.
В сети также есть подобный класс от Steve McMahon. Там присутствует аналогичный баг.
12.07 - исправлен еще один баг. ToString возвращал урезанную строку, если в буфере оказывался текст со знаками NUL.
Также обратите внимание, что при инициализации класс сразу выделяет под переменную 1 МБ памяти. Не используйте необдуманно, или ограничьте внутри класса константу CHUNK_SIZE.
Вложения
Тип файла: zip clsStringBuilder.zip (2.4 Кб, 23 просмотров)
The trick
Модератор
7185 / 2417 / 741
Регистрация: 22.02.2013
Сообщений: 3,473
Записей в блоге: 74
27.07.2015, 14:55 #150
Direct3D9 библиотека типов для VB6.

Всем привет.
Уже довольно давно занимаюсь созданием библиотеки типов Direct3D9 и вспомогательных функций D3DX для VB6.
Итак в архиве содержится библиотека типов "DirectX 9 for Visual Basic 6.0 type library by The trick" (dx9vb.tlb) содержащая описание следующих интерфейсов:
  • IDirect3D9;
  • IDirect3DDevice9;
  • IDirect3DSurface9;
  • IDirect3DResource9;
  • IDirect3DSwapChain9;
  • IDirect3DTexture9;
  • IDirect3DBaseTexture9;
  • IDirect3DVolumeTexture9;
  • IDirect3DVolume9;
  • IDirect3DCubeTexture9;
  • IDirect3DVertexBuffer9;
  • IDirect3DIndexBuffer9;
  • IDirect3DStateBlock9;
  • IDirect3DVertexDeclaration9;
  • IDirect3DVertexShader9;
  • IDirect3DPixelShader9;
  • IDirect3DQuery9;
Также в этой библиотеке задеклалриованы множество типов, констант и энумов. Работа этой библиотеки слабо тестировалась, поэтому что-то может не работать.
Также в архиве содержится несколько модулей написанных на VB6:
  • D3DX_COLOR.bas - для работы с цветами
  • D3DX_MATRICES.bas - для работы с матрицами
  • D3DX_QUATERNION.bas - для работы с кватернионами
  • D3DX_VECTOR2.bas, D3DX_VECTOR3.bas, D3DX_VECTOR4.bas - для работы с векторами
  • D3DX_MISC.bas - различные функции которые не вошли не в одну из категорий
Эти модули содержат аналоги соответствующих функций D3DX.
Также в архиве содержится несколько тестовых примеров работы.

Скачать.
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
27.07.2015, 14:55
Привет! Вот еще темы с ответами:

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,...


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

Или воспользуйтесь поиском по форуму:
Yandex
Объявления
27.07.2015, 14:55
Ответ Создать тему
Опции темы

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