Jump to content
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble

MSFN is made available via donations, subscriptions and advertising revenue. The use of ad-blocking software hurts the site. Please disable ad-blocking software or set an exception for MSFN. Alternatively, register and become a site sponsor/subscriber and ads will be disabled automatically. 


Recommended Posts


I agree, it could be a very useful tool GSM.

If you can post the source code then it would certainly helpful for the tools current location in 'programming'.

I'll even go as far as to say that there may even be a more prominent location, (or at least a way for MSFN to better show it off), too!

Note - To the less knowledgeable among us, due to the fact that the tool was written in Vb.NET, it will require that the host PC has at least .NET Framework v2.0.50727 in order for it to run.

Share this post


Link to post
Share on other sites

Don't wanna p*** on anyone's parade, but I kind of fail to see the point. There's been apps to do exactly this for ages e.g. magical jellybean keyfinder, and they're open source too. Want to see how it's done? Download its source code, and look at TForm1.DecodeMSKey. Don't like or can't understand pascal? Fine, you can easily find sample code in basically any other language that exists within seconds using google searching for common related terms, like this. There's even pre-written vbscripts that do this... Or C# versions.

Having yet-another-app that does this brings very, very little, especially when it's closed source.

Share this post


Link to post
Share on other sites
Don't wanna p*** on anyone's parade, but I kind of fail to see the point. There's been apps to do exactly this for ages e.g. magical jellybean keyfinder, and they're open source too. Want to see how it's done? Download its source code, and look at TForm1.DecodeMSKey. Don't like or can't understand pascal? Fine, you can easily find sample code in basically any other language that exists within seconds using google searching for common related terms, like this. There's even pre-written vbscripts that do this... Or C# versions.

Having yet-another-app that does this brings very, very little, especially when it's closed source.

Surely the source code would define whether or not there was anything different or better with this particular implementation. The only tool I've ever used for this task was a VBScript and I've not tested in on any OS other than XP (x86). This used Vb.NET, which so far the ones you've linked didn't and also as far as I'm aware Magical Jelly Bean Keyfinder isn'y advertised as working in Windows 7.
Very nice - care to post the source for this little app?

the source is not necessary because it can be found all over the internet:

Here in Delphi: http://www.swissdelphicenter.ch/en/showcode.php?id=2252

And you can use .NET Reflector to open his application and see the code

The source really is necessary, this is a Programming Forum, not a tool repository, therefore in this location the tool serves no real benefit to the Members. The topic shouldn't require interested Members to download and use a 3rd party tool in order to access the code within.

Share this post


Link to post
Share on other sites

The original source code was a vbs script and I wanted to see if it would work in Vb.net

I made the app to see if it would work on Win7. Sorry about not posting the source code

it slipped my mind.

Imports System.IO
Public Class Form1
Dim Desktop = Microsoft.VisualBasic.CreateObject("Wscript.Shell").SpecialFolders("Desktop")
Dim KeyTxt = Desktop & "\" & My.Computer.Name & "_Key.txt"
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Label1.Text = ""
Label2.Text = "Gunsmokingman Get OS Key"
End Sub
'-> Get The OS Key
Dim OsKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"
Function GetKey(ByVal rpk)
Dim i, j
Dim dwAccumulator = "", szProductKey = ""
Const rpkOffset = 52 : i = 28
Dim szPossibleChars = "BCDFGHJKMPQRTVWXY2346789"
Do
dwAccumulator = 0 : j = 14
Do
dwAccumulator = dwAccumulator * 256
dwAccumulator = rpk(j + rpkOffset) + dwAccumulator
rpk(j + rpkOffset) = (dwAccumulator \ 24) And 255
dwAccumulator = dwAccumulator Mod 24
j = j - 1
Loop While j >= 0
i = i - 1 : szProductKey = Mid(szPossibleChars, dwAccumulator + 1, 1) & szProductKey
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i - 1 : szProductKey = "-" & szProductKey
End If
Loop While i >= 0
GetKey = szProductKey
Label1.Text = szProductKey
End Function
'-> Button1 Get The Os Key
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Button1.Text = "Get Key" Then
Button1.Text = "Clear Key"
GetKey(Microsoft.VisualBasic.CreateObject("Wscript.Shell").RegRead(OsKey))
Else
Button1.Text = "Get Key"
Label1.Text = ""
End If
End Sub
'-> Button2 Save The Os Key
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
If Label1.Text = "" Then
MsgBox(Space(6) & "Error No Key Text" & vbCrLf & _
" Press The Get Key Button" & vbCrLf & _
" Then Press The Save Key", 4128)
Else
Dim sw As StreamWriter = New StreamWriter(KeyTxt.ToString)
sw.WriteLine(" Saved At " & Chr(187) & Chr(160) & KeyTxt.ToString)
sw.WriteLine(" Os Key " & Chr(187) & Chr(160) & Label1.Text)
sw.Close()
Microsoft.VisualBasic.CreateObject("Wscript.Shell").Run(Chr(34) & KeyTxt.ToString & Chr(34), 1, True)
End If
End Sub
End Class

