windows-xp/Source/XPSP1/NT/net/rras/cps/pba/source/loadreg.frm

'//+----------------------------------------------------------------------------
'//
'// File:     loadreg.frm
'//
'// Module:   pbadmin.exe
'//
'// Synopsis: The regions dialog.
'//
'// Copyright (c) 1997-1999 Microsoft Corporation
'//
'// Author:   quintinb   Created Header    09/02/99
'//
'//+----------------------------------------------------------------------------

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmLoadRegion 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   4665
   ClientLeft      =   135
   ClientTop       =   1545
   ClientWidth     =   4485
   Icon            =   "LoadReg.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4665
   ScaleWidth      =   4485
   ShowInTaskbar   =   0   'False
   WhatsThisButton =   -1  'True
   WhatsThisHelp   =   -1  'True
   Begin VB.CommandButton cmbEdit 
      Caption         =   "edit"
      Height          =   345
      Left            =   3120
      TabIndex        =   2
      Top             =   630
      WhatsThisHelpID =   90010
      Width           =   1215
   End
   Begin VB.CommandButton cmbDelete 
      Caption         =   "del"
      Height          =   345
      Left            =   3120
      TabIndex        =   3
      Top             =   1125
      WhatsThisHelpID =   90020
      Width           =   1215
   End
   Begin VB.CommandButton cmbregsave 
      Caption         =   "add"
      Height          =   330
      Left            =   3120
      TabIndex        =   1
      Top             =   120
      WhatsThisHelpID =   90000
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Height          =   60
      Left            =   3120
      TabIndex        =   7
      Top             =   1680
      Width           =   1245
   End
   Begin VB.CommandButton cmbOK 
      Caption         =   "ok"
      Height          =   345
      Left            =   3120
      TabIndex        =   5
      Top             =   3720
      WhatsThisHelpID =   10030
      Width           =   1215
   End
   Begin VB.CommandButton cmbCancel 
      Cancel          =   -1  'True
      Caption         =   "cancel"
      Height          =   345
      Left            =   3120
      TabIndex        =   6
      Top             =   4200
      WhatsThisHelpID =   10040
      Width           =   1230
   End
   Begin VB.CommandButton loadReg 
      Caption         =   "import"
      Height          =   375
      Left            =   3120
      TabIndex        =   4
      Top             =   1920
      WhatsThisHelpID =   90030
      Width           =   1215
   End
   Begin ComctlLib.ListView RegionList 
      Height          =   4455
      Left            =   120
      TabIndex        =   0
      Top             =   105
      WhatsThisHelpID =   90040
      Width           =   2835
      _ExtentX        =   5001
      _ExtentY        =   7858
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   327682
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   1
      BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "region"
         Object.Width           =   4022
      EndProperty
   End
   Begin MSComDlg.CommonDialog commonregion 
      Left            =   3480
      Top             =   2640
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "Open Region File"
      Filter          =   "*.pbr Region file| *.pbr"
   End
End
Attribute VB_Name = "frmLoadRegion"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim intMaxRegionID As Integer

Dim EditList As EditLists

Dim bEditMode As Boolean
Dim nNewOne As Integer

Dim FirstEntry As Boolean
Dim dbDataRegion As Database
Dim rsDataRegion As Recordset

Function FillRegionList()

    On Error GoTo ErrTrap
            
    Dim strTemp As String
    Dim intRowID As Integer
    Dim itmX As ListItem
    
    RegionList.ListItems.Clear
    RegionList.Sorted = False
    intMaxRegionID = 0
    If rsDataRegion.BOF = False Then
        rsDataRegion.MoveFirst
        Do While Not rsDataRegion.EOF
            Set itmX = RegionList.ListItems.Add()
            intRowID = rsDataRegion!ID
            With itmX
                .Text = rsDataRegion!Region
                strTemp = "Key:" & intRowID
                .Key = strTemp
            End With
            If intMaxRegionID < intRowID Then
                intMaxRegionID = intRowID
            End If
            rsDataRegion.MoveNext
            If rsDataRegion.AbsolutePosition Mod 40 = 0 Then DoEvents
        Loop
    End If
    RegionList.Sorted = True

Exit Function
ErrTrap:
    Exit Function
End Function

