windows-nt/Source/XPSP1/NT/net/rras/cps/pba/source/delta.frm
2020-09-26 16:20:57 +08:00

486 lines
15 KiB
Plaintext

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 frmdelta
BorderStyle = 3 'Fixed Dialog
Caption = "vew"
ClientHeight = 5205
ClientLeft = 1830
ClientTop = 1350
ClientWidth = 7155
Icon = "delta.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 5205
ScaleWidth = 7155
ShowInTaskbar = 0 'False
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin ComctlLib.ListView lvDelta
Height = 3855
Left = 120
TabIndex = 5
Top = 720
WhatsThisHelpID = 11010
Width = 7095
_ExtentX = 12515
_ExtentY = 6800
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
_Version = 327682
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 11
BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Text = "access id"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 1
Key = ""
Object.Tag = ""
Text = "Country"
Object.Width = 3704
EndProperty
BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 2
Key = ""
Object.Tag = ""
Text = "Regionid"
Object.Width = 1499
EndProperty
BeginProperty ColumnHeader(4) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 3
Key = ""
Object.Tag = ""
Text = "popname"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(5) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 4
Key = ""
Object.Tag = ""
Text = "area code"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(6) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 5
Key = ""
Object.Tag = ""
Text = "access num"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(7) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 6
Key = ""
Object.Tag = ""
Text = "minimum speed"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(8) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 7
Key = ""
Object.Tag = ""
Text = "maximum speek"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(9) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 8
Key = ""
Object.Tag = ""
Text = "flip/reserved"
Object.Width = 1235
EndProperty
BeginProperty ColumnHeader(10) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 9
Key = ""
Object.Tag = ""
Text = "flags"
Object.Width = 1235
EndProperty
BeginProperty ColumnHeader(11) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 10
Key = ""
Object.Tag = ""
Text = "dialup entry"
Object.Width = 2381
EndProperty
End
Begin VB.ComboBox cmbSelect
Height = 315
Left = 1440
Style = 2 'Dropdown List
TabIndex = 1
Top = 195
WhatsThisHelpID = 11000
Width = 2835
End
Begin VB.CommandButton cmbCancel
Cancel = -1 'True
Caption = "close"
Height = 375
Left = 5520
TabIndex = 4
Top = 4680
WhatsThisHelpID = 10020
Width = 1695
End
Begin VB.CommandButton cmbdprint
Caption = "print"
Height = 375
Left = 1680
TabIndex = 2
Top = 4680
WhatsThisHelpID = 10050
Width = 1695
End
Begin VB.CommandButton cmbSave
Caption = "save"
Height = 375
Left = 3600
TabIndex = 3
Top = 4680
WhatsThisHelpID = 11020
Width = 1695
End
Begin MSComDlg.CommonDialog cmdialog
Left = 2040
Top = 4680
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label ListLabel
Alignment = 1 'Right Justify
Caption = "file"
Height = 255
Left = 120
TabIndex = 0
Top = 225
WhatsThisHelpID = 11000
Width = 1215
End
End
Attribute VB_Name = "frmdelta"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
Dim sqlstm As String
Dim rsversion As Recordset
Dim version As Integer
Dim deltacount As Integer
Dim intX As Integer
On Error GoTo LoadErr
CenterForm Me, Screen
LoadDeltaResources
cmbSelect.ItemData(0) = 0
Set rsversion = gsyspb.OpenRecordset("Select max(DeltaNum) as HiVersion from Delta WHERE NewVersion=0")
If IsNull(rsversion!HiVersion) Then
version = 0
Else
version = rsversion!HiVersion
End If
rsversion.Close
Set rsversion = Nothing
If version > 1 Then
If version < 6 Then
deltacount = version - 1
Else
deltacount = 5
End If
For intX = 1 To deltacount
cmbSelect.AddItem LoadResString(5206) & " " & version - 1
cmbSelect.ItemData(intX) = version
version = version - 1
Next
End If
'FillDeltaList
Screen.MousePointer = 0
Exit Sub
LoadErr:
Screen.MousePointer = 0
Exit Sub
End Sub
Function LoadDeltaResources()
On Error GoTo LoadErr
'column headers
lvDelta.ColumnHeaders(1).Text = LoadResString(6061) ' Access ID
lvDelta.ColumnHeaders(2).Text = LoadResString(6062) ' Country
lvDelta.ColumnHeaders(3).Text = LoadResString(6063) ' RegionID
lvDelta.ColumnHeaders(4).Text = LoadResString(6064) ' Pop Name
lvDelta.ColumnHeaders(5).Text = LoadResString(6065) ' Area Code
lvDelta.ColumnHeaders(6).Text = LoadResString(6066) ' Access Number
lvDelta.ColumnHeaders(7).Text = LoadResString(6067) ' Min Speed
lvDelta.ColumnHeaders(8).Text = LoadResString(6068) ' Max Speed
lvDelta.ColumnHeaders(9).Text = LoadResString(6069) ' Flip (reserved)
lvDelta.ColumnHeaders(10).Text = LoadResString(6070) ' Flags
lvDelta.ColumnHeaders(11).Text = LoadResString(6071) ' Dialup Entry
Me.Caption = LoadResString(5208) & " " & gsCurrentPB
ListLabel.Caption = LoadResString(5209)
cmbdprint.Caption = LoadResString(1008)
cmbSave.Caption = LoadResString(1014)
cmbCancel.Caption = LoadResString(1005)
cmbSelect.AddItem LoadResString(5207)
cmbSelect.Text = LoadResString(5207)
' set fonts
SetFonts Me
lvDelta.Font.Charset = gfnt.Charset
lvDelta.Font.Name = gfnt.Name
lvDelta.Font.Size = gfnt.Size
On Error GoTo 0
Exit Function
LoadErr:
Exit Function
End Function
Private Sub cmbCancel_Click()
CloseDB
Unload Me
End Sub
Private Sub CloseDB()
rsDataDelta.Close
dbDataDelta.Close
set temp = Nothing
End Sub
Private Sub cmbdprint_Click()
Dim X As Printer
Dim linecount As Integer
Dim sqlstm As String
Dim fieldnum As Integer
Dim renewmaster As Recordset
On Error GoTo ErrTrap
Screen.MousePointer = 13
cmbdprint.Enabled = False
' popup print screen, set parms and print
Load frmPrinting
frmPrinting.JobType = 1
frmPrinting.JobParm1 = cmbSelect.ListIndex
frmPrinting.Show vbModal
cmbdprint.Enabled = True
cmbdprint.SetFocus
Screen.MousePointer = 0
Exit Sub
ErrTrap:
cmbdprint.Enabled = True
Screen.MousePointer = 0
Exit Sub
End Sub
Private Sub cmbSelect_Click()
Dim AccessID As String, CountryNum As String, RegionID As String, POPName As String
Dim AreaCode As String, AccessNum As String, strStatus As String, MinSpeed As String
Dim MaxSpeed As String, Flip As String, Flags As String, DialUp As String
Dim Comments As String
Dim sqlstm As String, renewsql As String
Dim deltanum As Integer
AccessID = LoadResString(6061)
CountryNum = LoadResString(6062)
RegionID = LoadResString(6063)
POPName = LoadResString(6064)
AreaCode = LoadResString(6065)
AccessNum = LoadResString(6066)
MinSpeed = LoadResString(6067)
MaxSpeed = LoadResString(6068)
Flip = LoadResString(6069)
Flags = LoadResString(6070)
DialUp = LoadResString(6071)
strStatus = LoadResString(6072)
Comments = LoadResString(6074)
If cmbSelect.Text <> "" Then
deltanum = cmbSelect.ItemData(cmbSelect.ListIndex)
If deltanum = 0 Then
renewsql = "SELECT AccessNumberId, CountryNumber, RegionId, CityName, AreaCode, " & _
"AccessNumber, Status, MinimumSpeed, Maximumspeed, flipFactor, Flags, " & _
"ScriptID, Comments FROM DialUpPort WHERE Status = '1' order by AccessNumberId "
Set temp = gsyspb.OpenRecordset(renewsql, dbOpenSnapshot)
Else
sqlstm = "SELECT delta.* From delta WHERE delta.DeltaNum = " & deltanum & " and delta.NewVersion <> 1 order by AccessNumberId"
renewsql = "SELECT delta.AccessNumberId, delta.CountryNumber, delta.RegionId, " & _
"delta.CityName, delta.AreaCode, delta.AccessNumber, delta.MinimumSpeed, " & _
"delta.MaximumSpeed, delta.Flipfactor, delta.Flags, delta.ScriptId " & _
"FROM delta WHERE delta.DeltaNum = " & deltanum & _
" and delta.NewVersion <> 1 order by AccessNumberId"
Set temp = gsyspb.OpenRecordset(sqlstm, dbOpenSnapshot)
End If
'new
Set dbDataDelta = OpenDatabase(gsCurrentPBPath)
Set rsDataDelta = dbDataDelta.OpenRecordset(renewsql)
FillDeltaList
If rsDataDelta.RecordCount <> 0 Then
cmbdprint.Enabled = True
cmbSave.Enabled = True
Else
cmbdprint.Enabled = False
cmbSave.Enabled = False
End If
End If
End Sub
' Save_Click()
Private Sub cmbSave_Click()
Dim filesaveas As String
Dim renewset As Recordset
Dim intX As Integer
On Error GoTo ErrTrap
cmdialog.FileName = ""
cmdialog.Flags = cdlOFNHideReadOnly
cmdialog.Filter = "*.pbk | *.pbk"
cmdialog.FilterIndex = 1
cmdialog.ShowSave
filesaveas = cmdialog.FileName
If filesaveas = "" Then Exit Sub
Screen.MousePointer = 11
If CheckPath(filesaveas) = 0 Then
intX = MsgBox(LoadResString(6020) & Chr(13) & filesaveas & Chr$(13) & _
LoadResString(6021), _
vbQuestion + vbYesNo + vbDefaultButton2)
If intX = 7 Then
Screen.MousePointer = 0
Exit Sub
End If
End If
If cmbSelect.ListIndex = 0 Then
Set renewset = gsyspb.OpenRecordset("DialUpPort", dbOpenSnapshot)
masterOutfile filesaveas, renewset
renewset.Close
Else
deltaoutfile filesaveas, temp
End If
Screen.MousePointer = 0
Exit Sub
ErrTrap:
Screen.MousePointer = 0
If Err.Number = 32755 Then
Exit Sub
ElseIf Err.Number = 75 Then
MsgBox LoadResString(6022), vbInformation
Exit Sub
Else
Exit Sub
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
CheckChar KeyAscii
End Sub
Function FillDeltaList() As Integer
Dim strTemp As String
Dim intRow, intX As Integer
Dim itmX As ListItem
On Error GoTo ErrTrap
If gsCurrentPB = "" Then
lvDelta.ListItems.Clear
Exit Function
End If
Me.Enabled = False
Screen.MousePointer = 11
If rsDataDelta.BOF = False Then
rsDataDelta.MoveLast
'If rsDataDelta.RecordCount > 50 Then RefreshPBLabel "loading"
lvDelta.ListItems.Clear
lvDelta.Sorted = False
rsDataDelta.MoveFirst
Do While Not rsDataDelta.EOF
Set itmX = lvDelta.ListItems.Add()
With itmX
.Text = rsDataDelta!AccessNumberId
.SubItems(1) = rsDataDelta!CountryNumber
.SubItems(2) = rsDataDelta!RegionID
.SubItems(3) = rsDataDelta!CityName
.SubItems(4) = rsDataDelta!AreaCode
.SubItems(5) = rsDataDelta!AccessNumber
'.SubItems(5) = gStatusText(rsDataDelta!status)
.SubItems(6) = rsDataDelta!MinimumSpeed
.SubItems(7) = rsDataDelta!MaximumSpeed
.SubItems(8) = rsDataDelta!FlipFactor
.SubItems(9) = rsDataDelta!Flags
.SubItems(10) = rsDataDelta!ScriptID
'.SubItems(9) = rsDataDelta!ScriptId
'.SubItems(9) = rsDataDelta!Comments
strTemp = "Key:" & rsDataDelta!AccessNumberId
.Key = strTemp
End With
If rsDataDelta.AbsolutePosition Mod 300 = 0 Then DoEvents
rsDataDelta.MoveNext
Loop
Else
lvDelta.ListItems.Clear
End If
lvDelta.Sorted = True
Me.Enabled = True
Screen.MousePointer = 0
Exit Function
ErrTrap:
Me.Enabled = True
FillDeltaList = 1
Screen.MousePointer = 0
Exit Function
End Function