PC World Komputer 1997 July & August/Pcwk7897.iso/mgxsuite/abc.z/NETWORK.FRM

Text File | 1996-12-16 | 16KB | 564 lines

VERSION 4.00
Begin VB.Form NetworkDatabaseDemo
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Network Database Demo"
   ClientHeight    =   1950
   ClientLeft      =   1245
   ClientTop       =   2190
   ClientWidth     =   5265
   ClipControls    =   0   'False
   BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   2355
   Icon            =   "NETWORK.frx":0000
   Left            =   1185
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1950
   ScaleWidth      =   5265
   Top             =   1845
   Width           =   5385
   Begin VB.CommandButton BrowseBtn
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Browse..."
      Height          =   375
      Left            =   3690
      TabIndex        =   6
      Top             =   795
      Width           =   1335
   End
   Begin VB.PictureBox Picture1
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   4350
      Picture         =   "NETWORK.frx":030A
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   4
      Top             =   195
      Width           =   495
   End
   Begin VB.Data Data1
      Appearance      =   0  'Flat
      Caption         =   "Data1"
      Connect         =   ""
      DatabaseName    =   ""
      Exclusive       =   0   'False
      Height          =   270
      Left            =   1440
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "Network"
      Top             =   3600
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.CommandButton cmdCancel
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   2640
      TabIndex        =   2
      Top             =   1440
      Width           =   1335
   End
   Begin VB.CommandButton cmdOK
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   1065
      TabIndex        =   1
      Top             =   1440
      Width           =   1335
   End
   Begin VB.TextBox Text1
      Appearance      =   0  'Flat
      Height          =   285
      Left            =   105
      TabIndex        =   0
      Top             =   840
      Width           =   3465
   End
   Begin MSComDlg.CommonDialog OpenDatabaseFile
      Left            =   120
      Top             =   1440
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin AbcflowLib.ABC ABC1
      Left            =   4320
      Top             =   1440
      _Version        =   65536
      _ExtentX        =   1085
      _ExtentY        =   873
      _StockProps     =   1
   End
   Begin VB.Label Label2
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "Press ""Browse"" to choose another database."
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   840
      TabIndex        =   5
      Top             =   120
      Width           =   3015
   End
   Begin VB.Label Label1
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Database File:"
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   120
      TabIndex        =   3
      Top             =   600
      Width           =   1245
   End
   Begin VB.Line Line1
      BorderColor     =   &H00FFFFFF&
      X1              =   0
      X2              =   5280
      Y1              =   1320
      Y2              =   1320
   End
End
Attribute VB_Name = "NetworkDatabaseDemo"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

    Dim ABC As Object
    Dim NetSource As RECORD
    Dim UserName As String
    Dim DataBaseFile As String
    Dim TestFileValid As String

    Const DATA_ERRCONTINUE = 1
    Const DATA_ERRDISPLAY = 0
    Const OFN_FILEMUSTEXIST = &H1000&
    Const OFN_PATHMUSTEXIST = &H800&



Private Sub ABC1_AppQuitNOTIFY()
    Data1.Recordset.Close
    End
End Sub

Private Sub ABC1_DoubleClickSUBCLASS(ByVal Object As Object, ByVal Chart As Object, Override As Boolean)
    Dim Obj As Object

    Set Obj = ABC1.Chart.Objects.ItemFromText(".mdb")

    If Obj.Valid Then
        ' Get the database from the chart
        Data1.DatabaseName = Obj.Text
        GetDatabaseInfo (Object.Text)
    Else

    End If
    Override = True

End Sub

Private Sub BrowseBtn_Click()
    'In case of error
    On Error Resume Next

    'Set properties here
    OpenDatabaseFile.CancelError = True
    OpenDatabaseFile.DefaultExt = "mdb"
    OpenDatabaseFile.Filter = "Database Files(*.mdb)|*.mdb"
    OpenDatabaseFile.Flags = OFN_FILEMUSTEXIST And OFN_PATHMUSTEXIST
    OpenDatabaseFile.Action = 1

    'Close if cancelled
    If Err = 32755 Then
        Exit Sub
    Else
        DataBaseFile = OpenDatabaseFile.filename
    End If

    Text1.Text = DataBaseFile
End Sub

Private Sub cmdCancel_Click()
     Unload NetworkDatabaseDemo
     End
End Sub

