Liren Large Software Subsidy 10/10.iso/l/l405/4.ddi/CPYSTRU.FR_/CPYSTRU.bin

Visual Basic Form | 1993-04-28 | 5.4 KB | 187 lines

VERSION 2.00
Begin Form fCpyStru
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Copy Table(s)"
   ClientHeight    =   3300
   ClientLeft      =   2730
   ClientTop       =   2235
   ClientWidth     =   6525
   ControlBox      =   0   'False
   Height          =   3705
   Left            =   2670
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3278.104
   ScaleMode       =   0  'User
   ScaleWidth      =   6554.436
   Top             =   1890
   Width           =   6645
   Begin CheckBox cCopyData
      BackColor       =   &H00C0C0C0&
      Caption         =   "Copy Data"
      Height          =   255
      Left            =   3675
      TabIndex        =   9
      Top             =   2310
      Value           =   1  'Checked
      Width           =   1380
   End
   Begin TextBox cDataBase
      BackColor       =   &H00FFFFFF&
      Height          =   285
      Left            =   3045
      TabIndex        =   1
      Tag             =   "OL"
      Top             =   420
      Width           =   3375
   End
   Begin CommandButton CloseButton
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   375
      Left            =   4830
      TabIndex        =   4
      Top             =   2730
      Width           =   1515
   End
   Begin CommandButton OkayButton
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   3045
      TabIndex        =   3
      Top             =   2730
      Width           =   1485
   End
   Begin TextBox cConnect
      BackColor       =   &H00FFFFFF&
      Height          =   540
      Left            =   3045
      MultiLine       =   -1  'True
      TabIndex        =   0
      Tag             =   "OL"
      Top             =   1155
      Width           =   3375
   End
   Begin CheckBox cCopyIndexes
      BackColor       =   &H00C0C0C0&
      Caption         =   "Copy Indexes"
      Height          =   255
      Left            =   3675
      TabIndex        =   2
      Top             =   1890
      Value           =   1  'Checked
      Width           =   1605
   End
   Begin ListBox cTableList
      BackColor       =   &H00FFFFFF&
      Height          =   2760
      Left            =   105
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   5
      Tag             =   "OL"
      Top             =   420
      Width           =   2775
   End
   Begin Label ServerLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Target Connect String:"
      Height          =   255
      Left            =   3045
      TabIndex        =   8
      Top             =   840
      Width           =   2115
   End
   Begin Label DataBaseLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Target Database:"
      Height          =   225
      Left            =   3045
      TabIndex        =   7
      Top             =   105
      Width           =   1725
   End
   Begin Label TableListLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Tables:"
      Height          =   225
      Index           =   0
      Left            =   105
      TabIndex        =   6
      Top             =   105
      Width           =   2295
   End
Option Explicit
Sub CloseButton_Click ()
  RefreshTables fTables.cTableList, True  'just in case some were added
  Unload Me
End Sub
Sub Form_Load ()
  Dim i As Integer
  RefreshTables cTableList, False
  cDataBase = gstDBName
  cConnect = gCurrentDB.Connect
  Left = (Screen.Width - Width) / 2
  Top = (Screen.Height - Height) / 2
End Sub
Sub Form_Paint ()
  Outlines Me
End Sub
Sub OkayButton_Click ()
  Dim i As Integer
  Dim diff_db As Integer
  Dim to_nm As String
  Dim to_db As database
  Dim Connect As String
  On Error GoTo OkayErr
  MsgBar "Copying Table(s)", True
  SetHourglass Me
  If cDataBase = "" Or cDataBase = gstDBName Then
    Set to_db = gCurrentDB
    diff_db = False
  Else
    Set to_db = OpenDatabase(cDataBase, False, False, cConnect + ";LoginTimeout=" & glLoginTimeout)
    to_db.QueryTimeout = glQueryTimeout
    diff_db = True
  End If
  For i = 0 To cTableList.ListCount - 1
    If cTableList.Selected(i) Then
      If diff_db = False Then
        to_nm = InputBox("Enter New Table Name:")
        If to_nm = "" Then GoTo skipit
      Else
        to_nm = (cTableList.List(i))
      End If
    Else
      GoTo skipit
    End If
    SetHourglass Me
    If CopyStruct(gCurrentDB, to_db, (cTableList.List(i)), to_nm, (cCopyIndexes)) = True Then
      If cCopyData = 1 Then
        If CopyData(gCurrentDB, to_db, (cTableList.List(i)), to_nm) = False Then
          Beep
          MsgBox "Copy of Data To " + (cTableList.List(i)) + " was UnSuccessful!"
        End If
      End If
      ResetMouse Me
      MsgBox "Copy of " + (cTableList.List(i)) + " Structure was Successful!"
      cTableList.Selected(i) = False
    Else
      ResetMouse Me
      Beep
      MsgBox "Copy of " + (cTableList.List(i)) + " UnSuccessful!"
    End If
skipit:
  Next
  GoTo OkayEnd
OkayErr:
  ShowError
  Resume OkayEnd
OkayEnd:
  On Error Resume Next
  MsgBar "", False
End Sub