Function LoadRegionRes()

    On Error GoTo LoadErr
    Me.Caption = LoadResString(2003) & " " & gsCurrentPB
    RegionList.ColumnHeaders(1).Text = LoadResString(2005)
    cmbregsave.Caption = LoadResString(1011)
    cmbEdit.Caption = LoadResString(1012)
    cmbDelete.Caption = LoadResString(1013)
    loadReg.Caption = LoadResString(2004)
    cmbOK.Caption = LoadResString(1002)
    cmbCancel.Caption = LoadResString(1003)
    ' set fonts
    SetFonts Me
    RegionList.Font.Charset = gfnt.Charset
    RegionList.Font.Name = gfnt.Name
    RegionList.Font.Size = gfnt.Size

    On Error GoTo 0

Exit Function

LoadErr:
    Exit Function
End Function

Function SaveEdit(ByVal Action As String, ByVal ID As Integer, ByVal NewRegion As String, Optional ByVal OldRegion As String) As Integer

    ' populate the array - for performance reasons
    
    Dim intX As Integer
    Dim bFound As Boolean
    
    On Error GoTo SaveErr
    bFound = False
    If Action = "U" Or Action = "D" Then
        intX = 1
        Do While intX <= EditList.Count
            If ID = EditList.ID(intX) Then
                ' this handles Adds that have been Updated before being
                '  written to the db.
                If Action = "U" And EditList.Action(intX) = "A" Then
                    Action = "A"
                    'If EditList.Region(intX) = "" And _
                        EditList.Action(intX) = "A" Then Action = "A"
                End If
                bFound = True
                Exit Do
            End If
            intX = intX + 1
        Loop
    End If
    If Not bFound Then
        intX = EditList.Count + 1
        EditList.Count = intX
        ReDim Preserve EditList.Action(intX)
        ReDim Preserve EditList.ID(intX)
        ReDim Preserve EditList.Region(intX)
        ReDim Preserve EditList.OldRegion(intX)
    End If
    
    EditList.Action(intX) = Action
    EditList.ID(intX) = ID
    EditList.Region(intX) = NewRegion
    If Action = "U" Then
        EditList.OldRegion(intX) = OldRegion
    End If
    On Error GoTo 0
    
Exit Function
SaveErr:
    Exit Function

End Function

Private Sub cmbCancel_Click()

    Unload Me
    
End Sub

Private Sub cmbDelete_Click()

    Dim intX As Integer
    
    On Error Resume Next
    intX = MsgBox(LoadResString(6024), vbQuestion + vbYesNo + vbDefaultButton2)
    If intX = 6 Then
        SaveEdit "D", _
            Right(RegionList.SelectedItem.Key, Len(RegionList.SelectedItem.Key) - 4), _
            RegionList.SelectedItem.Text
        RegionList.ListItems.Remove RegionList.SelectedItem.Key
    End If
    RegionList.SetFocus

End Sub

Private Sub cmbEdit_Click()

    On Error GoTo ErrTrap
    RegionList.SetFocus
    RegionList.StartLabelEdit

    Exit Sub
ErrTrap:
    Exit Sub
End Sub

