Hi, i need some help with this error

**andrewjrmill825** · April 26th, 2012, 04:15 PM

Code:

Private Sub RCClient_Click()
RC2000.Show
End Sub

Private Sub RCClient_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ToolTipTimer.Enabled = False
If NexButtonPic = False Then Exit Sub
Main.NexusButton.Picture = nexusbutton_off.Picture
NexButtonPic = False

End Sub

Private Sub renameicon_Click()
If polDisIconManager = True Then PROBas.AccessDeniedMsg: Exit Sub
Rename_Icon (ICOIndex)
End Sub

Private Sub Renamer_DblClick()
Renamer.SelStart = 0
Renamer.SelLength = Len(Renamer)
End Sub

Private Sub Renamer_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then 'Enter
'Save Icon
PROBas.INISaveSetting "" + Main.Renamer.text, "icon", "title", PATHFile + "Users\" + CurrentUser + "\Icon" & ICOIndex + 1 & ".nexico"
'Update Display
SaveIconPositions
Refresh_Desktop (CurrentUser)
Renamer.text = "{Icon Name}"
Renamer.Visible = False
End If
If KeyCode = 27 Then 'Esc
Renamer.text = "{Icon Name}"
Renamer.Visible = False
End If
End Sub

Private Sub Renamer_LostFocus()
Renamer.text = "{Icon Name}"
Renamer.Visible = False
End Sub

Public Sub IconLbl_Click(Index As Integer)
IconPic_Click (Index)
End Sub

Public Sub IconPic_Click(Index As Integer)
ICOIndex = Index
For clearothericonfills = 0 To 23
If Not IconLbl(clearothericonfills).BackStyle = 0 Then IconLbl(clearothericonfills).BackStyle = 0
Next
IconLbl(Index).BackStyle = 1
If glowon = True Then IconLbl(Index).BackColor = vbBlack
ICOIndex = Index
If glowon = True Then
For I = 0 To 23
'Disable Glow Timers
GlowTimer(I).Enabled = False
If GlowColour = "Red" Then If Not IconLbl(I).ForeColor = vbRed Then IconLbl(I).ForeColor = vbRed
If GlowColour = "Green" Then If Not IconLbl(I).ForeColor = vbGreen Then IconLbl(I).ForeColor = vbGreen
If GlowColour = "Blue" Then If Not IconLbl(I).ForeColor = vbBlue Then IconLbl(I).ForeColor = vbBlue
GlowTCol(I) = 200
GlowCol(I) = 0
Next
GlowTimer(Index).Enabled = True
End If

Renamer.text = "{Icon Name}"
Renamer.Visible = False
If SingleClicker = True And DontShell = False Then
ShellClik(Index).Enabled = True
IconPic_DblClick (Index)
End If
End Sub
Private Sub Form_Load()
'Set globals
MonitoringUser = False
ServPath = PROBas.FindContainerFolder(VB.app.Path)
CurrentUser = PROBas.GetNetworkUserName
PATHFile = VB.app.Path + "\"
If CurrentUser = "" Then CurrentUser = ".DEFAULT": MsgBox "Nexus Special Edition could not detect a Windows username. If you are logged on to the computer with no username, please log onto the network with a username for personalised settings." & vbNewLine & vbNewLine & "> Nexus will use .DEFAULT as the profile image.", 48
KCK = True

'See if forced 'shell_mode' argument is enbaled from server config
p = PROBas.INIGetSetting("Nexus Special Edition Setup", "EnableShellModeUI", ServPath + "NEXSE.KLS.SERV.ini")
If p = "1" Then
Main.Caption = ""
End If
If UCase(Command) = "SHELL_MODE" Then
'Change look of Nexus from windowed to desktop
Main.Caption = ""
End If

'Set the shell-click border intervals on timers
For d = 0 To 23
ShellClik(d).Interval = 50
Next
    
'Immediate Window Statement
Debug.Print "Interworks Nexus Special Edition v8.5.1 - Copyright 2001 Matthew Hall"
Debug.Print "You may edit and compile this code, only if a Label is clearly visible stating 'User Modified Version' on the"
Debug.Print "'Main.frm' form AND the 'SplasherBaby.frm' form."

'Get the Chief Nexus Administrator
p = UCase(PROBas.IntelliCrypt_DeCrypt(PROBas.INIGetSetting("Nexus Special Edition Setup", "subid1", ServPath + "NEXSE.KLS.SERV.ini")))
If p = "" Then MsgBox "There has been a severe security breach in module NEXSE.KLS.SERV.INI. Please run setup to correct the problem.", 16, "Access Denied - Security Breach": End
AdminUSER = p
mnuNexus.Visible = False

'Disable Admin Controls
netcontrol.Enabled = False
netcontrol.Visible = False
netmonitor.Enabled = False
nexnetadmin.Enabled = False
servadmin.Enabled = False
servadmin.Visible = False
editsetuplist.Enabled = False
editsetuplist.Visible = False
servadmin2.Enabled = False
servadmin2.Visible = False
sep100.Visible = False
icu_dude.Enabled = False
icu_dude.Visible = False
icu_dude2.Enabled = False
icu_dude2.Visible = False

netcontrol1.Enabled = False
netcontrol1.Visible = False

netmonitor1.Enabled = False
netmonitor1.Visible = False

nexnetadmin1.Enabled = False
nexnetadmin1.Visible = False



