home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Object = "{C40817A0-3291-11D2-9233-0008C744D2C9}#1.0#0"; "FASTLOGIN.OCX" Object = "{BB859389-001D-11D1-8E83-00805F3AEC32}#1.0#0"; "SYSTRAY.OCX" Begin VB.Form FrmMain Caption = "Form1" ClientHeight = 4005 ClientLeft = 165 ClientTop = 735 ClientWidth = 8865 LinkTopic = "Form1" ScaleHeight = 4005 ScaleWidth = 8865 StartUpPosition = 3 'Windows Default Visible = 0 'False Begin VB.TextBox DDELink Height = 285 Left = 1080 TabIndex = 6 Text = "Text1" Top = 3180 Width = 3435 End Begin VB.Timer Timer2 Interval = 10000 Left = 3360 Top = 2760 End Begin VB.Timer Timer1 Enabled = 0 'False Interval = 500 Left = 3480 Top = 2040 End Begin SysTrayCtl.cSysTray cSysTray1 Left = 240 Top = 2940 _ExtentX = 900 _ExtentY = 900 InTray = 0 'False TrayIcon = "FrmMain.frx":0000 TrayTip = "FastBoss Click to open Toolbar" End Begin FastLogin.FastLogn FastLogn1 Left = 1080 Top = 2400 _ExtentX = 3096 _ExtentY = 767 End Begin VB.CommandButton Command3 Caption = "Log On" Height = 435 Left = 2280 TabIndex = 5 Top = 960 Width = 1815 End Begin VB.CommandButton Command6 Caption = "Command6" Height = 435 Left = 2280 TabIndex = 4 Top = 300 Width = 1575 End Begin VB.CommandButton Command5 Caption = "show hover" Height = 375 Left = 60 TabIndex = 3 Top = 540 Width = 2000 End Begin VB.CommandButton Command4 Caption = "update" Height = 255 Left = 60 TabIndex = 2 Top = 1020 Width = 2000 End Begin VB.CommandButton Command2 Caption = "request team" Height = 375 Left = 60 TabIndex = 1 Top = 1860 Width = 2000 End Begin MSWinsockLib.Winsock Winsock1 Left = 360 Top = 2400 _ExtentX = 741 _ExtentY = 741 _Version = 327681 Protocol = 1 End Begin VB.CommandButton Command1 Caption = "show team" Height = 375 Left = 60 TabIndex = 0 Top = 60 Width = 2000 End Begin VB.Image Image1 Height = 480 Index = 1 Left = 4080 Picture = "FrmMain.frx":08DA Top = 2520 Width = 480 End Begin VB.Image Image1 Height = 480 Index = 0 Left = 4080 Picture = "FrmMain.frx":11A4 Top = 1800 Width = 480 End Begin VB.Menu personclickdrop Caption = "Personclickdrop" Begin VB.Menu sendmessage Caption = "Send Message" End Begin VB.Menu OpenPortal Caption = "Open Portal" End Begin VB.Menu AvatarCreate Caption = "Test New Portal" End Begin VB.Menu bar001 Caption = "-" End Begin VB.Menu NameSlot Caption = "<Name>" End Begin VB.Menu TeleSlot Caption = "<Tele>" End Begin VB.Menu FaxSlot Caption = "<Fax>" End End Begin VB.Menu statusdrop Caption = "Statusdrop" Begin VB.Menu statuschange Caption = "Available" Index = 0 End Begin VB.Menu statuschange Caption = "-" Index = 1 End Begin VB.Menu statuschange Caption = "Busy" Index = 2 End Begin VB.Menu statuschange Caption = "Do Not Disturb" Index = 3 End Begin VB.Menu statuschange Caption = "Not at Desk" Index = 4 End Begin VB.Menu statuschange Caption = "On Phone" Index = 5 End Begin VB.Menu statuschange Caption = "Break" Index = 6 End Begin VB.Menu statuschange Caption = "Stepped Out" Index = 7 End Begin VB.Menu statuschange Caption = "-" Index = 8 End Begin VB.Menu statuschange Caption = "Other" Index = 9 End End Begin VB.Menu intraydrop Caption = "intraydrop" Begin VB.Menu viewmessage Caption = "View Full Message" End Begin VB.Menu replytomessage Caption = "Reply" End Begin VB.Menu deletemessage Caption = "Delete" End End Begin VB.Menu sentmsgdrop Caption = "sentmsgdrop" Begin VB.Menu DeleteSentMsg Caption = "Delete" End End Begin VB.Menu persondrop Caption = "PersonDrop" Begin VB.Menu sendclip Caption = "Send ClipBoard" End Begin VB.Menu SendUrl Caption = "Send Url" End Begin VB.Menu fhfhg Caption = "-" End Begin VB.Menu removeportal Caption = "Remove Portal" End End Begin VB.Menu PortalData Caption = "PortalData" Begin VB.Menu PortalStore Caption = "No Data" Index = 0 End Begin VB.Menu PortalStore Caption = "2." Index = 1 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "3." Index = 2 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "4." Index = 3 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "5." Index = 4 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "6." Index = 5 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "7." Index = 6 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "8." Index = 7 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "9." Index = 8 Visible = 0 'False End Begin VB.Menu PortalStore Caption = "10." Index = 9 Visible = 0 'False End End Attribute VB_Name = "FrmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub AvatarCreate_Click() Dim fred As New FrmPerson 'fred.Label1.Caption = CurrentPerson.Name 'fred.Label1.Tag = CurrentPerson.Address 'fred.Show CreateAvatar CurrentPerson.Userid, CurrentPerson.Address, CurrentPerson.Name, "" End Sub Private Sub Command1_Click() FrmTeam.Show End Sub Private Sub Command10_Click() GetRealEstate xtop, xleft, xright, xbottom End Sub Private Sub Command2_Click() Dim Opstr As String msql = "SELECT FASTBOSS.USER_DETAILS.* FROM FASTBOSS.TEAM_MEMBER , FASTBOSS.USER_DETAILS WHERE FASTBOSS.TEAM_MEMBER.USER_ID = FASTBOSS.USER_DETAILS.USER_ID and FASTBOSS.TEAM_MEMBER.TEAM_ID =3" Opstr = "0101" & msql & "|" senc = Encrypt(Opstr, 8479, 4597) Winsock1.RemoteHost = ServerAddr Winsock1.RemotePort = 19000 Winsock1.SendData senc End Sub Private Sub Command3_Click() Dim Opstr As String msql = "UPDATE fastboss.user_details " msql = msql & "SET fastboss.user_details.status = 'Logged On'," msql = msql & "fastboss.user_details.status_changed = " & ToDateNow() & "," msql = msql & "fastboss.user_details.ip_address='" & LazyBastard(FrmMain.Winsock1.LocalIP) & "'," msql = msql & "fastboss.user_details.current_location='" & "From Laptop" & "'," msql = msql & "fastboss.user_details.roving_tel_no='" & "01202897274" & "'," msql = msql & "fastboss.user_details.logged_on = " & ToDateNow() & "" msql = msql & " where fastboss.user_details.user_id='" & CurrentUserId & "'" Debug.Print msql Opstr = "0201" & msql & "|" senc = Encrypt(Opstr, 8479, 4597) Winsock1.RemoteHost = ServerAddr Winsock1.RemotePort = 19000 Winsock1.SendData senc End Sub Private Sub Command4_Click() Dim Opstr As String 'msql = "SELECT FASTBOSS.USER_DETAILS.* FROM FASTBOSS.TEAM_MEMBER , FASTBOSS.USER_DETAILS WHERE FASTBOSS.TEAM_MEMBER.USER_ID = FASTBOSS.USER_DETAILS.USER_ID and FASTBOSS.TEAM_MEMBER.TEAM_ID =3" msql = "UPDATE fastboss.user_details SET fastboss.user_details.status = 'turkey' where fastboss.user_details.user_id='eapkw02'" Opstr = "0201" & msql & "|" senc = Encrypt(Opstr, 8479, 4597) Winsock1.RemoteHost = ServerAddr Winsock1.RemotePort = 19000 Winsock1.SendData senc End Sub Private Sub Command5_Click() FrmFloat.FormShaper1.ShapeIt "sme" FrmFloat.Show End Sub Private Sub Command6_Click() Dim Opstr As String msql = "SELECT FASTBOSS.TEAM.* FROM FASTBOSS.TEAM" Opstr = "0102" & msql & "|" senc = Encrypt(Opstr, 8479, 4597) Winsock1.RemoteHost = ServerAddr Winsock1.RemotePort = 19000 Winsock1.SendData senc End Sub Private Sub Command8_Click() Dim ipfull As String, ipsmall As String ipfull = Winsock1.LocalIP ipsmall = LazyBastard(ipfull) For tmp1 = 1 To 4 Debug.Print Asc(Mid(ipsmall, tmp1, 1)) Next End Sub Private Sub Command9_Click() FrmMsgView.Show End Sub Private Sub cSysTray1_MouseDown(Button As Integer, Id As Long) If Timer1.Enabled Then 'Must be a new mail message ... ensure toolbar is up and show messages Timer1.Enabled = False Set cSysTray1.TrayIcon = Image1(1).Picture cSysTray1.TrayTip = "FastBoss Click to open Toolbar" If Not FrmCtlBar.Visible Then DrawCtlBar ShowPopUpWin FrmCtlBar End If If Not FrmMsgView.Visible Then FrmMsgView.ZOrder 1 FrmMsgView.Top = FrmCtlBar.Top FrmMsgView.Left = 2500 onestep = FrmMsgView.Height / 5 FrmCtlBar.ZOrder FrmMsgView.Show For tmp1 = 1 To 5 FrmMsgView.Top = FrmMsgView.Top - onestep For tmp2 = 1 To 50: DoEvents: Next Next FrmMsgView.Top = FrmCtlBar.Top - FrmMsgView.Height FrmMsgView.Show Else FrmMsgView.Show End If Else If FrmCtlBar.Visible Then HideCtlBar Else DrawCtlBar ShowPopUpWin FrmCtlBar End If End If End Sub Private Sub cSysTray2_MouseDown(Button As Integer, Id As Long) Timer1.Enabled = False cSysTray2.InTray = False End Sub Private Sub deletemessage_Click() If FrmMsgView.MSFlexGrid1.Rows = 1 Then FrmMsgView.MSFlexGrid1.Rows = 0 Else FrmMsgView.MSFlexGrid1.RemoveItem InTrayRow End If End Sub Private Sub DeleteSentMsg_Click() If FrmMsgView.MSFlexGrid2.Rows = 1 Or FrmMsgView.MSFlexGrid2.Rows = 0 Then FrmMsgView.MSFlexGrid2.Rows = 0 Else FrmMsgView.MSFlexGrid2.RemoveItem SentMessagesRow End If End Sub Private Sub dragaccept_Click() DragAcceptFiles Me.hwnd, True End Sub Private Sub dragdecline_Click() DragAcceptFiles Me.hwnd, False End Sub Private Sub FastLogn1_LoginCancel() End End Sub Private Sub FastLogn1_LoginResponse(Userid As String, AccessLevel As String, UserName As String, UserTele As String) WriteLog "Setup sys tray" cSysTray1.InTray = True 'now log on ... LoggedOn = 1 CurrentUserId = Userid Dim Opstr As String WriteLog "Draw control bar" DrawCtlBar WriteLog "Show control bar as on top" ShowPopUpWin FrmCtlBar WriteLog "Get reg settings" location = GetSetting("FastBoss", "Settings", "Location", "") TeleNo = GetSetting("FastBoss", "Settings", "TeleNo", "") FaxNo = GetSetting("FastBoss", "Settings", "FaxNo", "") ServerAddr = GetSetting("FastBoss", "Settings", "ServerAddr", "132.146.197.83") WriteLog "Build sql" msql = "UPDATE fastboss.user_details " msql = msql & "SET fastboss.user_details.status = 'Logged On'," msql = msql & "fastboss.user_details.status_changed = " & ToDateNow() & "," msql = msql & "fastboss.user_details.ip_address='" & LazyBastard(FrmMain.Winsock1.LocalIP) & "'," msql = msql & "fastboss.user_details.current_location='" & location & "'," msql = msql & "fastboss.user_details.roving_tel_no='" & TeleNo & "'," msql = msql & "fastboss.user_details.roving_fax_no='" & FaxNo & "'," msql = msql & "fastboss.user_details.logged_on = " & ToDateNow() & "" msql = msql & " where fastboss.user_details.user_id='" & CurrentUserId & "'" Debug.Print msql Opstr = "0201" & msql & "|" senc = Encrypt(Opstr, 8479, 4597) Winsock1.RemoteHost = ServerAddr Winsock1.RemotePort = 19000 WriteLog "Send Data " & senc Winsock1.SendData senc WriteLog "Data sent" DoEvents 'Now get current users details msql = "SELECT FASTBOSS.USER_DETAILS.* FROM FASTBOSS.user_details where fastboss.user_details.user_id='" & CurrentUserId & "'" Opstr = "0106" & msql & "|" senc = Encrypt(Opstr, 8479, 4597) FrmMain.Winsock1.RemoteHost = ServerAddr FrmMain.Winsock1.RemotePort = 19000 FrmMain.Winsock1.SendData senc DoEvents End Sub Private Sub Form_Load() 'FrmSplash.Show 1 FrmCtlBar.Label2.ToolTipText = "FastBoss Version " & App.Major & "." & App.Minor & " Rev " & App.Revision If LoggedOn = 0 Then Winsock1.Bind 19100 CRLF = Chr(13) & Chr(10) FastLogn1.Login "FastBoss", "fastboss" 'FastLogn1_LoginResponse "stand01", 0, "Andy Derrick", "01202 206903" 'CurrentUserId = "stand01" ShortBeepInterval = 4 CurrentTeam = "NCC11" CurrentTeamIndex = 3 End If End Sub Private Sub OpenPortal_Click() Dim fred As New FrmPerson fred.Label1.Caption = CurrentPerson.Name fred.Label1.Tag = CurrentPerson.Address fred.Show End Sub Private Sub PortalStore_Click(Index As Integer) On Error GoTo e_trap iRet = ShellExecute(Me.hwnd, vbNullString, PortalStore(Index).Tag, vbNullString, "c:\", SW_SHOWNORMAL) Exit Sub e_trap: Debug.Print Err.Description Resume Next End Sub Private Sub removeportal_Click() DeleteAvatar CurrentPerson.Userid Unload Me End Sub Private Sub replytomessage_Click() ShowAtCursor FrmSendMessage, 0, 0, 0 End Sub Private Sub sendclip_Click() Dim clipdata As String Debug.Print "Start clipboard stuff" Debug.Print Clipboard.GetFormat(1) clipdata = Clipboard.GetData Debug.Print clipdata End Sub Private Sub sendmessage_Click() ShowAtCursor FrmSendMessage, 1, 0, 0 End Sub Private Sub SendUrl_Click() With FrmMain.Winsock1 msgstring = "C100" & CurrentURL.Title & "|" & CurrentURL.Link & "|" & User.Name & "|" 'msgstring = "C100" & "Test|Test|" .RemoteHost = CurrentPerson.Address .RemotePort = 19100 Debug.Print msgstring .SendData msgstring Debug.Print msgstring End With End Sub Private Sub statuschange_Click(Index As Integer) If statuschange(Index).Caption <> "Other" Then UpdateStatus statuschange(Index).Caption Else ShowAtCursor FrmCustStatus, 1, 0, 0 End If End Sub Private Sub Timer1_Timer() If BeepCounter > 0 Then BeepCounter = BeepCounter - 1 Beep End If If cSysTray1.Tag = "Y" Then Set cSysTray1.TrayIcon = Image1(0).Picture cSysTray1.Tag = "N" Else Set cSysTray1.TrayIcon = Image1(1).Picture cSysTray1.Tag = "Y" End If End Sub Private Sub Timer2_Timer() On Error GoTo e_trap Winsock1.RemoteHost = ServerAddr Winsock1.RemotePort = 2 Winsock1.SendData "Ping!" Exit Sub e_trap: Resume Next End Sub Private Sub viewmessage_Click() FrmView.Label1.Caption = CurrentMessage.msg FrmView.Label3.Caption = CurrentMessage.Name FrmView.Show End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim tdata As String, InAddress As String Winsock1.GetData tdata InAddress = Winsock1.RemoteHostIP Inport = Winsock1.RemotePort Debug.Print tdata HandleMessages tdata, InAddress, Inport End Sub Function MinsToTime(InMins) xhours = Int(InMins / 60) xmins = InMins - (xhours * 60) If xhours > 999 Then MinsToTime = "999>>" Else MinsToTime = Format(xhours, "00") & ":" & Format(xmins, "00") End If End Function 
(.txt)