I have included the Vb.net project files so you can open it in Vb.net and make any changes you want.

Source Code

New Source Code Get_KeyV1

New Get_KeyV1

Edited by gunsmokingman

Share this post


Link to post
Share on other sites
This used Vb.NET, which so far the ones you've linked didn't

I only linked to a couple, but it's not exactly hard to find. I linked to 3, but google can easily find more (I even included a sample search query, many other queries work fine too) The algo is pretty simple, and it's really easy to port it from C# if you're more of a VB person -- there's even automated tools to do this for you, even online versions of it... And porting an existing vbscript to VB isn't exactly hard either as both languages are very similar in syntax. And like MagicAndre1981 said, you could even use reflector for this.

and also as far as I'm aware Magical Jelly Bean Keyfinder isn'y advertised as working in Windows 7.

I doubt it stopped working just because it doesn't explicitly mention on its home page that it's been tested with a unreleased beta OS, as those same digitalproductid's haven't changed in just about forever (Win2k era at least), nor their locations. Even more so as Win 7 is pretty much Vista R2, and all those old tools still work fine on Vista.

this is a Programming Forum, not a tool repository, therefore in this location the tool serves no real benefit to the Members.

Indeed, without the source it's in the wrong section. But I honestly don't see this section as a very good place to share code anyways. Useful bits tend to just get moved at the very end of a "repository" thread no one seemingly reads, which explains why I haven't bothered sharing FixPE (a C# app that does much the same as modifype.exe -- except it works on OS'es past XP and lacks a couple of its bugs), and even removed my font installer (fontinst.exe replacement) & screen saver scripts a while ago. Not that anyone noticed (as it just gets no readers). Feel free to delete the posts with no content.

If anything, it would be FAR better if the section was split into more relevant subsections: a batch/cmd section, a scripting section (e.g. vbscript/jscript/autoit), an actual programming section (C, C++, C#, Java, ...) and perhaps one to share tools and toys (create a new post for your new tool, where people can reply, make requests, report bugs, ask for features, etc). Right now, most of what we see in here is along the lines of "help me [write for me] a batch file to do xyz" and not so much programming related anyways. There doesn't seem to be a whole lot of programmers (as in people who this for a living) hanging around either.

Edited by CoffeeFiend

Share this post


Link to post
Share on other sites

That is true - but I think it goes without saying that those of us who do this for a living don't need a forum for help on it, either. I asked for source because I wanted to see how gun did it, not because it's inherently useful. Also, being a programming section, putting a tool without source (as it appeared to slip gun's mind, so no worries) is kind of useless.

Everyone should just lighten up a bit.

Share this post


Link to post
Share on other sites
I think it goes without saying that those of us who do this for a living don't need a forum for help on it

I meant that the other way around, not many of us around to answer such questions for others.

Share this post


Link to post
Share on other sites
I think it goes without saying that those of us who do this for a living don't need a forum for help on it

I meant that the other way around, not many of us around to answer such questions for others.

True. Why is this? Really it's because 95% of this sub-forum on MSFN is all batch and scripting (and nothing wrong with that, it's one of the top topics in one of the hardcore programming forums I referred to below). There are people that know these things on here and are getting a workout from what I can tell, but it's kind of hard to want to participate if nothing comes up that's in your field of expertise or interest. That's my category, to be honest. There's programming things I could post and things I could help on, but they never seem to come up in here, and I'm really about 90% sure from the posts here that enough would be interested to count on one hand what I would post. I could always roll the dice and post a couple of things that are semi-relevant to the other topics on this board, though...

Now, my interest in this site and participating in this forum is more of a software and hardware nature. I get value from those things, and I get value in the technicals of the OS for what programming projects I do do. I also have posted a couple of my semi-completed projects on here, to mild notice (and that's fine as long as they're useful to someone - they seemed to be, which makes it worthwhile to me to post them, and I have no regrets in posting them).

Now, I participate in a 2 or 3 other forums that are more hardcore towards "actual programming" (as CoffeeFiend puts it), and the large preponderance of people are people that do programming for a living (I'd say 99%). For a couple of the topics, it seems I'm the hobbyist sitting among everyone else who is making a buck doing what is involved in the forums (and some accomplished enough that you could call them luminaries in their chosen competency). And many of them participate, ask questions, answer them occasionally, and yes even profess then and again the usefulness of such forums to them.

My thoughts on these things? Usually, people tend to participate and flock to things that have others who are interested in the topic as well. It's a initial gauge I know most put up when they first see something - no posts on what I'm interested in? Maybe I should move on. Posts on what I'm interested in? Let me stay awhile. Of course, any site can't be everything to everyone. A forum is what the aggregate of its posting members make of it.

Now, let me go through my source and see what I could post here...

Share this post


Link to post
Share on other sites

I think you're probably right - at MSFN, anything more than scripting is pretty much above and beyond what people come here for (that's mostly questions about Windows and associated Microsoft apps, and hacking said apps judging from the apps in the member apps section).

I'd be interested to know, either publicly or in a PM, what dev forums you are speaking of to see if they're the same 2 or 3 I normally visit :).

