PC World Komputer 1996 February/PCWK0296.iso/po7_win/object10/vbsql.frm

Visual Basic Form | 1994-11-07 | 28.2 KB | 864 lines

VERSION 2.00
Begin Form frmVBSQL
   BorderStyle     =   3  'Fixed Double
   Caption         =   "VB*SQL"
   ClientHeight    =   5835
   ClientLeft      =   660
   ClientTop       =   1815
   ClientWidth     =   10800
   Height          =   6525
   Icon            =   VBSQL.FRX:0000
   Left            =   600
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5835
   ScaleWidth      =   10800
   Top             =   1185
   Width           =   10920
   Begin OraData OraData1
      AllowMoveLast   =   -1  'True
      AutoBinding     =   -1  'True
      Caption         =   " Previous Record - Next Record"
      Connect         =   ""
      DatabaseName    =   ""
      Height          =   495
      HiddenName      =   "OraData1"
      Left            =   5400
      Options         =   0
      ReadOnly        =   0   'False
      RecordSource    =   ""
      TabIndex        =   6
      Top             =   5280
      TrailingBlanks  =   0   'False
      Width           =   3975
   End
   Begin CommonDialog CMRun
      Left            =   4920
      Top             =   0
   End
   Begin CommonDialog CMFilePrint
      Left            =   2160
      Top             =   0
   End
   Begin CommandButton cmdExit
      Caption         =   "Exit"
      Height          =   495
      Left            =   9480
      TabIndex        =   7
      Top             =   5280
      Width           =   1215
   End
   Begin CommandButton cmdAdd
      Caption         =   "Add"
      Height          =   495
      Left            =   4080
      TabIndex        =   5
      Top             =   5280
      Width           =   1215
   End
   Begin CommandButton cmdDelete
      Caption         =   "Delete"
      Height          =   495
      Left            =   2760
      TabIndex        =   4
      Top             =   5280
      Width           =   1215
   End
   Begin TgDemo OutTable
      AllowArrows     =   -1  'True
      AllowTabs       =   -1  'True
      DataSource      =   "OraData1"
      Editable        =   -1  'True
      EditDropDown    =   -1  'True
      ExposeCellMode  =   0  'Expose upon selection
      FetchMode       =   0  'By cell
      HeadingHeight   =   1
      Height          =   2895
      HorzLines       =   0  'None
      Layout          =   VBSQL.FRX:0302
      LayoutIndex     =   1
      Left            =   120
      LinesPerRow     =   1
      MarqueeUnique   =   -1  'True
      SplitPropsGlobal=   -1  'True
      SplitTabMode    =   0  'Don't tab across splits
      TabCapture      =   0   'False
      TabIndex        =   1
      Top             =   2280
      UseBookmarks    =   -1  'True
      Width           =   10575
      WrapCellPointer =   0   'False
   End
   Begin CommonDialog CMSaveAs
      Left            =   3960
      Top             =   0
   End
   Begin CommonDialog CMOpen
      Left            =   4440
      Top             =   0
   End
   Begin CommonDialog CMFont
      Left            =   2640
      Top             =   0
   End
   Begin TextBox txtConnection
      Height          =   285
      Left            =   8160
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   120
      Width           =   2535
   End
   Begin CommandButton cmdClear
      Caption         =   "Clear"
      Height          =   495
      Left            =   1440
      TabIndex        =   3
      Top             =   5280
      Width           =   1215
   End
   Begin CommandButton cmdExecute
      Caption         =   "Execute"
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   5280
      Width           =   1215
   End
   Begin TextBox txtSQL
      Height          =   1455
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Text            =   "select * from emp;"
      Top             =   480
      Width           =   10575
   End
   Begin Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Connection:"
      Height          =   195
      Left            =   7080
      TabIndex        =   8
      Top             =   120
      Width           =   1035
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Dynaset:"
      Height          =   195
      Left            =   120
      TabIndex        =   10
      Top             =   2040
      Width           =   765
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      Caption         =   "SQL Statement:"
      Height          =   195
      Left            =   120
      TabIndex        =   9
      Top             =   240
      Width           =   1350
   End
   Begin Menu mFile
      Caption         =   "&File"
      Begin Menu mFilePrint
         Caption         =   "&Print"
      End
      Begin Menu mFilePrintSetup
         Caption         =   "P&rint Setup"
      End
      Begin Menu mFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mSQL
      Caption         =   "S&QL"
      Begin Menu mSQLOpen
         Caption         =   "&Open"
      End
      Begin Menu mSQLRun
         Caption         =   "&Run"
      End
      Begin Menu mSQLSaveAs
         Caption         =   "Save &As"
      End
   End
   Begin Menu mSession
      Caption         =   "&Session"
      Begin Menu mSessionBeginTrans
         Caption         =   "&Begin Transaction"
      End
      Begin Menu mSessionCommit
         Caption         =   "&Commit"
      End
      Begin Menu mSessionRollback
         Caption         =   "&Rollback"
      End
   End
   Begin Menu mDynaset
      Caption         =   "&Dynaset"
      Begin Menu mDynasetFont
         Caption         =   "&Font"
      End
      Begin Menu mDynasetGraph
         Caption         =   "&Graph"
      End
      Begin Menu mDynasetHeadings
         Caption         =   "&Headings"
      End
      Begin Menu mDynasetReadOnly
         Caption         =   "&ReadOnly"
      End
      Begin Menu mRSetSaveAs
         Caption         =   "Save &As"
         Begin Menu mDSetCommaDel
            Caption         =   "&Comma Delimited"
         End
         Begin Menu mDynasetSQLScript
            Caption         =   "&SQL Script"
         End
         Begin Menu mDSetTabDel
            Caption         =   "&Tab Delimited"
         End
      End
   End
   Begin Menu mHelp
      Caption         =   "&Help"
      Begin Menu mHelpContents
         Caption         =   "&Contents"
      End
      Begin Menu mHelpAbout
         Caption         =   "&About VB*SQL..."
      End
   End
