Binggung nih bos, boleh donk di upload project-nya ke file-nya milis
----- Original Message ----- From: Dhani Aristyawan ( EDP ) To: [email protected] Sent: Thursday, November 30, 2006 8:40 AM Subject: RE: [indoprog-vb] Nomor Seri Processor Dear Andristyanto, Coba ketik syntax ini : ************************************ Buat module baru dengan nama "cWmi" ************************************ Option Explicit Private Function ShowMethods(ByVal xi_objSWbemObjSet As SWbemObjectSet, _ ByRef xi_ctrlTreeview As TreeView) As Collection Dim p_objSWbemObject As SWbemObject Dim p_objProperties As SWbemPropertySet Dim p_objProperty As SWbemProperty Dim p_objMethods As SWbemMethodSet Dim p_objMethod As SWbemMethod Dim p_objItem As ListItem Dim p_objColHeader As ColumnHeader Dim p_objNode As Node Dim p_lngLoop As Long Dim p_lngNumMethods As Long Dim p_lngNumInParam As Long Dim p_lngNumOutParam As Long Dim p_lngMethodCount As Long Dim p_colMethodItems As Collection Dim p_colTmpItems As Collection Dim p_objClassItemData As cItemData Set p_colTmpItems = New Collection Set p_colMethodItems = New Collection Debug.Print FrmCoba.Caption = FrmCoba.Caption & " -- Methods" For Each p_objSWbemObject In xi_objSWbemObjSet Set p_objMethods = p_objSWbemObject.Methods_ ' --------------------------------------- ' No methods ' --------------------------------------- If p_objMethods.Count <= 0 Then Set p_objNode = xi_ctrlTreeview.Nodes.Add(Text:="No Methods", _ Key:="i1") ' --------------------------------------- ' Get the parameters, if any ' --------------------------------------- Else p_lngMethodCount = 0& p_lngNumMethods = p_objMethods.Count If p_lngNumMethods > 0 Then For Each p_objMethod In p_objMethods p_lngMethodCount = p_lngMethodCount + 1 Set p_objNode = xi_ctrlTreeview.Nodes.Add(Text:=p_objMethod.Name, _ Key:="i" & CStr(p_lngMethodCount)) Debug.Print "- " & p_objMethod.Name ' ------------------------------------ ' Input parameters ' ------------------------------------ p_lngNumInParam = 0& If Not (p_objMethod.InParameters Is Nothing) Then p_lngNumInParam = p_objMethod.InParameters.Properties_.Count If p_lngNumInParam > 0 Then For Each p_objProperty In p_objMethod.InParameters.Properties_ Set p_objClassItemData = New cItemData p_objClassItemData.Name = "[In] " & p_objProperty.Name p_objClassItemData.Value = TranslateType(p_objProperty.CIMType) p_colTmpItems.Add p_objClassItemData Set p_objClassItemData = Nothing Next End If End If ' ------------------------------------ ' Output parameters ' ------------------------------------ p_lngNumOutParam = 0& If Not (p_objMethod.OutParameters Is Nothing) Then p_lngNumOutParam = p_objMethod.OutParameters.Properties_.Count If p_lngNumOutParam > 0 Then For Each p_objProperty In p_objMethod.OutParameters.Properties_ Set p_objClassItemData = New cItemData p_objClassItemData.Name = "[Out] " & p_objProperty.Name p_objClassItemData.Value = TranslateType(p_objProperty.CIMType) p_colTmpItems.Add p_objClassItemData Set p_objClassItemData = Nothing Next End If End If p_colMethodItems.Add Item:=p_colTmpItems, _ Key:="i" & CStr(p_lngMethodCount) Set p_colTmpItems = New Collection Next End If End If ' ------------------------------------- ' We only want to go thru this one tine ' to get the methods ' ------------------------------------- Exit For Next ' ------------------------------------------ ' Set the return value ' ------------------------------------------ Set ShowMethods = p_colMethodItems End Function Private Function TranslateType(ByVal xi_typCimType As WbemCimtypeEnum) As String Select Case xi_typCimType Case wbemCimtypeString TranslateType = "String" Case wbemCimtypeObject TranslateType = "CIM Object" Case wbemCimtypeDatetime TranslateType = "Date/Time" Case wbemCimtypeBoolean TranslateType = "Boolean" Case wbemCimtypeSint8 TranslateType = "Signed 8-bit integer" Case wbemCimtypeSint16 TranslateType = "Signed 16-bit integer" Case wbemCimtypeSint32 TranslateType = "Signed 32-bit integer" Case wbemCimtypeSint64 TranslateType = "Signed 64-bit integer" Case wbemCimtypeUint8 TranslateType = "Unsigned 8-bit integer" Case wbemCimtypeUint16 TranslateType = "Unsigned 16-bit integer" Case wbemCimtypeUint32 TranslateType = "Unsigned 32-bit integer" Case wbemCimtypeUint64 TranslateType = "Unsigned 64-bit integer" Case wbemCimtypeReal32 TranslateType = "Real 32-bit number" Case wbemCimtypeReal64 TranslateType = "Real 64-bit number" Case wbemCimtypeReference TranslateType = "Reference" Case wbemCimtypeChar16 TranslateType = "16-bit character" Case Else TranslateType = "Unknown" End Select End Function Public Function PopulateListMultiple(ByVal xi_objSWbemObjSet As SWbemObjectSet, _ ByRef xi_ctrlTreeview As TreeView, _ Optional ByVal xi_strCaptionName As String = "Caption") As Collection Dim p_objSWbemObject As SWbemObject Dim p_objProperties As SWbemPropertySet Dim p_objProperty As SWbemProperty Dim p_objItem As ListItem Dim p_objColHeader As ColumnHeader Dim p_objNode As Node Dim p_avntTmp As Variant Dim p_strTmp As String Dim p_strCaption As String Dim p_lngLoop As Long Dim p_lngNumValueItems As Long Dim p_lngItemsKeyCount As Long Dim p_lngPropertyLoopCount As Long Dim p_colListItems As Collection Dim p_colTmpItems As Collection Dim p_objClassItemData As cItemData Set p_colTmpItems = New Collection Set p_colListItems = New Collection If (xi_objSWbemObjSet Is Nothing) Then Set p_objNode = xi_ctrlTreeview.Nodes.Add(Text:="No items could be found!") 'PopulateListMultiple = vbEmpty Exit Function ElseIf (xi_objSWbemObjSet.Count <= 0) Then Set p_objNode = xi_ctrlTreeview.Nodes.Add(Text:="No items could be found!") 'PopulateListMultiple = vbEmpty Exit Function End If ' ------------------------------------------ ' Just show the methods ' ------------------------------------------ p_lngItemsKeyCount = 0& For Each p_objSWbemObject In xi_objSWbemObjSet p_lngItemsKeyCount = p_lngItemsKeyCount + 1 ' --------------------------------------- ' Set the caption in the treeview ' Note that some items don't have captions! ' --------------------------------------- On Error Resume Next p_strCaption = p_objSWbemObject.Properties_.Item(xi_strCaptionName) On Error GoTo 0 If p_strCaption = "" Then p_strCaption = "Default" End If Set p_objNode = xi_ctrlTreeview.Nodes.Add(Text:=p_strCaption, _ Key:="i" & CStr(p_lngItemsKeyCount)) ' --------------------------------------- ' ' --------------------------------------- For Each p_objProperty In p_objSWbemObject.Properties_ p_lngPropertyLoopCount = p_objSWbemObject.Properties_.Count If p_lngPropertyLoopCount > 0 Then Set p_objClassItemData = New cItemData If VarType(p_objProperty.Value) = (vbArray Or vbVariant) Then p_avntTmp = p_objProperty.Value p_lngNumValueItems = UBound(p_avntTmp) For p_lngLoop = 0 To p_lngNumValueItems If p_lngLoop = 0 Then p_strTmp = p_avntTmp(p_lngLoop) Else p_strTmp = p_strTmp & "|" & p_avntTmp(p_lngLoop) End If Next p_lngLoop ElseIf VarType(p_objProperty.Value) <> vbNull Then p_objClassItemData.Name = p_objProperty.Name p_strTmp = p_objProperty.Value Else p_objClassItemData.Name = p_objProperty.Name p_strTmp = "Null" End If p_objClassItemData.Name = p_objProperty.Name p_objClassItemData.Value = p_strTmp End If p_colTmpItems.Add p_objClassItemData Set p_objClassItemData = Nothing Next p_colListItems.Add Item:=p_colTmpItems, _ Key:="i" & CStr(p_lngItemsKeyCount) Set p_colTmpItems = New Collection Next ' ------------------------------------------ ' Return the array ' ------------------------------------------ Set PopulateListMultiple = p_colListItems End Function ---------------------------------------------------------- End of cWmi ---------------------------------------------------------- Kemudian untuk mengambil ID Processor ketikkan syntax ini : ******************************************** Buat module baru, namanya terserah ******************************************** Option Explicit Dim ProcessorIDNya$ Private m_objWmi As cWmi Private m_colItems As Collection Public Function LiatProc() As String CmdCariProc LiatProc = ProcessorIDNya End Function Private Sub CmdCariProc() Dim anu As TreeView Set m_objWmi = New cWmi Dim p_objSet As SWbemObjectSet FrmCoba.TV.Nodes.Clear ' ------------------------------------------ ' Note: Any of the Objects Sets can come back ' empty, so we need to handle this in ' the called function ' ------------------------------------------ 'On Error Resume Next Set p_objSet = GetObject("winmgmts:{impersonationLevel=impersonate}"). _ ExecQuery("select processorid from Win32_Processor") Set m_colItems = m_objWmi.PopulateListMultiple(xi_objSWbemObjSet:=p_objSet, _ xi_ctrlTreeview:=FrmCoba.TV) Dim p_objColItem As cItemData Dim p_colItems As Collection If Not (m_colItems Is Nothing) Then If m_colItems.Count > 0 Then Set p_colItems = m_colItems("i1") If Not (p_colItems Is Nothing) Then Set p_objColItem = p_colItems(2) ProcessorIDNya = p_objColItem.Value End If End If End If ' ------------------------------------------ ' Cleanup ' ------------------------------------------ If Not (p_objSet Is Nothing) Then Set p_objSet = Nothing Exit Sub ErrorHandler: MsgBox "An error has ocurred: " & Err.Description End Sub ---------------------------------------------------------- End of module untuk baca ID processor ---------------------------------------------------------- Jangan lupa membuat 1 form yang berisi object TreeView ( di syntax diatas aku kasih nama frmCoba ) Semoga membantu Best Regards, Dhani Aristyawan, S.Kom. EDP Supervisor PT. ALP Petro Industry ( AGIP ) Jl. Raya Kebonsari Ds Legok - Pasuruan 67155 Telp : 0343 - 853308 Fax : 0343 - 853307 _____ From: [email protected] [mailto:[EMAIL PROTECTED] On Behalf Of Andristyanto Sagitta Pratama Sent: Wednesday, November 29, 2006 7:52 PM To: [email protected] Subject: [indoprog-vb] Nomor Seri Processor kk2 yang jago vb mohon bantuannya dong.. Bisa ga dapetin nomer serinya processor lewat vb. Soalnya ak mau gunain nomor ini untuk security programku. Thanks ya kk. [Non-text portions of this message have been removed] [Non-text portions of this message have been removed]
