home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
On Hand
/
On_Hand_From_Softbank_1994_Release_2_Disc_2_1994.iso
/
00202
/
s
/
disk4
/
sql.fr_
/
sql.bin
Wrap
Text File
|
1993-04-28
|
5KB
|
206 lines
VERSION 2.00
Begin Form fSQL
BackColor = &H00C0C0C0&
Caption = "SQL Statement"
ClientHeight = 2880
ClientLeft = 3690
ClientTop = 1575
ClientWidth = 5250
Height = 3285
Icon = SQL.FRX:0000
Left = 3630
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 2863.353
ScaleMode = 0 'User
ScaleWidth = 5268
Top = 1230
Width = 5370
Begin CheckBox cPassThru
BackColor = &H00C0C0C0&
Caption = "&SQL PassThrough"
Height = 225
Left = 210
TabIndex = 4
Top = 553
Width = 2640
End
Begin CommandButton CreateQueryDefbtn
Caption = "Create &QueryDef"
Height = 375
Left = 3045
TabIndex = 3
Top = 121
Visible = 0 'False
Width = 1695
End
Begin CommandButton ExecuteSQLButton
Caption = "&Execute SQL"
Default = -1 'True
Enabled = 0 'False
Height = 372
Left = 120
TabIndex = 2
Top = 120
Width = 1332
End
Begin CommandButton ClearSQLButton
Caption = "&Clear SQL"
Height = 372
Left = 1560
TabIndex = 1
Top = 120
Width = 1332
End
Begin TextBox cSQLStatement
BackColor = &H00FFFFFF&
Height = 1932
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Tag = "OL"
Top = 840
Width = 5052
End
End
Option Explicit
Sub ClearSQLButton_Click ()
cSQLStatement = ""
cSQLStatement.SetFocus
End Sub
Sub CreateQueryDefbtn_Click ()
Dim qn As String
Dim q As querydef
On Error GoTo CQDErr
qn = InputBox("Enter QueryDef Name:")
If qn = "" Then Exit Sub
Set q = gCurrentDB.CreateQueryDef(qn, cSQLStatement)
RefreshTables fTables.cTableList, True
GoTo CQDEnd
CQDErr:
ShowError
Resume CQDEnd
CQDEnd:
End Sub
Sub cSQLStatement_Change ()
If cSQLStatement <> "" Then
ExecuteSQLButton.Enabled = True
Else
ExecuteSQLButton.Enabled = False
End If
End Sub
Sub ExecuteSQLButton_Click ()
Dim RetSQL As Long
If cSQLStatement = "" Then Exit Sub
MsgBar "Executing SQL Statement", True
SetHourglass Me
If UCase(Mid(cSQLStatement, 1, 6)) = "SELECT" And InStr(UCase(cSQLStatement), " INTO ") = 0 Then
On Error GoTo SQLDSErr
MakeDynaset:
gfFromSQL = True
'create a new dynaset form
gstDynaString = ""
On Error GoTo SQLDSErr
If VDMDI.cSingleRecord = True Then
Dim dsform1 As New fDynaset
dsform1.Show
ElseIf VDMDI.cDataCtl = True Then
Dim dsform2 As New fDataForm
dsform2.Show
Else
Dim dsform3 As New fGridFrm
dsform3.Show
End If
ElseIf UCase(cSQLStatement) = "LISTTABLES" Then
GoTo MakeDynaset
Else
On Error GoTo SQLErr
If gstDataType = "ODBC" Then
If UCase(Mid(cSQLStatement, 1, 4)) = "USE " Then
Beep
MsgBox "'Use' not allowed, try Open DataBase.", 48
GoTo SQLEnd
End If
RetSQL = gCurrentDB.ExecuteSQL(cSQLStatement)
If RetSQL > 0 Then
If gfTransPending Then gfDBChanged = True
End If
MsgBox CStr(RetSQL) + " row(s) Affected by SQL Statement.", 48
Else
gCurrentDB.Execute (cSQLStatement)
MsgBox "Execute of SQL Statement was Successful.", 48
End If
End If
GoTo SQLEnd
SQLErr:
If Err = 3065 Then 'row returning so try to create dynaset
Resume MakeDynaset
End If
ShowError
Resume SQLEnd
SQLDSErr:
Resume SQLEnd
SQLEnd:
ResetMouse Me
MsgBar "", False
End Sub
Sub Form_Load ()
Dim x As Integer
cSQLStatement = GetINIString("SQLStatement", "")
x = Val(GetINIString("SQLWindowHeight", "3000"))
Height = x
x = Val(GetINIString("SQLWindowWidth", "5370"))
Width = x
x = Val(GetINIString("SQLWindowTop", "0"))
Top = x
x = Val(GetINIString("SQLWindowLeft", CStr(fTables.Left + fTables.Width)))
Left = x
End Sub
Sub Form_Paint ()
Outlines Me
End Sub
Sub Form_Resize ()
On Error Resume Next
If WindowState <> 1 Then
cSQLStatement.Width = Width - 320
cSQLStatement.Height = Height - 1450
Outlines Me
Me.Refresh
End If
End Sub
Sub Form_Unload (Cancel As Integer)
Dim x As Integer
Me.WindowState = 1
Cancel = True
End Sub