Option Explicit
Sub cmdAdd_Click ()
 'Add a new record iff editable=true
 If OutTable.Editable = True Then
  OraData1.Recordset.DbAddNew
 Else
  Call RaiseError("Error", "The Dynaset is currently marked READONLY")
 End If
End Sub
Sub cmdClear_Click ()
 txtSQL = ""
 OraData1.RecordSource = "select * from dual where 1=0"
 OraData1.Refresh
 mDynaset.Enabled = False
 cmdDelete.Enabled = False
 cmdAdd.Enabled = False
End Sub
Sub cmdDelete_Click ()
 'Delete's the current record iff editable=true
 If OutTable.Editable = True Then
  'Is there any data? Currently only RecordCount can tell
  'you that but it will retrieve all of the records first.
  If OraData1.Recordset.BOF = True And OraData1.Recordset.EOF = True Then
   Call RaiseError("Error", "No row(s) to delete.")
  Else
   OraData1.Recordset.DbDelete
  End If
 Else
  Call RaiseError("Error", "The Dynaset is currently marked READONLY")
 End If
End Sub
Sub cmdExecute_click ()
 ExecuteSQLStatement (txtSQL)
 txtSQL.SetFocus
End Sub
Sub cmdExit_Click ()
 'Simply call FILE->Exit
 Call mFileExit_click