Private Sub cmbOK_Click()

    Dim rsTemp As Recordset
    Dim intX, intY As Integer
    Dim intRegionID As Integer
    Dim itemY As ListItem
    Dim bUpdates As Boolean
    Dim PerformedDelete As Boolean
    Dim rsTempPop As Recordset, rsTempDelta As Recordset
    Dim i As Integer, deltnum As Integer
    Dim deltasql As String, popsql As String
    
    PerformedDelete = False
    If bEditMode Then
        RegionList.SetFocus
        SendKeys "{ENTER}", True
        RegionList_AfterLabelEdit 1, RegionList.SelectedItem.Text
        'bEditMode = False
    End If
    
    On Error GoTo SaveErr
    Me.MousePointer = 11
    frmLoadRegion.Enabled = False
    bUpdates = False
    
    Set rsTemp = gsyspb.OpenRecordset("Region", dbOpenDynaset)
    
    'Debug.Print ("editlist.count = " & EditList.Count)
    For intX = 1 To EditList.Count
        Select Case EditList.Action(intX)
            Case "D"  'delete
                gsyspb.Execute "Delete from Region Where RegionID =" & EditList.ID(intX)
                popsql = "Select * from DialUpPort where RegionID = " & EditList.ID(intX)
                Set rsTempPop = gsyspb.OpenRecordset(popsql, dbOpenDynaset)
                If Not (rsTempPop.BOF And rsTempPop.EOF) Then
                    rsTempPop.MoveFirst
                    Do Until rsTempPop.EOF
                        rsTempPop.Edit
                        rsTempPop!RegionID = 0
                        rsTempPop.Update
                            
                        If rsTempPop!status = 1 Then
                            Set rsTempDelta = gsyspb.OpenRecordset("Select * from Delta order by DeltaNum", dbOpenDynaset)
                            If rsTempDelta.RecordCount = 0 Then
                                deltnum = 1
                            Else
                                rsTempDelta.MoveLast
                                deltnum = rsTempDelta!deltanum
                                If deltnum > 6 Then
                                    deltnum = deltnum - 1
                                End If
                            End If
                            For i = 1 To deltnum
                                deltasql = "Select * from delta where DeltaNum = " & i & _
                                    " AND AccessNumberId = '" & rsTempPop!AccessNumberId & "' " & _
                                    " order by DeltaNum"
                                Set rsTempDelta = gsyspb.OpenRecordset(deltasql, dbOpenDynaset)
                                If Not (rsTempDelta.BOF And rsTempDelta.EOF) Then
                                    rsTempDelta.Edit
                                Else
                                    rsTempDelta.AddNew
                                    rsTempDelta!deltanum = i
                                    rsTempDelta!AccessNumberId = rsTempPop!AccessNumberId
                                End If
                                If rsTempPop!status = 1 Then
                                    rsTempDelta!CountryNumber = rsTempPop!CountryNumber
                                    rsTempDelta!AreaCode = rsTempPop!AreaCode
                                    rsTempDelta!AccessNumber = rsTempPop!AccessNumber
                                    rsTempDelta!MinimumSpeed = rsTempPop!MinimumSpeed
                                    rsTempDelta!MaximumSpeed = rsTempPop!MaximumSpeed
                                    rsTempDelta!RegionID = rsTempPop!RegionID
                                    rsTempDelta!CityName = rsTempPop!CityName
                                    rsTempDelta!ScriptId = rsTempPop!ScriptId
                                    rsTempDelta!Flags = rsTempPop!Flags
                                    rsTempDelta.Update
                                End If
                            Next i
                        End If
                    rsTempPop.MoveNext
                    Loop
                End If
                
                
                LogRegionDelete EditList.Region(intX), EditList.Region(intX) & ";" & EditList.ID(intX)
                PerformedDelete = True
                bUpdates = True
            Case "U"  'update
                If EditList.Region(intX) <> "" Then
                    gsyspb.Execute "Update Region set RegionDesc='" & EditList.Region(intX) & _
                        "' Where RegionID =" & EditList.ID(intX)
                    LogRegionEdit EditList.OldRegion(intX), EditList.Region(intX) & ";" & EditList.ID(intX)
                    bUpdates = True
                End If
            Case "A"  'add
                If EditList.Region(intX) <> "" Then
                    With rsTemp
                        .AddNew
                        !RegionID = EditList.ID(intX)
                        !RegionDesc = EditList.Region(intX)
                        .Update
                    End With
                    LogRegionAdd EditList.Region(intX), EditList.Region(intX) & ";" & EditList.ID(intX)
                End If
        End Select
        If intX Mod 5 = 0 Then DoEvents
    Next
    If PerformedDelete Then
        If Not ReIndexRegions(gsyspb) Then GoTo SaveErr
    End If
    
    rsTemp.Close
    
    If bUpdates Then frmMain.FillPOPList
    frmLoadRegion.Enabled = True
    Me.MousePointer = 0
    On Error GoTo 0
    Unload Me

Exit Sub