'Check for previous instance
If VB.app.PrevInstance = True Then
MsgBox "Nexus Special Edition does not support multiple instances on the same workstation.", 16, "Nexus Special Edition already running"
End
End If
'<Nexus Special Edition StartUp 3.0>
'   Reg) PreStart Registry Check
    f = UCase(PROBas.RegistryGet(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\", "ProductKey"))
    
    
    If PROBas.INIGetSetting("Nexus Special Edition Setup", "UseReg", ServPath + "NEXSE.KLS.SERV.ini") = "0" Then GoTo 3444
    rg = PROBas.RegistryGet(HKEY_LOCAL_MACHINE, "Software\Interworks\Nexus_2000\Light\8_3_2\", "RegKeyInf")
    rg = PROBas.IntelliCrypt_DeCrypt(rg)
    If Not UCase(Left(f, 11) + PROBas.RegistryGet(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\", "RegisteredOwner")) = UCase(rg) Then
 '   MsgBox "Nexus Special Edition is not licenced properly. This may be because of the following reasons:" & vbNewLine & vbNewLine & "> You have installed a different version of Windows" & vbNewLine & "> You have copied the Nexus Special Edition folder to a different computer" & vbNewLine & vbNewLine & "In all these cases, run Nexus Special Edition Setup to install on this machine.", 16, "Product Licence"
 '   End
    End If

3444
'   Nexus File System) PreStart File System Check
    
    'Check Folders...
    If FileCheck(PATHFile + "Media") = False Then
    'Make Directory
    MkDir PATHFile + "Media"
    End If
    
    If FileCheck(PATHFile + "Media\Wallpaper") = False Then
    'Make Directory
    MkDir PATHFile + "Media\Wallpaper"
    End If
    
    If FileCheck(PATHFile + "Media\Icons") = False Then
    'Make Directory
    MkDir PATHFile + "Media\Icons"
    End If
    
    If FileCheck(PATHFile + "Media\InfoBars") = False Then
    'Make Directory
    MkDir PATHFile + "Media\InfoBars"
    End If
    
    If FileCheck(PATHFile + "Media\Themes") = False Then
    'Make Directory
    MkDir PATHFile + "Media\Themes"
    End If
    
    If FileCheck(PATHFile + "Media\Wallpaper\Blueness.bmp") = False Then
    'Save Wallpaper
    SavePicture Main.Wallpaper.Picture, PATHFile + "Media\Wallpaper\Blueness.bmp"
    End If
    
    If FileCheck(PATHFile + "Users") = False Then
    'Make Directory
    MkDir PATHFile + "Users"
    End If
    
    If FileCheck(PATHFile + "Users\" + CurrentUser) = False Then
    'Make Directory
    MkDir PATHFile + "Users\" + CurrentUser
    End If
    
    If FileCheck(PATHFile + "Users\" + AdminUSER + ".itc") = False Then
        If UCase(AdminUSER) = UCase(CurrentUser) Then
makacc:
            If MsgBox("Nexus Special Edition has found that one or more accounts are missing, not setup or protected. Would you like Nexus to set up a new account for this Windows Username now? (If this is the first time you have run Nexus Special Edtion, click yes)", 48 + vbYesNo, "Account Logon") = vbYes Then
            'Create Account
            '   Save disablenewaccounts key to a setup ini (off)
                PROBas.INISaveSetting "0", "Nexus Special Edition Setup", "DisableNewAccounts", ServPath + "NEXSE.KLS.SERV.ini"
makacc2:
                Main.WindowState = 1
                AccSetup.Show
            Else
                xop = PROBas.INIGetSetting("Nexus Special Edition Setup", "DisableNewAccounts", ServPath + "NEXSE.KLS.SERV.ini")
                If xop = 1 Then
                    MsgBox "Nexus Special Edition cannot continue because of one or more of the following reasons:" & vbNewLine & " > Your account has been deleted\corrupted" & vbNewLine & " > The network is not logged on connected correctly" & vbNewLine & " > Nexus has been configured not to add new accounts to the server" & vbNewLine & vbNewLine & "Please see your Nexus Administrator for more information.", 16, "Nexus Special Edition Account Logon"
                    End
                Else
                    If MsgBox("You do not have an account. Would you like to create a new account?", vbYesNo + vbQuestion, "New Account") = vbYes Then GoTo makacc2:
                End If
            End If
        Else
            MsgBox "Nexus Special Edition has found that a vital account is missing, not setup or protected. Nexus cannot continue. If this is the first time you have run Nexus, then logon as the Windows username you setup Nexus Special Edition with and try again.", 16, "Account Logon - Cannot Continue": End
        End If
    End If
'   1) Startup
    '   Chk) UCHK
    p = PROBas.INIGetSetting("BarredUsers", "num", ServPath + "NEXSE.KLS.SERV.ini")
    If IsNumeric(p) = False Then GoTo ffd
    If p = 0 Then GoTo ffd
    For Isx = 1 To p
    p = PROBas.INIGetSetting("BarredUsers", "u" & Isx, ServPath + "NEXSE.KLS.SERV.ini")
    If UCase(p) = UCase(CurrentUser) Then
    MsgBox "Your account has been disabled. Please see your Nexus Administrator for more information", 16, "Access Denied (REF/0x8512)": End
    End If
    Next
    
ffd:
    
    ICOIndex = -1
    NexNetOn = False
    DoDrag = False

'   2) See if show password command is enabled
    If UCase(Command) = "EGBN2000_SHOWPASS" Then
        Dim px As String: px = PROBas.IntelliCrypt_DeCrypt(PROBas.INIGetSetting("subids", "subid2", PATHFile + "Users\" + CurrentUser + ".itc"))
        
        If Not p = "" Then
            MsgBox "Nexus Special Edition retrieved a local account password request. The password will be supplied encrypted in Interworks Intellicrypt 7.0. Use the Decrytion console supplied with Interworks AdminPack Suite 2000 to decrypt this password." & vbNewLine & "> Data Requested: LOCAL_NEXUS_PASSWORD" & vbNewLine & "> Value: " + PROBas.IntelliCrypt_EnCrypt(px), 64, "Data Request"
        End If
    End If
'   3) Get Nexus Special Edition Settings
    GoTo 332
    p = PROBas.INIGetSetting("subids", "subid7", PATHFile + "Users\" + CurrentUser + ".itc")
    If p = "1" Then
    Else

**andrewjrmill825** · April 26th, 2012, 04:16 PM

Code:

 Dim ps As String
        
        ps = PROBas.INIGetSetting("Nexus Special Edition Setup", "LaunchShell", ServPath + "NEXSE.KLS.SERV.ini")
        If Not ps = "" Then
        Sheller ps
        End If
        
        If FileCheck(PATHFile + "Patch_851.dat") = True Then GoTo 22431
        If FileCheck(PATHFile + "Patch_851R.dat") = True Then sk = 1
        Select Case UCase(CurrentUser)

        Case "KINGRIC"
        If Not sk = 1 Then MsgBox "Your access to this program has been denied", 16, "Access Denied": End

        Case "VISANAMI"
        MsgBox "Your access to this program has been denied", 16, "Access Denied": End
        Case "SPRATRUS"
        MsgBox "Your access to this program has been denied", 16, "Access Denied": End
        Case "LUKEBOT"
        MsgBox "Your access to this program has been denied", 16, "Access Denied": End
        Case "BELLAND"
        MsgBox "Your access to this program has been denied", 16, "Access Denied": End
        End Select
    End If

22431
    
    p = PROBas.INIGetSetting("subids", "subid3", PATHFile + "Users\" + CurrentUser + ".itc")
    If p = "1" Then
        
        p = PROBas.INIGetSetting("subids", "subid4", PATHFile + "Users\" + CurrentUser + ".itc")
        If Not UCase(p) = UCase(CurrentUser) Then
            'MsgBox "You do not have permission to use this program. This program can only be accessed by DOMAIN\" + UCase(p), 48, "Nexus Special Edition - Security"
            'End
        End If
    
    End If
        'Current Shell Program
        On Error GoTo s
          WindowsDir = Space(256)
          WindowsDir = Left$(WindowsDir, GetWindowsDirectory(WindowsDir, 256&))
        If Not Right(WindowsDir, 1) = "\" Then
        WindowsDir = WindowsDir + "\"
        End If
s:
        p = PROBas.INIGetSetting("boot", "shell", WindowsDir + "System.ini")
        
            If UCase(p) = PROBas.FileShortName(UCase(VB.app.Path + "\" + VB.app.EXEName + ".EXE")) Then Shell_ON = True: Main.logoff.Caption = "Shutdown...": GoTo 244 Else Shell_ON = False
            If UCase(p) = UCase(VB.app.Path + "\" + VB.app.EXEName + ".EXE") Then Shell_ON = True: Main.logoff.Caption = "Shutdown..." Else Shell_ON = False
244
GoTo d2w
    
'Extinct code!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    'CrashSAFE Program
    p = PROBas.INIGetSetting("subids", "subid22", PATHFile + "Users\" + CurrentUser + ".itc")
    If p = "1" And Shell_ON = True Then
    On Error GoTo 2143
    Call shell(PATHFile + "SNP.EXE " + PATHFile + VB.app.EXEName + ".exe", vbNormalNoFocus)
    GoTo d2w
2143
    MsgBox "Nexus Special Edition could not open the Safety Net Program (SNP.EXE). As a result, if Nexus Special Edition crashes, you will be unable to restart Nexus until you reset your computer if you are using Nexus as your shell.", 48, "Warning!"
    End If
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

d2w:
    If Not PROBas.INIGetSetting("Nexus Special Edition Setup", "LogonMsg", ServPath + "NEXSE.KLS.SERV.ini") = "" Then
    MsgBox PROBas.INIGetSetting("Nexus Special Edition Setup", "LogonMsg", ServPath + "NEXSE.KLS.SERV.ini"), 64, "Logon Message"
    End If

    
'Determine if a password and the login dialog is required
Dim ReqLogin As Boolean
p = PROBas.INIGetSetting("Nexus Special Edition Setup", "RequirePassword", ServPath + "NEXSE.KLS.SERV.ini")
If p = "1" Then
ReqLogin = True
Else
ReqLogin = False
End If
Dim a As Integer
    
p = PROBas.INIGetSetting("subids", "subid1", PATHFile + "Users\" + CurrentUser + ".itc")

If p = "0" And ReqLogin = False Then
'Check account type

a = SEGlobals.GetAccountType(CurrentUser)
'Set Account Type (Workstation, Server or Roaming)
If a = 2 Then
'Server Account type
MsgBox "Nexus Special Edition cannot log on with this account. This is because:" & vbNewLine & vbNewLine & " > The account type is Server" & vbNewLine & " > This version of Nexus is Workstation or Roaming types only." & vbNewLine & vbNewLine & "Please see your Nexus Administrator for more information", 16, "Nexus Special Edition Workstation"
End
End If


End If
    If p = "1" Or ReqLogin = True Then
        
        Main.Enabled = False
        KCK = True
        Main.WindowState = 1
        KCK = False
        p = PROBas.IntelliCrypt_DeCrypt(PROBas.INIGetSetting("subids", "subid2", PATHFile + "Users\" + CurrentUser + ".itc"))
        
        If ReqLogin = True Then
            If p = "" Then
            ChangeUserPassword.ChangePass "", CurrentUser
            ChangeUserPassword.Info = "Here you can set your password for your account. A password is needed to access your Nexus Special Edition account. Click OK when you have entered your password"
            Do
            DoEvents
            p = PROBas.IntelliCrypt_DeCrypt(PROBas.INIGetSetting("subids", "subid2", PATHFile + "Users\" + CurrentUser + ".itc"))
            Loop Until Not p = ""
        
        End If
        
    End If
        
    PasswordScreen.GetPass (p)
    PasswordScreen.SetFocus
    GoTo pwdscron
Else
    p4 = 882
    KCK = False
End If
    


'   4) Get icons, programs, theme & shell
        
        Refresh_Desktop

pwdscron:
        If UCase(Command) = "RESETICONS" Then SaveIconPositions  'argument to reset icon positions
        
'        If PasswordScreen.Visible = True Then
 '       PasswordScreen.SetFocus: PasswordScreen.Hide: PasswordScreen.Show
  '      End If
        On Error Resume Next
        If ReqLogin = True Then Exit Sub
'        If p4 = 882 Then frmTips.Show
End Sub

Public Sub Form_Resize()
On Error GoTo sizerr
If Main.WindowState = 1 Then Exit Sub
If Main.edfoldermenu = False Then Exit Sub

'Adjust the screen for resolutions from 640x480 to anything you can throw at it
'(Does not change the icon positions)

'   Info-Bar
Main.InfoBar.Width = Main.ScaleWidth
Main.InfoBar.Left = 0
Main.InfoBar.Top = Main.ScaleHeight - Main.InfoBar.Height

'   Nexus Button
Main.NexusButton.Top = InfoBar.Top + 15
Main.NexusButton.Left = 120

'   Network Toolbar
Main.NexNetTools.Top = InfoBar.Top
Main.NexNetTools.Left = 885

'   Media Bar
Main.MediaBar.Top = Main.InfoBar.Top + 45
Main.MediaBar.Left = (Main.ScaleWidth - 580) - (Main.Tme.Width + Main.InfoUser.Width + Main.MediaBar.Width)

'   Resume Media Player
If Not KCK = True Then Load Media_Player

'   Username Information
Main.InfoUser.Top = Main.InfoBar.Top + 45
Main.InfoUser.Left = (Main.ScaleWidth - 480) - (Main.Tme.Width + Main.InfoUser.Width)
Main.InfoUser.Caption = "Username: " + CurrentUser

'   Clock
Main.Tme.Top = Main.InfoBar.Top + 45
Main.Tme.Left = Main.ScaleWidth - (Main.Tme.Width + 200)

'   Desktop Items
Main.Wallpaper.Width = Main.ScaleWidth
Main.Wallpaper.Left = 0
Main.Wallpaper.Height = Main.ScaleHeight - Main.InfoBar.Height + 40

sizerr:
'Either minimised because of
'shutdown or winMin
If Not Main.WindowState = 1 Then Main.WindowState = 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
If KCK = True Then Exit Sub
If NexNetOn = True Then
killnet_Click
If NexNetOn = True Then Cancel = 1: Exit Sub
End If
If Shell_ON = True Then Cancel = 1: ShutDown.Show: Exit Sub

If MsgBox("Are you sure you want to end your Nexus session?", vbYesNo + 48, "Exit Nexus Special Edition?") = vbYes Then
'Save Icons
SaveIconPositions
End
Else
Cancel = 1
End If
End Sub

Private Sub logoff_Click()
If Shell_ON = True Then
ShutDown.Show
Else
Unload Main
End If
End Sub


Private Sub Renamer_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If NexButtonPic = False Then Exit Sub
Main.NexusButton.Picture = nexusbutton_off.Picture
NexButtonPic = False
End Sub

Private Sub sendsms_Click()
If polDisSMS = True Then PROBas.AccessDeniedMsg: Exit Sub
SMSDude.Show

End Sub

Private Sub sendsms2_Click()
If polDisSMS = True Then PROBas.AccessDeniedMsg: Exit Sub
SMSDude.Show
End Sub

Private Sub sendsms3_Click()
If polDisSMS = True Then PROBas.AccessDeniedMsg: Exit Sub
SMSDude.Show
End Sub

Public Sub servadmin_Click()
If polAdminServerAdmin = True Then GoTo 113
If UCase(CurrentUser) = AdminUSER Or UCase(CurrentUser) = AdminUSER Then
113
ServerAdmin.Show
Else
PROBas.AccessDeniedMsg
End If
End Sub

Private Sub servadmin2_Click()
servadmin_Click
End Sub

Private Sub ShellClik_Timer(Index As Integer)
If BorderNum(Index) = 5 Then ShellClik(Index).Enabled = False: BorderNum(Index) = 0: Exit Sub
Clicker.Height = IconLbl(Index).Height
Clicker.Width = IconLbl(Index).Width
Clicker.Top = IconLbl(Index).Top
Clicker.Left = IconLbl(Index).Left
BorderNum(Index) = BorderNum(Index) + 1
Select Case BorderNum(Index)
Case 1
Clicker.Visible = True
Case 2
Clicker.Visible = False
Case 3
Clicker.Visible = True
Case 4
Clicker.Visible = False
End Select
End Sub

Private Sub shellman_Click()
If polDisSheller = True Then PROBas.AccessDeniedMsg: Exit Sub
NexusSpecial.Sheller.Show
End Sub

Private Sub taskmon_Click()
If polDistaskMon = True Then PROBas.AccessDeniedMsg: Exit Sub
Tasks.Show
End Sub

Public Sub thm_Click()
If polDisThemeManager = True Then PROBas.AccessDeniedMsg: Exit Sub
ThemeMan.Show
End Sub

Private Sub Tme_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Main.Cycle.Enabled = False
Tme = Format(Date, "ddd dd mmm")
End If
If Button = 2 Then
PopupMenu TimeMenu, , Tme.Left, Tme.Top, change_time_date
End If
End Sub

Private Sub Tme_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If NexButtonPic = False Then Exit Sub
Main.NexusButton.Picture = nexusbutton_off.Picture
NexButtonPic = False
End Sub

Private Sub Tme_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Main.Cycle.Enabled = True
Tme = Format(Time, "h:mm:ss AMPM")
End Sub

Private Sub ToolTipTimer_Timer()
On Error Resume Next 'Debugs the non-modal error
ToolTipTimer.Enabled = False
Media_Player.ShowNowPlayingWindow
End Sub

Private Sub u_manager_Click()
If polAdminUserManager = True Then GoTo 2252
If UCase(CurrentUser) = UCase(AdminUSER) Then
2252
UserRights.Show
Else
PROBas.AccessDeniedMsg
End If
End Sub

Private Sub u_manager2_Click()
If polAdminUserManager = True Then GoTo 225
If UCase(CurrentUser) = UCase(AdminUSER) Then
225
UserRights.Show
Else
PROBas.AccessDeniedMsg
End If
End Sub

Private Sub upd_Click()
p = PROBas.INIGetSetting("subids", "subid20", PATHFile + "Users\" + CurrentUser + ".itc")
Dim ps As String
ps = p
If p = "" Or FileCheck(ps) = False Then
If MsgBox("The update program could not be found on the network. Do you want to set the path in Login Settings?", vbYesNo + 48, "Network Update") = vbYes Then
If polDisSettings = True Then PROBas.AccessDeniedMsg: Exit Sub
With N2000LSettings
.Show
.NetBrowse_Click
End With
Exit Sub
End If
Else
If MsgBox("This will end your Nexus Special Edition session and start the update procedure. Continue?", vbYesNo + 32, "Update Nexus Special Edition") = vbYes Then
ps = p
OpenIt Main, ps
End
End If
End If
End Sub

Private Sub Wallpaper_Click()
Renamer.text = "{Icon Name}"
Renamer.Visible = False
For clearothericonfills = 0 To 23
If glowon = True Then
If GlowTimer(clearothericonfills).Enabled = True Then GoTo 33
End If
If Not IconLbl(clearothericonfills).BackStyle = 0 Then IconLbl(clearothericonfills).BackStyle = 0
33
If glowon = True Then
If GlowColour = "Red" Then If Not IconLbl(clearothericonfills).ForeColor = vbRed Then IconLbl(clearothericonfills).ForeColor = vbRed
If GlowColour = "Green" Then If Not IconLbl(clearothericonfills).ForeColor = vbGreen Then IconLbl(clearothericonfills).ForeColor = vbGreen
If GlowColour = "Blue" Then If Not IconLbl(clearothericonfills).ForeColor = vbBlue Then IconLbl(clearothericonfills).ForeColor = vbBlue
End If
Next
ICOIndex = -1
End Sub

Private Sub Wallpaper_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If polDisDeskMenu = True Then Exit Sub
If polHideProgramsMenu = True Then GoTo 22242
If Button = 2 And Shift = 1 Then PopupMenu Programs: Exit Sub
22242
If Button = 2 Then PopupMenu DeskMenu, , , , newico: Exit Sub
End Sub

Private Sub Wallpaper_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ToolTipTimer.Enabled = False
If NexButtonPic = False Then Exit Sub
Main.NexusButton.Picture = nexusbutton_off.Picture
NexButtonPic = False
End Sub

Private Sub Wallpaper_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call IconManager.AddIcon(PROBas.GetFileTitle(Data.Files(1)), "", Data.Files(1))
End Sub

Private Sub web_Click()
    If polDisMB6 = True Then PROBas.AccessDeniedMsg: Exit Sub
    Set frmD = New MiniBrowzer
    frmD.Show
End Sub

**andrewjrmill825** · April 26th, 2012, 04:19 PM

Code:

'Register API Calls
Private Declare Function SetForegroundWindow Lib "USER32" (ByVal hWnd As Long) As Long
'Local Declarations
Dim ShLst As Integer
Dim BorderNum(24) As Integer
Dim DontShell As Boolean
Dim MonitoringUser As Boolean
Dim DpX As Single
Dim DpY As Single
Dim DoDrag As Boolean

Public Sub Refresh_Desktop(Optional UserImage As String, Optional DontLoadTheme As Boolean)
Dim UserToLogon As String
Dim oldusernm As String

If UserImage = "" Then
UserImage = CurrentUser
UserToLogon = CurrentUser
Else
UserToLogon = UserImage
CurrentUser = UserImage
End If
'Set the shell monitoring section
If ShellMonSect = "" Then ShellMonSect = Now

CurrentPolicy = CurrentUser

If FileCheck(PATHFile + "Users\" + CurrentUser) = False Then
'Run profile creater
GoTo createthemefile
End If
If FileCheck(PATHFile + "Users\" + CurrentUser + ".itc") = False Then
'Run profile creater
GoTo createthemefile
End If


'See if Disable SetDesktop is invoked..
p = PROBas.INIGetSetting("Nexus Special Edition Setup", "DisableSetDesktop", ServPath + "NEXSE.KLS.SERV.ini")
If Not p = "1" Then
'The SetDesktop routine is allowed
Main.CheckDesktop.Enabled = True
End If


'Check General Policy Settings
d = SEGlobals.PolicyGet(1, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
MsgBox "Your account has been disabled. Please see your Nexus administrator.", 16, "Account Disabled"
End
End If

d = SEGlobals.PolicyGet(2, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polHideIcons = True
Else
polHideIcons = False
End If

d = SEGlobals.PolicyGet(3, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisIconMenu = True
Else
polDisIconMenu = False
End If

d = SEGlobals.PolicyGet(4, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisDeskMenu = True
Else
polDisDeskMenu = False
End If

d = SEGlobals.PolicyGet(5, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisNexusButtonMenu = True
Else
polDisNexusButtonMenu = False
End If

d = SEGlobals.PolicyGet(6, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polHideWallpaper = True
Else
polHideWallpaper = False
End If

d = SEGlobals.PolicyGet(7, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polHideGamesMenu = True
On Error GoTo 99022
mnuGame.Visible = False
GoTo 331
99022
Main.mnuMyMenus.Visible = False
331
Else
polHideGamesMenu = False
mnuGame.Visible = True
Main.mnuMyMenus.Visible = True
End If

d = SEGlobals.PolicyGet(8, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polHideProgramsMenu = True
On Error GoTo 9902
Main.Programs.Visible = False
GoTo 2323
9902
Main.mnuMyMenus.Visible = False
Else
polHideProgramsMenu = False
Programs.Visible = True
Main.mnuMyMenus.Visible = True
End If
2323
d = SEGlobals.PolicyGet(9, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polHideFolders = True
On Error GoTo 2522
mnuFavFolders.Visible = False
GoTo 3332
2522
Main.mnuMyMenus.Visible = False
3332
Else
polHideFolders = False
Main.mnuMyMenus.Visible = True
mnuFavFolders.Visible = True
End If

d = SEGlobals.PolicyGet(10, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polHideNetworkMenu = True
netmenu.Visible = False
Else
polHideNetworkMenu = False
netmenu.Visible = True
End If

d = SEGlobals.PolicyGet(11, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polHideToolsMenu = True
toolmenu.Visible = False
Else
polHideToolsMenu = False
toolmenu.Visible = True
End If

'Start ADMIN Policy Priviledges

sep100.Visible = False
son = 0
aon = 0

d = SEGlobals.PolicyGet(12, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
aon = 1
polAdminUserManager = True
u_manager.Visible = True
u_manager.Enabled = True
u_manager2.Visible = True
u_manager2.Enabled = True
Else
u_manager.Visible = False
u_manager.Enabled = False
u_manager2.Visible = False
u_manager2.Enabled = False
polAdminUserManager = False
End If


d = SEGlobals.PolicyGet(13, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
aon = 1
polAdminServerAdmin = True
servadmin.Enabled = True
servadmin.Visible = True
servadmin2.Enabled = True
servadmin2.Visible = True
Else
polAdminServerAdmin = False
servadmin.Enabled = False
servadmin.Visible = False
servadmin2.Enabled = False
servadmin2.Visible = False
End If

d = SEGlobals.PolicyGet(14, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
son = 1
polAdminNexNetAdmin = True
netmonitor1.Enabled = True
netmonitor1.Visible = True
nexnetadmin1.Enabled = True
nexnetadmin1.Visible = True
netmonitor.Enabled = True
netmonitor.Visible = True
nexnetadmin.Enabled = True
nexnetadmin.Visible = True
Else
polAdminNexNetAdmin = False
netmonitor1.Enabled = False
netmonitor1.Visible = False
nexnetadmin1.Enabled = False
nexnetadmin1.Visible = False
polAdminNexNetAdmin = False
netmonitor.Enabled = False
netmonitor.Visible = False
nexnetadmin.Enabled = False
nexnetadmin.Visible = False
End If

d = SEGlobals.PolicyGet(15, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
aon = 1
polAdminRCCandICU = True
netcontrol.Enabled = True
netcontrol.Visible = True
icu_dude.Enabled = True
icu_dude.Visible = True
icu_dude2.Enabled = True
icu_dude2.Visible = True
netcontrol1.Enabled = True
netcontrol1.Visible = True
Else
polAdminRCCandICU = False
netcontrol.Enabled = False
netcontrol.Visible = False
icu_dude.Enabled = False
icu_dude.Visible = False
icu_dude2.Enabled = False
icu_dude2.Visible = False
netcontrol1.Enabled = False
netcontrol1.Visible = False
End If

'Nexus applets policies
d = SEGlobals.PolicyGet(16, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisIconManager = True
Else
polDisIconManager = False
End If

d = SEGlobals.PolicyGet(17, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisNewIconWiz = True
Else
polDisNewIconWiz = False
End If

d = SEGlobals.PolicyGet(18, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisProgramManager = True
Else
polDisProgramManager = False
End If

d = SEGlobals.PolicyGet(19, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisGameMenuEdit = True
Else
polDisGameMenuEdit = False
End If

d = SEGlobals.PolicyGet(20, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisThemeManager = True
Else
polDisThemeManager = False
End If

d = SEGlobals.PolicyGet(21, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisWindowSettings = True
Else
polDisWindowSettings = False
End If

d = SEGlobals.PolicyGet(22, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisIconSelection = True
Else
polDisIconSelection = False
End If

d = SEGlobals.PolicyGet(23, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisMB6 = True
Else
polDisMB6 = False
End If

d = SEGlobals.PolicyGet(24, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisNexusLOC2000 = True
Else
polDisNexusLOC2000 = False
End If

d = SEGlobals.PolicyGet(25, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisChat = True
Else
polDisChat = False
End If

d = SEGlobals.PolicyGet(26, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisFileClient = True
Else
polDisFileClient = False
End If

d = SEGlobals.PolicyGet(27, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisMUSICShare = True
Else
polDisMUSICShare = False
End If

d = SEGlobals.PolicyGet(28, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisNexNet = True
Else
polDisNexNet = False
End If

d = SEGlobals.PolicyGet(29, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisNexNetConnectionEdit = True
Else
polDisNexNetConnectionEdit = False
End If

d = SEGlobals.PolicyGet(30, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDistaskMon = True
Else
polDistaskMon = False
End If

d = SEGlobals.PolicyGet(31, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisSMS = True
Else
polDisSMS = False
End If

d = SEGlobals.PolicyGet(32, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisSheller = True
Else
polDisSheller = False
End If

d = SEGlobals.PolicyGet(33, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisLocker = True
Else
polDisLocker = False
End If

d = SEGlobals.PolicyGet(34, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisSettings = True
Else
polDisSettings = False
End If

d = SEGlobals.PolicyGet(35, PATHFile + "Users\" + CurrentPolicy + ".itc", CurrentPolicy)
If d = True Then
polDisPathfile = True
Else
polDisPathfile = False
End If

'Sort out menu seperators according to enabled items
If son = 1 And aon = 1 Then sep100.Visible = True
If son = 0 And aon = 0 Then sep1005.Visible = False: sep7.Visible = False
If son = 1 Or aon = 1 Then sep1005.Visible = True
If aon = 1 Then sep7.Visible = True

'AdminUser Override
p = UCase(PROBas.IntelliCrypt_DeCrypt(PROBas.INIGetSetting("Nexus Special Edition Setup", "subid1", ServPath + "NEXSE.KLS.SERV.ini")))
If p = "" Then MsgBox "There has been a severe security breach in module NEXSE.KLS.SERV.INI. Please run setup to correct the problem.", 16, "Access Denied - Security Breach": End
AdminUSER = p

If UCase(CurrentUser) = AdminUSER Then

AdminUSER = UCase(CurrentUser)
'Enable Admin Control Tools
polAdminRCCandICU = True
polAdminServerAdmin = True
polAdminUserManager = True
polAdminNexNetAdmin = True

u_manager.Visible = True
u_manager.Enabled = True
u_manager2.Visible = True
u_manager2.Enabled = True
netcontrol.Enabled = True
netcontrol.Visible = True
netmonitor.Enabled = True
nexnetadmin.Enabled = True
servadmin.Enabled = True
servadmin.Visible = True
editsetuplist.Enabled = True
editsetuplist.Visible = True
edit_template.Visible = True
edit_template.Enabled = True
icu_dude.Enabled = True
icu_dude.Visible = True
icu_dude2.Enabled = True
icu_dude2.Visible = True
servadmin2.Enabled = True
servadmin2.Visible = True

**andrewjrmill825** · April 26th, 2012, 04:20 PM

[CODE]netcontrol1.Enabled = True
netcontrol1.Visible = True

netmonitor1.Enabled = True
netmonitor1.Visible = True
sep100.Visible = True

nexnetadmin1.Enabled = True
nexnetadmin1.Visible = True
sep1005.Visible = True
sep7.Visible = True
sep1005.Visible = True
Else
'Disable template Controls
edit_template.Visible = False
edit_template.Enabled = False
editsetuplist.Enabled = False
editsetuplist.Visible = False
End If

'The user tag file needs to be opened for filenum 486 (Nexus) or 487 (NexNet)
On Error Resume Next
Close
Open PATHFile + "Users\" + CurrentUser + ".atag" For Output As FreeFile
If NexNetOn = True Then Open PATHFile + "Users\" + CurrentUser + ".btag" For Output As FreeFile

If DontLoadTheme = True Then GoTo fini_rfsh
le_start:

'Theme Loader 8.5.1
mt = 0

Form_Resize

'Get Theme Information from .NexTheme file in user directory

' Check for Theme File existence
If FileCheck(PATHFile + "Users\" + UserToLogon + "\CurrentTheme.NexTheme") = False Then
GoTo createthemefile
End If
GetThemeInf:

'Nexus Button
If FileCheck(PATHFile + "Users\" + UserToLogon + "\NexusButton_a.btn") = False Then
GoTo 33225
Else
If FileCheck(PATHFile + "Users\" + UserToLogon + "\NexusButton_b.btn") = False Then
GoTo 33225
Else
'They both exist so load them in
On Error GoTo 3322
nexusbutton_on.Picture = LoadPicture(PATHFile + "Users\" + UserToLogon + "\NexusButton_a.btn")
nexusbutton_off.Picture = LoadPicture(PATHFile + "Users\" + UserToLogon + "\NexusButton_b.btn")
NexusButton.Picture = nexusbutton_off.Picture
End If
End If
GoTo 23
3322
MsgBox "Nexus encountered problems with your Nexus Button image(s). The images must be of a valid picture format (BMP, JPG or GIF) in order to work.", 48, "Warning"
33225
nexusbutton_on.Picture = default_on.Picture
nexusbutton_off.Picture = default_off.Picture
NexusButton.Picture = nexusbutton_off.Picture
23
'Customised Info-Bar Tags
If FileCheck(PATHFile + "Users\" + UserToLogon + "\InfoBar.mod") = False Then GoTo 99883
On Error Resume Next
p = PROBas.INIGetSetting("mod", "infobar.user.forecolor", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then InfoUser.ForeColor = p
p = PROBas.INIGetSetting("mod", "infobar.user.backcolor", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then InfoUser.BackColor = p
p = PROBas.INIGetSetting("mod", "infobar.user.fontname", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then InfoUser.FontName = p
p = PROBas.INIGetSetting("mod", "infobar.user.fontbold", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then InfoUser.FontBold = p
p = PROBas.INIGetSetting("mod", "infobar.user.fontitalic", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then InfoUser.FontItalic = p
p = PROBas.INIGetSetting("mod", "infobar.user.fontunderline", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then InfoUser.FontUnderline = p
p = PROBas.INIGetSetting("mod", "infobar.user.fontsize", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then InfoUser.FontSize = p

p = PROBas.INIGetSetting("mod", "infobar.time.forecolor", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then Tme.ForeColor = p
p = PROBas.INIGetSetting("mod", "infobar.time.backcolor", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then Tme.BackColor = p
p = PROBas.INIGetSetting("mod", "infobar.time.fontname", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then Tme.FontName = p
p = PROBas.INIGetSetting("mod", "infobar.time.fontbold", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then Tme.FontBold = p
p = PROBas.INIGetSetting("mod", "infobar.time.fontitalic", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then Tme.FontItalic = p
p = PROBas.INIGetSetting("mod", "infobar.time.fontunderline", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then Tme.FontUnderline = p
p = PROBas.INIGetSetting("mod", "infobar.time.fontsize", PATHFile + "Users\" + UserToLogon + "\InfoBar.mod")
If Not p = "" Then Tme.FontSize = p

GoTo 4009
99883
'Set the info-bar to default
Tme.BackColor = &HC00000
Tme.ForeColor = &HFFFFFF
Tme.FontName = "Tahoma"
Tme.FontSize = 8.25
Tme.FontBold = False
Tme.FontItalic = False
Tme.FontUnderline = False
InfoUser.BackColor = &HC00000
InfoUser.ForeColor = &HFFFFFF
InfoUser.FontName = "Tahoma"
InfoUser.FontSize = 8.25
InfoUser.FontBold = False
InfoUser.FontItalic = False
InfoUser.FontUnderline = False
4009
'Hot Tracking and SingleClik
r = PROBas.INIGetSetting("theme", "hot_track", PATHFile + "Users\" + CurrentUser + "\CurrentTheme.NexTheme")
If r = "1" Then
HotTrack = True
Else
HotTrack = False
End If
r2 = PROBas.INIGetSetting("theme", "oneclick", PATHFile + "Users\" + CurrentUser + "\CurrentTheme.NexTheme")
If r2 = "1" Then
SingleClicker = True
Else
SingleClicker = False
End If

' Wallpaper

' Wallpaper Setting
p = PROBas.INIGetSetting("theme", "kwikwallpaper", PATHFile + "\Users\" + CurrentUser + "\CurrentTheme.NexTheme")
Dim KWK As Boolean
If p = "1" Then
KWK = True
Else
KWK = False
End If

'Policy Overtake
If polHideWallpaper = True Then
Main.Picture = LoadPicture("")
Main.Wallpaper.Visible = False
Main.Wallpaper.Picture = LoadPicture("")
GoTo 87222
End If

p = PROBas.INIGetSetting("theme", "wallpaper", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
If KWK = False Then
Main.Wallpaper.Picture = LoadPicture("")
Main.Picture = LoadPicture("")
Main.Wallpaper.Visible = True
Else
Main.Picture = LoadPicture("")
Main.Wallpaper.Visible = False
Main.Wallpaper.Picture = LoadPicture("")
End If
GoTo saa
End If

Dim ds As String
ds = p
If FileCheck(ds) = False Then
invpic:
PROBas.INISaveSetting "", "theme", "wallpaper", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
If KWK = False Then
Main.Wallpaper.Picture = LoadPicture("")
Main.Picture = LoadPicture("")
Main.Wallpaper.Visible = True
Else
Main.Picture = LoadPicture("")
Main.Wallpaper.Visible = False
Main.Wallpaper.Picture = LoadPicture("")
End If

If MsgBox("Your wallpaper picture file could not be found. You may have deleted it by accident. Do you want to try and find it?", vbYesNo + 48, "Wallpaper Picture File Missing") = vbYes Then
With IconForm.CD
Err.Clear
On Error GoTo s
.DialogTitle = "Find Missing Wallpaper Picture File"
.FileName = p
.InitDir = PATHFile + "Media\Wallpaper"
.ShowOpen
PROBas.INISaveSetting .FileName, "theme", "wallpaper", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
If KWK = False Then
Main.Wallpaper.Picture = LoadPicture(.FileName)
Main.Picture = LoadPicture("")
Main.Wallpaper.Visible = True
Else
Main.Picture = LoadPicture(.FileName)
Main.Wallpaper.Visible = False
Main.Wallpaper.Picture = LoadPicture("")
End If
End With
s:
End If
Else
On Error GoTo invpic
If KWK = False Then
Main.Wallpaper.Picture = LoadPicture(p)
Main.Picture = LoadPicture("")
Main.Wallpaper.Visible = True
Else
Main.Picture = LoadPicture(p)
Main.Wallpaper.Visible = False
Main.Wallpaper.Picture = LoadPicture("")
End If

End If

saa:
87222
' Desktop Colour
p = PROBas.INIGetSetting("theme", "desktop", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
invcolr:
PROBas.INISaveSetting "8388608", "theme", "desktop", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
Main.BackColor = 8388608#
Else
On Error GoTo invcolr
Main.BackColor = p
End If

' InfoBar Picture
p = PROBas.INIGetSetting("theme", "infbar", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "#" Then GoTo s2
If p = "" Then
invbar:
PROBas.INISaveSetting "#", "theme", "infbar", PATHFile + "\Users" + UserToLogon + "\CurrentTheme.NexTheme"
Main.InfoBar.Picture = LoadPicture("")
If MsgBox("Your Info-Bar picture file could not be found. You may have deleted it by accident. Do you want to try and find it?", vbYesNo + 48, "Info-Bar Picture File Missing") = vbYes Then
With IconForm.CD
On Error GoTo s2
.DialogTitle = "Find Missing Info-Bar Picture"
.FileName = p
.InitDir = PATHFile + "Media\InfoBars"
.ShowOpen
If FileCheck(.FileName) = False Then GoTo s2
PROBas.INISaveSetting .FileName, "theme", "infbar", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
Main.InfoBar.Picture = LoadPicture(.FileName)
End With
GoTo cnt
s2:
PROBas.INISaveSetting "#", "theme", "infbar", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
Main.InfoBar.Picture = Main.DefaultIBAR.Picture
Else
GoTo s2
End If
Else
Err.Clear
On Error GoTo invbar
Dim o As String
o = p
If FileCheck(o) = False And Not p = "#" Then GoTo invbar
If p = "#" Then Main.InfoBar.Picture = Main.DefaultIBAR.Picture Else Main.InfoBar.Picture = LoadPicture(p)
End If
cnt:

'Get icon varibles
If polHideIcons = True Then
'Hide the icons
For I = 0 To 23
IconLabel(I) = ""
Main.IconLbl(I).Visible = False
IconPicture(I) = ""
Main.IconPic(I).Visible = False
IconShellString(I) = ""
Next
GoTo 9871349
End If

oldusernm = "$%%%$"
Dim i_onoff(23) As Integer
For I = 0 To 23
p = PROBas.INIGetSetting("user", "i" & I + 1, PATHFile + "Users\" + UserToLogon + ".itc")
If Not p = 1 Then i_onoff(I) = 0 Else i_onoff(I) = 1
Next

'Get from icon file and set global varibles
For I = 0 To 23
If i_onoff(I) = 1 Then
IconLabel(I) = PROBas.INIGetSetting("icon", "title", PATHFile + "Users\" + UserToLogon + "\Icon" & I + 1 & ".nexico")
IconPicture(I) = PROBas.INIGetSetting("icon", "picture", PATHFile + "Users\" + UserToLogon + "\Icon" & I + 1 & ".nexico")
IconShellString(I) = PROBas.INIGetSetting("icon", "shellstring", PATHFile + "Users\" + UserToLogon + "\Icon" & I + 1 & ".nexico")
Main.IconLbl(I).Visible = True
Main.IconPic(I).Visible = True
Else
IconLabel(I) = ""
Main.IconLbl(I).Visible = False
IconPicture(I) = ""
Main.IconPic(I).Visible = False
IconShellString(I) = ""
End If
Next

'Set the desktop icons
Dim noicons As Boolean
noicons = True

For I = 0 To 23
If IconLabel(I) = "" Then
Main.IconPic(I).Visible = False
Main.IconLbl(I).Visible = False
Else
noicons = False
'Set icon positions
p = PROBas.INIGetSetting("icon", "ptop", PATHFile + "Users\" + UserToLogon + "\Icon" & I + 1 & ".nexico")
If Not p = "" Then Main.IconPic(I).Top = p
p = PROBas.INIGetSetting("icon", "pleft", PATHFile + "Users\" + UserToLogon + "\Icon" & I + 1 & ".nexico")
If Not p = "" Then Main.IconPic(I).Left = p
p = PROBas.INIGetSetting("icon", "ltop", PATHFile + "Users\" + UserToLogon + "\Icon" & I + 1 & ".nexico")
If Not p = "" Then Main.IconLbl(I).Top = p
p = PROBas.INIGetSetting("icon", "lleft", PATHFile + "Users\" + UserToLogon + "\Icon" & I + 1 & ".nexico")
If Not p = "" Then Main.IconLbl(I).Left = p

Main.IconPic(I).Visible = True

'Check for KwikIcon
If Left(IconPicture(I), 1) = "#" Then
If Len(IconPicture(I)) = 2 And Right(IconPicture(I), 1) = "0" Then GoTo npic
p = Right(IconPicture(I), Len(IconPicture(I)) - 1)
If Left(p, 1) = "0" Then p = Right(p, 1)
If p > 25 Then GoTo npic
IconPic(I).Picture = KwikICO.Preset(p - 1).Picture
GoTo nxt
End If

If IconPicture(I) = "" Then GoTo npic

If PROBas.FileCheck(IconPicture(I)) = True Then
Main.IconPic(I).Picture = LoadPicture(IconPicture(I))
Else
npic:
Main.IconPic(I).Picture = Main.DefaultIcon
End If
nxt:
If IconLabel(I) = "" Then
Main.IconLbl(I).Caption = "{No Text Label}"
Else
Main.IconLbl(I).Caption = IconLabel(I)
End If
End If
Next

If noicons = True Then
If MsgBox("You do not have any icons on your desktop, would you like to add one?", vbYesNo + 32, "No Icons On Desktop") = vbYes Then
If polDisNewIconWiz = True Then PROBas.AccessDeniedMsg: GoTo 9871349
NewIcon.NewIconWizard
End If
End If

9871349

'Get program menu items from profile image register
'Also get Game Menu items

oldusernm = "£££##^"
Dim dd As Integer

For dd = 1 To 8

p = PROBas.INIGetSetting("user", "g" & dd, PATHFile + "Users\" + UserToLogon + ".itc")
If p = "1" Then
p1 = PROBas.INIGetSetting("game", "shellstring", PATHFile + "Users\" + UserToLogon + "\Game" & dd & ".nexgam")
If p1 = "" Then
PROBas.INISaveSetting "0", "user", "g" & dd, PATHFile + "Users\" + UserToLogon + ".itc"
GoTo 21344
End If
p2 = PROBas.INIGetSetting("game", "title", PATHFile + "Users\" + UserToLogon + "\Game" & dd & ".nexgam")
If p2 = "" Then p2 = "Game Shortcut (" & dd & ")"
'Update menu
Select Case dd
Case 1
Main.gm1.Visible = True
Main.gm1.Caption = p2
GameMenuShell(1) = p1

Case 2
Main.gm2.Visible = True
Main.gm2.Caption = p2
GameMenuShell(2) = p1

Case 3
Main.gm3.Visible = True
Main.gm3.Caption = p2
GameMenuShell(3) = p1

Case 4
Main.gm4.Visible = True
Main.gm4.Caption = p2
GameMenuShell(4) = p1

Case 5
Main.gm5.Visible = True
Main.gm5.Caption = p2
GameMenuShell(5) = p1

Case 6
Main.gm6.Visible = True
Main.gm6.Caption = p2
GameMenuShell(6) = p1

Case 7
Main.gm7.Visible = True
Main.gm7.Caption = p2
GameMenuShell(7) = p1[CODE]

**andrewjrmill825** · April 26th, 2012, 04:21 PM

Code:

Case 8
Main.gm8.Visible = True
Main.gm8.Caption = p2
GameMenuShell(8) = p1

End Select
21344
Else
Select Case dd
Case 1
Main.gm1.Visible = False

Case 2
Main.gm2.Visible = False

Case 3
Main.gm3.Visible = False

Case 4
Main.gm4.Visible = False

Case 5
Main.gm5.Visible = False

Case 6
Main.gm6.Visible = False

Case 7
Main.gm7.Visible = False

Case 8
Main.gm8.Visible = False
End Select
    End If
    Next

'Folder Menu Items
Dim dds As Integer

    For dds = 1 To 8

    p = PROBas.INIGetSetting("user", "f" & dds, PATHFile + "Users\" + UserToLogon + ".itc")
    If p = "1" Then
    p1 = PROBas.INIGetSetting("folder", "shellstring", PATHFile + "Users\" + UserToLogon + "\Folder" & dds & ".nexfol")
    If p1 = "" Then
    PROBas.INISaveSetting "0", "user", "f" & dds, PATHFile + "Users\" + UserToLogon + ".itc"
    GoTo 213441
    End If
    p2 = PROBas.INIGetSetting("folder", "title", PATHFile + "Users\" + UserToLogon + "\Folder" & dds & ".nexfol")
    If p2 = "" Then p2 = "Folder Shortcut (" & dds & ")"
    'Update menu
Select Case dds
Case 1
Main.f1.Visible = True
Main.f1.Caption = p2
FolderMenuShell(1) = p1

Case 2
Main.f2.Visible = True
Main.f2.Caption = p2
FolderMenuShell(2) = p1

Case 3
Main.f3.Visible = True
Main.f3.Caption = p2
FolderMenuShell(3) = p1

Case 4
Main.f4.Visible = True
Main.f4.Caption = p2
FolderMenuShell(4) = p1

Case 5
Main.f5.Visible = True
Main.f5.Caption = p2
FolderMenuShell(5) = p1

Case 6
Main.f6.Visible = True
Main.f6.Caption = p2
FolderMenuShell(6) = p1

Case 7
Main.f7.Visible = True
Main.f7.Caption = p2
FolderMenuShell(7) = p1

Case 8
Main.f8.Visible = True
Main.f8.Caption = p2
FolderMenuShell(8) = p1

End Select
213441
Else
Select Case dds
Case 1
Main.f1.Visible = False

Case 2
Main.f2.Visible = False

Case 3
Main.f3.Visible = False

Case 4
Main.f4.Visible = False

Case 5
Main.f5.Visible = False

Case 6
Main.f6.Visible = False

Case 7
Main.f7.Visible = False

Case 8
Main.f8.Visible = False
End Select
    End If
    Next


Dim progname(30) As String
Dim p_onoff(30) As Integer
Dim tmpvar As String
Dim tmpshell As String

For I = 1 To 30
progname(I) = PROBas.INIGetSetting("user", "p" & I, PATHFile + "Users\" + UserToLogon + ".itc")

If Not progname(I) = "1" Then
p_onoff(I) = 0
PMShell(I) = ""
PMName(I) = ""
Main.app(I).Visible = False
Main.app(I).Caption = ""
Else
p_onoff(I) = 1

'  get the program item's name from file
tmpvar = PROBas.INIGetSetting("program", "title", PATHFile + "Users\" + UserToLogon + "\Program" & I & ".nexprog")

'  set the program item's caption
If tmpvar = "" Then
PMName(I) = "Program Item " & I
Main.app(I).Caption = PMName(I)
Main.app(I).Visible = True
Else
Main.app(I).Visible = True
PMName(I) = tmpvar
Main.app(I).Caption = tmpvar
End If

tmpshell = PROBas.INIGetSetting("program", "shellstring", PATHFile + "Users\" + UserToLogon + "\Program" & I & ".nexprog")

'  set the program item's shell assosiation
If tmpshell = "" Then
Main.app(I).Visible = False
Main.app(I).Caption = ""
PMName(I) = ""
PMShell(I) = ""
Else
PMShell(I) = tmpshell
End If

End If
Next


'   Icon Font Properties
p = PROBas.INIGetSetting("theme", "icounderline", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
PROBas.INISaveSetting "0", "theme", "icounderline", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
p = 0
End If
If p = "0" Then r = False Else r = True
For I = 0 To 23
Main.IconLbl(I).FontUnderline = r
Next

p = PROBas.INIGetSetting("theme", "icobold", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
PROBas.INISaveSetting "0", "theme", "icobold", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
p = 0
End If
If p = "0" Then r = False Else r = True
For I = 0 To 23
Main.IconLbl(I).FontBold = r
Next

p = PROBas.INIGetSetting("theme", "icoitalic", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
PROBas.INISaveSetting "0", "theme", "icoitalic", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
p = 0
End If
If p = "0" Then r = False Else r = True
For I = 0 To 23
Main.IconLbl(I).FontItalic = r
Next

p = PROBas.INIGetSetting("theme", "icofontcol", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
PROBas.INISaveSetting "16777215", "theme", "icofontcol", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
p = 16777215#
End If
For I = 0 To 23
Main.IconLbl(I).ForeColor = p
Next

p = PROBas.INIGetSetting("theme", "icosize", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
PROBas.INISaveSetting "12", "theme", "icosize", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
p = 8
End If
For I = 0 To 23
Main.IconLbl(I).FontSize = p
Next

p = PROBas.INIGetSetting("theme", "icofont", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
invfont:
PROBas.INISaveSetting "Tahoma", "theme", "icofont", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
On Error Resume Next
For I = 0 To 23
Main.IconLbl(I).Font = "Tahoma"
Next
Else
On Error GoTo invfont
For I = 0 To 23
Main.IconLbl(I).Font = p
Next
End If

'   Icon Colour
p = PROBas.INIGetSetting("theme", "icocol", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme")
If p = "" Then
invicol:
PROBas.INISaveSetting "16711680", "theme", "icocol", PATHFile + "\Users\" + UserToLogon + "\CurrentTheme.NexTheme"
On Error Resume Next
For I = 0 To 23
Main.IconLbl(I).BackColor = 16711680
Next
Else
On Error GoTo invicol
For I = 0 To 23
Main.IconLbl(I).BackStyle = 1
Main.IconLbl(I).BackColor = p
Main.IconLbl(I).BackStyle = 0
Next
End If


'Start IKON-GLO
'GET all the values

'Effect On\Off
p = PROBas.INIGetSetting("theme", "icoeffect_on", PATHFile + "\Users\" + CurrentUser + "\CurrentTheme.NexTheme")
If p = "1" Then xUseGlow = 1 Else xUseGlow = 0

'Effect Type
p = PROBas.INIGetSetting("theme", "icoeffect_glowboth", PATHFile + "\Users\" + CurrentUser + "\CurrentTheme.NexTheme")
If p = "1" Then
xTxtAndBack = True
xBack = True
Else
xTxtAndBack = False
xBack = True
End If

'Effect Glow Colour

p = PROBas.INIGetSetting("theme", "icoeffect_col", PATHFile + "\Users\" + CurrentUser + "\CurrentTheme.NexTheme")
On Error Resume Next
Select Case p
Case 1
xColour = "Red"
Case 2
xColour = "Green"
Case 3
xColour = "Blue"
Case Else
xColour = "Red"
End Select

'Glow Speed
xSpeed = PROBas.INIGetSetting("theme", "icoeffect_glowspeed", PATHFile + "\Users\" + CurrentUser + "\CurrentTheme.NexTheme")


'Set Varibles
GlowColour = xColour
GlowBack = xBack
GlowTxtAndBack = xTxtAndBack
If xUseGlow = 1 Then glowon = True Else glowon = False
For I = 0 To 23
Main.GlowTimer(I).Interval = xSpeed
Next


'End IKON-GLO

Wallpaper_Click
fini_rfsh:
Main.Cycle.Enabled = True
Exit Sub
'Create a theme file if there is no theme file found (also uses this when you first logon)
createthemefile:
mt = 1
Main.WindowState = 1
AccSetup.Show
End Sub

Private Sub Accounts_Click()
AccountInfo.Show
End Sub

Private Sub Accounts_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ToolTipTimer.Enabled = False
End Sub

Private Sub AccountTimer_Timer()
Dim CreditBalance_x As String
Dim ServerF As String
If AccountsOn = False Then ConnectionSeconds = ConnectionSeconds + 1: Exit Sub
p = PROBas.INIGetSetting("subids", "subid11", PATHFile + "Users\" + CurrentUser + ".itc")
If p = "" Then
MsgBox "Connection with host lost! Check that all network cables are in place and try reconnecting.", 48, "Connection Failure"
killn:
NexNetOn = False
NexNetTools.Visible = False
'Disable Account Timer
Main.AccountTimer.Enabled = False
'Notify Session Cost if accounts are on.
If AccountsOn = True Then MsgBox "Session Cost: " & (ConnectionSeconds * NetCostPerSec) & "p. This has been deducted from your NexNet Account. Thank you for using NexNet", 64, "Session Information"
ConnectionSeconds = 0
'Unload all nexnet forms
On Error Resume Next
Unload Chat_Client 'Done
Unload File_Client 'Done
Unload RCC_Client 'ToDo (Half Done - Activity Monitor Done)
Unload NetTraffic 'ToDo
Unload NetAgent
Unload AccountInfo 'Developing
Exit Sub
Else
ServerF = p
End If

ConnectionSeconds = ConnectionSeconds + 1
'Get Balance
p = PROBas.IntelliCrypt_DeCrypt(PROBas.INIGetSetting(PROBas.IntelliCrypt_EnCrypt(UCase(CurrentUser)), "subid2", ServerF))
If p = "" Or p <= 0 Then
noac:
MsgBox "You have no credit left or your account is disabled. Please see your NexNet Administrator.", 48, "NexNet Connection"
GoTo killn:
Else
CreditBalance = p
End If

'Deduct Balance (Var)
CreditBalance = CreditBalance - NetCostPerSec
'Save New Balance
CreditBalance_x = CreditBalance
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(CreditBalance_x), PROBas.IntelliCrypt_EnCrypt(UCase(CurrentUser)), "subid2", ServerF
End Sub

Private Sub adgames_Click()
If polDisGameMenuEdit = True Then PROBas.AccessDeniedMsg: Exit Sub
EditGameMenu.Show
End Sub

Public Sub awincpl_desk_Click()
If polDisThemeManager = True Then PROBas.AccessDeniedMsg: Exit Sub
Dim ExWinDir As String
        On Error GoTo sx
          ExWinDir = Space(256)
          ExWinDir = Left$(ExWinDir, GetWindowsDirectory(ExWinDir, 256&))
        If Not Right(WindowsDir, 1) = "\" Then
        ExWinDir = ExWinDir + "\"
        End If
        If FileCheck(ExWinDir + "System\DESK.CPL") = False Then GoTo sx
Call shell("start " + ExWinDir + "System\DESK.CPL", vbHide)
Exit Sub
sx:
MsgBox "Nexus Special Edition could not get your Windows Directory or could not find the control panel extension 'DESK.CPL' on your computer. You may not have access to the Windows API or have missing files on your hard drive. Please see your system Administrator.", 16, "Windows Interface Error"
End Sub

Private Sub bind_password_Click()
Dim theiconfile As String
    
    theiconfile = PATHFile + "Users\" + CurrentUser + "\Icon" & ICOIndex + 1 & ".nexico"

    'See if icon was previously locked
    Dim dstr_key As String
    
    dstr_key = PROBas.INIGetSetting("icon", "status", theiconfile)
    
    If Not UCase(PROBas.IntelliCrypt_DeCrypt(dstr_key)) = "ICONLOCKED" Then
        'Icon was unlocked so user must have clicked to set password
        'Get a password to use for the icon
        If ChangeIconPass.NewIconPassword(theiconfile) = True Then MsgBox "Bind password attempt successful. Next time access is required, you will be prompted for the decryption password.", 64, "Icon Security"
    Else
        MsgBox "Icon already locked!", 16, "Icon Security"
    End If
End Sub[/

**Peter_B** · April 26th, 2012, 04:38 PM

OK, I'll ask one more time. What is Media_Player? What is MPlayer(0)?

Remember that it is you who want to get this application to compile, so you should be prepared to put in a bit of work to help people help you.

Edit: I started writing this after the OP had posted the first bit of code, but before he posted any more.
Edit 2: OK, Media_Player seems to be a form, but what is on it?

**andrewjrmill825** · April 26th, 2012, 04:57 PM

sorry about this, this is whats in the MPlayer form

[CODEDim SavePlaybackStatus As Boolean
Dim MediaPos2 As String
Dim MediaPos As String
Dim Media_PlayImageNum As Integer
Dim Media_LOADED As Boolean
Dim AutoMix_ON As Boolean
Dim AutoMix_PLAYERID As Integer
Dim AutoMix_MEDIAID As Integer

Public Sub UpdateMediaOptions()
If AutoMix_ON = False Then Exit Sub
With MediaBarOptions
.cmdClearList.Caption = "STOP && CLEAR Playlist"
For asd = 0 To lstPlayList.ListCount - 1
.lstPlayList.AddItem lstPlayList.List(asd)
.lstPlayListb.AddItem PROBas.GetFileTitle(lstPlayList.List(asd))
Next
End With
End Sub

Public Sub PlaySingle(ExFilenm As String)
'Stop all other media
If AutoMix_ON = True Then StopAndClearPlaylistMixer
d = PROBas.INIGetSetting("mediabar", "autoplay", PATHFile + "Users\" + CurrentUser + ".itc")
MPlayer(0).FileName = ExFilenm
AutoMix_PLAYERID = 0
If Not d = 1 Then MPlayer(0).Stop
Media_LOADED = True
Media_PlayImageNum = -1
playimg_timer.Enabled = True
End Sub

Public Sub StopAndClearPlaylistMixer()
StopMedia
lstPlayList.Clear
AutoMix_ON = False
AutoMix_MEDIAID = -1
AutoMix_PLAYERID = 0
End Sub

Public Sub StartNewPlaylistMixer()
'Starts a new playlist process
If AutoMix_ON = True Then AutoMix_ON = False
lstPlayList.Clear
AutoMix_MEDIAID = -1
AutoMix_PLAYERID = 0
For asd = 0 To MediaBarOptions.lstPlayList.ListCount - 1
lstPlayList.AddItem MediaBarOptions.lstPlayList.List(asd)
Next
MPlayer(0).Stop
MPlayer(1).Stop
Media_LOADED = True
playimg_timer.Enabled = True
AutoMix_ON = True
End Sub

Public Sub ShowNowPlayingWindow()
If Media_LOADED = False Then Media_NowPlaying.ShowNowPlaying "", Main.MediaBar.Left, Main.MediaBar.Top: Exit Sub
Media_NowPlaying.ShowNowPlaying PROBas.GetFileTitle(MPlayer(AutoMix_PLAYERID).FileName), Main.MediaBar.Left, Main.MediaBar.Top
End Sub
Public Sub StopMedia()
MPlayer(AutoMix_PLAYERID).Stop
MPlayer(AutoMix_PLAYERID).CurrentPosition = 0
PROBas.INISaveSetting "0", "mediabar", "dump_playing", PATHFile + "Users\" + CurrentUser + ".itc"
End Sub

Public Sub PauseMedia()
On Error GoTo 432
MPlayer(AutoMix_PLAYERID).Pause
432
Exit Sub
MsgBox "Media Bar cannot pause\playback this file. It may be of the wrong format or corrupt. If you downloaded this file, try downloading it again - or contact your media vendor.", 16, "Media Error"
End Sub

Public Sub ResumePlayMedia()
On Error GoTo 435
MPlayer(AutoMix_PLAYERID).Play
Exit Sub
435
MsgBox "Media Bar cannot playback this file. It may be of the wrong format or corrupt. If you downloaded this file, try downloading it again - or contact your media vendor.", 16, "Media Error"
End Sub

Private Sub Form_Load()
'Get Mix %
sf = PROBas.INIGetSetting("mediabar", "mixpercent", PATHFile + "Users\" + CurrentUser + ".itc")
If IsNumeric(sf) = False Then sf = 2.8
If sf < 1 Or sf > 50 Then sf = 2.8
txtMixPrcnt = sf
'Get ResumePlayback
gds = PROBas.INIGetSetting("mediabar", "resumeplayback", PATHFile + "Users\" + CurrentUser + ".itc")
If gds = 1 Then SavePlaybackStatus = True

'See if there was media playing when Nexus was last closed
If SavePlaybackStatus = False Then Exit Sub
eg = PROBas.INIGetSetting("mediabar", "dump_playing", PATHFile + "Users\" + CurrentUser + ".itc")
If Not eg = 1 Then Exit Sub
'There was music playing...
' see if it was a playlist or single media file
eg = PROBas.INIGetSetting("mediabar", "dump_medianum", PATHFile + "Users\" + CurrentUser + ".itc")
If eg = "" Then Exit Sub
If eg = 1 Then
'Single Media File
egfaa = PROBas.INIGetSetting("mediabar", "dump_media1", PATHFile + "Users\" + CurrentUser + ".itc")
GoTo startplayback
Else
'Playlist
' re-construct the playlist
Dim egfa As String
For fdg = 1 To eg
egfa = PROBas.INIGetSetting("mediabar", "dump_media" & fdg, PATHFile + "Users\" + CurrentUser + ".itc")
If FileCheck(egfa) = False Then MsgBox "The media that was playing in your last Nexus session could not be found. Playback cannot commence.", 16, "Auto-Resume": Exit Sub
lstPlayList.AddItem egfa
Next
sfee = 1
'Now set the vairbles...
startplayback:
exh = PROBas.INIGetSetting("mediabar", "dumpvar_AutoMix_PLAYERID", PATHFile + "Users\" + CurrentUser + ".itc")
If exh = "" Then exh = 0
exn = PROBas.INIGetSetting("mediabar", "dumpvar_AutoMix_MEDIAID", PATHFile + "Users\" + CurrentUser + ".itc")
ewn = PROBas.INIGetSetting("mediabar", "dumpvar_CurrentPosition", PATHFile + "Users\" + CurrentUser + ".itc")
If AutoMix_ON = True Then AutoMix_ON = False
AutoMix_MEDIAID = exn
AutoMix_PLAYERID = exh
If sfee = 1 Then MPlayer(AutoMix_PLAYERID).FileName = lstPlayList.List(AutoMix_MEDIAID) Else MPlayer(AutoMix_PLAYERID).FileName = egfaa
Media_LOADED = True
MPlayer(AutoMix_PLAYERID).CurrentPosition = ewn
If sfee = 1 Then AutoMix_ON = True
playimg_timer.Enabled = True
Main.Form_Resize
End If

Exit Sub
End Sub

Private Sub lstPlayList_Click()
If lstPlayList.ListCount = 0 Then Exit Sub
If lstPlayList = "" Then Exit Sub
MsgBox lstPlayList
End Sub

Private Sub MixTimer_Timer()
If AutoMix_ON = False Then GreenLabel = "AutoMix OFF": MediaPos2 = "{No Media}": MediaPos = "{No Media}": Exit Sub
If MPlayer(AutoMix_PLAYERID).CurrentPosition = -1 And MPlayer(AutoMix_PLAYERID).PlayState = mpPlaying Then
MediaPos2 = "{No Media}": MediaPos = "{No Media}": GreenLabel.Caption = "Media Error!": Exit Sub 'Warningpage.AddWarning "Media Playback Error": Exit Sub
Else
If AutoMix_MEDIAID > lstPlayList.ListCount Then GoTo finrec
If Not GreenLabel = "Playing (" & (AutoMix_MEDIAID + 1) & "\" & lstPlayList.ListCount & ")..." Then GreenLabel = "Playing (" & (AutoMix_MEDIAID + 1) & "\" & lstPlayList.ListCount & ")..."
If MPlayer(AutoMix_PLAYERID).CurrentPosition = 0 Then GreenLabel = "Stopped"
If MPlayer(AutoMix_PLAYERID).PlayState = mpPaused Then GreenLabel = "Paused"
If MPlayer(AutoMix_PLAYERID).PlayState = mpWaiting Then GreenLabel = "!WARNING!": Warningpage.AddWarning "Media Automation Error"
If MPlayer(AutoMix_PLAYERID).Duration > 100 Then
Main.MediaBar_Progress.Max = MPlayer(AutoMix_PLAYERID).Duration
End If
If AutoMix_PLAYERID = 0 Then
MediaPos = MPlayer(AutoMix_PLAYERID).CurrentPosition & "\" & MPlayer(AutoMix_PLAYERID).Duration
If Not MPlayer(AutoMix_PLAYERID).Duration > 100 Then
If Not MPlayer(AutoMix_PLAYERID).Duration < 1 Then
Main.MediaBar_Progress.Value = MPlayer(AutoMix_PLAYERID).CurrentPosition
End If
End If
MediaPos2 = "{No Media Playing}"
Else
If Not MPlayer(AutoMix_PLAYERID).Duration > 100 Then
If Not MPlayer(AutoMix_PLAYERID).Duration < 1 Then
Main.MediaBar_Progress.Value = MPlayer(AutoMix_PLAYERID).CurrentPosition
End If
End If
MediaPos2 = MPlayer(AutoMix_PLAYERID).CurrentPosition & "\" & MPlayer(AutoMix_PLAYERID).Duration
MediaPos = "{No Media Playing}"
End If

xx = (MPlayer(AutoMix_PLAYERID).Duration / 100) * txtMixPrcnt ' % before end
If MPlayer(AutoMix_PLAYERID).CurrentPosition >= MPlayer(AutoMix_PLAYERID).Duration - xx Or AutoMix_MEDIAID = -1 Then
'The end of the last song is nigh...
' Show mixin label
MixinNow.Visible = True
' Change PLAYERID
If AutoMix_PLAYERID = 0 Then
AutoMix_PLAYERID = 1
Else
AutoMix_PLAYERID = 0
End If
' Update MEDIAID
AutoMix_MEDIAID = AutoMix_MEDIAID + 1
' Start Playing Next Media File
On Error GoTo finrec
MPlayer(AutoMix_PLAYERID).FileName = lstPlayList.List(AutoMix_MEDIAID)
Else
MixinNow.Visible = False
End If

Exit Sub
finrec:
MsgBox "The Playlist Mixer Process has finished.", 64, "Media Bar Notification"
lstPlayList.Clear
AutoMix_MEDIAID = -1
AutoMix_PLAYERID = 0
AutoMix_ON = False
Media_LOADED = False
End If
End Sub

Private Sub playimg_timer_Timer()
If Media_LOADED = False Then
'Reset image counter var
Media_PlayImageNum = -1
'Load the dead play image
Main.MediaBar.Picture = playimg_dead.Picture
PROBas.INISaveSetting "0", "mediabar", "dump_playing", PATHFile + "Users\" + CurrentUser + ".itc"
Else
If Not MPlayer(AutoMix_PLAYERID).PlayState = mpStopped Then PROBas.INISaveSetting "1", "mediabar", "dump_playing", PATHFile + "Users\" + CurrentUser + ".itc" Else PROBas.INISaveSetting "0", "mediabar", "dump_playing", PATHFile + "Users\" + CurrentUser + ".itc"

'Save Auto-Resume Settings
If SavePlaybackStatus = True Then
'Number of media files
If AutoMix_ON = True Then

'Playlist
If lstPlayList.ListCount = 0 Then Media_LOADED = False: Exit Sub

PROBas.INISaveSetting lstPlayList.ListCount, "mediabar", "dump_medianum", PATHFile + "Users\" + CurrentUser + ".itc"

'Save Playlist
For affs = 1 To lstPlayList.ListCount
PROBas.INISaveSetting lstPlayList.List(affs - 1), "mediabar", "dump_media" & affs, PATHFile + "Users\" + CurrentUser + ".itc"
Next

Else

'Single Media
PROBas.INISaveSetting "1", "mediabar", "dump_medianum", PATHFile + "Users\" + CurrentUser + ".itc"
PROBas.INISaveSetting MPlayer(AutoMix_PLAYERID).FileName, "mediabar", "dump_media1", PATHFile + "Users\" + CurrentUser + ".itc"

End If

'Save Current Varibles
PROBas.INISaveSetting AutoMix_PLAYERID, "mediabar", "dumpvar_AutoMix_PLAYERID", PATHFile + "Users\" + CurrentUser + ".itc"
PROBas.INISaveSetting AutoMix_MEDIAID, "mediabar", "dumpvar_AutoMix_MEDIAID", PATHFile + "Users\" + CurrentUser + ".itc"
PROBas.INISaveSetting MPlayer(AutoMix_PLAYERID).CurrentPosition, "mediabar", "dumpvar_CurrentPosition", PATHFile + "Users\" + CurrentUser + ".itc"

End If

'----------------------------------
If MPlayer(AutoMix_PLAYERID).PlayState = mpStopped Then Main.MediaBar.Picture = playimg_dead.Picture: Media_PlayImageNum = -1: Main.MediaBar_Progress.Value = 0: Exit Sub
If Not MPlayer(AutoMix_PLAYERID).PlayState = mpPlaying Then Main.MediaBar.Picture = playimg(0).Picture: Media_PlayImageNum = -1: Exit Sub
If Media_PlayImageNum >= 2 Then Media_PlayImageNum = -1

'Update Progress Bar Control
Main.MediaBar_Progress.Max = MPlayer(AutoMix_PLAYERID).Duration
Main.MediaBar_Progress.Value = MPlayer(AutoMix_PLAYERID).CurrentPosition

'Update Plaing Images On Media Bar
Media_PlayImageNum = Media_PlayImageNum + 1
Main.MediaBar.Picture = playimg(Media_PlayImageNum).Picture
End If
End Sub
][/CODE] thanks and sorry if I did not give more info.

**dglienna** · April 26th, 2012, 09:20 PM

Nobody is going to read this (or any of the other un-formatted code that you have posted. Look at your Post #20. EDIT your code, and fix the tags

**Peter_B** · April 27th, 2012, 05:42 AM

There are two possible reasons for the error. Either Media_Player.MPlayer(0) does have a PlayState member, but it can't be seen from the calling code - but this doesn't make sense as MPlayer(0) is obviously seen.

Or Media_Player.MPlayer(0) doesn't have a PlayState member. In this case fixing it would involve adding new functionality. This is more than can be done in a discussion forum.

But either way, I'm out

Thread: Hi, i need some help with this error

Thread Tools

Display

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Re: Hi, i need some help with this error

Posting Permissions