End Sub
'Attempt to execute a SQL statement or VB*SQL Command.
'SELECT will return a dynaset
'DESC will describe an object(slightly different than SQL*Plus).
Sub ExecuteSQLStatement (stext As String)
Dim SQLStatement$, DescSQL$, ObjectName$, Owner$, ObjectType$
Dim IsTerm%, Verb%
Dim DDesc As Object
Dim en%
Dim et$
 ObjectName$ = ""
 Owner$ = UCase$(Trim$(UserName$))     'Default Owner
 'Strip spaces
 SQLStatement$ = stext
 Call ConvertCRLFtoSpace(SQLStatement$)
 SQLStatement$ = Trim$(SQLStatement)
 If SQLStatement$ = "" Then
  Call RaiseError("Error", "No SQL statement was specified.")
 Else
 'This might take a while
 Screen.MousePointer = HOURGLASS
 On Error GoTo OraError
  'Strip semicolon or slash(side effect)
  IsTerm% = IsTerminated(SQLStatement$)
  'Determine the SQL verb, object and owner
  Verb% = SQLvoo(SQLStatement$, ObjectName$, Owner$)
 Select Case Verb%
   Case SQL_VERB_SELECT
    'A SELECT will return a dynaset
    OraData1.RecordSource = SQLStatement$
    OraData1.Refresh
    mDynaset.Enabled = True
    cmdDelete.Enabled = True
    cmdAdd.Enabled = True
   Case SQL_VERB_DESCRIBE
    DescSQL$ = "Select owner Owner, object_name ObjectName, object_type ObjectType from all_objects where object_name='" + ObjectName$ + "'"
    'Look for this object as owned by User$
    Set DDesc = OraDatabase.DbCreateDynaset(DescSQL$ + " and owner='" + Owner$ + "'", 0&)
    DDesc.DbMoveFirst
    If DDesc.RecordCount = 0 Then
     'Look for this object as owned by anyone
     Set DDesc = OraDatabase.DbCreateDynaset(DescSQL$, 0&)
     DDesc.DbMoveFirst
    End If
    If DDesc.RecordCount = 0 Then
      Call RaiseInfo("Information", "Object " + ObjectName$ + " does not exist.")
      DescSQL$ = ""
    Else
     'Set the new owner and objecttype
     Owner$ = DDesc.Fields("owner").value
     ObjectType$ = DDesc.Fields("objecttype")
     If ObjectType$ = "TABLE" Or ObjectType$ = "VIEW" Then
      DescSQL$ = "Select table_name ""Table"", column_name ""Columns"",nullable ""Null?"" , data_type ""Data Type"", data_length ""Length"" , data_precision ""Precision"", data_scale ""Scale"" from all_tab_columns where table_name='" + ObjectName$ + "' and owner='" + Owner$ + "' order by column_id"
     ElseIf ObjectType$ = "PACKAGE" Or ObjectType$ = "FUNCTION" Or ObjectType$ = "FUNCTION BODY" Or ObjectType$ = "PROCEDURE" Then
      DescSQL$ = "Select text ""Source"" from user_source where type='" + ObjectType$ + "' and name='" + ObjectName$ + "' order by line"
     ElseIf ObjectType$ = "SEQUENCE" Then
      DescSQL$ = "select sequence_name SequenceName, min_value MinValue, max_value MaxValue, increment_by ""Increment"" from all_sequences where sequence_owner='" + Owner$ + "' and sequence_name='" + ObjectName$ + "'"
     ElseIf ObjectType$ = "INDEX" Then
      DescSQL$ = "select index_name IndexName, table_owner TableOwner, table_name TableName , table_type TableType, uniqueness from all_indexes where owner='" + Owner$ + "' and index_name='" + ObjectName$ + "'"
     Else
      Call RaiseInfo("Information", "Object " + ObjectName$ + " is a(n) " + ObjectType$)
      DescSQL$ = ""
     End If
    End If
    If DescSQL$ <> "" Then
     'A DESC will return a dynaset
     OraData1.RecordSource = DescSQL$
     OraData1.Refresh
    End If
    cmdDelete.Enabled = False
    cmdAdd.Enabled = False
   Case Else
    'Any SQL except SELECT will not return anything
    OraDatabase.DbExecuteSQL (SQLStatement$)
    mDynaset.Enabled = False
    cmdDelete.Enabled = False
    cmdAdd.Enabled = False
   End Select
   'Reset the mouse pointer
   Screen.MousePointer = DEFAULT
  End If
 Exit Sub
OraError:
 Screen.MousePointer = DEFAULT
 frmOraError.Show MODAL
 Exit Sub
