Pci Bus scanner in VB.net und leuft unter XP



Form hat ein Richtextbox
beim starten ladet das Programm PCI vendor Tabelle

datei ist in debug ordner drine vendor.txt

kann man beim www.pcidatabase.com/ runterladen als CVS datei


in function pci_scann() wird PCIBus durchgesucht und in variable devices() wir dann gespeichert



formular Quellcode

   Spoiler

C/C++-Quelltext

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

Public Class Form1 Private Structure devices_pci Dim Vendor As Integer Dim Device As Integer Dim Firma As String Dim Beschreibung As String Dim Chip As String Dim Devoce_string As String End Structure Private Alle_vendors() As devices_pci Private Alle_vendors_c As Long Private Sub Printt(ByVal text As String) RichTextBox1.SelectionStart = Len(RichTextBox1.Text) RichTextBox1.SelectedText = text & Chr(13) Application.DoEvents() End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Me.Show() Application.DoEvents() open_vendor_names() Printt("Database Load") Printt("PCI Scann Start") pci_scann() Printt("PCI Scann End") Printt("Devices Found: " & pcibus.devices_count) Dim Device_v As String Dim an As Integer an = 0 For i = 1 To pcibus.devices_count Device_v = Strings.Right(Hex(pcibus.devices(i)), 8) For ii = 1 To Alle_vendors_c If Strings.Right(Device_v, 4) = Hex(Alle_vendors(ii).Device) Or Strings.Left(Device_v, 4) = Hex(Alle_vendors(ii).Vendor) Then Printt(Alle_vendors(ii).Firma & " " & Alle_vendors(ii).Chip & " " & Alle_vendors(ii).Beschreibung) an = 1 Exit For End If Next If an = 0 Then Printt(Device_v) Else an = 0 End If Next End Sub Private Sub Form1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize RichTextBox1.Width = Me.Width - 30 RichTextBox1.Height = Me.Height - 50 End Sub Private Sub open_vendor_names() Dim DATEINAME = Application.StartupPath & "\vendor.txt" Dim Zeile As String Dim Felder() As String ReDim Alle_vendors(0) Dim Count As Long Count = 0 Dim sr = My.Computer.FileSystem.OpenTextFileReader(DATEINAME, _ System.Text.Encoding.Default) Do While (sr.Peek > -1) ' Dateiende abfragen Zeile = sr.ReadLine ' Eine Datenzeile lesen Felder = Zeile.Split(",") ' Splitten in Felder Count = Count + 1 ReDim Preserve Alle_vendors(Count) Alle_vendors(Count).Vendor = CInt(Val("&H" & Ohne_klamern(Felder(0)))) Alle_vendors(Count).Device = CInt(Val("&H" & Ohne_klamern(Felder(1)))) Alle_vendors(Count).Firma = Ohne_klamern(Felder(2)) Alle_vendors(Count).Beschreibung = Ohne_klamern(Felder(3)) Alle_vendors(Count).Chip = Ohne_klamern(Felder(4)) Alle_vendors(Count).Devoce_string = Ohne_klamern(Felder(1)) & Ohne_klamern(Felder(0)) 'RichTextBox1.Text = RichTextBox1.Text & "0x" & Ohne_klamern(Felder(0)) & Ohne_klamern(Felder(1)) & " " & Felder(2) & " " & Felder(3) & " " & Felder(4) & Chr(10) & Chr(13) Application.DoEvents() Loop Alle_vendors_c = Count 'RichTextBox1.Text = "Load alle wendors" End Sub Function Ohne_klamern(ByVal daten As String) As String Dim daten_out As String daten_out = daten If Strings.Left(daten_out, 1) = Chr(34) Then daten_out = Strings.Right(daten_out, Len(daten_out) - 1) End If If Strings.Right(daten_out, 1) = Chr(34) Then daten_out = Strings.Left(daten_out, Len(daten_out) - 1) End If If Strings.Left(daten_out, 2) = "0x" Then daten_out = Strings.Right(daten_out, Len(daten_out) - 2) End If Ohne_klamern = daten_out End Function End Class

pcibus.bas

   Spoiler

C/C++-Quelltext

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

Module pcibus Private Declare Sub PortOut Lib "IO.DLL" (ByVal Port As Integer, ByVal Data As Byte) Private Declare Sub PortWordOut Lib "IO.DLL" (ByVal Port As Integer, ByVal Data As Integer) Private Declare Sub PortDWordOut Lib "IO.DLL" (ByVal Port As Integer, ByVal Data As Long) Private Declare Function PortIn Lib "IO.DLL" (ByVal Port As Integer) As Byte Private Declare Function PortWordIn Lib "IO.DLL" (ByVal Port As Integer) As Integer Private Declare Function PortDWordIn Lib "IO.DLL" (ByVal Port As Integer) As Long Private Const Adress_port = &HCF8 Private Const Data_port = &HCFC Private Const No_device = &HFFFFFFFF Private Const PCI_adresse = &H80000000 Private Const PCI_Count_ad = &H100 Private Const PCI_End_adresse = &H80FFFF00 '0x71138086 //82371AB/EB/MB PIIX4/E/M Power Management Controller. 'xxxx.... ->Device '....xxxx ->Vendor Public devices() As Long Public Devices_s() As String Public devices_count As Long Function pci_scann() Dim Adresse As Long Dim PCI_Data As Long ReDim devices(0) Dim count As Long Dim Pci_data_s As String For i = PCI_adresse To PCI_End_adresse Step PCI_Count_ad Adresse = i And &HFFFFFF00 PortDWordOut(Adress_port, Adresse) PCI_Data = PortDWordIn(Data_port) Pci_data_s = Strings.Right(Hex(PCI_Data), 8) PCI_Data = Val("&H" & Pci_data_s) If PCI_Data <> &HFFFFFFFF Then 'Device_ = Hi_int(PCI_Data) 'Vendor_ = Lo_int(PCI_Data) count = count + 1 ReDim Preserve devices(count) devices(count) = PCI_Data End If Next devices_count = count End Function Public Function Hi_int(ByVal daten As Long) As Integer Dim Zahl As String Dim H_Z As String Dim L_z As String Zahl = Hex(daten) For i = 1 To Len(Zahl) If i < 5 Then L_z = L_z & Mid(Zahl, i, 1) If i > 4 Then H_Z = H_Z & Mid(Zahl, i, 1) Next Hi_int = Val("&H" & H_Z) End Function Public Function Lo_int(ByVal daten As Long) As Integer Dim Zahl As String Dim H_Z As String Dim L_z As String Zahl = Hex(daten) For i = 1 To Len(Zahl) If i < 5 Then L_z = L_z & Mid(Zahl, i, 1) If i > 4 Then H_Z = H_Z & Mid(Zahl, i, 1) Next Lo_int = Val("&H" & L_z) End Function End Module

Edit:
Was noch fehlt
Der Class Code
Base Class, Sub Class

version Nr.2
mit Classcode






edit:
Class code fertig
Subclass fehlt noch