home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Small_Data2209878222011.psc / Advanced.frm < prev    next >
Text File  |  2011-08-22  |  14KB  |  418 lines
  1. VERSION 5.00
  2. Begin VB.Form Advanced 
  3.    BackColor       =   &H00EEE8E6&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   " Advanced Functions"
  6.    ClientHeight    =   4185
  7.    ClientLeft      =   45
  8.    ClientTop       =   435
  9.    ClientWidth     =   5715
  10.    BeginProperty Font 
  11.       Name            =   "Arial"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H000000C0&
  20.    Icon            =   "Advanced.frx":0000
  21.    LinkTopic       =   "Form1"
  22.    LockControls    =   -1  'True
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   4185
  26.    ScaleWidth      =   5715
  27.    Begin VB.CommandButton cmdAction 
  28.       BackColor       =   &H00EEE8E6&
  29.       Caption         =   "Merge Databases"
  30.       Height          =   300
  31.       Index           =   1
  32.       Left            =   3820
  33.       Style           =   1  'Graphical
  34.       TabIndex        =   13
  35.       Top             =   2860
  36.       Width           =   1775
  37.    End
  38.    Begin VB.PictureBox Picture1 
  39.       Appearance      =   0  'Flat
  40.       AutoSize        =   -1  'True
  41.       BackColor       =   &H80000005&
  42.       ForeColor       =   &H80000008&
  43.       Height          =   510
  44.       Left            =   180
  45.       Picture         =   "Advanced.frx":08CA
  46.       ScaleHeight     =   480
  47.       ScaleWidth      =   480
  48.       TabIndex        =   11
  49.       TabStop         =   0   'False
  50.       Top             =   3540
  51.       Width           =   510
  52.    End
  53.    Begin VB.CommandButton cmdAction 
  54.       BackColor       =   &H00EEE8E6&
  55.       Caption         =   "Manage Users"
  56.       Height          =   300
  57.       Index           =   0
  58.       Left            =   3820
  59.       Style           =   1  'Graphical
  60.       TabIndex        =   10
  61.       Top             =   180
  62.       Width           =   1775
  63.    End
  64.    Begin VB.CommandButton cmdAction 
  65.       BackColor       =   &H00EEE8E6&
  66.       Caption         =   "Find Duplicates"
  67.       Height          =   300
  68.       Index           =   3
  69.       Left            =   3820
  70.       Style           =   1  'Graphical
  71.       TabIndex        =   9
  72.       Top             =   720
  73.       Width           =   1775
  74.    End
  75.    Begin VB.CommandButton cmdAction 
  76.       BackColor       =   &H00EEE8E6&
  77.       Caption         =   "Find Incomplete"
  78.       Height          =   300
  79.       Index           =   6
  80.       Left            =   3820
  81.       Style           =   1  'Graphical
  82.       TabIndex        =   8
  83.       Top             =   1260
  84.       Width           =   1775
  85.    End
  86.    Begin VB.CommandButton cmdAction 
  87.       BackColor       =   &H00EEE8E6&
  88.       Caption         =   "Upload Settings"
  89.       Height          =   300
  90.       Index           =   8
  91.       Left            =   3820
  92.       Style           =   1  'Graphical
  93.       TabIndex        =   7
  94.       Top             =   1800
  95.       Width           =   1775
  96.    End
  97.    Begin VB.CommandButton cmdAction 
  98.       BackColor       =   &H00EEE8E6&
  99.       Caption         =   "Disaster Recovery"
  100.       Height          =   300
  101.       Index           =   2
  102.       Left            =   3820
  103.       Style           =   1  'Graphical
  104.       TabIndex        =   6
  105.       Top             =   2340
  106.       Width           =   1775
  107.    End
  108.    Begin VB.CommandButton cmdAction 
  109.       BackColor       =   &H00EEE8E6&
  110.       Caption         =   "Close"
  111.       Height          =   300
  112.       Index           =   7
  113.       Left            =   4690
  114.       Style           =   1  'Graphical
  115.       TabIndex        =   0
  116.       Top             =   3740
  117.       Width           =   900
  118.    End
  119.    Begin VB.Label Label1 
  120.       Appearance      =   0  'Flat
  121.       BackColor       =   &H00EEE8E6&
  122.       Caption         =   "Merge the current local and the remote database. Differences are transmitted from Local to Remote."
  123.       ForeColor       =   &H00000000&
  124.       Height          =   435
  125.       Index           =   1
  126.       Left            =   180
  127.       TabIndex        =   12
  128.       ToolTipText     =   " WARNING ! - This option is only intended for experts !!"
  129.       Top             =   2860
  130.       Width           =   3600
  131.    End
  132.    Begin VB.Label Label1 
  133.       Appearance      =   0  'Flat
  134.       BackColor       =   &H00EEE8E6&
  135.       Caption         =   "Create /  Load disaster recovery copy of database"
  136.       ForeColor       =   &H00000000&
  137.       Height          =   435
  138.       Index           =   2
  139.       Left            =   180
  140.       TabIndex        =   5
  141.       ToolTipText     =   " WARNING ! - This option is only intended for experts !!"
  142.       Top             =   2340
  143.       Width           =   3600
  144.    End
  145.    Begin VB.Label Label1 
  146.       BackColor       =   &H00EEE8E6&
  147.       Caption         =   "Enter / Edit settings for up- and download of database to / from website"
  148.       Height          =   435
  149.       Index           =   8
  150.       Left            =   180
  151.       TabIndex        =   4
  152.       Top             =   1800
  153.       Width           =   3600
  154.    End
  155.    Begin VB.Label Label1 
  156.       BackColor       =   &H00EEE8E6&
  157.       Caption         =   "Find records with empty fields in current database"
  158.       Height          =   435
  159.       Index           =   6
  160.       Left            =   180
  161.       TabIndex        =   3
  162.       Top             =   1260
  163.       Width           =   3600
  164.    End
  165.    Begin VB.Label Label1 
  166.       BackColor       =   &H00EEE8E6&
  167.       Caption         =   "Find duplicate records in database.  Looks for Name and Address"
  168.       Height          =   435
  169.       Index           =   3
  170.       Left            =   180
  171.       TabIndex        =   2
  172.       Top             =   720
  173.       Width           =   3600
  174.    End
  175.    Begin VB.Label Label1 
  176.       BackColor       =   &H00EEE8E6&
  177.       Caption         =   "Enter / Edit administrator name(s) and password(s)"
  178.       Height          =   435
  179.       Index           =   0
  180.       Left            =   180
  181.       TabIndex        =   1
  182.       Top             =   180
  183.       Width           =   3600
  184.    End
  185. End
  186. Attribute VB_Name = "Advanced"
  187. Attribute VB_GlobalNameSpace = False
  188. Attribute VB_Creatable = False
  189. Attribute VB_PredeclaredId = True
  190. Attribute VB_Exposed = False
  191. Option Explicit
  192.  
  193. Private Sub Find_Duplicates()
  194.  
  195. On Error GoTo errhandler
  196.  
  197. Dim N                       As Long
  198. Dim P                       As Long
  199. Dim count                   As Long
  200. Dim tmp                     As String
  201. Dim a()                     As String
  202. Dim itmX                    As Object
  203.     
  204.     ' clear lvwValidate
  205.     Validate.lvwValidate.ColumnHeaders.Clear
  206.     Validate.lvwValidate.ListItems.Clear
  207.     
  208.     ' add column headers: main.lblfield().caption
  209.     Validate.lvwValidate.ColumnHeaders.add , , "Number", 900, lvwColumnLeft
  210.     Validate.lvwValidate.ColumnHeaders.add , , "Record 1", 900, lvwColumnRight
  211.     Validate.lvwValidate.ColumnHeaders.add , , "Record 2", 900, lvwColumnRight
  212.     Validate.lvwValidate.ColumnHeaders.add , , "Name / Address", 2500, lvwColumnLeft
  213.     
  214.     ' set View property to Report.
  215.     Validate.lvwValidate.View = lvwReport
  216.         
  217.     ReDim a(1 To UBound(nr))
  218.         
  219.     ' First, Last
  220.     For N = 1 To UBound(nr)
  221.         tmp = nr(N).txtField(1) & Space$(1) & _
  222.               nr(N).txtField(2)
  223.         tmp = Replace(tmp, ".", Space$(1))                          ' remove "."
  224.         tmp = Replace(tmp, ",", Space$(1))                          ' remove ","
  225.         tmp = Replace(tmp, "&", Space$(1))                          ' remove "&"
  226.         Do While InStr(tmp, Space$(2))
  227.             tmp = Replace(tmp, Space$(2), Space$(1))                ' remove double spaces
  228.         Loop
  229.         a(N) = Trim$(tmp)
  230.     Next N
  231.        
  232.     ' find identical records
  233.     count = 0
  234.     For N = 1 To UBound(nr)
  235.         For P = N + 1 To UBound(nr) - 1
  236.             If Len(a(N)) > 0 And a(N) = a(P) Then
  237.                 count = count + 1
  238.                 Set itmX = Validate.lvwValidate.ListItems.add()
  239.                 itmX.Text = Format$(count, "0000")
  240.                 itmX.SubItems(1) = N
  241.                 itmX.SubItems(2) = P
  242.                 itmX.SubItems(3) = a(P)
  243.             End If
  244.         Next P
  245.     Next N
  246.         
  247.     ReDim a(1 To UBound(nr))
  248.         
  249.     ' compare: First, Last, Street, Number, Floor
  250.     For N = 1 To UBound(nr)
  251.         tmp = nr(N).txtField(1) & Space$(1) & _
  252.               nr(N).txtField(2) & Space$(1) & _
  253.               nr(N).txtField(4) & Space$(1) & _
  254.               nr(N).txtField(5) & Space$(1) & _
  255.               nr(N).txtField(6)
  256.         tmp = Replace(tmp, ".", Space$(1))                          ' remove "."
  257.         tmp = Replace(tmp, ",", Space$(1))                          ' remove ","
  258.         tmp = Replace(tmp, "&", Space$(1))                          ' remove "&"
  259.         Do While InStr(tmp, Space$(2))
  260.             tmp = Replace(tmp, Space$(2), Space$(1))                ' remove double spaces
  261.         Loop
  262.         a(N) = Trim$(tmp)
  263.     Next N
  264.     
  265.     ' find identical records
  266.     For N = 1 To UBound(nr)
  267.         For P = N + 1 To UBound(nr) - 1
  268.             If Len(a(N)) > 0 And a(N) = a(P) Then
  269.                 count = count + 1
  270.                 Set itmX = Validate.lvwValidate.ListItems.add()
  271.                 itmX.Text = Format$(count, "0000")
  272.                 itmX.SubItems(1) = N
  273.                 itmX.SubItems(2) = P
  274.                 itmX.SubItems(3) = a(P)
  275.             End If
  276.         Next P
  277.     Next N
  278.         
  279.     Validate.Show 1
  280.         
  281. errhandler:
  282.     Exit Sub
  283. End Sub
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294. Public Sub cmdAction_Click(Index As Integer)
  295.  
  296. On Error GoTo errhandler
  297.     
  298. Dim msg                     As String
  299. Dim Response                As Long
  300.  
  301.     Select Case Index
  302.     
  303. 'MANAGE USERS
  304.         Case 0
  305.             Me.Visible = False
  306.             Main.StatusBar1.Panels.Item(3).Text = " Edit database administrator information..."
  307.             MasterUsers.Show 1
  308.             Me.Visible = True
  309.             
  310. 'MERGE DATABASES
  311.         Case 1
  312.             DBCompare = UpdateRemoteRecords(MAIN_DIR_G & "Database.zlb", uploaddb.RemoteFileName)
  313.             If DBCompare.RecordsIdentical Then
  314.                 msg = "The two databases are identical     "
  315.             Else
  316.                 msg = "The local and the remote copy of the database were different.     " & vbCrLf & vbCrLf & _
  317.                       "A total of " & DBCompare.NumUpdatedRecords & " records in the local copy were included " & vbCrLf & _
  318.                       "in the website copy of the database."
  319.             End If
  320.             Response = MsgBox(msg, vbInformation + vbOKOnly, " DATABASE UPDATE")
  321.                 
  322. 'CREATE RECOVERY COPY
  323.         Case 2
  324.             Me.Visible = False
  325.             Main.StatusBar1.Panels.Item(3).Text = " Create Disaster Recovery copy of database..."
  326.             DisasterRecovery.Show 1
  327.             Me.Visible = True
  328.             
  329. 'FIND DUPLICATE RECORDS
  330.         Case 3
  331.             Me.Visible = False
  332.             Main.StatusBar1.Panels.Item(3).Text = " Search for duplicates in current Record set..."
  333.             Call Find_Duplicates
  334.             Advanced.Visible = False
  335.             AppConfig.Visible = False
  336.             Me.Visible = True
  337.             
  338. 'INCOMPLETE RECORDS
  339.         Case 6
  340.             Main.Visible = False
  341.             Me.Visible = False
  342.             Main.StatusBar1.Panels.Item(3).Text = " Find incomplete records in database..."
  343.             FromIncomplete_G = True
  344.             Incomplete.Show
  345.             
  346. 'UPLOAD SETTINGS
  347.         Case 8
  348.             Me.Visible = False
  349.             Main.StatusBar1.Panels.Item(3).Text = " Enter settings for up- and download..."
  350.             UploadInfo.Show 1
  351.             Main.FileItem(12).Visible = True
  352.             Main.FileItem(13).Visible = True
  353.             Me.Visible = True
  354.             
  355. 'UNLOAD FORM
  356.         Case 7
  357.             FromIncomplete_G = False
  358.             Unload Me
  359.             
  360.     End Select
  361.     
  362. errhandler:
  363.     Exit Sub
  364. End Sub
  365.  
  366.  
  367. Private Sub Form_Load()
  368.  
  369.     Call form_StayOnTop(Advanced, True, "C")
  370.             
  371.     If WebServerConnectionOK_G Then
  372.         Me.Height = 4560
  373.         Me.Picture1.Top = 3540
  374.         Me.cmdAction(7).Top = 3740
  375.         cmdAction(1).Visible = True
  376.         Label1(1).Visible = True
  377.         cmdAction(2).Visible = True
  378.         Label1(2).Visible = True
  379.         cmdAction(8).Visible = True
  380.         Label1(8).Visible = True
  381.     Else
  382.         Me.Height = 4560 - 1620
  383.         Me.Picture1.Top = 3540 - 1620
  384.         Me.cmdAction(7).Top = 3740 - 1620
  385.         cmdAction(1).Visible = False
  386.         Label1(1).Visible = False
  387.         cmdAction(2).Visible = False
  388.         Label1(2).Visible = False
  389.         cmdAction(8).Visible = False
  390.         Label1(8).Visible = False
  391.     End If
  392.     
  393. End Sub
  394. Private Sub Form_Unload(Cancel As Integer)
  395.     
  396. On Error GoTo errhandler
  397.  
  398. Dim N                       As Long
  399.  
  400.     ' scan forms collection and close all loaded forms - except Main - which is in the process of closing anyway
  401.     For N = Forms.count - 1 To 0 Step -1
  402.         If Forms(N).Name <> "Main" Then
  403.             Unload Forms(N)
  404.             WaitABit 0.2
  405.         End If
  406.     Next N
  407.     
  408. errhandler:
  409.     Exit Sub
  410. End Sub
  411.  
  412.  
  413. Public Sub Label1_Click(Index As Integer)
  414.  
  415. End Sub
  416.  
  417.  
  418.