End Sub
Sub Form_Load ()
 'Initialize Grid settings
 OutTable.SelectMode = 1
 OutTable.Headings = True
 OutTable.Editable = False
 OutTable.MarqueeStyle = 3
 'Values
 '0 - Dotted Cell Border (Default)
 '1 - Solid Cell Border
 '2 - Highlight Cell
 '3 - Highlight Row
 '4 - Highlight Row & Cell
 '5 - None
 'Initialize Menu settings
 mDynasetHeadings.Checked = True
 mDynasetReadonly.Checked = True
 mDynaset.Enabled = False
 mSessionCommit.Enabled = False
 mSessionRollback.Enabled = False
 'Initialize buttons
 cmdAdd.Enabled = False
 cmdDelete.Enabled = False
 Call CenterForm(frmVBSQL)
 'For display purposes
 If DatabaseName$ = "" Then
  txtConnection = UserName$ + "@<local host>"
 Else
  txtConnection = UserName$ + "@" + DatabaseName$
 End If
 OraData1.DatabaseName = DatabaseName$
 OraData1.Connect = Connect$
End Sub
'Check for a 'terminator' of sorts. In SQL*Plus a statement
'is terminated(and executed) after a semicolon or forward
'slash(and a return). This function also has the effect of
'stripping spaces iff the statement was terminated by a
'semicolon or forward slash
Function IsTerminated (SQLStatement As String) As Integer
 Dim Temp$
 'Remove any trailing spaces
 Temp$ = RTrim$(SQLStatement$)
 'Check for semicolon or forward slash
 If Right$(Temp$, 1) = ";" Or Right$(Temp$, 1) = "/" Then
  'Strip the semicolon or forward slash and spaces
  SQLStatement$ = Trim$(Left$(Temp$, Len(Temp$) - 1))
  IsTerminated = True
 Else
  IsTerminated = False
 End If
End Function
Sub mDSetCommaDel_Click ()
 Call SaveToFile("Comma Delimited(*.TXT)|*.TXT|All Files(*.*)|*.*", "TXT", ",")
End Sub
Sub mDSetTabDel_Click ()
 Call SaveToFile("Tab Delimited(*.TXT)|*.TXT|All Files(*.*)|*.*", "TXT", Chr(9))
End Sub
Sub mDynasetFont_Click ()
 'Only get the ANSI and Screen Fonts
 CMFont.Flags = CF_ANSIONLY Or CF_SCREENFONTS
 CMFont.Action = DLG_FONT
 'If the user didn't hit cancel and there is a font
 If Err = 0 And CMFont.FontName <> "" Then
  OutTable.FontName = CMFont.FontName
 End If
End Sub
Sub mDynasetGraph_Click ()
 Set GraphDyn = OraData1.Recordset '.DbClone
 frmGraphO.Show MODAL
 Unload frmGraphO
End Sub
Sub mDynasetHeadings_Click ()
 If mDynasetHeadings.Checked = True Then
  OutTable.Headings = False
  mDynasetHeadings.Checked = False
 Else
  OutTable.Headings = True
  mDynasetHeadings.Checked = True
 End If
End Sub
Sub mDynasetReadOnly_Click ()
 'Mark the grid readonly/readwrite
 If OutTable.Editable = True Then
  OutTable.Editable = False
  mDynasetReadonly.Checked = True
 Else
  OutTable.Editable = True
  mDynasetReadonly.Checked = False
 End If
End Sub
Sub mDynasetSQLScript_Click ()
 Call SaveToSQLScript("SQL Script(*.SQL)|*.SQL|All Files(*.*)|*.*", "SQL", ",")
End Sub
Sub mFileExit_click ()
 'Commit and exit
 If mSessionBeginTrans.Checked = True Then
  OraSession.DbCommitTrans
 End If
 Unload frmVBSQL
End Sub
Sub mFilePrint_Click ()
 'Print the current form
 CMFilePrint.Flags = 0
 CMFilePrint.Action = DLG_PRINT
 frmVBSQL.PrintForm
End Sub
Sub mFilePrintSetup_Click ()
 'Display the print setup dialog
 CMFilePrint.Flags = PD_PRINTSETUP
 CMFilePrint.Action = DLG_PRINT
End Sub
Sub mHelpAbout_Click ()
 frmAbout.Show MODAL