Private Sub cmdOK_Click()


    Dim DataBaseFileOne As Integer
    Dim DataBaseFileTwo As Integer

    Err = 0

    DataBaseFile = Text1.Text

    DataBaseFileOne = InStr(DataBaseFile, "NETBASE1.MDB")
    DataBaseFileTwo = InStr(DataBaseFile, "NETBASE2.MDB")

    If Not DataBaseFileOne > 1 And DataBaseFileTwo = 0 Then
    Err = 2
    ElseIf Not DataBaseFileTwo > 1 And DataBaseFileOne = 0 Then
    Err = 2
    End If

    If Err = 1 Then
        cmdOK.Enabled = False
        MsgBox "File does not exist!", 48
        Text1.SetFocus
    End If
    If Err = 2 Then
        cmdOK.Enabled = False
        MsgBox "This is an Invalid Database File!", 48
        Text1.SetFocus
    End If

    If Err = 0 Then
        cmdOK.Enabled = False

        NetworkDatabaseDemo.WindowState = 1 ' iconize form
        NetworkDatabaseDemo.Refresh

        'Build the chart
        Call DrawNetChart(DataBaseFile)

        Call ValidateFilename
    End If

End Sub

Private Sub DrawNetChart(DataBaseFile As String)

    Dim Shape As Object
    Dim Shape1 As Object
    Dim TextTitle As Object
    Dim recCount As Integer
    Dim PageWidth As Integer
    Dim ChartCancelled As Integer
    Dim CurrentRec As String
    Dim FieldInfo As String
    Dim ProcessorType As String
    Dim Chart As Object
    Dim ABCObject As Object
    Dim NewLine() As Object
    Dim Obj As Object
    Dim DataBaseText As Object
    Dim Counter As Integer
    Dim TotalCount As Integer

    'Get the chart
    Set Chart = ABC.New

    Rem Set the Chart's internal type
    Chart.Type = "NETWORK"
    Chart.TypeUsesEXE = True

    Set ABCObject = Chart.Objects

    'Prepare for chart to draw
    Chart.NoRepaint = True
    Chart.MasterItems.HideAll
    Chart.PageLayout.Orientation = 1
    Chart.View = 1
    ABC.ShapePaletteVisible = False

    ' Set defaults so there are no shape numbers
    Set Obj = Chart.DrawShape
    Obj.Shape.NumberShowN = False
    Chart.SetDefaults Obj
    Obj.Clear_               'This object can be seen when selected'

    'Set gauge
    ABC.PercentGauge NetworkDatabaseDemo.Caption, "Building Diagram", "Please Wait..."
    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled = True Then
        Call EndAppDraw
        End If

    'Title page
    Chart.CurrentShapePalette = "Standard"
    Chart.CurrentShape = "Rounded Process"
    Chart.DrawPositionX = 4.5
    Chart.DrawPositionY = 0.5
    Set Shape = Chart.DrawShape
    Shape.Height = 0.5
    Shape.Width = 5.5
    Shape.Text = "Network Diagram"
    Shape.Font.Size = 18
    Shape.Font.Bold = True
    Shape.Shape.BorderWidth = 3
    Shape.Shape.BorderColor = ABC.RED
    Shape.Shape.FillColor = ABC.GRAY

    'give feedback here
    'ABC.PercentGaugeValue = 10

    'cancel chart?
    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled Then
        Call EndAppDraw
        End If

   'Get Network palette
    Chart.CurrentShapePalette = "Net - PC Workstations"
    Chart.CurrentShape = "Tower"

    'Set shape spacing
    Chart.DrawPositionX = 4.5
    Chart.DrawPositionY = 1.5

    Set Shape1 = Chart.DrawShape
    Shape1.Height = 1.25
    Shape1.Width = 1.25
    Shape1.Text = "SERVER"
    Shape1.Font.Bold = True
    Shape1.Font.Size = 12

    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled Then
        Call EndAppDraw
        End If

    'Open the Database
    Data1.DatabaseName = DataBaseFile
    Data1.RecordSource = "Network"
    Data1.Refresh

    'Get the number of records
    recCount = GetRecNum(Data1.Recordset)
    Data1.Refresh

    PageWidth = Chart.PageLayout.Width

    If recCount <= 5 Then
    Chart.DrawSpacingX = PageWidth / recCount
    Chart.DrawPositionX = (PageWidth / 2) / recCount
    Else
    Chart.DrawSpacingX = 1.5
    Chart.DrawPositionX = 1
    End If

    Chart.DrawPositionY = 3.5
    Chart.DrawDirection = 1

    Do While Not Data1.Recordset.EOF
        CurrentRec = GetCurrRec(Data1.Recordset)
        CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)
        FieldInfo = Trim(NetSource.User)
        ProcessorType = Trim(NetSource.Computer)

    'Draw Shapes and add Usernames
        Chart.CurrentShape = ProcessorType
        Set Shape = Chart.DrawShape
        Shape.Height = 1.25
        Shape.Width = 1.25
        Shape.Text = FieldInfo
        Shape.Font.Size = 12
        Shape.Font.Color = ABC.BLUE

        TotalCount = recCount
        Counter = 100 / TotalCount


    'Draw Lines from server to workstation
        Chart.CurrentLineRouting = 3

            ReDim NewLine(recCount) As Object

        Set NewLine(recCount) = Chart.DrawLine(Shape1, Shape, 2, 0)
        NewLine(recCount).Line_.StemWidth = 3
        recCount = recCount - 1

    'Increment gauge

        If Counter > 0 Then
        ABC.PercentGaugeValue = Int(100 - (Counter * recCount))
        End If



     Data1.Recordset.MoveNext

    Loop

    'Give feedback here
    'ABC.PercentGaugeValue = 90

    ChartCancelled = ABC.PercentGaugeCancelled
        If ChartCancelled Then
        Call EndAppDraw
        End If

    'Give double-click instructions
    Chart.DrawPositionX = 1.5
    Chart.DrawPositionY = 5
    Set TextTitle = Chart.DrawTextBlock(UCase("To find server information, Double-click on a shape."))
    TextTitle.Font.Bold = True
    TextTitle.Font.Size = 16
    TextTitle.CenterX = PageWidth / 2

    ' Write out database name
    Chart.DrawPositionX = 1.5
    Chart.DrawPositionY = 5.25
    Set DataBaseText = Chart.DrawTextBlock(LCase(Text1))
    DataBaseText.Font.Bold = False
    DataBaseText.Font.Size = 12
    DataBaseText.CenterX = PageWidth / 2

    'Data1.Recordset.Close
    Data1.Refresh

    'Give feedback here
    ABC.PercentGaugeValue = 99
    ABC.HidePercentGauge

    'Draw chart
    Chart.NoRepaint = False
    Chart.Repaint