SaveErr:
    frmLoadRegion.Enabled = True
    Me.MousePointer = 0
    MsgBox LoadResString(6056) & Chr(13) & Chr(13) & Err.Description, vbExclamation
    Exit Sub

    'GsysPb.Execute "Delete from Region", dbFailOnError
    'Set rsTemp = GsysPb.OpenRecordset("Region", dbOpenDynaset)
    'For intX = 1 To RegionList.ListItems.Count
    '    Set itemY = RegionList.ListItems(intX)
    '    With rsTemp
    '        .AddNew
    '        !regionID = Right(itemY.Key, Len(itemY.Key) - 4)
    '        !regiondesc = Left$(itemY.Text, 30)
    '        .Update
    '    End With
    '    If intX Mod 25 = 0 Then DoEvents
    'Next
    'rsTemp.Close
    'Set rsTemp = Nothing
    


    'check for deletes
    'Set rsTemp = GsysPb.OpenRecordset("Region", dbOpenDynaset)
    'If Not (rsTemp.BOF And rsTemp.EOF) Then
    '    rsTemp.MoveLast
    '    rsTemp.MoveFirst
    '    For intX = 1 To rsTemp.RecordCount
    '        intRegionID = rsTemp!regionID
    '        intY = 1
    '        Do While intY <= RegionList.ListItems.Count
    '            Set itemY = RegionList.ListItems(intY)
    '            If Val(Right(itemY.Key, Len(itemY.Key) - 4)) = intRegionID Then
    '                Exit Do
    '            End If
    '            intY = intY + 1
    '        Loop
    '        If intY > RegionList.ListItems.Count Then  ' no find - didn't fall out of loop early
                'clear region id
    '            GsysPb.Execute "Update DialUpPort set RegionID = 0 WHERE RegionID =" & intRegionID
    '            GsysPb.Execute "Update Delta set RegionID = 0 WHERE RegionID ='" & intRegionID & "'"
    '        End If
    '        rsTemp.MoveNext
    '        If intX Mod 25 = 0 Then DoEvents
    '    Next
    'End If
    'rsTemp.Close
    'Set itemY = Nothing

    
End Sub

Private Sub cmbregsave_Click()
    
    Dim itmX As ListItem
    Dim strNewKey, strOldKey, strOldText, strNewRegion As String
    
    On Error GoTo ErrTrap
    
    If bEditMode Then
        RegionList.SetFocus
        SendKeys "{ENTER}", True
        bEditMode = False
    End If
        
    strNewRegion = LoadResString(2006)
    
    Set itmX = RegionList.FindItem(strNewRegion, lvwText)
    If Not itmX Is Nothing Then
        itmX.Selected = True
        Set RegionList.SelectedItem = RegionList.ListItems(itmX.Key)
        RegionList.SetFocus
        itmX.EnsureVisible
        Exit Sub
    Else
        strNewKey = "Key:" & intMaxRegionID + 1
    'If RegionList.SelectedItem Is Nothing Then
        Set itmX = RegionList.ListItems.Add()
        With itmX
            .Text = strNewRegion
            .Key = strNewKey
            .Selected = True
        End With
        Set RegionList.SelectedItem = RegionList.ListItems(itmX.Key)
        RegionList.SetFocus
        itmX.EnsureVisible
    'Else   'jump thru hoops to make listview work right.
    '    With RegionList.SelectedItem
    '        strOldText = .Text
    '        .Text = strNewRegion
    '        strOldKey = .Key
    '        .Key = strNewKey
    '    End With
    '    Set itmX = RegionList.ListItems.Add()
    '    With itmX
    '        .Text = strOldText
    '        .Key = strOldKey
    '    End With
    'End If
 
        SaveEdit "A", intMaxRegionID + 1, ""  ' save an empty region to key on later
        intMaxRegionID = intMaxRegionID + 1
    End If
    
    Set RegionList.SelectedItem = RegionList.ListItems(itmX.Key)
    RegionList.SetFocus
    RegionList.StartLabelEdit
    ' The second StartLabelEdit causes this to work ???
    RegionList.StartLabelEdit
    
    On Error GoTo 0
    
Exit Sub

ErrTrap:
    Me.MousePointer = 0
    Exit Sub
    
End Sub


Private Sub Form_Activate()
    
    Screen.MousePointer = 11
    Me.Enabled = False
    FillRegionList
    Me.Enabled = True
    Screen.MousePointer = 0
    If RegionList.ListItems.Count = 0 Then
        RegionList.TabStop = False
    End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim ShiftDown
    ShiftDown = (Shift And vbShiftMask) > 0
    
    If KeyCode = 222 And ShiftDown Then
        Beep
        KeyCode = 0
    End If
    
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    CheckChar KeyAscii
End Sub


Private Sub Form_Load()

    On Error GoTo LoadErr
    bEditMode = False
    
    CenterForm Me, Screen
    EditList.Count = 0
    Me.Enabled = False
    LoadRegionRes
    'new
    Set dbDataRegion = OpenDatabase(gsCurrentPBPath)
    Set rsDataRegion = dbDataRegion.OpenRecordset("Select RegionDesc as Region, RegionID as ID from Region order by RegionDesc")
    
    Me.Enabled = True
    Screen.MousePointer = 0
    FirstEntry = True
    
