This little handy tool intend me to get familiar with Purebasic.
It reads the OEM-Infos like Name, Organisation ProductID and comment from the registry.
You can make changes and save it back.
Truly it saves a backup of the keys before editing.
)Code: Select all
;---------------------------------------------------------------------------------------
; Author: Manne
; Date: 30.03.2003
; PrgName: OEM-Info
;
; Die Umsetzung dieses Tools diente mir in erster linie dazu um mich etwas mit PB vertraut zu machen.
; Der vorliegende Sourcecode ist FREEWARE und darf nicht als Shareware oder kommerzielles Produkt
; in compilierter Form veröffentlicht werden.
;---------------------------------------------------------------------------------------
;- Deklaration der Variablen
;---------------------------------------------------------------------------------------
DefType.s system, owner, organisation, regnum, prodname, comment, servicepack, filename
DefType.l result, check, Head, tfText, btText, strName, strOrga, strRegnum, strComment, strProdName, strServicePack
state.b
Dim status.b(4)
;---------------------------------------------------------------------------------------
;- Fonts für die spätere Nutzung in den Gadgets laden
;---------------------------------------------------------------------------------------
Head = LoadFont(0, "Times New Roman", 14, #PB_Font_Bold | #PB_Font_Underline)
tfText = LoadFont(1, "Times New Roman", 10, #PB_Font_Bold)
btText = LoadFont(2, "Times New Roman", 12, #PB_Font_Bold)
;---------------------------------------------------------------------------------------
;- Prozeduren deklarieren
;---------------------------------------------------------------------------------------
Procedure.s ExePath()
tmp$ = Space(1000)
GetModuleFilename_(0,@tmp$,1000)
ProcedureReturn GetPathPart(tmp$)
EndProcedure
Procedure.l WriteFile(name.s)
Shared system, owner, organisation, regnum, comment, check
check = CreateFile(0, name)
WriteStringN("REGEDIT4")
WriteStringN("")
WriteStringN("[HKEY_LOCAL_MACHINE\Software\Microsoft\"+ system +"\CurrentVersion]")
WriteStringN(Chr(34) + "RegisteredOwner" + Chr(34) + "=" + Chr(34) + owner + Chr(34))
WriteStringN(Chr(34) + "RegisteredOrganization" + Chr(34) + "=" + Chr(34) + organisation + Chr(34))
WriteStringN(Chr(34) + "ProductId" + Chr(34) + "=" + Chr(34) + regnum + Chr(34))
WriteStringN("")
WriteStringN("[HKEY_LOCAL_MACHINE\System\ControlSet001\services\lanmanserver\parameters]")
WriteStringN(Chr(34) + "SrvComment" + Chr(34) + "=" + Chr(34) + comment + Chr(34))
CloseFile(0)
ProcedureReturn check
EndProcedure
Procedure.s ReadRegKey(OpenKey.l,SubKey.s,ValueName.s)
hKey.l=0
keyvalue.s=Space(255)
datasize.l=255
If RegOpenKeyEx_(OpenKey,SubKey,0,#KEY_READ,@hKey)
MessageRequester("Stop", "Error Reading key", #MB_ICONWARNING)
End
Else
If RegQueryValueEx_(hKey,ValueName,0,0,@keyvalue,@datasize)
keyvalue = "Not specified"
Else
keyvalue=Left(keyvalue,datasize-1)
EndIf
RegCloseKey_(hKey)
EndIf
ProcedureReturn keyvalue
EndProcedure
Procedure.l WriteRegKey(OpenKey.l,SubKey.s,keyset.s,keyvalue.s)
hKey.l=0
If RegCreateKey_(OpenKey,SubKey,@hKey)=0
result=1
datasize.l=Len(keyvalue)
If RegSetValueEx_(hKey,keyset,0,#REG_SZ,@keyvalue,datasize)=0
result=2
EndIf
RegCloseKey_(hKey)
EndIf
ProcedureReturn result
EndProcedure
;---------------------------------------------------------------------------------------
;- Prüfen unter welchem OS das Tool ausgeführt wird und Ablegen des Systemdirectorys zur späteren Verwendung
;---------------------------------------------------------------------------------------
ergebnis = OSVersion()
Select ergebnis
Case #PB_OS_Windows_98
system = "Windows"
Case #PB_OS_Windows_ME
system = "Windows"
Case #PB_OS_Windows_NT_4
system = "Windows NT"
Case #PB_OS_Windows_2000
system = "Windows NT"
Case #PB_OS_Windows_XP
system = "Windows NT"
Default
MessageRequester("Attention", "This Tool is for WIN 98, NT4 or higher,"+ Chr(13) + "older Versions are not supported!", #MB_IconStop)
End
EndSelect
;---------------------------------------------------------------------------------------
;- Werte aus der Registry auslesen
;---------------------------------------------------------------------------------------
owner = ReadRegKey(#HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\"+ system +"\CurrentVersion","RegisteredOwner")
organisation = ReadRegKey(#HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\"+ system +"\CurrentVersion","RegisteredOrganization")
regnum = ReadRegKey(#HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\"+ system +"\CurrentVersion","ProductId")
prodname = ReadRegKey(#HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\"+ system +"\CurrentVersion","ProductName")
servicepack = ReadRegKey(#HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\"+ system +"\CurrentVersion","CSDVersion")
comment = ReadRegKey(#HKEY_LOCAL_MACHINE,"System\ControlSet001\Services\lanmanserver\parameters","SrvComment")
prodname = ReplaceString(prodname, "Microsoft", "")
;---------------------------------------------------------------------------------------
;- Prüfen ob bereits eine Sicherung angelegt wurde und anlegen
;---------------------------------------------------------------------------------------
filename = ExePath() + "sicher.reg"
check = ReadFile(0, filename)
If check 0
CloseFile(0)
check = MessageRequester("Information", "Backup exists, overwrite?", #MB_ICONQUESTION | #MB_YESNO)
Select check
Case 6
check = WriteFile(filename)
If check = 0
MessageRequester("Stop", "Error Overwriting backup", #MB_ICONSTOP)
EndIf
Case 7
filename = SaveFileRequester("Save", "sicher.reg", "Backup|*.reg", 0)
check = WriteFile(filename)
If check = 0
MessageRequester("Stop", "Error saving file", #MB_ICONSTOP)
EndIf
EndSelect
Else
check = WriteFile(filename)
If check = 0
MessageRequester("Stop", "Error saving backup", #MB_ICONSTOP)
EndIf
EndIf
;---------------------------------------------------------------------------------------
; PureBasic Visual Designer v3.62
;- Window Constants
;
#Window_0 = 0
;- Gadget Constants
;
#Gadget_0 = 0
#Gadget_1 = 1
#Gadget_2 = 2
#Gadget_3 = 3
#Gadget_4 = 4
#Gadget_5 = 5
#Gadget_6 = 6
#Gadget_7 = 7
#Gadget_8 = 8
#Gadget_9 = 9
#Gadget_10 = 10
#Gadget_11 = 11
#Gadget_12 = 12
#Gadget_13 = 13
#Gadget_14 = 14
#Gadget_15 = 15
#Gadget_16 = 16
#Gadget_17 = 17
;- StatusBar Constants
;
#StatusBar_0 = 0
;- Prozedur zur Erstellung des Fensters
;---------------------------------------------------------------------------------------
Procedure Open_Window_0()
Shared state, strName, strOrga, strRegnum, strComment, strProdName, strServicePack
If OpenWindow(#Window_0, 100, 100, 374, 284, #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "OEM - Info")
If CreateStatusBar(#StatusBar_0, WindowID())
AddStatusBarField(374)
StatusBarText(#StatusBar_0, 0, "Ready")
state = 1
EndIf
If CreateGadgetList(WindowID())
TextGadget(#Gadget_0, 72, 20, 230, 20, "Registered User", #PB_Text_Center)
TextGadget(#Gadget_1, 20, 60, 80, 20, "Name:")
TextGadget(#Gadget_2, 20, 90, 80, 20, "Organisation:")
TextGadget(#Gadget_3, 20, 120, 80, 20, "Product-ID:")
TextGadget(#Gadget_4, 20, 150, 80, 20, "Comment:")
TextGadget(#Gadget_5, 20, 180, 80, 20, "OS:")
strName = StringGadget(#Gadget_6, 110, 60, 160, 20, "")
strOrga = StringGadget(#Gadget_7, 110, 90, 160, 20, "")
strRegnum = StringGadget(#Gadget_8, 110, 120, 160, 20, "")
strComment = StringGadget(#Gadget_9, 110, 150, 160, 20, "")
strProdName = StringGadget(#Gadget_10, 110, 180, 100, 20, "", #PB_String_ReadOnly)
strServicePack = StringGadget(#Gadget_11, 210, 180, 100, 20, "", #PB_String_ReadOnly)
CheckBoxGadget(#Gadget_12, 300, 60, 60, 20, "change")
CheckBoxGadget(#Gadget_13, 300, 90, 60, 20, "change")
CheckBoxGadget(#Gadget_14, 300, 120, 60, 20, "change")
CheckBoxGadget(#Gadget_15, 300, 150, 60, 20, "change")
ButtonGadget(#Gadget_16, 50, 220, 110, 30, "Save")
ButtonGadget(#Gadget_17, 220, 220, 110, 30, "Close")
EndIf
EndIf
EndProcedure
;---------------------------------------------------------------------------------------
;- Fenster erstellen und Standard-Cursor im Fenster und den Gadgets auf 0 setzen
;---------------------------------------------------------------------------------------
Open_Window_0()
hwnd = WindowID()
SetClassLong_(hwnd, #GCL_HCURSOR, 0)
SetClassLong_(strName, #GCL_HCURSOR, 0)
SetClassLong_(strOrga, #GCL_HCURSOR, 0)
SetClassLong_(strRegnum, #GCL_HCURSOR, 0)
SetClassLong_(strComment, #GCL_HCURSOR, 0)
SetClassLong_(strProdName, #GCL_HCURSOR, 0)
SetClassLong_(strServicePack, #GCL_HCURSOR, 0)
;---------------------------------------------------------------------------------------
;- Cursor laden
;---------------------------------------------------------------------------------------
cur0 = LoadCursor_(0, #IDC_ARROW)
cur1 = LoadCursor_(0, #IDC_NO)
cur2 = LoadCursor_(0, #IDC_IBEAM)
;---------------------------------------------------------------------------------------
;- Gagdgets deaktivieren und Statusvariable setzen, Text und Schriftart setzen
;---------------------------------------------------------------------------------------
DisableGadget(#Gadget_6, 1) : status(0) = 0
DisableGadget(#Gadget_7, 1) : status(1) = 0
DisableGadget(#Gadget_8, 1) : status(2) = 0
DisableGadget(#Gadget_9, 1) : status(3) = 0
DisableGadget(#Gadget_16, 1) : status(4) = 0
SetGadgetText(#Gadget_6, owner)
SetGadgetText(#Gadget_7, organisation)
SetGadgetText(#Gadget_8, regnum)
SetGadgetText(#Gadget_9, comment)
SetGadgetText(#Gadget_10, prodname)
SetGadgetText(#Gadget_11, servicepack)
SetGadgetFont(#Gadget_0, Head)
SetGadgetFont(#Gadget_1, tfText)
SetGadgetFont(#Gadget_2, tfText)
SetGadgetFont(#Gadget_3, tfText)
SetGadgetFont(#Gadget_4, tfText)
SetGadgetFont(#Gadget_5, tfText)
SetGadgetFont(#Gadget_16, btText)
SetGadgetFont(#Gadget_17, btText)
;---------------------------------------------------------------------------------------
;- hier wird auf die Events entsprechend reagiert
;---------------------------------------------------------------------------------------
Repeat
Event = WaitWindowEvent()
Gosub changecursor
If Event = #PB_EventCloseWindow
Quit = 1
ElseIf Event = #PB_Event_Gadget
Select EventGadgetID()
Case 6
If EventType() = #PB_EventType_Change And status(4) = 0
status(4) = 1
DisableGadget(#Gadget_16, 0)
EndIf
Case 7
If EventType() = #PB_EventType_Change And status(4) = 0
status(4) = 1
DisableGadget(#Gadget_16, 0)
EndIf
Case 8
If EventType() = #PB_EventType_Change And status(4) = 0
status(4) = 1
DisableGadget(#Gadget_16, 0)
EndIf
Case 9
If EventType() = #PB_EventType_Change And status(4) = 0
status(4) = 1
DisableGadget(#Gadget_16, 0)
EndIf
Case 12
If status(0) = 0
DisableGadget(#Gadget_6, 0) ;enable
ActivateGadget(#Gadget_6)
status(0) = 1
Else
DisableGadget(#Gadget_6, 1) ; disable
status(0) = 0
status(4) = 0
EndIf
If state = 2
StatusBarText(#StatusBar_0, 0, "Ready")
state = 1
EndIf
Case 13
If status(1) = 0
DisableGadget(#Gadget_7, 0)
ActivateGadget(#Gadget_7)
status(1) = 1
Else
DisableGadget(#Gadget_7, 1)
status(1) = 0
status(4) = 0
EndIf
If state = 2
StatusBarText(#StatusBar_0, 0, "Ready")
state = 1
EndIf
Case 14
If status(2) = 0
DisableGadget(#Gadget_8, 0)
ActivateGadget(#Gadget_8)
status(2) = 1
Else
DisableGadget(#Gadget_8, 1)
status(2) = 0
status(4) = 0
EndIf
If state = 2
StatusBarText(#StatusBar_0, 0, "Ready")
state = 1
EndIf
Case 15
If status(3) = 0
DisableGadget(#Gadget_9, 0)
ActivateGadget(#Gadget_9)
status(3) = 1
Else
DisableGadget(#Gadget_9, 1)
status(3) = 0
status(4) = 0
EndIf
If state = 2
StatusBarText(#StatusBar_0, 0, "Ready")
state = 1
EndIf
Case 16
If status(0) = 1
owner = GetGadgetText(#Gadget_6)
result = WriteRegKey(#HKEY_LOCAL_MACHINE, "Software\Microsoft\"+ system +"\CurrentVersion", "RegisteredOwner", owner)
EndIf
If status(1) = 1
organisation = GetGadgetText(#Gadget_7)
result = WriteRegKey(#HKEY_LOCAL_MACHINE, "Software\Microsoft\"+ system +"\CurrentVersion", "RegisteredOrganization", organisation)
EndIf
If status(2) = 1
regnum = GetGadgetText(#Gadget_8)
result = WriteRegKey(#HKEY_LOCAL_MACHINE, "Software\Microsodt\"+ system +"\CurrentVersion", "ProductId", regnum)
EndIf
If status(3) = 1
comment = GetGadgetText(#Gadget_9)
result = WriteRegKey(#HKEY_LOCAL_MACHINE, "System\ControlSet001\Services\lanmanserver\parameters", "SrvComment", comment)
EndIf
If result = 2
StatusBarText(#StatusBar_0, 0, "Changes saved")
DisableGadget(#Gadget_16, 1)
status(4) = 0
state = 2
If status(0) = 1
SetGadgetState(#Gadget_12, 0)
status(0) = 0
DisableGadget(#Gadget_6, 1)
EndIf
If status(1) = 1
SetGadgetState(#Gadget_13, 0)
status(1) = 0
DisableGadget(#Gadget_7, 1)
EndIf
If status(2) = 1
SetGadgetState(#Gadget_14, 0)
status(2) = 0
DisableGadget(#Gadget_8, 1)
EndIf
If status(3) = 1
SetGadgetState(#Gadget_15, 0)
status(3) = 0
DisableGadget(#Gadget_9, 1)
EndIf
Else
If result = 0
MessageRequester("Stop", "Error opening registry", #MB_IconStop)
End
Else
MessageRequester("Stop", "Error saving", #MB_IconStop)
End
EndIf
EndIf
Case 17
quit = 1
EndSelect
EndIf
Until Quit
;---------------------------------------------------------------------------------------
;- Cursor aus dem Speicher entfernen
;---------------------------------------------------------------------------------------
DestroyCursor_(cur0)
DestroyCursor_(cur1)
DestroyCursor_(cur2)
;---------------------------------------------------------------------------------------
End
;- Sub zum Ändern des Maus-Cursors
;---------------------------------------------------------------------------------------
changecursor:
GetCursorPos_(cursorpos.POINT)
MapWindowPoints_(0, hwnd, cursorpos, 1)
Select ChildWindowFromPoint_(hwnd, cursorpos\x, cursorpos\y)
Case strName
If status(0) = 0
SetCursor_(cur1)
Else
SetCursor_(cur2)
EndIf
Case strOrga
If status(1) = 0
SetCursor_(cur1)
Else
SetCursor_(cur2)
EndIf
Case strRegnum
If status(2) = 0
SetCursor_(cur1)
Else
SetCursor_(cur2)
EndIf
Case strComment
If status(3) = 0
SetCursor_(cur1)
Else
SetCursor_(cur2)
EndIf
Case strProdName
SetCursor_(cur1)
Case strServicePack
SetCursor_(cur1)
Case hwnd : SetCursor_(cur0) ; Default, fuer das Hauptfenster
EndSelect
Return
;---------------------------------------------------------------------------------------
Manne