Printable View
Hi, i downloaded this program from planet source code.com and i fond what i was looking for, what im assking if anymore can fixs this or show me how please, and if you help me, i will pay some money for it. Or i can make you a program visual basic 2010, just tell me what you would like. thanks for looking at my post.:wave:http://www.mediafire.com/?7k4zrq5c6n7a2hh this is the download link. thanks agine everyone:thumb:
Send email to the writer of the software. That's the best way to fix a problem with someone else's code.
The problom im haveing is i tryed to e-mailing and website the program was 2002, all his emails donot work or his website, so what sould i do.
I still need help.:)
People do not tend to go to external links to download stuff... Post the file(s) in .zip format here and we can then have a look. Also, explain to us where is the error and when it occurs.
Hi, the error i get is(Compile error method or data member not found)
And I would upload the file, but i have tryed to do that and it comes up with an error so i cant upload the file thats way i put the link. thanks everyone.:wave:
Please Help me with this I will pay or make you a program on visual basic 2010, im just learning visual basic 6.0. I have made a lot of programs with it but im more familiar with visual basic 2010, I found that they are almost the same, but anyway I need some help with this program. I would up load it here but it says the file is to big. So thanks, Oh I can program using C#2010 or C++ 2010 just tell me what you would like on a program and what language you want me to use. Thanks for looking at my post, Oh, I tried to e-mail, but the owner hasn't
got back to me. Thanks.
Post the section of code where the error occurs and highlight the line the error occurs on. No need to upload the file(s) just copy the revelant section and paste into a post. Be sure to use code tags to retain formatting for readability.
(the error that shows up when I try to make it to exe is the second sentence line here is the errorCode:'Save Icons Pos.
Main.SaveIconPositions
If Media_Player.MPlayer(0).PlayState = mpPlaying Or Media_Player.MPlayer(0).PlayState = mpPaused Then
(.playstate), and here is the code of the rest that its in
Thanks for your helpCode:'Save Icons Pos.
Main.SaveIconPositions
If Media_Player.MPlayer(0).PlayState = mpPlaying Or Media_Player.MPlayer(0).PlayState = mpPaused Then
Media_Player.MPlayer(0).Stop
Media_Player.MPlayer(0).FileName = ""
Main.MediaBar.Picture = Media_Player.playimg_dead.Picture
Main.MediaBar_Progress.Value = 0
Media_Player.playimg_timer.Enabled = False
End If
If Media_Player.MPlayer(1).PlayState = mpPlaying Or Media_Player.MPlayer(1).PlayState = mpPaused Then
Media_Player.MPlayer(1).Stop
Media_Player.MPlayer(1).FileName = ""
Main.MediaBar.Picture = Media_Player.playimg_dead.Picture
Main.MediaBar_Progress.Value = 0
Media_Player.playimg_timer.Enabled = False
End If
What does this mean?In order for anyone to be able to help you must post the exact error messages. It also looks like you will need to provide a lot more information on the classes involved in this, i.e. what is Media_Player.MPlayer(0)?Quote:
Originally Posted by andrewjrmill825
The best way to do this is to make a complete, but minimal, program which when compiled demonstrates the error. If this involves classes/functions which are not standard VB ones include the relevant (and minimal) code for these also.
Ok I made a text file that shows all the work and what error coms up.
I would post it here but it say its to big. I wanted to post my code and I even tried to upload I text file I made but it sys
Your file of 116.0 KB bytes exceeds the forum's limit of 100.0 KB for this filetype.
what sould I do.
116 KB is a lot of code. Do you really need all that code to demonstrate this error?
No but I tried this. here is the error
When I make it to a exe the error i get is(Compile error method or data member not found)(.PlayState) that's the error
OK, so whatever Media_Player.MPlayer(0) is, it doesn't have a PlayState member. But what is Media_Player.MPlayer(0)?
If you provided enough code for us to compile and reproduce this error, we would be able to see this. For example, presumably the source code is not all in the same file. So start with the file which has this error, and start cutting irrelevant bits out. Then post the remainder, along with any other files from the project which include classes/functions referred to from this cut-down file.
The goal should be to get to the minimum amount of code which reproduces the original error.
Code:'Save Icons Pos.
Main.SaveIconPositions
If Media_Player.MPlayer(0).PlayState = mpPlaying Or Media_Player.MPlayer(0).PlayState = mpPaused Then
Media_Player.MPlayer(0).Stop
Media_Player.MPlayer(0).FileName = ""
Main.MediaBar.Picture = Media_Player.playimg_dead.Picture
Main.MediaBar_Progress.Value = 0
Media_Player.playimg_timer.Enabled = False
End If
If Media_Player.MPlayer(1).PlayState = mpPlaying Or Media_Player.MPlayer(1).PlayState = mpPaused Then
Media_Player.MPlayer(1).Stop
Media_Player.MPlayer(1).FileName = ""
Main.MediaBar.Picture = Media_Player.playimg_dead.Picture
Main.MediaBar_Progress.Value = 0
Media_Player.playimg_timer.Enabled = False
End If
KCK = True ' Set Kicker Var to unload all forms with no trouble
Dim I ' Declare loop variable.
'Unload all forms
fz:
If NexNetOn = True Then killnet_Click
If VB.Forms.Count = 0 Then GoTo 2224
If VB.Forms.Count = 1 Then GoTo 2224
For I = 0 To VB.Forms.Count - 1
If VB.Forms(I).Caption = Main.Caption Then GoTo eeex
If VB.Forms.Count = 1 Then GoTo 2224
Unload VB.Forms(I)
GoTo fz
eeex:
Next I
Code:'Show Login Dialog
Main.WindowState = 1
KCK = False 'Unset Kicker Var
Main.Enabled = False
PasswordScreen.Show
PasswordScreen.SetFocus
PasswordScreen.UserName.Locked = False
'Reset Shell Monitor Vars
WbShlLst = 0
ShLst = 0
ShellMonSect = ""
Exit Sub
End If
If cmd = "#newfolder" Then
NewFolder.NewFolderWizard
Exit Sub
End If
If cmd = "#newicon" Then
NewIcon.NewIconWizard
Exit Sub
End If
If cmd = "#newgame" Then
NewGame.NewGameWizard
Exit Sub
End If
If cmd = "#snake" Then
SnakeMain.Show 'MsgBox "Nexus Special Edition could not find the 'Snake 2000' applet. You may not have access to Nexus games, or there was an error during installation. Please see your Nexus Administrator", 16
Exit Sub
End If
If cmd = "#snake2000" Then
MsgBox "Nexus Special Edition could not find the 'Snake 2000' applet. You may not have access to Nexus games, or there was an error during installation. Please see your Nexus Administrator", 16
Exit Sub
End If
If cmd = "#sms" Then
If polDisSMS = True Then PROBas.AccessDeniedMsg: Exit Sub
SMSDude.Show
Exit Sub
End If
If cmd = "#iconmanager" Then
IconManager.Show
Exit Sub
End If
If cmd = "#programmanager" Then
NexusSpecial.programman.Show
Exit Sub
End If
If cmd = "#nexusloc" Then
If polDisNexusLOC2000 = True Then PROBas.AccessDeniedMsg: Exit Sub
NexusLOC.Show
Exit Sub
End If
If cmd = "#lockenvironment" Then
locker_Click
Exit Sub
End If
If cmd = "#lock" Then
locker_Click
Exit Sub
End If
If cmd = "#themes" Then
If polDisThemeManager = True Then PROBas.AccessDeniedMsg: Exit Sub
ThemeMan.Show
Exit Sub
End If
If cmd = "#minibrowzer" Then
If polDisMB6 = True Then PROBas.AccessDeniedMsg: Exit Sub
Set frmD = New MiniBrowzer
frmD.Show
Exit Sub
End If
If cmd = "#thememanager" Then
If polDisThemeManager = True Then PROBas.AccessDeniedMsg: Exit Sub
ThemeMan.Show
Exit Sub
End If
If cmd = "#loginsettings" Then
If polDisSettings = True Then PROBas.AccessDeniedMsg: Exit Sub
N2000LSettings.Show
Exit Sub
End If
If cmd = "#shellstring" Then
shellman_Click
Exit Sub
End If
If cmd = "#open" Then
shellman_Click
Exit Sub
End If
If cmd = "#run" Then
shellman_Click
Exit Sub
End If
If cmd = "#musicshare" Then
If polDisMUSICShare = True Then PROBas.AccessDeniedMsg: Exit Sub
Call ConnectToNet.MP3Client
Exit Sub
End If
If cmd = "#nexver" Then
NexVer.Show
Exit Sub
End If
If cmd = "#closenexus" Then
Unload Main
Exit Sub
End If
If cmd = "#taskmonitor" Then
If polDistaskMon = True Then PROBas.AccessDeniedMsg: Exit Sub
Tasks.Show
Exit Sub
End If
If cmd = "#chat" Then
chatter_Click
Exit Sub
End If
If cmd = "#fileclient" Then
netfiles_Click
Exit Sub
End If
If cmd = "#tasks" Then
If polDistaskMon = True Then PROBas.AccessDeniedMsg: Exit Sub
Tasks.Show
Exit Sub
End If
If cmd = "#pathfile" Then
If polDisPathfile = True Then PROBas.AccessDeniedMsg: Exit Sub
Sheller PATHFile
Exit Sub
End If
If cmd = "#usermanager" Then
u_manager_Click
Exit Sub
End If
If cmd = "#servadmin" Or cmd = "#serveradmin" Then
servadmin_Click
Exit Sub
End If
If cmd = "#trafficmonitor" Or cmd = "#trafficmonitor" Then
netmonitor_Click
Exit Sub
End If
If cmd = "#nexnetadmin" Or cmd = "#nexnexaccounts" Then
nexnetAdmin_Click
Exit Sub
End If
If cmd = "#icu" Or cmd = "#usermonitor" Then
icu_dude_Click
Exit Sub
End If
If cmd = "#icu4" Then
icu_dude_Click
Exit Sub
End If
If cmd = "#setuptemplate" Or cmd = "#edittemplate" Then
edit_template_Click
Exit Sub
End If
If cmd = "#gamemanager" Or cmd = "#editgamemenu" Then
adgames_Click
Exit Sub
End If
If cmd = "#foldermanager" Or cmd = "#editgamemenu" Then
Main.edfoldermenu_Click
Exit Sub
End If
If cmd = "#rcc" Or cmd = "#remotecontrol" Then
netcontrol_Click
Exit Sub
End If
If cmd = "#ircc" Or cmd = "#remotecontrolconsole" Then
netcontrol_Click
Exit Sub
End If
'Menu Shortcuts
If cmd = "#menu.nexus" Then
PopupMenu mnuNexus, , , , shellman
Exit Sub
End If
If cmd = "#menu.network" Then
If polHideNetworkMenu = True Then PROBas.AccessDeniedMsg: Exit Sub
PopupMenu netmenu, , , , netchat
Exit Sub
End If
If cmd = "#menu.nexustools" Then
If polHideToolsMenu = True Then PROBas.AccessDeniedMsg: Exit Sub
PopupMenu toolmenu, , , , newiconbaby
Exit Sub
End If
If cmd = "#menu.desktop" Then
If polDisDeskMenu = True Then PROBas.AccessDeniedMsg: Exit Sub
PopupMenu DeskMenu, , , , newico
Exit Sub
End If
If cmd = "#menu.programs" Then
If polHideProgramsMenu = True Then PROBas.AccessDeniedMsg: Exit Sub
PopupMenu Programs
Exit Sub
End If
If cmd = "#menu.games" Then
If polHideGamesMenu = True Then PROBas.AccessDeniedMsg: Exit Sub
PopupMenu mnuGame
Exit Sub
End If
If cmd = "#menu.folders" Then
If polHideFolders = True Then PROBas.AccessDeniedMsg: Exit Sub
PopupMenu mnuFavFolders
Exit Sub
End If
MsgBox "The applet shortcut that was requested is unavailable. Try re-wording the command and try again.", 16, "Nexus Special Edition - Applet Shortcuts"
Exit Sub
End If
'Dont use Minibrowzer Varible
Dim DMB As Boolean
p = PROBas.INIGetSetting("subids", "subid6", PATHFile + "Users\" + CurrentUser + ".itc")
If p = "1" Then DMB = True Else DMB = False
'----------------------------------
'See if shell is media that can be put in the media bar
If UCase$(ShellString) Like "*.WMA" = True Then GoTo loadtomediabar
If UCase$(ShellString) Like "*.WAV" = True Then GoTo loadtomediabar
If UCase$(ShellString) Like "*.ASX" = True Then GoTo loadtomediabar
If UCase$(ShellString) Like "*.MP3" = True Then GoTo loadtomediabar
If UCase$(ShellString) Like "*.SND" = True Then GoTo loadtomediabar
GoTo 4444
loadtomediabar:
msga = MsgBox("The file you are opening is a recognised audio media file. Would you like to hear it through the Media Bar?", vbQuestion + vbYesNoCancel)
If msga = vbYes Then
Media_Player.PlaySingle (ShellString)
Exit Sub
Else
If msga = vbCancel Then Exit Sub
End If
4444
Tester.Picture = LoadPicture("")
On Error Resume Next
Tester.Picture = LoadPicture(ShellString)
If Err <> 0 Then GoTo fd
'File is a picture
ShLst = ShLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, ShLst, ServPath + "RC2000\" + CurrentUser + "\Shell List.ini"
Viewer.ShowPIC ShellString
Exit Sub
fd:
If Right$(ShellString, 1) = "\" Or Left$(UCase$(ShellString), 3) = "WWW" Or Left$(UCase$(ShellString), 5) = "FILE:" Or Left$(UCase$(ShellString), 5) = "HTTP:" Or Left$(UCase$(ShellString), 6) = "HTTPS:" Or UCase$(ShellString) Like "*.HTML" = True Or UCase$(ShellString) Like "*.HTM" = True Or UCase$(ShellString) Like "*.JPG" = True Or UCase$(ShellString) Like "*.GIF" = True Then
If Not InStr(vbNull, UCase$(ShellString), "A:\") = 0 Then
If MsgBox("Please insert the floppy disk that contains the file '" + ShellString + "', and click OK. If you want to discard this request, click 'Cancel'.", vbQuestion + vbOKCancel, "Insert Floppy Disk") = vbOK Then
If DMB = False Then
If CheckFileLOC(ShellString) = True Then
If NoWarn = False Then
If polDisNexusLOC2000 = True Then GoTo 52
MsgBox "The file you are opening is protected by Interworks NexusLOC 2000. You will not be able to modify this file in any way, or you may not have access to it.", 48, "NexusLOC 2000 Warning"
52
End If
End If
If polDisMB6 = True Then MsgBox "Your Nexus Administrator has disabled Minibrowzer 6.0. The shell sting will be opened with the standard Windows shell.", 48, "Access Denied": GoTo 22237
Set frmD = New MiniBrowzer
frmD.Show
WbShlLst = WbShlLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, WbShlLst, ServPath + "RC2000\" + CurrentUser + "\Web Shell List.ini"
frmD.brwWebBrowser.Navigate ShellString
Else
If CheckFileLOC(ShellString) = True Then
If NoWarn = False Then
If polDisNexusLOC2000 = True Then GoTo 909
MsgBox "The file you are opening is protected by Interworks NexusLOC 2000. You will not be able to modify this file in any way, or you may not have access to it.", 48, "NexusLOC 2000 Warning"
909
End If
End If
ShLst = ShLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, ShLst, ServPath + "RC2000\" + CurrentUser + "\Shell List.ini"
OpenIt Main, ShellString
End If
Else
Exit Sub
End If
Else
If DMB = False Then
If CheckFileLOC(ShellString) = True Then
If NoWarn = False Then
If polDisNexusLOC2000 = True Then GoTo 335
MsgBox "The file or folder you are opening may be protected by Interworks NexusLOC 2000. You will not be able to modify this file in any way, or you may not have access to it.", 48, "NexusLOC 2000 Warning"
335
End If
End If
If polDisMB6 = True Then MsgBox "Your Nexus Administrator has disabled Minibrowzer 6.0. The shell sting will be opened with the standard Windows shell.", 48, "Access Denied": GoTo 22237
Set frmD = New MiniBrowzer
frmD.Show
WbShlLst = WbShlLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, WbShlLst, ServPath + "RC2000\" + CurrentUser + "\Web Shell List.ini"
On Error Resume Next
frmD.brwWebBrowser.Navigate ShellString
Else
If CheckFileLOC(ShellString) = True Then
If NoWarn = False Then
If polDisNexusLOC2000 = True Then GoTo 2572
MsgBox "The file you are opening is protected by Interworks NexusLOC 2000. You will not be able to modify this file in any way, or you may not have access to it.", 48, "NexusLOC 2000 Warning"
2572
End If
End If
22237
ShLst = ShLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, ShLst, ServPath + "RC2000\" + CurrentUser + "\Shell List.ini"
OpenIt Main, ShellString
End If
End If
Exit Sub
End If
p = Len(ShellString) + 1
Do
p = p - 1
If p = 0 Then MsgBox "Could not change directory! Please re-specify shell string.", 48:: GoTo 72
thedir = Left(ShellString, p - 1)
Loop Until Right(thedir, 1) = "\" Or Len(thedir) = 2
72
On Error GoTo serr
If Not InStr(vbNull, UCase$(ShellString), "A:\") = 0 Then
If MsgBox("Please insert the floppy disk that contains the file '" + ShellString + "', and click OK. Click cancel to cancel", vbOKCancel + vbQuestion, "Insert Floppy Disk") = vbOK Then
ChDir thedir
If CheckFileLOC(ShellString) = True Then
If NoWarn = False Then
If polDisNexusLOC2000 = True Then GoTo 127
MsgBox "The file you are opening is protected by Interworks NexusLOC 2000. You will not be able to modify this file in any way, or you may not have access to it.", 48, "NexusLOC 2000 Warning"
127
End If
End If
ShLst = ShLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, ShLst, ServPath + "RC2000\" + CurrentUser + "\Shell List.ini"
Call shell(ShellString, vbNormalFocus)
Else
Exit Sub
End If
Else
On Error Resume Next
ChDir thedir
Err.Clear
If Not UCase(ShellString) Like "*.EXE" Then GoTo trystart
If CheckFileLOC(ShellString) = True Then
If NoWarn = False Then
If polDisNexusLOC2000 = True Then GoTo 8832
MsgBox "The file you are opening is protected by Interworks NexusLOC 2000. You will not be able to modify this file in any way, or you may not have access to it.", 48, "NexusLOC 2000 Warning"
8832
End If
End If
ShLst = ShLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, ShLst, ServPath + "RC2000\" + CurrentUser + "\Shell List.ini"
Call shell(ShellString, vbNormalFocus)
End If
Exit Sub
serr:
If Err = 5 Or Err = 76 Then GoTo trystart
MsgBox "Could not shell the string specified. (" + Err.Description + ")", 48, "Error Number " & Err
Exit Sub
trystart:
Err.Clear
'On Error Resume Next
ChDir thedir
If CheckFileLOC(ShellString) = True Then
If NoWarn = False Then
If polDisNexusLOC2000 = True Then GoTo 678
MsgBox "The file you are opening may be protected by Interworks NexusLOC 2000. You will not be able to modify this file in any way, or you may not have access to it.", 48, "NexusLOC 2000 Warning"
678
End If
End If
ShLst = ShLst + 1
PROBas.INISaveSetting PROBas.IntelliCrypt_EnCrypt(ShellString), ShellMonSect, ShLst, ServPath + "RC2000\" + CurrentUser + "\Shell List.ini"
Call OpenIt(Main, ShellString)
End Sub
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
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
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
[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]
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[/
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?
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.
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
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 :(