Exit Sub
LoadErr:
    Me.Enabled = True
    Screen.MousePointer = 0
    Exit Sub
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    rsDataRegion.Close
    dbDataRegion.Close
    
End Sub

Private Sub loadReg_Click()

    Dim fileopen As String
    Dim maxindex As Integer
    Dim indexcount, intY As Integer
    Dim Count As Integer
    Dim itmX As ListItem
    Dim strTemp As String
    Dim bFlag As Boolean
    
    On Error GoTo ErrTrap
    maxindex = 200
    ReDim Region(maxindex) As String
    
    commonregion.Filter = LoadResString(2007)
    commonregion.FilterIndex = 1
    commonregion.Flags = cdlOFNHideReadOnly
    commonregion.ShowOpen
    fileopen = commonregion.FileName
    If fileopen = "" Then Exit Sub
    
    Open fileopen For Input Access Read As #1
    If EOF(1) Then
        Close #1
        Exit Sub
    End If
    Input #1, Count
    indexcount = 1
    Do While indexcount <= Count And Not EOF(1)
        Input #1, Region(indexcount)
        Region(indexcount) = Left(Trim(Region(indexcount)), 30)
        If Region(indexcount) <> "" Then
            indexcount = indexcount + 1
        End If
    Loop
    Close #1
    Count = indexcount - 1
    
    For indexcount = 1 To Count
        ' check for dups
        intY = 1
        bFlag = False
        Do While intY <= RegionList.ListItems.Count
            If LCase(RegionList.ListItems(intY)) = LCase(Region(indexcount)) Then
                bFlag = True
                Exit Do
            End If
            intY = intY + 1
        Loop
        ' add if not a dup
        If Not bFlag Then
            Set itmX = RegionList.ListItems.Add()
            With itmX
                .Text = Left(Region(indexcount), 30)
                strTemp = "Key:" & intMaxRegionID + 1
                .Key = strTemp
            End With
            SaveEdit "A", intMaxRegionID + 1, Left(Region(indexcount), 30)
            intMaxRegionID = intMaxRegionID + 1
        End If
    Next indexcount
    RegionList.Sorted = True
        
Exit Sub

ErrTrap:
    If Err.Number = 62 Or Err.Number = 3163 Then
        Exit Sub
    Else
        Exit Sub
    End If

End Sub

Private Sub RegionList_BeforeLabelEdit(Cancel As Integer)
    'Debug.Print ("BeforeLabelEdit")
    bEditMode = True
    
    'Debug.Print ("working on " & RegionList.SelectedItem.index)
    nNewOne = RegionList.SelectedItem.index
    
End Sub

' This doesn't get called if no changes are made to the default text
'
Private Sub RegionList_AfterLabelEdit(Cancel As Integer, NewString As String)

    'Debug.Print ("AfterLabelEdit")
    Dim itmX As ListItem
    
    bEditMode = False
    
    If Trim(NewString) = "" Then
        Cancel = True
        RegionList.StartLabelEdit
        Exit Sub
    End If
    ' null indicates the user canceled the edit
    If Not IsNull(NewString) Then
        NewString = Left(Trim(NewString), 30)
        
        ' check for dups
        Set itmX = RegionList.FindItem(NewString, lvwText)
        If Not itmX Is Nothing Then
            If itmX.index <> nNewOne Then
                MsgBox LoadResString(6025), vbExclamation
                Cancel = True
                RegionList.StartLabelEdit
                Exit Sub
            End If
        End If
        
        'Debug.Print (NewString)
        Set itmX = RegionList.SelectedItem
        'Debug.Print (itmX.Key)
        SaveEdit "U", Right(itmX.Key, Len(itmX.Key) - 4), NewString, itmX
        RegionList.SortKey = 0
        RegionList.Sorted = True
    End If

End Sub

Private Sub RegionList_ItemClick(ByVal Item As ComctlLib.ListItem)
    If bEditMode Then
        RegionList_AfterLabelEdit 1, RegionList.ListItems.Item(nNewOne).Text
    End If
End Sub

Private Sub RegionList_LostFocus()
    If RegionList.ListItems.Count > 0 Then
        RegionList.TabStop = True
    End If
End Sub