home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD36292262000.psc / Startup.bas < prev    next >
Encoding:
BASIC Source File  |  2000-02-21  |  3.1 KB  |  77 lines
  1. Attribute VB_Name = "Startup"
  2. Public os_info As OSVERSIONINFO
  3. Public Barleft As Integer
  4. Public Btns() As New Btn
  5. Public Icons() As New Task
  6. Public RootPath As String
  7. Public SystemPath As String
  8.  
  9. Sub Main()
  10. 'If FindWindow("Shell_TrayWnd", vbNullString) Then MsgBox "This program can not run while windows is running!", vbCritical, "WARNING": End
  11. Dim strBuf As String
  12. strBuf = Space$(MAX_SIZE)
  13. If GetWindowsDirectory(strBuf, MAX_SIZE) Then RootPath = Left(strBuf, InStr(1, strBuf, Chr(0)) - 1) + "\"
  14. strBuf = Space$(MAX_SIZE)
  15. If GetSystemDirectory(strBuf, MAX_SIZE) Then SystemPath = Left(strBuf, InStr(1, strBuf, Chr(0)) - 1) + "\"
  16. os_info.dwOSVersionInfoSize = Len(os_info)
  17. Call GetVersion(os_info)
  18. Win32_IE = os_info.dwMajorVersion
  19. ReDim Icons(0)
  20. ReDim Btns(0)
  21. Barleft = 80 * Screen.TwipsPerPixelX
  22. Call setMinMax
  23. Desktop.Show
  24. Call EnumWindows(AddressOf EnumWindowsProc, 0)
  25. Desktop.Timer1.Enabled = True
  26. Call SystemTray
  27. 'If GetKeyState(VK_SHIFT) <> &H8000 Then Call StartUp
  28. End Sub
  29.  
  30. Private Function StartUp()
  31.     Const szRunPath = ("Software\Microsoft\Windows\CurrentVersion\Run")
  32.     Const szRunOncePath = ("Software\Microsoft\Windows\CurrentVersion\RunOnce")
  33.     RunEntriesIn HKEY_LOCAL_MACHINE, szRunOncePath
  34.     DeleteEntriesIn HKEY_LOCAL_MACHINE, szRunOncePath
  35.     RunEntriesIn HKEY_CURRENT_USER, szRunOncePath
  36.     DeleteEntriesIn HKEY_CURRENT_USER, szRunOncePath
  37.     RunEntriesIn HKEY_LOCAL_MACHINE, szRunPath
  38.     RunEntriesIn HKEY_CURRENT_USER, szRunPath
  39.     'StartupMenu
  40. End Function
  41.  
  42. Function RunEntriesIn(key, Path)
  43.     Dim hKey As Long, lResult As Long, szNameBuffer As String * 1024, _
  44.     szValueBuffer As String * 1024, dwLoop As Integer
  45.     lResult = RegOpenKeyEx(key, Path, 0, KEY_READ, hKey)
  46.     If (lResult = ERROR_SUCCESS) Then
  47.         Do
  48.             lResult = RegEnumValue(hKey, dwLoop, szNameBuffer, Len(szNameBuffer), 0, 0, szValueBuffer, Len(szValueBuffer))
  49.             If lResult = ERROR_SUCCESS Then Call Shell(Left(szValueBuffer, InStr(1, szValueBuffer, Chr(0)) - 1), vbNormalFocus) Else Call RegCloseKey(hKey): Exit Function
  50.             dwLoop = dwLoop + 1
  51.         Loop
  52.         Call RegCloseKey(hKey)
  53.     End If
  54. End Function
  55.  
  56. Private Function DeleteEntriesIn(key As HKeys, Path As String)
  57.     Dim hKey  As Long
  58.     Dim lResult As Long
  59.     lResult = RegOpenKeyEx(key, Path, 0, KEY_READ, hKey)
  60.     If (lResult = ERROR_SUCCESS) Then
  61.         Dim szNameBuffer As String * 1024, szValueBuffer As String * 1024
  62.         Dim dwLoop As Long, dwNameSize As Long, dwValueSize As Long
  63.         Do
  64.             dwNameSize = Len(szNameBuffer)
  65.             dwValueSize = Len(szValueBuffer)
  66.  
  67.             lResult = RegEnumValue(hKey, dwLoop, szNameBuffer, dwNameSize, 0, 0, szValueBuffer, dwValueSize)
  68.             If (lResult = ERROR_NO_MORE_ITEMS) Then Call RegCloseKey(hKey): Exit Function
  69.             If (lResult = ERROR_SUCCESS) Then
  70.                 lResult = RegDeleteValue(hKey, szNameBuffer)
  71.             If (lResult <> ERROR_SUCCESS) Then Call RegCloseKey(hKey): Exit Function
  72.             End If
  73.         Loop
  74.         Call RegCloseKey(hKey)
  75.     End If
  76. End Function
  77.