Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

240 lines
6.3 KiB

'//+----------------------------------------------------------------------------
'//
'// File: copypb.frm
'//
'// Module: pbadmin.exe
'//
'// Synopsis: The dialog to copy a phonebook
'//
'// Copyright (c) 1997-1999 Microsoft Corporation
'//
'// Author: quintinb Created Header 09/02/99
'//
'//+----------------------------------------------------------------------------
VERSION 5.00
Begin VB.Form frmCopyPB
BorderStyle = 3 'Fixed Dialog
ClientHeight = 2895
ClientLeft = 3675
ClientTop = 1620
ClientWidth = 3285
Icon = "copyPB.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 2895
ScaleWidth = 3285
ShowInTaskbar = 0 'False
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin VB.TextBox NewPBText
Height = 315
Left = 405
MaxLength = 8
TabIndex = 1
Top = 1995
WhatsThisHelpID = 13020
Width = 2250
End
Begin VB.CommandButton cmbCancel
Cancel = -1 'True
Caption = "cancel"
Height = 375
Left = 1635
TabIndex = 3
Top = 2415
WhatsThisHelpID = 10040
Width = 1005
End
Begin VB.CommandButton cmbOK
Caption = "ok"
Default = -1 'True
Enabled = 0 'False
Height = 375
Left = 420
TabIndex = 2
Top = 2415
WhatsThisHelpID = 10030
Width = 1065
End
Begin VB.Label OriginalPBLabel
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 285
Left = 390
TabIndex = 6
Top = 1440
WhatsThisHelpID = 13010
Width = 2250
End
Begin VB.Label OrigLabel
BackStyle = 0 'Transparent
Caption = "orig"
Height = 240
Left = 405
TabIndex = 5
Top = 1215
WhatsThisHelpID = 13010
Width = 2385
End
Begin VB.Label NewLabel
BackStyle = 0 'Transparent
Caption = "new"
Height = 240
Left = 420
TabIndex = 0
Top = 1755
WhatsThisHelpID = 13020
Width = 2340
End
Begin VB.Label DescLabel
BackStyle = 0 'Transparent
Caption = "enter a new ..."
Height = 930
Left = 90
TabIndex = 4
Top = 105
Width = 2955
End
End
Attribute VB_Name = "frmCopyPB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strPB As String
Function LoadCopyRes()
On Error GoTo LoadErr
Me.Caption = LoadResString(4070)
DescLabel.Caption = LoadResString(4068)
OrigLabel.Caption = LoadResString(4071)
NewLabel.Caption = LoadResString(4069)
cmbOK.Caption = LoadResString(1002)
cmbCancel.Caption = LoadResString(1003)
' set fonts
SetFonts Me
On Error GoTo 0
Exit Function
LoadErr:
Exit Function
End Function
Private Sub cmbCancel_Click()
Me.Hide
End Sub
Private Sub cmbOK_Click()
' mainly make sure that they've entered
' a unique pb name and then just do it.
Dim strNewPB, strOrigPB As String
Dim varRegKeys As Variant
Dim intX As Integer
Dim rsNewPB As Recordset
Dim dblFreeSpace As Double
On Error GoTo ErrTrap
Screen.MousePointer = 11
dblFreeSpace = GetDriveSpace(locPath, filelen(gsCurrentPBPath) + 10000)
If dblFreeSpace = -2 Then
Screen.MousePointer = 0
Exit Sub
End If
strNewPB = Trim(NewPBText.Text)
strOrigPB = Trim(OriginalPBLabel.Caption)
If TestNewPBName(strNewPB) = 0 Then
'ok
Me.Enabled = False
DBEngine.Idle
GsysPb.Close
Set GsysPb = Nothing
MakeFullINF strNewPB
MakeLogFile strNewPB
FileCopy locPath & strOrigPB & ".mdb", locPath & strNewPB & ".mdb"
OSWritePrivateProfileString "Phonebooks", strNewPB, strNewPB & ".mdb", locPath & gsRegAppTitle & ".ini"
OSWritePrivateProfileString vbNullString, vbNullString, vbNullString, locPath & gsRegAppTitle & ".ini"
'edit the mdb - options
frmMain.SetCurrentPB strNewPB
Set rsNewPB = GsysPb.OpenRecordset("Configuration")
DBEngine.Idle
rsNewPB.MoveLast
rsNewPB.Edit
rsNewPB!ServiceName = strNewPB
rsNewPB.Update
GsysPb.Execute "UPDATE Delta set DeltaNum = 1 where DeltaNum <> 1", dbFailOnError
GsysPb.Execute "UPDATE Delta set NewVersion = 0", dbFailOnError
GsysPb.Execute "DELETE * from PhoneBookVersions", dbFailOnError
DBEngine.Idle
rsNewPB.Close
Set rsNewPB = Nothing
strPB = strNewPB
Me.Enabled = True
Me.Hide
Else
NewPBText.SetFocus
NewPBText.SelStart = 0
NewPBText.SelLength = Len(NewPBText.Text)
End If
Screen.MousePointer = 0
Exit Sub
ErrTrap:
Screen.MousePointer = 0
Me.Enabled = True
Exit Sub
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
CheckChar KeyAscii
End Sub
Private Sub Form_Load()
strPB = ""
OriginalPBLabel.Caption = " " & gsCurrentPB
CenterForm Me, Screen
LoadCopyRes
End Sub
Private Sub NewPBText_Change()
If Trim$(NewPBText.Text) <> "" Then
cmbOK.Enabled = True
Else
cmbOK.Enabled = False
End If
End Sub
Private Sub NewPBText_KeyPress(KeyAscii As Integer)
KeyAscii = FilterPBKey(KeyAscii, NewPBText)
End Sub