'//+---------------------------------------------------------------------------- '// '// File: cab.frm '// '// Module: pbadmin.exe '// '// Synopsis: The options dialog in PBA '// '// 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" Begin VB.Form frmCab BorderStyle = 3 'Fixed Dialog Caption = "options" ClientHeight = 2595 ClientLeft = 2775 ClientTop = 1545 ClientWidth = 5955 Icon = "cab.frx":0000 KeyPreview = -1 'True LinkTopic = "Form1" LockControls = -1 'True MaxButton = 0 'False MinButton = 0 'False PaletteMode = 1 'UseZOrder ScaleHeight = 2595 ScaleWidth = 5955 ShowInTaskbar = 0 'False WhatsThisButton = -1 'True WhatsThisHelp = -1 'True Begin VB.CommandButton Command1 Cancel = -1 'True Caption = "cancel" Height = 375 Left = 4425 TabIndex = 7 Top = 2070 WhatsThisHelpID = 10040 Width = 1335 End Begin VB.CommandButton cmbcab Caption = "ok" Default = -1 'True Height = 375 Left = 4410 TabIndex = 6 Top = 1530 WhatsThisHelpID = 10030 Width = 1335 End Begin VB.TextBox txtUrl Height = 285 Left = 225 MaxLength = 100 TabIndex = 1 Top = 495 WhatsThisHelpID = 70000 Width = 5520 End Begin VB.TextBox UIDText Height = 315 Left = 210 MaxLength = 64 TabIndex = 3 Top = 1350 WhatsThisHelpID = 70010 Width = 2730 End Begin VB.TextBox PWDText Height = 330 IMEMode = 3 'DISABLE Left = 225 MaxLength = 64 PasswordChar = "*" TabIndex = 5 Top = 2085 WhatsThisHelpID = 70020 Width = 2715 End Begin MSComDlg.CommonDialog CommonDialog1 Left = 2940 Top = -30 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.Label ServerLabel BackStyle = 0 'Transparent Caption = "server" Height = 255 Left = 210 TabIndex = 0 Top = 240 WhatsThisHelpID = 70000 Width = 5520 End Begin VB.Label UIDLabel BackStyle = 0 'Transparent Caption = "uid" Height = 255 Left = 225 TabIndex = 2 Top = 1125 WhatsThisHelpID = 70010 Width = 2790 End Begin VB.Label pwdLabel BackStyle = 0 'Transparent Caption = "pwd" Height = 270 Left = 225 TabIndex = 4 Top = 1815 WhatsThisHelpID = 70020 Width = 2670 End End Attribute VB_Name = "frmcab" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim configuration As Recordset Function LoadOptionsRes() Dim cRef As Integer On Error GoTo LoadErr cRef = 5200 Me.Caption = LoadResString(cRef + 25) & " " & gsCurrentPB ServerLabel.Caption = LoadResString(cRef + 21) UIDLabel.Caption = LoadResString(cRef + 22) pwdLabel.Caption = LoadResString(cRef + 23) cmbcab.Caption = LoadResString(1002) Command1.Caption = LoadResString(1003) ' set fonts SetFonts Me On Error GoTo 0 Exit Function LoadErr: Exit Function End Function Function TrimURL(URL As String) As String URL = Trim(URL) TrimURL = URL If LCase(Left(URL, 4)) = "ftp:" Then TrimURL = Right(URL, Len(URL) - 4) End If If LCase(Left(URL, 5)) = "http:" Then TrimURL = Right(URL, Len(URL) - 5) End If Do While Left(TrimURL, 1) = "/" TrimURL = Right(TrimURL, Len(TrimURL) - 1) Loop Do While Left(TrimURL, 1) = "\" TrimURL = Right(TrimURL, Len(TrimURL) - 1) Loop End Function Private Sub cmbcab_Click() Dim rt As Integer Screen.MousePointer = 11 rt = SetOptions(txtUrl.Text, UIDText.Text, PWDText.Text) If rt = 1 Then UIDText.SetFocus ElseIf rt = 2 Then PWDText.SetFocus End If Screen.MousePointer = 0 Unload Me Exit Sub ErrTrap: Screen.MousePointer = 0 MsgBox LoadResString(6056) & Chr(13) & Chr(13) & Err.Description, vbExclamation Exit Sub Exit Sub End Sub Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Activate() txtUrl.SetFocus End Sub Private Sub Form_KeyPress(KeyAscii As Integer) CheckChar KeyAscii End Sub Private Sub Form_Load() Dim RS, configuration As Recordset Dim i As Integer Dim myPos As Integer On Error GoTo LoadErr If gsCurrentPB = "" Then Exit Sub End If CenterForm Me, Screen 'SSTab1.Tab = 0 LoadOptionsRes Set configuration = gsyspb.OpenRecordset("Configuration", dbOpenSnapshot) If configuration.RecordCount <> 0 Then If Not IsNull(configuration!URL) Then txtUrl.Text = configuration!URL End If If Not IsNull(configuration!ServerPWD) Then PWDText.Text = configuration!ServerPWD End If If Not IsNull(configuration!ServerUID) Then UIDText.Text = configuration!ServerUID End If End If configuration.Close Set configuration = Nothing Screen.MousePointer = 0 Exit Sub LoadErr: Screen.MousePointer = 0 MsgBox LoadResString(6056) & Chr(13) & Chr(13) & Err.Description, vbExclamation End Sub Private Sub LoadList(list As Control, sTableName As String, sName As String, sID As String) Dim RS As Recordset list.Clear Set Gsyspbpost = DBEngine.Workspaces(0).OpenDatabase(locPath + "pbserver.mdb") Set RS = Gsyspbpost.OpenRecordset("SELECT " & sName & "," & sID & " FROM " & sTableName) While Not RS.EOF list.AddItem RS(sName) list.ItemData(list.NewIndex) = RS(sID) RS.MoveNext Wend RS.Close Gsyspbpost.Close End Sub Sub selectListItem(list As Control, ByVal ID As Long) Dim i As Integer For i = 0 To list.ListCount - 1 If list.ItemData(i) = ID Then list.Selected(i) = True End If Next i End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = vbFormControlMenu Then Cancel = False Command1_Click End If End Sub Private Sub Form_Unload(Cancel As Integer) Set configuration = Nothing End Sub Private Sub PWDText_GotFocus() SelectText PWDText End Sub Private Sub txtUrl_GotFocus() SelectText txtUrl End Sub Private Sub txtUrl_KeyPress(KeyAscii As Integer) Select Case KeyAscii Case 32 'space KeyAscii = 0 Beep 'MsgBox LoadResString(6018), vbInformation End Select End Sub Private Sub UIDText_GotFocus() SelectText UIDText End Sub Private Sub UIDText_KeyPress(KeyAscii As Integer) Select Case KeyAscii '0-9 a-z A-Z Bkspc ctrl-C ctrl-V 'Case 48 To 57, 97 To 122, 65 To 90, 8, 3, 22 ' do nothing ' upper case 'Case 48 To 57 ' KeyAscii = KeyAscii + 32 ' shift to lower case 'Case Else ' KeyAscii = 0 ' Beep ' MsgBox LoadResString(6018), vbInformation Case 32 'space KeyAscii = 0 Beep Case Else 'do nothing End Select End Sub