End Sub
Sub mHelpContents_Click ()
 Call RaiseInfo("Warning", "Help not yet implemented.")
 'Send an F1 to the app which will cause the help file
 'listed in the project options to be opened.
 'SendKeys "{F1}"
End Sub
Sub mSessionBeginTrans_Click ()
 'Begin a transaction and set menus
 mSessionBeginTrans.Checked = True
 mSessionBeginTrans.Enabled = False
 mSessionCommit.Enabled = True
 mSessionRollback.Enabled = True
 OraSession.DbBeginTrans
End Sub
Sub mSessionCommit_Click ()
 'Commit a transaction and set menus
 mSessionBeginTrans.Checked = False
 mSessionBeginTrans.Enabled = True
 mSessionCommit.Enabled = False
 mSessionRollback.Enabled = False
 OraSession.DbCommitTrans
End Sub
Sub mSessionRollback_Click ()
 'Roolback a transaction and set menus
 mSessionBeginTrans.Checked = False
 mSessionBeginTrans.Enabled = True
 mSessionCommit.Enabled = False
 mSessionRollback.Enabled = False
 OraSession.DbRollback
End Sub
Sub mSQLOpen_Click ()
 Dim TextLine$, Filename$
 Dim FNum%
 'Init Variables
 TextLine$ = ""
 On Error GoTo SQLOpenCancel
 'Initialize the Open file dialog
 CMOpen.Filter = "SQL Scripts(*.SQL)|*.SQL|All Files(*.*)|*.*"
 CMOpen.CancelError = True
 CMOpen.Action = DLG_FILE_OPEN
 Filename$ = CMOpen.Filename
  If Filename$ <> "" And Dir$(Filename$) <> "" Then
    FNum% = FreeFile
    Open Filename$ For Input As FNum%
    txtSQL = ""
    While Not EOF(FNum%)
     Line Input #FNum%, TextLine$  ' Get complete line.
     txtSQL = txtSQL + TextLine$ + Chr$(13) + Chr$(10)
    Wend
    Close FNum% 'Close file.
  End If
SQLOpenCancel:
 Exit Sub
End Sub
Sub mSQLRun_Click ()
 Dim TextLine$, Filename$
 'Init Variables
 TextLine$ = ""
 On Error GoTo SQLRunCancel
 'Initialize the Open file dialog
 CMRun.Filter = "SQL Scripts(*.SQL)|*.SQL|All Files(*.*)|*.*"
 CMRun.DialogTitle = "Run"
 CMRun.CancelError = True
 CMRun.Action = DLG_FILE_OPEN
 Filename$ = CMRun.Filename
 Call RunSQLScript(Filename$)
SQLRunCancel:
Exit Sub
End Sub
Sub mSQLSaveAs_Click ()
 Dim TextLine$, Filename$
 Dim FNum%
 'Init Variables
 TextLine$ = ""
 On Error GoTo SQLSaveAsCancel:
 'Initialize the SaveAs file dialog
 CMSaveAs.Filter = "SQL Scripts(*.SQL)|*.SQL|All Files(*.*)|*.*"
 CMSaveAs.DefaultExt = "SQL"
 CMSaveAs.CancelError = True
 CMSaveAs.Action = DLG_FILE_SAVE
 Filename$ = CMSaveAs.Filename
 'Write the sql to a file
 If Filename$ <> "" Then
   FNum% = FreeFile
   Open Filename$ For Output As FNum%
   'TextLine$ = txtSQL
   Print #FNum%, txtSQL ' Write complete line.
   Close FNum% 'Close file.
 End If
SQLSaveAsCancel:
 Exit Sub
End Sub
Sub OraData1_Error (DataErr As Integer, Response As Integer)
 frmOraError.Show MODAL
 Response = DATA_ERRCONTINUE
End Sub
Sub OutTable_DblClick ()
 If OutTable.Editable = False Then
  Call RaiseError("Error", "The Dynaset is currently marked READONLY")
 End If
End Sub
Sub OutTable_KeyPress (KeyAscii As Integer)
 If KeyAscii = KEY_ESCAPE Then
  OutTable.DataChanged = False
  OutTable.Modified = False ' Nullify user's editing
  OutTable.EditActive = False   ' Exit edit mode
 End If
