SİSTEM BİLGİLERİNİ VEREN PROJE

SİSTEM BİLGİSİ                         KOD İNDİR

KURULUMSUZ EXE PROGRAMI                                  EXE İNDİR                                    

Imports System.Net.NetworkInformation Imports System Imports System.Management Public Class Form1 Public p As Ping Public pCevap As PingReply Public ipID As String Public ipSure As String Public ipAdres As String Public ipPing As String Public MacAdresi As String = [String].Empty Dim s As Integer = 100 Private Sub Label1_Click(sender As System.Object, e As System.EventArgs) Handles Label1.Click Timer3.Interval = 100 Timer3.Start() Form2.PictureBox2.Hide() Form2.Show() End Sub Private Sub Timer3_Tick(sender As System.Object, e As System.EventArgs) Handles Timer3.Tick s -= 1 If s <= 20 Then Form2.PictureBox2.Hide() If s <= 1 Then s = 100 : Form2.Close() End Sub Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load Call IPBul() btnGoster.PerformClick() End Sub Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing Timer1.Stop() Timer2.Stop() End Sub Private Sub IPBul() On Error Resume Next If My.Computer.Network.IsAvailable = False Then ipID = "İnternet Bağlı değil" Exit Sub End If 'Try p = New Ping pCevap = p.Send(Label3.Text) ipID = pCevap.Address.ToString ipSure = pCevap.RoundtripTime.ToString ipAdres = pCevap.Address.AddressFamily.ToString ipPing = pCevap.Status.ToString 'Catch pExc As PingException ' MessageBox.Show(pExc.InnerException.Message) 'End Try End Sub Public Function BilgiAl(ByVal wmiObjectInfo As String, Optional ByVal wmiRelativePath As String = "Win32_Processor") As String BilgiAl = Nothing Try Dim wmiClass As New System.Management.ManagementClass Dim wmiObject As New System.Management.ManagementObject wmiClass.Path.RelativePath = wmiRelativePath For Each wmiObject In wmiClass.GetInstances BilgiAl = (wmiObject(wmiObjectInfo)) Return BilgiAl Next Catch exc As Exception Return "n/a" End Try End Function Public Sub WindowsBilgileriniOku() On Error Resume Next If My.Computer.Network.IsAvailable = False Then Me.Text = "İnternet Bağlı değil. İlgili Biigiler Görüntülenmez" End If Timer1.Start() Timer2.Start() pCevap = p.Send(Label3.Text) ipID = pCevap.Address.ToString ipSure = pCevap.RoundtripTime.ToString ipAdres = pCevap.Address.AddressFamily.ToString ipPing = pCevap.Status.ToString On Error Resume Next Cursor.Current = Cursors.AppStarting LWiev.Items(0).SubItems.Item(1).Text = (My.Computer.Info.OSFullName) LWiev.Items(1).SubItems.Item(1).Text = (My.Computer.Info.OSPlatform) LWiev.Items(2).SubItems.Item(1).Text = (My.Computer.Info.OSVersion) LWiev.Items(3).SubItems.Item(1).Text = (Environment.OSVersion.ServicePack) LWiev.Items(4).SubItems.Item(1).Text = (Environment.OSVersion.VersionString) LWiev.Items(5).SubItems.Item(1).Text = (BilgiAl("OSArchitecture", "win32_operatingsystem")) LWiev.Items(6).SubItems.Item(1).Text = (Environment.GetEnvironmentVariable("PROCESSOR_ARCHITECTURE")) LWiev.Items(7).SubItems.Item(1).Text = (ipID.ToString) ' ipID = pCevap.Address.ToString LWiev.Items(8).SubItems.Item(1).Text = (pCevap.ToString) LWiev.Items(9).SubItems.Item(1).Text = (ipSure.ToString) LWiev.Items(10).SubItems.Item(1).Text = (ipAdres.ToString) LWiev.Items(11).SubItems.Item(1).Text = (ipPing.ToString) & " - (Başarılı)" LWiev.Items(12).SubItems.Item(1).Text = (Environment.UserDomainName.ToString) 'Bilgisayar adı LWiev.Items(13).SubItems.Item(1).Text = (Environment.UserName.ToString) 'Kullanıcı adı LWiev.Items(14).SubItems.Item(1).Text = ("") 'system saati timer1 LWiev.Items(15).SubItems.Item(1).Text = ("") 'Tuşlar 15-17 LWiev.Items(16).SubItems.Item(1).Text = ("") 'Tuşlar 15-17 LWiev.Items(17).SubItems.Item(1).Text = ("") 'Tuşlar 15-17 LWiev.Items(18).SubItems.Item(1).Text = (Screen.PrimaryScreen.Bounds.Width & " x " & Screen.PrimaryScreen.Bounds.Height _ & " Bit : " & Screen.PrimaryScreen.BitsPerPixel) Dim getInfo As System.IO.DriveInfo getInfo = My.Computer.FileSystem.GetDriveInfo("C:\") LWiev.Items(19).SubItems.Item(1).Text = (Format((getInfo.TotalSize / 1000000000), "#.##") & " GB.") LWiev.Items(20).SubItems.Item(1).Text = (Format(((getInfo.TotalSize - getInfo.TotalFreeSpace) / 1000000000), "#.##") & " GB.") LWiev.Items(21).SubItems.Item(1).Text = (Format((getInfo.TotalFreeSpace / 1000000000), "#.##") & " GB.") LWiev.Items(22).SubItems.Item(1).Text = (getInfo.DriveFormat) Call CPU_Ozet() ' 23 CPU özet Call SurucuID() ' 24 DeviceId No Call CPU_No() ' 25 CPU Seri No Call GetMACAddress() ' 26 MacAddress LWiev.Items(27).SubItems.Item(1).Text = String.Format(My.Computer.Info.AvailablePhysicalMemory.ToString("N0")) '29 "Kullanılabilir Fiziksel Bellek: LWiev.Items(28).SubItems.Item(1).Text = String.Format(My.Computer.Info.TotalPhysicalMemory.ToString("N0")) ' 30 Toplam Fiziksel Bellek: " LWiev.Items(29).SubItems.Item(1).Text = (ULong.MinValue) ' 31 Kullanılabilir Sanal Bellek: LWiev.Items(30).SubItems.Item(1).Text = String.Format(My.Computer.Info.TotalVirtualMemory.ToString("N0")) '32 Toplam Sanal Bellek Call HDSerialBul() ' 31 HDD serial Call HDModeli() ' 32 Harddisk modelini bulmak Call HDDTipi() '33 HDD Tipi txtAnahtar.Text = UrunAnahtariAl("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\", "DigitalProductId") End Sub Public Function UrunAnahtariAl(ByVal KeyPath As String, ByVal ValueName As String) As String Dim Tampon As Object = My.Computer.Registry.GetValue(KeyPath, ValueName, 0) If Tampon Is Nothing Then Return "Sizin Anahtar görünmüyor" Dim say As String = "" For l As Integer = LBound(Tampon) To UBound(Tampon) say = say & " " & Hex(Tampon(l)) Next Dim Baslangic As Integer = 52 Dim Bitis As Integer = 67 Dim Rakam(24) As String Rakam(0) = "B" : Rakam(1) = "C" : Rakam(2) = "D" : Rakam(3) = "F" Rakam(4) = "G" : Rakam(5) = "H" : Rakam(6) = "J" : Rakam(7) = "K" Rakam(8) = "M" : Rakam(9) = "P" : Rakam(10) = "Q" : Rakam(11) = "R" Rakam(12) = "T" : Rakam(13) = "V" : Rakam(14) = "W" : Rakam(15) = "X" Rakam(16) = "Y" : Rakam(17) = "2" : Rakam(18) = "3" : Rakam(19) = "4" Rakam(20) = "6" : Rakam(21) = "7" : Rakam(22) = "8" : Rakam(23) = "9" Dim dUzunluk As Integer = 29 Dim sUzunluk As Integer = 15 Dim Rakamsal(15) As String Dim boyut(30) As String Dim say2 As String = "" For i As Integer = Baslangic To Bitis Rakamsal(i - Baslangic) = Tampon(i) say2 = say2 & " " & Hex(Rakamsal(i - Baslangic)) Next Dim AnahtarDizesi As String = "" For i As Integer = dUzunluk - 1 To 0 Step -1 If ((i + 1) Mod 6) = 0 Then boyut(i) = "-" AnahtarDizesi = AnahtarDizesi & "-" Else Dim HN As Integer = 0 For N As Integer = (sUzunluk - 1) To 0 Step -1 Dim Value As Integer = ((HN * 2 ^ 8) Or Rakamsal(N)) Rakamsal(N) = Value \ 24 HN = (Value Mod 24) Next boyut(i) = Rakam(HN) AnahtarDizesi = AnahtarDizesi & Rakam(HN) End If Next Return StrReverse(AnahtarDizesi) End Function Private Sub form1_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp ' If e.KeyCode = Keys.Enter Then btnGoster.PerformClick() ElseIf e.KeyCode = Keys.Escape Then Me.Close() End If End Sub Private Sub btnGoster_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGoster.Click WindowsBilgileriniOku() End Sub Private Sub txtAnahtar_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles txtAnahtar.KeyDown If e.KeyValue = 27 OrElse e.KeyValue = 13 Then e.SuppressKeyPress = True End If End Sub Private Sub txtAnahtar_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles txtAnahtar.MouseClick txtAnahtar.SelectAll() 'txtAnahtar.Copy() Clipboard.SetText(UrunAnahtariAl("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\", _ "DigitalProductId"), TextDataFormat.Text) End Sub Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick LWiev.Items(14).SubItems.Item(1).Text = (TimeOfDay) End Sub Private Sub Timer2_Tick(sender As System.Object, e As System.EventArgs) Handles Timer2.Tick If (My.Computer.Keyboard.NumLock) Then LWiev.Items(15).SubItems.Item(1).Text = ("AÇIK") Else LWiev.Items(15).SubItems.Item(1).Text = ("KAPALI") End If If (My.Computer.Keyboard.CapsLock) Then LWiev.Items(16).SubItems.Item(1).Text = ("AÇIK") Else LWiev.Items(16).SubItems.Item(1).Text = ("KAPALI") End If If (My.Computer.Keyboard.ScrollLock) Then LWiev.Items(17).SubItems.Item(1).Text = ("AÇIK") Else LWiev.Items(17).SubItems.Item(1).Text = ("KAPALI") End If End Sub Public Sub CPU_Ozet() Dim Nesnemiz Nesnemiz = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'") LWiev.Items(23).SubItems.Item(1).Text = Nesnemiz.Caption 'MessageBox.Show("CPU Özet: " & Nesnemiz.Caption) End Sub Public Sub SurucuID() 'DeviceId No Dim Nesnemiz Nesnemiz = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'") LWiev.Items(24).SubItems.Item(1).Text = (Nesnemiz.DeviceID) End Sub Public Sub CPU_No() Dim Nesnemiz Nesnemiz = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'") 'MessageBox.Show("CPU Seri No: " & Nesnemiz.ProcessorID) LWiev.Items(25).SubItems.Item(1).Text = (Nesnemiz.ProcessorID) End Sub Public Function GetMACAddress() As String Dim mc As New ManagementClass("Win32_NetworkAdapterConfiguration") Dim moc As ManagementObjectCollection = mc.GetInstances() Dim MACAddress As String = [String].Empty For Each mo As ManagementObject In moc If MACAddress = [String].Empty Then If CBool(mo("IPEnabled")) = True Then MACAddress = mo("MacAddress").ToString() LWiev.Items(26).SubItems.Item(1).Text = (MACAddress) End If End If mo.Dispose() Next MACAddress = MACAddress.Replace(":", "") Return MACAddress End Function Public Sub HDSerialBul() Dim disk As New ManagementClass("Win32_PhysicalMedia") For Each Hdisk As ManagementObject In disk.GetInstances() If Hdisk("SerialNumber") <> Nothing Then 'MessageBox.Show("HDD serial " & CStr(Hdisk("SerialNumber"))) LWiev.Items(31).SubItems.Item(1).Text = CStr(Hdisk("SerialNumber")) End If Next Hdisk End Sub Public Sub HDModeli() 'Harddisk modelini bulmak Dim ara As New Management.ManagementObjectSearcher("select * from Win32_PhysicalMedia") Dim wmi_HD As Management.ManagementObject ara = New System.Management.ManagementObjectSearcher("select * from Win32_DiskDrive") For Each wmi_HD In ara.Get() 'MessageBox.Show(wmi_HD("Model")) LWiev.Items(32).SubItems.Item(1).Text = (wmi_HD("Model")) Next End Sub Private Sub HDDTipi() ' HDD Tipi alınması Dim searcher As ManagementObjectSearcher = _ New ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive") For Each wmi_HD As ManagementObject In searcher.Get() LWiev.Items(33).SubItems.Add(wmi_HD("InterfaceType").ToString()) Next wmi_HD End Sub Private Sub txtAnahtar_MouseLeave(sender As System.Object, e As System.EventArgs) Handles txtAnahtar.MouseLeave Dim tooltip As New ToolTip() tooltip.SetToolTip(txtAnahtar, "Seçildiği an Anahtar Panoya Kopyalandı") End Sub Private Sub Label1_MouseLeave(sender As System.Object, e As System.EventArgs) Handles Label1.MouseLeave Label1.ForeColor = SystemColors.ControlText End Sub Private Sub Label1_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseMove Label1.ForeColor = Color.Red End Sub End Class
FlashForm Kodları :
Public Class Form2 Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick Me.Opacity = 1.1 * Me.Opacity If Me.Opacity = 0.1 Then Timer1.Enabled = False 'Me.Close() End If End Sub Private Sub Form2_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load Timer1.Interval = 30 Timer1.Start() End Sub Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click Me.Close() End Sub End Class