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

Visual Basic Form | 1992-10-21 | 5.7 KB | 202 lines

VERSION 2.00
Begin Form fCpyStru
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Copy Table Structure(s)"
   Height          =   3570
   Left            =   1710
   LinkTopic       =   "Form1"
   ScaleHeight     =   3144
   ScaleMode       =   0  'User
   ScaleWidth      =   6012
   Top             =   2010
   Width           =   6105
   Begin TextBox cDataBase
      Height          =   288
      Left            =   4080
      TabIndex        =   1
      Top             =   720
      Width           =   1812
   End
   Begin CommandButton CloseButton
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   372
      Left            =   3000
      TabIndex        =   6
      Top             =   2640
      Width           =   2772
   End
   Begin CommandButton OkayButton
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   372
      Left            =   3000
      TabIndex        =   5
      Top             =   2160
      Width           =   2772
   End
   Begin TextBox cPassword
      Height          =   288
      Left            =   4080
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   1440
      Width           =   1812
   End
   Begin TextBox cUserName
      Height          =   288
      Left            =   4080
      TabIndex        =   2
      Top             =   1080
      Width           =   1812
   End
   Begin TextBox cDBName
      Height          =   288
      Left            =   4080
      TabIndex        =   0
      Top             =   360
      Width           =   1812
   End
   Begin CheckBox cCopyIndexes
      BackColor       =   &H00C0C0C0&
      Caption         =   "Copy Indexes"
      Height          =   252
      Left            =   3000
      TabIndex        =   4
      Top             =   1800
      Value           =   1  'Checked
      Width           =   1812
   End
   Begin ListBox cTableList
      Height          =   2565
      Left            =   120
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   7
      Top             =   360
      Width           =   2775
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Target Location:"
      Height          =   252
      Left            =   3120
      TabIndex        =   13
      Top             =   120
      Width           =   1812
   End
   Begin Label ServerLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Server:"
      Height          =   252
      Left            =   3000
      TabIndex        =   12
      Top             =   360
      Width           =   1092
   End
   Begin Label DataBaseLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "DataBase:"
      Height          =   252
      Left            =   3000
      TabIndex        =   11
      Top             =   720
      Width           =   1092
   End
   Begin Label PasswordLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Password:"
      Height          =   252
      Left            =   3000
      TabIndex        =   10
      Top             =   1440
      Width           =   1212
   End
   Begin Label UserNameLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "User Name:"
      Height          =   252
      Left            =   3000
      TabIndex        =   9
      Top             =   1080
      Width           =   1212
   End
   Begin Label TableListLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Tables:"
      Height          =   252
      Index           =   0
      Left            =   240
      TabIndex        =   8
      Top             =   120
      Width           =   2292
   End
Option Explicit
Sub CloseButton_Click ()
  Unload Me
  RefreshTables cTableList   'just in case some were added
End Sub
Sub Form_Load ()
  Dim i As Integer
  RefreshTables cTableList
  cDBName = gstDBName
  cDataBase = gstDataBase
  cUserName = gstUserName
  cPassword = gstPassword
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 Structure(s)", False
  If cDBName = "" Or (cDBName = gstDBName And cDataBase = gstDataBase) Then
    Set to_db = gCurrentDB
    diff_db = False
  Else
    connect = "UID=" + cUserName + ";PWD=" + cPassword
    If cDataBase <> "" Then
      connect = connect + ";DATABASE=" + cDataBase
    End If
    Set to_db = OpenDatabase(cDBName, False, False, connect)
    to_db.QueryTimeout = VDMDI.cQueryTimeout
    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
      ResetMouse Me
      MsgBox "Copy of " + cTableList.List(i) + " Successful!"
      If diff_db = False Then
        cTableList.AddItem to_nm
      End If
    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
  to_db.Close
  MsgBar "", False
End Sub