End Sub

Private Sub EndAppDraw()
        ABC.HidePercentGauge
        End
End Sub

Private Sub Form_Load()
   'Open ABC
    Set ABC = CreateObject("ABCFlow.Application")
   ' ABC.Maximize
    ABC.Hourglass = True
    ABC.Visible = True

    'Register the Events
    ABC.RegisterEvent ABC1, "Network", "DoubleClickSUBCLASS"
    ABC.RegisterEvent ABC1, "Network", "AppQuitNOTIFY"

    'Load both forms
    Load ServerInfo
    NetworkDatabaseDemo.Left = (Screen.Width - Width) \ 2
    NetworkDatabaseDemo.Top = (Screen.Height - Height) \ 2
    Text1.Text = UCase(App.Path & "\" & "netbase1.mdb")
    NetworkDatabaseDemo.Show
End Sub

Private Sub GetDatabaseInfo(UserName As String)

    Dim CurrentRec As String


    Data1.RecordSource = "Network"
    Data1.Refresh

    'Find this username in the database
        If UserName = Data1.Recordset.Fields("User").Value Then
            CurrentRec = GetCurrRec(Data1.Recordset)
            CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)

    'Display server information
    ServerInfo.txtType.Text = Trim$(NetSource.Type)
    ServerInfo.txtProcess = Trim$(NetSource.Computer)
    ServerInfo.txtUserID = Trim$(NetSource.UserID)
    ServerInfo.txtUserName = Trim$(NetSource.User)
    ServerInfo.txtServer = Trim$(NetSource.Server)
    ServerInfo.Show 1


        ElseIf UserName = "" Then
                    MsgBox "This Station is Unassigned.", 64
        ElseIf Not UserName = Data1.Recordset.Fields("User").Value Then
            Data1.Recordset.MoveFirst
            Do
                Data1.Recordset.MoveNext
                    On Error GoTo Error_out
            Loop Until Data1.Recordset.EOF = True Or UserName = Data1.Recordset.Fields("User").Value
                CurrentRec = GetCurrRec(Data1.Recordset)
                CopyMemory NetSource, ByVal CurrentRec, Len(NetSource)

    'Display server information
    ServerInfo.txtType.Text = Trim$(NetSource.Type)
    ServerInfo.txtProcess = Trim$(NetSource.Computer)
    ServerInfo.txtUserID = Trim$(NetSource.UserID)
    ServerInfo.txtUserName = Trim$(NetSource.User)
    ServerInfo.txtServer = Trim$(NetSource.Server)
    ServerInfo.Show 1

        End If

Error_out:
          Select Case Err
                Case 3021
            ServerInfo.Hide
            MsgBox UCase("This is not a Workstation!") + Chr(13) + Chr(13) + "  Please choose a valid name."

            'DATA_ERRDISPLAY = 0
            'DATA_ERRCONTINUE = 1
            Data1.Refresh
            Data1.Recordset.MoveFirst
            Resume CloseDB
                Case Else
                Data1.Refresh
                ServerInfo.Hide
          End Select

CloseDB:
        Data1.Refresh
        Data1.Recordset.MoveFirst

End Sub

Private Sub Text1_Change()
    Call ValidateFilename
End Sub

Private Sub Text1_GotFocus()

    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)

End Sub

Private Sub ValidateFilename()
    Dim Attr As Single

    On Error Resume Next

    Attr = GetAttr(Text1)
    If Err Then
        cmdOK.Enabled = False
    Else
        cmdOK.Enabled = True
    End If

End Sub