End Sub
Sub RunSQLScript (Filename As String)
 Dim SQLStatement$, CurrentLine$
 Dim FNum%
 SQLStatement$ = ""
 CurrentLine$ = ""
 On Error GoTo RunSQLError
 If Filename$ <> "" And Dir$(Filename$) <> "" Then
  FNum% = FreeFile
  Open Filename$ For Input As FNum%
  'txtSQL = ""
  While Not EOF(FNum%)
    Line Input #FNum%, CurrentLine$
    SQLStatement$ = SQLStatement$ + Trim(CurrentLine$)
    If Len(SQLStatement$) < 1 Then
     'do nothing
    ElseIf Left$(SQLStatement$, 2) = "--" Or UCase$(Left$(SQLStatement$, 3)) = "REM" Then
     Call RaiseInfo("Info", "Found Remark=" + SQLStatement$)
     SQLStatement$ = ""
    ElseIf Right$(SQLStatement$, 1) = ";" Or Right$(SQLStatement$, 1) = "/" Then
     'Need to strip the ; or /
     SQLStatement$ = Left$(SQLStatement$, Len(SQLStatement$) - 1)
     Call RaiseInfo("Info", "Execute SQL=" + SQLStatement$)
     txtSQL = SQLStatement$ 'I need to reference txtSQL here. I'd rather not.
     ExecuteSQLStatement (SQLStatement$)
     SQLStatement$ = ""
    Else
     SQLStatement$ = SQLStatement$ + " "
    End If
  Wend
  Close FNum% 'Close file.
 End If
 Exit Sub
RunSQLError:
 Call RaiseError("Error", "Error Reading " + Filename$)
 Exit Sub
End Sub
'Save a Dynaset to a file given a particular file extension and data delimeter
Sub SaveToFile (Filter As String, DefaultExt As String, Delimeter As String)
 Dim TextLine$, Filename$, FieldName$, Spaces$
 Dim FNum%, FieldCount%, i%, NSpaces%
 Dim FieldValue As Variant
 Dim flds() As Object
 'Init/Declare Variables
 TextLine$ = ""
 Dim DSClone As Object
 On Error GoTo SaveToCancel
 'Initialize the SaveAs file dialog
 CMSaveAs.Filter = Filter$
 CMSaveAs.DefaultExt = DefaultExt$
 CMSaveAs.CancelError = True
 CMSaveAs.Action = DLG_FILE_SAVE
 Filename$ = CMSaveAs.Filename
 'On Error GoTo SaveToError
 If Filename$ <> "" Then
   'This might take a while
   Screen.MousePointer = HOURGLASS
   'Find a free file
   FNum% = FreeFile
   Open Filename$ For Output As FNum%
   'Clone the RecordSet since that will prevent the grid or
   'any other control bound to that recordset to receive
   'events while I move through the recordset.
   Set DSClone = OraData1.Recordset.DbClone
   'Move to the first record
   DSClone.DbMoveFirst
   'Get the field count
   FieldCount% = DSClone.Fields.Count
   ReDim flds(0 To FieldCount% - 1)
   For i = 0 To (FieldCount% - 1)
    Set flds(i) = DSClone.Fields(i)
   Next i
   If mDynasetHeadings.Checked = True Then
    'Loop through all the field names in the row
    For i% = 0 To (FieldCount% - 1)
     FieldName$ = flds(i%).Name
     'Quote column headings if it contains a space
      If InStr(" ", FieldName$) Then
       TextLine$ = TextLine$ + """" + FieldName$ + """"
      Else
       TextLine$ = TextLine$ + FieldName$
      End If
     If i% < (FieldCount% - 1) Then
      TextLine$ = TextLine$ + Delimeter$
     End If
    Next i%
    Print #FNum%, TextLine$ ' Write all fields headings
   End If
   'Loop to the end of the recordset
   While DSClone.EOF <> True
    TextLine$ = ""
    'Loop through all the fields values in the row
    For i% = 0 To (FieldCount% - 1)
     'Unfortunately we don't yet know the Oracle column types.
     'If we did, we could accurately quote strings and dates
     'dates and leave numbers. Now, I'll just use IsNumber,
     'IsDate and look for spaces. Yes, I could look into the
     'table user_tab_columns. Go ahead...
     FieldValue = flds(i%).value
     If Not IsNull(FieldValue) Then 'Check for NULLs
      If IsDate(FieldValue) Or Not IsNumeric(FieldValue) Or InStr(" ", DSClone.Fields(i%).value) Then
       TextLine$ = TextLine$ + """" + FieldValue + """"
      Else
       TextLine$ = TextLine$ + FieldValue
      End If
     End If
     'Add the delimeter except after the last column
     If i% < (FieldCount% - 1) Then
      'I was thinking about saving a file in column format
      'NSpaces% = (OutTable.ColumnWidth(i%) - Len(FieldValue))
      'If NSpaces% > 0 Then
      ' Spaces$ = String(NSpaces%, " ")
      'Else
      ' Spaces$ = ""
      'End If
      'TextLine$ = TextLine$ + Spaces$
      TextLine$ = TextLine$ + Delimeter$
     End If
    Next i%
    'Print the row
    Print #FNum%, TextLine$
    'Advance to the next record
    DSClone.DbMoveNext
   Wend
   'Close file
   Close FNum%
   'Restore table to track record movement
   OutTable.Active = True
   'Restore the cursor
   Screen.MousePointer = DEFAULT
 End If
