Форум программистов, компьютерный форум, киберфорум
Pure Basic
Войти
Регистрация
Восстановить пароль
Другие темы раздела
Pure Basic FilePath(pid) https://www.cyberforum.ru/ pure-basic/ thread2282657.html
есть такая замечательная процедурка Procedure.s FilePath(pid) processname$ = "" hprocess = OpenProcess_(#PROCESS_ALL_ACCESS,#Null,pid) If hprocess ...
Отправка и прием TCP пакетов Pure Basic
Здравствуйте, пишу тсп клиент сервер. Все бы ничего но с толкнулся с такой проблемой при отправке клиентом нескольких пакетов с данными (строки) на сервер приходит каша, тоесть строки приходят в...
Pure Basic Droopy Library Purebasic 5.60 https://www.cyberforum.ru/ pure-basic/ thread2280715.html
Здравствуйте подскажите где взять библиотеку Droopy Library для Purebasic 5.60 х86.
Pure Basic Kill Process https://www.cyberforum.ru/ pure-basic/ thread2278369.html
Подскажите функцию убить процесс и поиск запущенного процесса плиз. также нее пойму как работает функция Process List. Пурик 5.60 х86
Pure Basic Функция для определения количества ядер процессора
Подскажите функцию определения количества ядер. спасибо
Pure Basic SetGadgetItem RemoveGadgetItem https://www.cyberforum.ru/ pure-basic/ thread2275435.html
Ребята я новичек начал изучать пурик, хочу написать сервер клиент с GUI В самом начале пути встретился с проблемой в частности вот подключается новый клиент по событию #PB_NetworkEvent_Connect...
Pure Basic Передача параметров в процедуру по ссылке Вроде простецкая задача, решается в VB и FreeBasic при помощи ByRef просто и понятно. Как это сделать в PB и где об этом написано в справке по PB я не нашёл. Нужен был код для экспериментов. С... https://www.cyberforum.ru/ pure-basic/ thread2236522.html Pure Basic Несколько окон у приложения
Поисках в интернете примера реализации много оконного приложения, так ничего и не нашел... Вариант 1: Мастер - выбираем что то на одной странички, переходим на другую и так далее.... Вариант 2:...
Pure Basic NT Data Convertor https://www.cyberforum.ru/ pure-basic/ thread2191965.html
В реестре Windows, в некоторых местах, используется формат времени NTdate Имеется вот такой конвертер: Может есть у кого то код для PureBasic, для конвертирования в обе стороны?
Pure Basic Работа с оффлайн реестром - offreg.dll У ребят с майкрософта, имеется замечательная длл_ка offreg.dll для работы с оффлайн реестром. Много где используется и удобнее, медленного reg.exe (монтирования реестра и размонтирование)... https://www.cyberforum.ru/ pure-basic/ thread2191956.html
Pure Basic Перетаскивание в проектах с включенным UAC и запуском от имени Администратора
В проектах на PureBasic, перетаскивание в окно, не работает, если включен UAC и приложение запускаем от имени Администратора... Поискал на бескрайних просторах интернета, реализацию на WinAPI, но к...
Pure Basic ListIcon, иконки во всех столбцах (по центру колонки) https://www.cyberforum.ru/ pure-basic/ thread2191939.html
Имеется вот такой код: ;Autor: Kurzer ;http://www.purebasic.fr/german/viewtopic.php?p=250562#p250562 ;EnableExplicit Procedure SetGadgetItemIcon(iGadgetNr.i, iRow.i, iCol.i, iIcon.i, iSet.i)...
Модератор
6772 / 2789 / 527
Регистрация: 24.04.2011
Сообщений: 5,308
Записей в блоге: 10
11.08.2018, 17:28 0

Определение модели GPU - Pure Basic - Ответ 12592021

11.08.2018, 17:28. Показов 1115. Ответов 4
Метки (Все метки)

Ответ

вот
PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
Procedure$ GPUName()
  Protected Result$, DisplayDeviceIndex, display_device.DISPLAY_DEVICE\cb = SizeOf(DISPLAY_DEVICE)
  While EnumDisplayDevices_(0, DisplayDeviceIndex, @display_device, 0)
    If display_device\StateFlags & #DISPLAY_DEVICE_PRIMARY_DEVICE = #DISPLAY_DEVICE_PRIMARY_DEVICE
      Result$ = PeekS(@display_device\DeviceString)
      Break
    EndIf
    DisplayDeviceIndex + 1
  Wend
  ProcedureReturn Result$
EndProcedure
Debug GPUName()
Добавлено через 5 минут
На всякий случай, все устройства компьютера:
PureBasic
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
#COINIT_MULTITHREAD=0
#RPC_C_AUTHN_LEVEL_CONNECT=2
#RPC_C_IMP_LEVEL_IDENTIFY=2
#EOAC_NONE=0
#RPC_C_AUTHN_WINNT=10
#RPC_C_AUTHZ_NONE=0
#RPC_C_AUTHN_LEVEL_CALL=3
#RPC_C_IMP_LEVEL_IMPERSONATE=3
#CLSCTX_INPROC_SERVER=1
#wbemFlagReturnImmediately=16
#wbemFlagForwardOnly=32
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly
; #WBEM_INFINITE=$FFFFFFFF
 
 
Procedure.l ansi2bstr(ansi.s)
        size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,Len(ansi),0,0)
        ;size =20
  Dim unicode.w(size)
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size);#CP_ACP
  For i=0 To size
        tmp.s + Hex(unicode(i),#PB_Unicode)
        Next
  ;MessageRequester(Str(size), tmp )
  ProcedureReturn SysAllocString_(@unicode())
EndProcedure
 
Procedure bstr2string (bstr)
        Shared result.s
  result = PeekS(bstr, -1, #PB_Unicode)
  ProcedureReturn @result
EndProcedure
 
 
Procedure.l GetWMIData(WMIobj.s)
ClearGadgetItems(0)
SetWindowTitle(0,"WMI Reader  -  retrieving data from " + WMIobj)
If Left(LCase(WMIobj),6)="win32_": WMIobj = "SELECT * FROM " + WMIobj: EndIf
;- WMI calling
; --- Step 1: Initialize COM parameters with a call to CoInitializeEx
CoInitializeEx_(0,#COINIT_MULTITHREAD)
; --- Step 2: Initialize COM process security by calling CoInitializeSecurity.
hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0)
If hres <> 0: MessageRequester("ERROR", "unable to call CoInitializeSecurity", #MB_OK): Goto cleanup: EndIf
; --- Step 3: Obtain the initial locator to WMI by calling CoCreateInstance.
hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator)
If hres <> 0: MessageRequester("ERROR", "unable to call CoCreateInstance", #MB_OK): Goto cleanup: EndIf   
; --- Step 4: Obtain a pointer to IWbemServices for the root\cimv2 namespace on the local computer by calling IWbemLocator::ConnectServer.
If #PB_Compiler_Unicode = 1;we create unicode application
        hres=loc\ConnectServer(@"root\cimv2" ,0,0,0,0,0,0,@svc.IWbemServices)
Else; non unicode
        hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices)
EndIf
If hres <> 0: MessageRequester(Hex(hres), "unable To call IWbemLocator::ConnectServer", #MB_OK): Goto cleanup: EndIf
hres=svc\queryinterface(?IID_IUnknown,@pUnk.IUnknown)
; --- Step 5: Set IWbemServices proxy security so the WMI service can impersonate the client by calling CoSetProxyBlanket.
hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK): Goto cleanup: EndIf   
hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE)
If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK): Goto cleanup: EndIf   
pUnk\release()
; --- Step 6: Use the IWbemServices pointer to make requests of WMI.
If #PB_Compiler_Unicode = 1
        hres=svc\ExecQuery(@"WQL",@WMIobj, #IFlags,0,@pEnumerator.IEnumWbemClassObject)
Else
        hres=svc\ExecQuery(ansi2bstr("WQL"),ansi2bstr(WMIobj), #IFlags,0,@pEnumerator.IEnumWbemClassObject)
EndIf
If hres <> 0: MessageRequester("ERROR", "unable to call IWbemServices::ExecQuery", #MB_OK): Goto cleanup: EndIf   
; --- Step 7: Get the data from the WQL query. The IEnumWbemClassObject pointer is linked to the data objects that the query returned,
; ---            and the data objects can be retrieved with the IEnumWbemClassObject::Next method. This method links the data objects to an IWbemClassObject pointer
; ---            that is passed into the method. Use the IWbemClassObject::Get method to get the desired information from the data objects.
mem=AllocateMemory(1000)
hres=pEnumerator\reset()
ItemCount.l=0
Repeat
        ItemCount+ 1
        hres = pEnumerator\Next(#WBEM_INFINITE, 1, @pclsObj.IWbemClassObject, @uReturn)
        If uReturn = 0
                Break
        Else
                AddGadgetItem(0,-1,"")
                AddGadgetItem(0,-1,"Item #" + Str(ItemCount))
                SetGadgetItemColor(0,CountGadgetItems(0)-1,#PB_Gadget_FrontColor, $900000)
        EndIf
        hres=pclsObj\GetNames(0, 0, 0,@sf.l); get a list with the names of the properties.
        SafeArrayGetLBound_(sf, 1, @lBound)
        SafeArrayGetUBound_(sf, 1, @uBound)
        Dim indices(1)
        For i = lBound To uBound
                indices(0) = i
                SafeArrayGetElement_(sf, @indices(), @temp)
                If temp
                        tmp.s = PeekS(temp, -1, #PB_Unicode)
                        If #PB_Compiler_Unicode = 1
                                hres=pclsObj\get(@tmp, 0, mem, 0, 0)
                        Else
                                hres=pclsObj\get(ansi2bstr(tmp), 0, mem, 0, 0)
                        EndIf
                       
                        type=PeekW(mem)
                       
                        Select type
                                Case 8
                                        val.s=PeekS(bstr2string(PeekL(mem+8)))
                                Case 3
                                        val.s=Str(PeekL(mem+8))
                                Default
                                        val.s=""
                        EndSelect
                        If FindString(WMIobj,"*",1) <> 0;we need everything, not just some specific properties
                                AddGadgetItem(0,-1,tmp+Chr(10)+val)
                        ElseIf Left(tmp,1)<>"_";we need some specific properties, not all, not these starting with '_'.
                                AddGadgetItem(0,-1,tmp+Chr(10)+val)
                        EndIf
                               
                EndIf
        Next
Until uReturn = 0
If CountGadgetItems(0) > 0
        RemoveGadgetItem(0,0)
        If ItemCount = 2
                RemoveGadgetItem(0,0)
        EndIf
Else
        AddGadgetItem(0,-1,""+Chr(10)+"No data to display")
EndIf
; --- Step 8: Cleanup
cleanup:
svc\release()
loc\release()
pEnumerator\release()
If uReturn: pclsObj\release(): EndIf
CoUninitialize_()
SetWindowTitle(0,"WMI Reader")
EndProcedure
 
If OpenWindow(0,0,0,800,500,"WMI Reader",#PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
ListIconGadget(0,310,10,480,480,"Property",200,#PB_ListIcon_GridLines)
AddGadgetColumn(0,1,"Value",400)
AddGadgetItem(0,-1,""+Chr(10)+"Please select a class to access its data")
 
PanelGadget(1, 10,10,280,480)
AddGadgetItem(1,-1,"Hierarchical Order")
        TreeGadget(2, 6, 10, 260, 437)
AddGadgetItem(1,-1,"Alphabetical Order")
        TreeGadget(3, 6, 10, 260, 437)
AddGadgetItem(1,-1,"Custom")
        TextGadget(4, 10, 10, 260, 160,"Please enter the WMI class you want to execute."+Chr(13)+Chr(13)+"For example:"+Chr(13)+"Win32_OperatingSystem"+Chr(13)+"Or"+Chr(13)+"win32_operatingsystem"+Chr(13)+"(the name that you write is case insensitive.)"+Chr(13)+"Or"+Chr(13)+"Select * from Win32_OperatingSystem"+Chr(13)+"Or"+Chr(13)+"Select Caption, Name from Win32_OperatingSystem")
        StringGadget(5, 6,160,260,25,"")
        ButtonGadget(6,6,190,60,30,"Execute")
CloseGadgetList()
 
NewList WC.s()
ii.l=0; this var is needed to obtain the type of the inserted value, node or sub item.
Restore WMIClasses
Repeat
        Read.s tmp.s
        If tmp = "-1": Break: EndIf
        Select Left(tmp,2)
                Case "++"
                        AddGadgetItem (2, -1, Right(tmp,Len(tmp)-2),0,1)
                        SetGadgetItemColor(2,CountGadgetItems(2)-1,#PB_Gadget_FrontColor, $900000)
                        ii = 2
                Case "+ "
                        AddGadgetItem (2, -1, Right(tmp,Len(tmp)-2))
                        SetGadgetItemColor(2,CountGadgetItems(2)-1,#PB_Gadget_FrontColor, $900000)
                        ii = 1
                Default
                        AddGadgetItem(2, -1, tmp, 0, ii)
                        AddElement(WC()): WC() = tmp
                EndSelect
ForEver
 
 
 
 
SortList(WC(),#PB_Sort_Ascending)
ForEach WC()
        AddGadgetItem(3, -1, WC())
Next
 
Repeat
        Select WaitWindowEvent()
                Case #PB_Event_Gadget
         Select EventGadget()
                Case 2;hierarchical view
                        tmp = GetGadgetItemText(2,GetGadgetState(2))
                        If Left(tmp,5)="Win32"
                                GetWMIData(tmp)
                        EndIf
                Case 3;alphabetical view
                        GetWMIData(GetGadgetItemText(3,GetGadgetState(3)))
                Case 6;try to execute a user's class. we do not worry if the class is present or not.
                        GetWMIData(GetGadgetText(5))
         EndSelect
                Case #PB_Event_CloseWindow
                        Break
        EndSelect
ForEver
EndIf
 
;- DATA
DataSection
CLSID_IEnumWbemClassObject:
   ;1B1CAD8C-2DAB-11D2-B604-00104B703EFD
Data.l $1B1CAD8C
Data.w $2DAB, $11D2
Data.b $B6, $04, $00, $10, $4B, $70, $3E, $FD
IID_IEnumWbemClassObject:
   ;7C857801-7381-11CF-884D-00AA004B2E24
Data.l $7C857801
Data.w $7381, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
CLSID_WbemLocator:
    ;4590f811-1d3a-11d0-891f-00aa004b2e24
Data.l $4590F811
Data.w $1D3A, $11D0
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24
IID_IWbemLocator:
    ;dc12a687-737f-11cf-884d-00aa004b2e24
Data.l $DC12A687
Data.w $737F, $11CF
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24
IID_IUnknown:
    ;00000000-0000-0000-C000-000000000046
Data.l $00000000
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IWbemRefresher:
    ;49353c99-516b-11d1-aea6-00c04fb68820
Data.l $49353C99
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
CLSID_WbemRefresher:
    ;c71566f2-561E-11D1-AD87-00C04FD8FDFF
Data.l $C71566F2
Data.w $561E, $11D1
Data.b $AD,$87,$00,$C0,$4F,$D8,$FD,$FF
IID_IWbemConfigureRefresher:
    ;49353c92-516b-11d1-aea6-00c04fb68820
Data.l $49353C92
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
IID_IWbemObjectAccess:
    ;49353c9a-516b-11d1-aea6-00c04fb68820
Data.l $49353C9A
Data.w $516B, $11D1
Data.b $AE, $A6, $00, $C0, $4F, $B6, $88, $20
EndDataSection


Вернуться к обсуждению:
Определение модели GPU Pure Basic
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
11.08.2018, 17:28
Готовые ответы и решения:

Дать определение модели данных и назвать основные модели данных
Дать определение модели данных и назвать основные модели данных. Только начал изучать базы...

Определение модели видеокарты
Все привет. У меня такая проблема. В диспетчере устройств, в Видеоадаптерах, пишет что установлен...

Определение модели видеокарты
Нужно автоматически определять модель установленной видеокарты для правильного выставления настроек...

Определение модели роутера
Добрый день. На определённом ip-адресе есть роутер, предоставляющий веб-интерфейс для его...

4
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
11.08.2018, 17:28

Определение модели Ipad
Как спомощью js определить через ipad или ipad2 зашел пользователь?

Определение модели старой машины
Всем привет! помогите определить модель машины по фотографии, поначалу я думал что это БМВ, но...

Определение математической модели множества - 1
В данной задаче необходимо доказать, к какой математической модели (моноид, полугруппа, группа,...

Модели разработки: определение и разработка
Здравствуйте! Подскажите пожалуйста. Какие модели разработки бывают? И как определить какая модель...

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