Account Login Username:
Active Server Pages Coding Standards Complete Applications Custom Controls/Forms/Menus Data Structures Databases/Data Access/DAO/ADO DDE Debugging and Error Handling DirectX Encryption Files/File Controls/Input/Output Games Graphics Internet/HTML Jokes/Humor Libraries Math/Dates Microsoft Office Apps/VBA Miscellaneous Object Oriented Programming (OOP) OLE/COM/DCOM/Active-X Registry Sound/MP3 String Manipulation VB function enhancement Windows API Call/Explanation Windows CE Windows System Services
by ICE (35 Submissions) Category: MiscellaneousCompatability: VB 6.0Difficulty: Intermediate Date Added: Fri 12th February 2021 Rating: (1 Votes)
It's a simple 1 form 1 module code All it does is let the user type in their name & then, when they reboot their PC ........ the name they typed in appears to the right of their PC's Clock in the bottom right corner follow along by carefully reading the text & yes you can copy an paste it,, making it faster like what needs to go on the form & the codes for both the form & the moduleIt should take less then 5 mins to make & 2 mins to test it. I think its like adding a personal touch to your own PC ,, Having your name in the system tray LOLFor form 1 you need 1 Label ( set just below the Title bar )Caption in the label is ....( Change name by the clock in the systray: )1 TextBox set just below the above LabelText is Blank ( text.text = "" )1 Command ButtonCaption ( Change name on systray )Note even if you test it in VB6 when you reboot your PCThere will be a name beside the Clock when it restarts LOL
' Name By Clock ' Form1Option ExplicitDim strSysTray01 As StringDim strSysTray02 As StringPrivate Sub Command1_Click()SaveSettingsMsgBox _"You have 2 restart your computer B4 the settings take place!", _vbOKOnly, "Restart now!!!"End SubSub SaveSettings()If Text1.Text <> "" Then strSysTray01 = Text1.TextSetStringValue "HKEY_USERS\.DEFAULT\CONTROL PANEL\INTERNATIONAL", _"s1159", strSysTray01SetStringValue "HKEY_USERS\.DEFAULT\CONTROL PANEL\INTERNATIONAL", _"s2359", strSysTray01End SubSub GetSettings()strSysTray01 = _GetStringValue("HKEY_USERS\.DEFAULT\CONTROL PANEL\INTERNATIONAL", "s1159")strSysTray02 = _GetStringValue("HKEY_USERS\.DEFAULT\CONTROL PANEL\INTERNATIONAL", "s2359")Text1.Text = IIf(strSysTray01 = "Error", "", strSysTray01)End SubPrivate Sub Form_Load()GetSettingsEnd Sub ' Name By Clock ....... This following section is for the ModuleOption ExplicitType FILETIMElLowDateTime As LonglHighDateTime As LongEnd Type Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _ByVal samDesired As Long, phkResult As Long) As LongDeclare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongDeclare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongDeclare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _(ByVal hKey As Long, ByVal lpSubKey As String) As LongDeclare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved _As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As LongDeclare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, _ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, _ByRef lpData As Long, lpcbData As Long) As LongDeclare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved _As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData _As Long) As LongDeclare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, _ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType _As Long, ByRef lpData As Long, ByVal cbData As Long) As LongDeclare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" _(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved _As Long, ByVal dwType As Long, ByRef lpData As Byte, _ByVal cbData As Long) As LongConst ERROR_SUCCESS = 0&Const ERROR_BADDB = 1009&Const ERROR_BADKEY = 1010&Const ERROR_CANTOPEN = 1011&eyHandle(MainKeyName As String) As LongConst HKEY_CLASSES_ROOT = &H80000000Const HKEY_CURRENT_USER = &H80000001Const HKEY_LOCAL_MACHINE = &H80000002Const HKEY_USERS = &H80000003Const HKEY_PERFORMANCE_DATA = &H80000004Const HKEY_CURRENT_CONFIG = &H80000005Const HKEY_DYN_DATA = &H80000006Select Case MainKeyNameCase "HKEY_CLASSES_ROOT"GetMainKeyHandle = HKEY_CLASSES_ROOTCase "HKEY_CURRENT_USER"GetMainKeyHandle = HKEY_CURRENT_USERCase "HKEY_LOCAL_MACHINE"GetMainKeyHandle = HKEY_LOCAL_MACHINECase "HKEY_USERS"GetMainKeyHandle = HKEY_USERSCase "HKEY_PERFORMANCE_DATA"GetMainKeyHandle = HKEY_PERFORMANCE_DATACase "HKEY_CURRENT_CONFIG"GetMainKeyHandle = HKEY_CURRENT_CONFIGCase "HKEY_DYN_DATA"GetMainKeyHandle = HKEY_DYN_DATAEnd SelectEnd FunctionFunction ErrorMsg(lErrorCode As Long) As StringDim GetErrorMsg As StringSelect Case lErrorCodeCase 1009, 1015GetErrorMsg = "The Registry Database is corrupt!"Case 2, 1010GetErrorMsg = "Bad Key Name"Case 1011GetErrorMsg = "Can't Open Key"Case 4, 1012GetErrorMsg = "Can't Read Key"Case 5GetErrorMsg = "Access to this key is denied"Case 1013GetErrorMsg = "Can't Write Key"Case 8, 14GetErrorMsg = "Out of memory"Case 87GetErrorMsg = "Invalid Parameter"Case 234GetErrorMsg = "There is more data than the buffer has been allocated to hold."Case ElseGetErrorMsg = "Undefined Error Code: " & Str$(lErrorCode)End SelectEnd FunctionPublic Function AGetStringValue(Subkey As String, Entry As String)Call ParseKey(Subkey, MainKeyHandle)If MainKeyHandle Thenrtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_READ, hKey)If rtn = ERROR_SUCCESS ThensBuffer = Space(255)lBufferSize = Len(sBuffer)rtn = RegQueryValueEx(hKey, Entry, 0, REG_SZ, sBuffer, lBufferSize)If rtn = ERROR_SUCCESS Thenrtn = RegCloseKey(hKey)sBuffer = Trim(sBuffer)AGetStringValue = Left(sBuffer, Len(sBuffer) - 1)ElseAGetStringValue = "Error"If DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfElseAGetStringValue = ""If DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfEnd IfEnd FunctionPrivate Sub ParseKey(Keyname As String, Keyhandle As Long)rtn = InStr(Keyname, "\")If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" ThenMsgBox "Incorrect Format:" + Chr(10) + Chr(10) + KeynameExit SubElseIf rtn = 0 ThenKeyhandle = GetMainKeyHandle(Keyname)Keyname = ""ElseKeyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1))Keyname = Right(Keyname, Len(Keyname) - rtn)End IfEnd SubFunction CreateKey(Subkey As String)Call ParseKey(Subkey, MainKeyHandle)If MainKeyHandle Thenrtn = RegCreateKey(MainKeyHandle, Subkey, hKey)If rtn = ERROR_SUCCESS Thenrtn = RegCloseKey(hKey)End IfEnd IfEnd FunctionFunction SetStringValue(Subkey As String, Entry As String, ByVal Value As String)Call ParseKey(Subkey, MainKeyHandle)If MainKeyHandle Thenrtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_WRITE, hKey)If rtn = ERROR_SUCCESS Thenrtn = RegSetValueEx(hKey, Entry, 0, REG_SZ, ByVal Value, Len(Value))If Not rtn = ERROR_SUCCESS ThenIf DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd Ifrtn = RegCloseKey(hKey)ElseIf DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfEnd IfEnd FunctionPublic Function GetStringValue(Subkey As String, Entry As String) As StringDim MemString As StringMemString = AGetStringValue(Subkey, Entry)If InStr(MemString, Chr(0)) ThenGetStringValue = Left(MemString, InStr(MemString, Chr(0)) - 1)ElseGetStringValue = MemStringEnd IfEnd Function''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''the stuff below here you'll have to see if you want to use it & fgure out where to place it,Maybe someone will figure it out & post it & let others know about it....Const ERROR_CANTREAD = 1012&Const ERROR_CANTWRITE = 1013&Const ERROR_OUTOFMEMORY = 14&Const ERROR_INVALID_PARAMETER = 87&Const ERROR_ACCESS_DENIED = 5&Const ERROR_NO_MORE_ITEMS = 259&Const ERROR_MORE_DATA = 234&Const REG_NONE = 0&Const REG_SZ = 1&Const REG_EXPAND_SZ = 2&Const REG_BINARY = 3&Const REG_DWORD = 4&Const REG_DWORD_LITTLE_ENDIAN = 4&Const REG_DWORD_BIG_ENDIAN = 5&Const REG_LINK = 6&Const REG_MULTI_SZ = 7&Const REG_RESOURCE_LIST = 8&Const REG_FULL_RESOURCE_DESCRIPTOR = 9&Const REG_RESOURCE_REQUIREMENTS_LIST = 10&Const KEY_QUERY_VALUE = &H1&Const KEY_SET_VALUE = &H2&Const KEY_CREATE_SUB_KEY = &H4&Const KEY_ENUMERATE_SUB_KEYS = &H8&Const KEY_NOTIFY = &H10&Const KEY_CREATE_LINK = &H20&Const READ_CONTROL = &H20000Const WRITE_DAC = &H40000Const WRITE_OWNER = &H80000Const SYNCHRONIZE = &H100000Const STANDARD_RIGHTS_REQUIRED = &HF0000Const STANDARD_RIGHTS_READ = READ_CONTROLConst STANDARD_RIGHTS_WRITE = READ_CONTROLConst STANDARD_RIGHTS_EXECUTE = READ_CONTROLConst KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFYConst KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or _KEY_CREATE_SUB_KEYConst KEY_EXECUTE = KEY_READDim hKey As Long, MainKeyHandle As LongDim rtn As Long, lBuffer As Long, sBuffer As StringDim lBufferSize As LongDim lDataSize As LongDim ByteArray() As ByteConst DisplayErrorMsg = FalseFunction SetDWORDValue(Subkey As String, Entry As String, Value As Long)Call ParseKey(Subkey, MainKeyHandle)If MainKeyHandle Thenrtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_WRITE, hKey)If rtn = ERROR_SUCCESS Thenrtn = RegSetValueExA(hKey, Entry, 0, REG_DWORD, Value, 4)If Not rtn = ERROR_SUCCESS ThenIf DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd Ifrtn = RegCloseKey(hKey)ElseIf DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfEnd IfEnd FunctionFunction GetDWORDValue(Subkey As String, Entry As String)Call ParseKey(Subkey, MainKeyHandle)If MainKeyHandle Thenrtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_READ, hKey)If rtn = ERROR_SUCCESS Thenrtn = RegQueryValueExA(hKey, Entry, 0, REG_DWORD, lBuffer, 4)If rtn = ERROR_SUCCESS Thenrtn = RegCloseKey(hKey)GetDWORDValue = lBufferElseGetDWORDValue = "Error"If DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfElseGetDWORDValue = "Error"If DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfEnd IfEnd FunctionFunction SetBinaryValue(Subkey As String, Entry As String, Value As String)Dim i As IntegerCall ParseKey(Subkey, MainKeyHandle)If MainKeyHandle Thenrtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_WRITE, hKey)If rtn = ERROR_SUCCESS ThenlDataSize = Len(Value)ReDim ByteArray(lDataSize)For i = 1 To lDataSizeByteArray(i) = Asc(Mid$(Value, i, 1))Nextrtn = RegSetValueExB(hKey, Entry, 0, REG_BINARY, ByteArray(1), lDataSize)If Not rtn = ERROR_SUCCESS ThenIf DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd Ifrtn = RegCloseKey(hKey)ElseIf DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfEnd IfEnd FunctionFunction GetBinaryValue(Subkey As String, Entry As String)Call ParseKey(Subkey, MainKeyHandle)If MainKeyHandle Thenrtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_READ, hKey)If rtn = ERROR_SUCCESS ThenlBufferSize = 1rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, 0, lBufferSize)sBuffer = Space(lBufferSize)rtn = RegQueryValueEx(hKey, Entry, 0, REG_BINARY, sBuffer, lBufferSize)If rtn = ERROR_SUCCESS Thenrtn = RegCloseKey(hKey)GetBinaryValue = sBufferElseGetBinaryValue = "Error"If DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfElseGetBinaryValue = "Error"If DisplayErrorMsg = True ThenMsgBox ErrorMsg(rtn)End IfEnd IfEnd IfEnd FunctionFunction DeleteKey(Keyname As String)Call ParseKey(Keyname, MainKeyHandle)If MainKeyHandle Thenrtn = RegOpenKeyEx(MainKeyHandle, Keyname, 0, KEY_WRITE, hKey)If rtn = ERROR_SUCCESS Thenrtn = RegDeleteKey(hKey, Keyname)rtn = RegCloseKey(hKey)End IfEnd IfEnd FunctionFunction GetMain
Download this snippet Add to My Saved Code
No comments have been posted about Name by the Clock. Why not be the first to post a comment about Name by the Clock.
0/1000 characters