SaveToCancel:
 Exit Sub
SaveToError:
 Screen.MousePointer = DEFAULT
 Call RaiseError("Error", "An error occurred while writing " + Filename$)
 Exit Sub
End Sub
'Write a SQL script capable of being able to recreate a table and insert values from
'a select statement and a dynaset. This routine will only work for select statements
'with ONE object. I'll leave multiple objects up to someone else.
Sub SaveToSQLScript (Filter As String, DefaultExt As String, Delimeter As String)
 Dim SQLStatement$, Filename$, XObject$, CreateText$, DataType$, TextLine$, Temp$
 Dim FNum%, fpos%, spos%, i%, FieldCount%
 Dim FieldValue As Variant
 Dim flds() As Object
 'Init Variables
 SQLStatement$ = txtSQL
 i% = IsTerminated(SQLStatement$)
 Dim DSClone As Object  'Original Dynaset Clone
 Dim DSDesc As Object   'Dynaset describing a tables' columns
 On Error GoTo SaveToSQLCancel
 'Initialize the SaveAs file dialog
 CMSaveAs.Filter = Filter$
 CMSaveAs.DefaultExt = DefaultExt$
 CMSaveAs.CancelError = True
 CMSaveAs.Action = DLG_FILE_SAVE
 Filename$ = CMSaveAs.Filename
 If Filename$ <> "" And Err = 0 Then
   'This might take a while
   Screen.MousePointer = HOURGLASS
   On Error GoTo FileError
   'Find a free file
   FNum% = FreeFile
   Open Filename$ For Output As FNum%