Share this post


Link to post
Share on other sites

I have updated my Get key, It will now list Computer Name, Ram Total, Date Installed, Get Key.

If anyone has any more suggestion as to what to add, I am open to suggestions.

Imports System
Imports System.IO

Public Class Form1
Const GB = 1073741824
Const MB = 1048576
Dim Act = Microsoft.VisualBasic.CreateObject("Wscript.Shell")
Dim RamSize = My.Computer.Info.TotalPhysicalMemory
Dim CName = My.Computer.Name
Dim R_A = Chr(160) & Chr(187) & Chr(160)
'-> On Load Clear Text
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TextGone()
End Sub
'-> Clear The Text Display Information
Private Sub TextGone()
Txt1b.Text = ""
Txt2b.Text = ""
Txt3b.Text = ""
Txt4b.Text = ""
SaveText.Enabled = False
End Sub
'-> Get Installed Ram Total
Dim RamInstalled
Private Sub InstalledRam()
If RamSize < GB Then
Txt2b.Text = FormatNumber(RamSize / MB, 2) & " MB"
Else
Txt2b.Text = FormatNumber(RamSize / GB, 2) & " GB"
End If
RamInstalled = " Install Ram " & R_A & Txt2b.Text
End Sub
'-> Get Install Date
Dim InstallDate
Private Sub InstalledDate()
Dim Wmi = GetObject("winmgmts:\\.\root\CIMV2")
Dim IDate = Microsoft.VisualBasic.CreateObject("WbemScripting.SWbemDateTime")
For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem")
IDate.Value = Obj.InstallDate
Dim T1 = Microsoft.VisualBasic.MonthName(IDate.Month.ToString)
Dim T2 = Microsoft.VisualBasic.WeekdayName(IDate.Day.ToString)
Txt3b.Text = T1 & "," & T2 & " " & IDate.GetVarDate
InstallDate = " Install Date " & R_A & Txt3b.Text
Next
Wmi = Nothing
End Sub
'-> Get The OS Key
Dim OsKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"
Dim Key
Function GetKey(ByVal rpk)
Dim i, j
Dim dwAccumulator = "", KeyOs = ""
Const rpkOffset = 52 : i = 28
Dim szPossibleChars = "BCDFGHJKMPQRTVWXY2346789"
Do
dwAccumulator = 0 : j = 14
Do
dwAccumulator = dwAccumulator * 256
dwAccumulator = rpk(j + rpkOffset) + dwAccumulator
rpk(j + rpkOffset) = (dwAccumulator \ 24) And 255
dwAccumulator = dwAccumulator Mod 24
j = j - 1
Loop While j >= 0
i = i - 1 : KeyOs = Mid(szPossibleChars, dwAccumulator + 1, 1) & KeyOs
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i - 1 : KeyOs = "-" & KeyOs
End If
Loop While i >= 0
GetKey = KeyOs
Txt4b.Text = KeyOs
Key = " OS Key " & R_A & KeyOs
End Function
'-> Show Text Information
Dim CmpName
Private Sub ShowText_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ShowText.Click
Txt1b.Text = CName
CmpName = " Computer Name " & R_A & CName
InstalledRam()
InstalledDate()
GetKey(Act.RegRead(OsKey))
SaveText.Enabled = True
End Sub
'-> Clear The Text Information
Private Sub ClearText_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ClearText.Click
TextGone()
End Sub
'-> Save Text Information
Private Sub SaveText_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SaveText.Click
Dim Desktop = Act.SpecialFolders("Desktop")
Dim KeyTxt = Desktop & "\" & My.Computer.Name & "_InstallInfo.txt"
Dim sw As StreamWriter = New StreamWriter(KeyTxt.ToString)
sw.WriteLine(" Save Location " & R_A & KeyTxt.ToString)
sw.WriteLine(CmpName)
sw.WriteLine(RamInstalled)
sw.WriteLine(InstallDate)
sw.WriteLine(Key)
sw.Close()
Act.Run(Chr(34) & KeyTxt.ToString & Chr(34), 1, True)
End Sub
End Class

