home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1996 February
/
PCWK0296.iso
/
po7_win
/
object10
/
vbsql.bas
< prev
next >
Wrap
BASIC Source File
|
1994-09-19
|
7KB
|
222 lines
Option Explicit
'Used for DbExecuteSQL
Global OraSession As Object
Global OraDatabase As Object
'Connection Information
Global UserName$
Global Password$
Global DatabaseName$
Global Connect$
Global Const SQL_VERB_CONNECT = 1
Global Const SQL_VERB_DESCRIBE = 2
Global Const SQL_VERB_SELECT = 3
Global Const SQL_VERB_OTHER = 99
'Globals taken from CONSTANT.TXT(included with VB)
Global Const KEY_ESCAPE = &H1B
Global Const KEY_RETURN = &HD
'Common Dialog Control
'Action Property
Global Const DLG_FILE_OPEN = 1
Global Const DLG_FILE_SAVE = 2
Global Const DLG_COLOR = 3
Global Const DLG_FONT = 4
Global Const DLG_PRINT = 5
Global Const DLG_HELP = 6
'Printer Dialog Flags
Global Const PD_ALLPAGES = &H0&
Global Const PD_SELECTION = &H1&
Global Const PD_PAGENUMS = &H2&
Global Const PD_NOSELECTION = &H4&
Global Const PD_NOPAGENUMS = &H8&
Global Const PD_COLLATE = &H10&
Global Const PD_PRINTTOFILE = &H20&
Global Const PD_PRINTSETUP = &H40&
Global Const PD_NOWARNING = &H80&
Global Const PD_RETURNDC = &H100&
Global Const PD_RETURNIC = &H200&
Global Const PD_RETURNDEFAULT = &H400&
Global Const PD_SHOWHELP = &H800&
Global Const PD_USEDEVMODECOPIES = &H40000
Global Const PD_DISABLEPRINTTOFILE = &H80000
Global Const PD_HIDEPRINTTOFILE = &H100000
' Show parameters
Global Const MODAL = 1
Global Const MODELESS = 0
' MousePointer
Global Const Default = 0 ' 0 - Default
Global Const ARROW = 1 ' 1 - Arrow
Global Const CROSSHAIR = 2 ' 2 - Cross
Global Const IBEAM = 3 ' 3 - I-Beam
Global Const ICON_POINTER = 4 ' 4 - Icon
Global Const UP_ARROW = 10 ' 10 - Up Arrow
Global Const HOURGLASS = 11 ' 11 - Hourglass
Global Const NO_DROP = 12 ' 12 - No drop
' Button parameter masks
Global Const LEFT_BUTTON = 1
Global Const RIGHT_BUTTON = 2
Global Const MIDDLE_BUTTON = 4
' MsgBox parameters
Global Const MB_OK = 0 ' OK button only
Global Const MB_OKCANCEL = 1 ' OK and Cancel buttons
Global Const MB_ABORTRETRYIGNORE = 2 ' Abort, Retry, and Ignore buttons
Global Const MB_YESNOCANCEL = 3 ' Yes, No, and Cancel buttons
Global Const MB_YESNO = 4 ' Yes and No buttons
Global Const MB_RETRYCANCEL = 5 ' Retry and Cancel buttons
Global Const MB_ICONSTOP = 16 ' Critical message
Global Const MB_ICONQUESTION = 32 ' Warning query
Global Const MB_ICONEXCLAMATION = 48 ' Warning message
Global Const MB_ICONINFORMATION = 64 ' Information message
' MsgBox return values
Global Const IDOK = 1 ' OK button pressed
Global Const IDCANCEL = 2 ' Cancel button pressed
Global Const IDABORT = 3 ' Abort button pressed
Global Const IDRETRY = 4 ' Retry button pressed
Global Const IDIGNORE = 5 ' Ignore button pressed
Global Const IDYES = 6 ' Yes button pressed
Global Const IDNO = 7 ' No button pressed
'Font Dialog Flags
Global Const CF_SCREENFONTS = &H1&
Global Const CF_PRINTERFONTS = &H2&
Global Const CF_BOTH = &H3&
Global Const CF_SHOWHELP = &H4&
Global Const CF_INITTOLOGFONTSTRUCT = &H40&
Global Const CF_USESTYLE = &H80&
Global Const CF_EFFECTS = &H100&
Global Const CF_APPLY = &H200&
Global Const CF_ANSIONLY = &H400&
Global Const CF_NOVECTORFONTS = &H800&
Global Const CF_NOSIMULATIONS = &H1000&
Global Const CF_LIMITSIZE = &H2000&
Global Const CF_FIXEDPITCHONLY = &H4000&
Global Const CF_WYSIWYG = &H8000& 'must also have CF_SCREENFONTS & CF_PRINTERFONTS
Global Const CF_FORCEFONTEXIST = &H10000
Global Const CF_SCALABLEONLY = &H20000
Global Const CF_TTONLY = &H40000
Global Const CF_NOFACESEL = &H80000
Global Const CF_NOSTYLESEL = &H100000
Global Const CF_NOSIZESEL = &H200000
Global Const DATA_ERRCONTINUE = 0
Global Const DATA_ERRDISPLAY = 1
Sub CenterForm (F As Form)
' Center the specified form within the screen
F.Move (Screen.Width - F.Width) \ 2, (Screen.Height - F.Height) \ 2
End Sub
'Look for CR or LF in a string and convert to a space.
'This is needed since [R,L]TRIM doesn't strip these.
Sub ConvertCRLFtoSpace (AString As String)
Dim lpos%, wpos%
Dim CR$, LF$
CR$ = Chr$(13)
LF$ = Chr$(10)
lpos% = Len(AString$)
wpos% = InStr(1, AString$, CR$)
While (wpos%)
Mid(AString, wpos%, 1) = " "
lpos% = wpos% + 1
wpos% = InStr(lpos, AString$, CR$)
Wend
wpos% = InStr(1, AString$, LF$)
While (wpos%)
Mid(AString, wpos%, 1) = " "
lpos% = wpos% + 1
wpos% = InStr(lpos, AString$, LF$)
Wend
End Sub
Sub NextToForm (F As Form, N As Form)
'Place form N next to Form F.
N.Move F.Width, F.Height
End Sub
Sub RaiseError (Title As String, Msg As String)
MsgBox Msg$, MB_OK + MB_ICONSTOP, Title$
End Sub
Sub RaiseInfo (Title As String, Msg As String)
MsgBox Msg$, MB_OK + MB_ICONINFORMATION, Title$
End Sub
'Determine the verb of the sql statement. Currently only SELECT
'DESCRIBE and OTHER. Returns a constant but also modifies the
'object and owner variables to reflect findings. Owner is only
'set if a different owner is specified in the select statement.
Function SQLvoo (SQLStatement As String, ObjectName As String, Owner As String) As Integer
Dim fpos%, spos%, ppos%, verb%
'Identify verb and object
If UCase$(Left$(SQLStatement$, 6)) = "SELECT" Then
verb% = SQL_VERB_SELECT
'Multiple objects such as emp,dept will not work.
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
ObjectName$ = Mid$(SQLStatement$, fpos% + 6, (fpos% + 6)) 'No space, object name at end
Else
ObjectName$ = Mid$(SQLStatement$, fpos% + 6, spos% - (fpos% + 6)) 'space, object name in middle
End If
ElseIf UCase$(Left$(SQLStatement$, 8)) = "DESCRIBE" Then
verb% = SQL_VERB_DESCRIBE
ObjectName$ = Mid$(SQLStatement$, 10)
ElseIf UCase$(Left$(SQLStatement$, 4)) = "DESC" Then
verb% = SQL_VERB_DESCRIBE
ObjectName$ = Mid$(SQLStatement$, 6)
'elseif - possibly look for sqlplus things here
Else
verb% = SQL_VERB_OTHER
End If
If verb% = SQL_VERB_SELECT Or verb% = SQL_VERB_DESCRIBE Then
ppos% = InStr(1, ObjectName$, ".")
If ppos% <> 0 Then 'OWNER.OBJECT
Owner$ = Mid$(ObjectName$, 1, (ppos% - 1))
ObjectName$ = Mid$(ObjectName$, (ppos% + 1), Len(ObjectName$))
Else
ObjectName$ = Mid$(SQLStatement$, 6)
End If
End If
'System tables always use upper case, so I'll do it now for
'later comparisons.
Owner$ = UCase$(Trim$(Owner$))
ObjectName$ = UCase$(Trim$(ObjectName$))
SQLvoo = verb%
End Function