'Build a CREATE TABLE statement from the columns descriptions in USER_TAB_COLUMNS
'Constraints are not checked. Try looking at USER_CONS_COLUMNS or USER_CONSTRAINTS
   'Determine the object to describe
   'Add ability to get SCOTT.EMP, but error on emp,dept for now
   fpos% = InStr(1, SQLStatement$, " FROM ", 1)  'Look for the FROM
   spos% = InStr(fpos% + 6, SQLStatement$, " ")  'Look for a space after the object
   If spos = 0 Then
    XObject$ = Mid$(SQLStatement$, fpos% + 6, (fpos% + 6))   'No space, object name at end
   Else
    XObject$ = Mid$(SQLStatement$, fpos% + 6, spos% - (fpos% + 6))    'space, object name in middle
   End If
   'Describe the columns so I can recreate the CREATE statement.
   Set DSDesc = OraDatabase.DbCreateDynaset("Select * from user_tab_columns where table_name='" + UCase$(XObject$) + "'", 0&)
   DSDesc.DbMoveFirst
   'Initialize the CREATE statement
   CreateText$ = "Create table " + XObject$ + "( "
   'Loop through and create the create statement
   For i% = 1 To DSDesc.RecordCount
    'Add column name and data type
    DataType$ = DSDesc.Fields("Data_Type").value
    CreateText$ = CreateText$ + DSDesc.Fields("column_name").value + " "
    CreateText$ = CreateText$ + DataType$
    Select Case DataType$
      'Precision and Scale must be added to numbers
      Case "NUMBER"
    If Not IsNull(DSDesc.Fields("data_precision").value) Then
     CreateText$ = CreateText$ + "(" + DSDesc.Fields("data_precision").value
     If DSDesc.Fields("data_scale").value > 0 Then
      CreateText$ = CreateText$ + "," + DSDesc.Fields("data_scale").value
     End If
     CreateText$ = CreateText$ + ")"
    End If
      'Size must be added to varchar2, raw and char
      Case "VARCHAR2", "RAW", "CHAR"
    CreateText$ = CreateText$ + "(" + DSDesc.Fields("data_length").value + ")"
    End Select
    'Allow NULLS?
    If DSDesc.Fields("nullable").value = "N" Then
     CreateText$ = CreateText$ + " NOT NULL"
    End If
     'Add the delimeter except after the last column
    If i% < DSDesc.RecordCount Then
      CreateText$ = CreateText$ + ","
    End If
    DSDesc.DbMoveNext
   Next i%
   'Finish off the CREATE statement
   CreateText$ = CreateText$ + " );"
    'Write the CREATE Statement to the file
    Print #FNum%, CreateText$
 'Clone the RecordSet since that will prevent the grid or any
 'other control bound to that recordset to receive events
 'while I move through the recordset.
 Set DSClone = OraData1.Recordset.DbClone
   'Move to the first record
   DSClone.DbMoveFirst
   FieldCount% = DSClone.Fields.Count
   ReDim flds(0 To FieldCount% - 1)
   For i% = 0 To (FieldCount% - 1)
    Set flds(i%) = DSClone.Fields(i%)
   Next i%
   'Loop to the end of the recordset
   While DSClone.EOF <> True
    TextLine$ = "Insert into " + XObject$ + " values ("
    'Loop through all the fields values in the row
    For i% = 1 To DSClone.Fields.Count
     'Unfortunately we don't yet know the Oracle column types.
     'If we did, we could accurately quote strings and dates
     'dates and leave numbers. Now, I'll just use IsNumber,
     'IsDate and look for spaces.
     FieldValue = flds(i%).value
     If IsNull(FieldValue) Then 'Check for NULLs
       TextLine$ = TextLine$ + "NULL"
     Else
      If IsDate(FieldValue) Or Not IsNumeric(FieldValue) Or InStr(" ", flds(i%).value) Then
       TextLine$ = TextLine$ + "'" + FieldValue + "'"
      Else
       TextLine$ = TextLine$ + FieldValue
      End If
     End If
     'Add the delimeter except after the last column
     If i% < FieldCount% Then
      TextLine$ = TextLine$ + Delimeter$
     End If
    Next i%
    TextLine$ = TextLine$ + ");"
    'Print the row
    Print #FNum%, TextLine$
    'Advance to the next record
    DSClone.DbMoveNext
   Wend
   'Close file
   Close FNum%
   'Restore the cursor
 End If
SaveToSQLCancel:
 Screen.MousePointer = DEFAULT
 Exit Sub
FileError:
  Screen.MousePointer = DEFAULT
  If OraSession.LastServerErr <> 0 Then
   frmOraError.Show MODAL
  Else
   Call RaiseError("Error", "An error occurred while writing " + Filename$)
  End If
  Exit Sub
End Sub
Sub sqltext_KeyPress (KeyAscii As Integer)
 Dim foo$
 If KeyAscii = KEY_RETURN Then
  foo$ = txtSQL
  If IsTerminated(foo$) Then
   ExecuteSQLStatement (foo$)
   KeyAscii = 0
  End If
 End If
End Sub