Source Code GetKey_V2

New Source Code Get_KeyV1

New Get_KeyV1

Share this post


Link to post
Share on other sites

I have updated this app, I fixed a flaw that appeared on XP in my last version.

This caused a error if ran on XP

Dim T2 = Microsoft.VisualBasic.WeekdayName(IDate.Day.ToString)

This is the fixed line of code, runs on XP

Dim T2 = Microsoft.VisualBasic.WeekdayName(Microsoft.VisualBasic.Weekday(IDate.GetVarDate))

Imports System
Imports System.IO
Public Class Form1
Const GB = 1073741824
Const MB = 1048576
'-> Objects From VBS Script
Dim Act = Microsoft.VisualBasic.CreateObject("Wscript.Shell")
Dim Tme = Microsoft.VisualBasic.CreateObject("WbemScripting.SWbemDateTime")
Dim Wmi = GetObject("winmgmts:\\.\root\CIMV2")
'-> Text Output Objects
Dim R_A = Chr(160) & Chr(187) & Chr(160)
Dim Vb = vbCrLf
'-> Computer System Objects
Dim RamSize = My.Computer.Info.TotalPhysicalMemory
Dim CName = " Computer Name " & R_A & My.Computer.Name
'-> Get Installed Ram Total
Dim Ram1, Ram2
Private Sub InstalledRam()
If RamSize < GB Then
Ram1 = FormatNumber(RamSize / MB, 2) & " MB"
Else
Ram1 = FormatNumber(RamSize / GB, 2) & " GB"
End If
Ram2 = " Install Ram " & R_A & Ram1
End Sub
'-> Get Install Date
Dim InstallDate, LastBoot, OsName
Private Sub SystemTimeDateBoot()
Dim A1, A2, T1, T2
For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem")
OsName = " Os Name " & R_A & Obj.Caption
Tme.Value = Obj.InstallDate
A1 = Tme.GetVarDate
T1 = Microsoft.VisualBasic.MonthName(Tme.Month.ToString)
T2 = Microsoft.VisualBasic.WeekdayName(Microsoft.VisualBasic.Weekday(A1))
InstallDate = " Install Date " & R_A & A1 & " " & T1 & "," & T2
Tme.Value = Obj.LastBootUpTime
A2 = Tme.GetVarDate
T1 = Microsoft.VisualBasic.MonthName(Tme.Month.ToString)
T2 = Microsoft.VisualBasic.WeekdayName(Microsoft.VisualBasic.Weekday(A2))
LastBoot = " Last Boot Up " & R_A & A2 & " " & T1 & "," & T2
Next
End Sub
'-> Disks Information
Dim HardDrive, Optical
Private Sub DiskInformation()
For Each Drv In My.Computer.FileSystem.Drives
If Drv.DriveType = DriveType.Fixed Then
HardDrive = HardDrive & Drv.Name & " "
End If
If Drv.DriveType = DriveType.CDRom Then
Optical = Optical & Drv.Name & " "
End If
Next
HardDrive = " Hard Disks " & R_A & HardDrive
Optical = " Optical Disks " & R_A & Optical
End Sub
'-> Get The OS Key
Dim OsKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"
Dim Key
Function GetKey(ByVal rpk)
Dim i, j
Dim dwAccumulator = "", KeyOs = ""
Const rpkOffset = 52 : i = 28
Dim szPossibleChars = "BCDFGHJKMPQRTVWXY2346789"
Do
dwAccumulator = 0 : j = 14
Do
dwAccumulator = dwAccumulator * 256
dwAccumulator = rpk(j + rpkOffset) + dwAccumulator
rpk(j + rpkOffset) = (dwAccumulator \ 24) And 255
dwAccumulator = dwAccumulator Mod 24
j = j - 1
Loop While j >= 0
i = i - 1 : KeyOs = Mid(szPossibleChars, dwAccumulator + 1, 1) & KeyOs
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i - 1 : KeyOs = "-" & KeyOs
End If
Loop While i >= 0
GetKey = KeyOs
Key = " OS Key " & R_A & KeyOs
End Function
'-> Button 01 Click Fill Textbox
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
InstalledRam()
SystemTimeDateBoot()
DiskInformation()
GetKey(Act.RegRead(OsKey))
TextBox1.Text = OsName & Vb & CName & Vb & _
Ram2 & Vb & _
InstallDate & Vb & _
LastBoot & Vb & _
HardDrive & Vb & _
Optical & Vb & _
Key
End Sub
'-> Button 02 Click Clear Textbox
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
TextBox1.Text = ""
Key = ""
Optical = ""
HardDrive = ""
LastBoot = ""
InstallDate = ""
End Sub
'-> Button 03 Click Save Textbox
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
If Not TextBox1.Text = "" Then
Dim Desktop = Act.SpecialFolders("Desktop")
Dim KeyTxt = Desktop & "\" & My.Computer.Name & "_BasicInfo.txt"
Dim sw As StreamWriter = New StreamWriter(KeyTxt.ToString)
sw.WriteLine(" Save Location " & R_A & KeyTxt.ToString)
sw.Write(TextBox1.Text)
sw.Close()
Act.Run(Chr(34) & KeyTxt.ToString & Chr(34), 1, False)
End If
End Sub
End Class

Source Code GetKey_V3

New Source Code Get_KeyV1

New Get_KeyV1

GetKey_V3.exe

Share this post


Link to post
Share on other sites

I have updated the app

Imports System
Imports System.IO
Public Class Form1
Const GB = 1073741824
Const MB = 1048576
'-> Objects From VBS Script
Dim Act = Microsoft.VisualBasic.CreateObject("Wscript.Shell")
Dim Tme = Microsoft.VisualBasic.CreateObject("WbemScripting.SWbemDateTime")
Dim Wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2")
'-> Output Varibles
Dim vB = vbCrLf
Dim ARW = Chr(160) & Chr(187) & Chr(160)
Dim Lne = "------------------------------------------------------------------"
'-> Varibles
Dim CName = My.Computer.Name
Dim OName = My.Computer.Info.OSFullName
Dim OsVer = My.Computer.Info.OSVersion
Dim SyRam = My.Computer.Info.TotalPhysicalMemory
Dim DigProID = "\DigitalProductId"
'-> Reg Key Varible
Dim RegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\"
'-> MsKeys(0) = Window Product Key
'-> MsKeys(1) = Office 2010
'-> MsKeys(2) = Office 2007
'-> MsKeys(3) = Office 2003
'-> MsKeys(4) = Office XP
Dim MsKeys() As String = { _
" Operating System Key " & ARW & RegKey & "Windows NT\CurrentVersion", _
" Office 14 2010 Key " & ARW & RegKey & "Office\14.0\Registration\{10140000-0011-0000-1000-0000000FF1CE}", _
" Office 12 2007 Key " & ARW & RegKey & "Office\12.0\Registration", _
" Office 11 2003 Key " & ARW & RegKey & "Office\11.0\Registration", _
" Office 10 XP Key " & ARW & RegKey & "Office\10.0\Registration"}
'-> Button Click Section
'-> Collect The Information
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim V1 = " Installed System Ram " & ARW
If My.Computer.Info.TotalPhysicalMemory > GB Then
SyRam = V1 & FormatNumber(My.Computer.Info.TotalPhysicalMemory / GB, 2) & " GB"
Else
SyRam = V1 & FormatNumber(My.Computer.Info.TotalPhysicalMemory / MB, 2) & " MB"
End If
TextBox1.Text = Lne & vB & _
" Computer System Name " & ARW & CName & vB & _
" Operating System Name " & ARW & OName & vB & _
" Os Version " & ARW & OsVer & vB & _
SyRam & vB
WmiQuerry()
TextBox1.ScrollBars = ScrollBars.Both
DiskInformation()
ListMSKeys()
End Sub
'-> Clear Text And Global Varibles
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
TextBox1.Text = ""
HardDrive = ""
Optical = ""
Removable = ""
SyRam = ""
Tm1 = ""
Tm2 = ""
TxtVar1 = ""
TextBox1.ScrollBars = ScrollBars.None
End Sub
'-> Save The Information
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
If Not TextBox1.Text = "" Then
Dim Desktop = Act.SpecialFolders("Desktop")
Dim KeyTxt = Desktop & "\" & My.Computer.Name & "_BasicInfo.txt"
Dim sw As StreamWriter = New StreamWriter(KeyTxt.ToString)
sw.Write(TextBox1.Text)
sw.Close()
Act.Run(Chr(34) & KeyTxt.ToString & Chr(34), 1, False)
End If
End Sub
'-> Code To Fill Textbox1
'-> Varible Used To Collect Various Microsoft Product Keys
Dim TxtVar1
Private Sub ListMSKeys()
For Each K In MsKeys
Dim Z1 = Split(K, ARW)
Dim A1 = Z1(1) & DigProID
Try
GetKey(Act.RegRead(A1))
TxtVar1 = TxtVar1 & Z1(0) & ARW & GetKey(Act.RegRead(A1)) & vbCrLf
Catch ex As Exception
End Try
Next
TextBox1.Text = TextBox1.Text & Lne & vB & TxtVar1
End Sub
'-> Wmi Querries
Dim Tm1
Dim Tm2
Private Sub WmiQuerry()
Dim Cpu = "", InDate = "", InTime = "", LBDate = "", LBTime = ""
For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem")
If Obj.BuildNumber >= 6000 Then
Cpu = True
Else
Cpu = False
End If
Next
Dim T1 = " Number Of Processors "
For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystem")
If Cpu = True Then
Cpu = T1 & ARW & Obj.NumberOfProcessors & vB & _
" Logical Processors " & ARW & Obj.NumberOfLogicalProcessors
Else
Cpu = T1 & ARW & Obj.NumberOfProcessors
End If
TextBox1.Text = TextBox1.Text & _
" Computer System Type " & ARW & Obj.SystemType & vB & _
Cpu & vB
Next
Dim SysUpTime = ""
For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem")
'-> Install Date
Tme.Value = Obj.InstallDate
Tm1 = Tme.GetVarDate
Tm2 = Split(Tme.GetVarDate, " ")
InDate = " Installed Date " & ARW & _
MonthName(Tme.Month) & ", " & WeekdayName(Weekday(Tm1)) & " " & Tme.Day & " " & Tme.Year
InTime = " Installed Time " & ARW & Tm2(1) & " " & Tm2(2)
'-> Last Boot Up
Tme.Value = Obj.LastBootUpTime
Tm1 = Tme.GetVarDate
Tm2 = Split(Tme.GetVarDate, " ")
LBDate = " Last Boot Date " & ARW & _
MonthName(Tme.Month) & ", " & WeekdayName(Weekday(Tm1)) & " " & Tme.Day & " " & Tme.Year
LBTime = " Last Boot Time " & ARW & Tm2(1) & " " & Tm2(2)
SysUpTime = " System Uptime Hours " & ARW & DateDiff("h", Tm1, Now)
Next
TextBox1.Text = TextBox1.Text & _
Lne & vB & _
InDate & vB & _
InTime & vB & _
LBDate & vB & _
LBTime & vB & _
SysUpTime & vB
End Sub
'-> Disks Information
Dim HardDrive, Optical, Removable
Private Sub DiskInformation()
For Each Drv In My.Computer.FileSystem.Drives
If Drv.DriveType = DriveType.Fixed Then
HardDrive = HardDrive & Drv.Name & " "
End If
If Drv.DriveType = DriveType.CDRom Then
Optical = Optical & Drv.Name & " "
End If
If Drv.DriveType = DriveType.Removable Then
Removable = Removable & Drv.Name & " "
End If
Next
HardDrive = " Local Hard Disks " & ARW & HardDrive
Optical = " Local Optical Drive " & ARW & Optical
Removable = " Local Removable Drive " & ARW & Removable
TextBox1.Text = TextBox1.Text & Lne & vB & HardDrive & vB & Optical & vB & Removable & vB
End Sub
'-> Get The OS Key
Dim Key
Function GetKey(ByVal rpk)
Dim i, j
Dim dwAccumulator = "", KeyOs = ""
Const rpkOffset = 52 : i = 28
Dim szPossibleChars = "BCDFGHJKMPQRTVWXY2346789"
Do
dwAccumulator = 0 : j = 14
Do
dwAccumulator = dwAccumulator * 256
dwAccumulator = rpk(j + rpkOffset) + dwAccumulator
rpk(j + rpkOffset) = (dwAccumulator \ 24) And 255
dwAccumulator = dwAccumulator Mod 24
j = j - 1
Loop While j >= 0
i = i - 1 : KeyOs = Mid(szPossibleChars, dwAccumulator + 1, 1) & KeyOs
If (((29 - i) Mod 6) = 0) And (i <> -1) Then
i = i - 1 : KeyOs = "-" & KeyOs
End If
Loop While i >= 0
GetKey = KeyOs
Key = KeyOs
End Function
'-> Code To Start The Graph Of Ram Usage
Dim SysRam
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
MachineRamSize()
RamF3.Text = ""
RamU3.Text = ""
RamInfoTxt.Visible = True
RamF1.Visible = True
RamF2.Visible = True
RamF3.Visible = True
RamU1.Visible = True
RamU2.Visible = True
RamU3.Visible = True
RamPanel.Visible = True
Timer1.Start()
End Sub
'-> Start The Timer To Update The Ram Graph
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
RamForGraph()
End Sub
Private Sub MachineRamSize()
If My.Computer.Info.TotalPhysicalMemory > GB Then
SysRam = FormatNumber(My.Computer.Info.TotalPhysicalMemory / GB, 2) & " GB "
Else
SysRam = FormatNumber(My.Computer.Info.TotalPhysicalMemory / MB, 2) & " MB "
End If
SysRam = " Total Ram " & ARW & SysRam
RamInfoTxt.Text = SysRam
End Sub
'-> Ram usage For Graph
Private Sub RamForGraph()
'-> Free Ram
Dim F3 = ""
If My.Computer.Info.AvailablePhysicalMemory > GB Then
F3 = FormatNumber(My.Computer.Info.AvailablePhysicalMemory / GB) & " GB "
ElseIf My.Computer.Info.AvailablePhysicalMemory < GB Then
F3 = FormatNumber(My.Computer.Info.AvailablePhysicalMemory / MB) & " MB "
End If
'-> Set The Free Percent Size
Dim F1 = FormatPercent(My.Computer.Info.AvailablePhysicalMemory / My.Computer.Info.TotalPhysicalMemory, 2)
Dim F2 = Replace(F1, "%", "")
F2 = F2 * 2.25
RamF3.Size = New Size(F2, 17)
RamF2.Text = F3 & " " & F1
'-> Used Ram
Dim U3 = ""
Dim Ram_Used = My.Computer.Info.TotalPhysicalMemory - My.Computer.Info.AvailablePhysicalMemory
If Ram_Used > GB Then
U3 = FormatNumber(Ram_Used / GB, 2) & " GB"
ElseIf Ram_Used < GB Then
U3 = FormatNumber(Ram_Used / MB, 2) & " MB"
End If
'-> Set The Used Percent Size
Dim U1 = FormatPercent(Ram_Used / My.Computer.Info.TotalPhysicalMemory, 2)
Dim U2 = Replace(U1, "%", "")
U2 = U2 * 2.25
RamU3.Size = New Size(U2, 17)
RamU2.Text = U3 & " " & U1
End Sub
End Class

Source Code Get_KeyV1

Get_KeyV1.exe

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...