home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Windows Gam…ming Gurus (2nd Edition) / Disc2.iso / msdn_vcb / samples / vc98 / sdk / dbmsg / sql / vbsql / text.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-04-03  |  16.2 KB  |  505 lines

  1. VERSION 2.00
  2. Begin Form PrimaryWindow 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Text"
  6.    ControlBox      =   0   'False
  7.    ForeColor       =   &H00000000&
  8.    Height          =   6585
  9.    Icon            =   TEXT.FRX:0000
  10.    Left            =   630
  11.    LinkMode        =   1  'Source
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   5895
  15.    ScaleWidth      =   7815
  16.    Top             =   75
  17.    Width           =   7935
  18.    Begin TextBox Text_Edit 
  19.       BackColor       =   &H00FFFFFF&
  20.       ForeColor       =   &H00000000&
  21.       Height          =   2775
  22.       Left            =   120
  23.       MultiLine       =   -1  'True
  24.       ScrollBars      =   3  'Both
  25.       TabIndex        =   0
  26.       Top             =   2760
  27.       Width           =   7575
  28.    End
  29.    Begin VBSQL VBSQL1 
  30.       Caption         =   "SQL Err/Msg"
  31.       Height          =   272
  32.       Left            =   5580
  33.       Top             =   2430
  34.       Visible         =   0   'False
  35.       Width           =   2055
  36.    End
  37.    Begin ListBox Titles_List 
  38.       Height          =   810
  39.       Left            =   135
  40.       TabIndex        =   9
  41.       Top             =   1410
  42.       Width           =   2415
  43.    End
  44.    Begin DirListBox Dir_Tree_Combo 
  45.       Height          =   1275
  46.       Left            =   3360
  47.       TabIndex        =   5
  48.       Top             =   1155
  49.       Width           =   2055
  50.    End
  51.    Begin FileListBox Text_File_List 
  52.       Height          =   1590
  53.       Left            =   5580
  54.       Pattern         =   "*.txt"
  55.       TabIndex        =   6
  56.       Top             =   840
  57.       Width           =   2055
  58.    End
  59.    Begin DriveListBox Drive_Combo 
  60.       Height          =   357
  61.       Left            =   3360
  62.       TabIndex        =   4
  63.       Top             =   833
  64.       Width           =   2048
  65.    End
  66.    Begin ListBox Database_List 
  67.       Height          =   420
  68.       Left            =   135
  69.       TabIndex        =   11
  70.       Top             =   360
  71.       Width           =   2415
  72.    End
  73.    Begin TextBox Title_Edit 
  74.       Height          =   323
  75.       Left            =   4605
  76.       TabIndex        =   2
  77.       Top             =   75
  78.       Width           =   3075
  79.    End
  80.    Begin Label Label5 
  81.       BackColor       =   &H00C0C0C0&
  82.       Caption         =   "Text in database:"
  83.       Height          =   225
  84.       Left            =   120
  85.       TabIndex        =   12
  86.       Top             =   2520
  87.       Width           =   2055
  88.    End
  89.    Begin Label Label4 
  90.       BackColor       =   &H00C0C0C0&
  91.       Caption         =   "Titles in database:"
  92.       Height          =   225
  93.       Left            =   120
  94.       TabIndex        =   10
  95.       Top             =   1185
  96.       Width           =   2055
  97.    End
  98.    Begin Label Text_File_Label 
  99.       BackColor       =   &H00C0C0C0&
  100.       Caption         =   "(none)"
  101.       Height          =   255
  102.       Left            =   3855
  103.       TabIndex        =   8
  104.       Top             =   480
  105.       Width           =   3870
  106.    End
  107.    Begin Label Label3 
  108.       BackColor       =   &H00C0C0C0&
  109.       Caption         =   "File:"
  110.       Height          =   255
  111.       Left            =   3360
  112.       TabIndex        =   7
  113.       Top             =   480
  114.       Width           =   375
  115.    End
  116.    Begin Label Label2 
  117.       BackColor       =   &H00C0C0C0&
  118.       Caption         =   "Text file title:"
  119.       ForeColor       =   &H00000000&
  120.       Height          =   255
  121.       Left            =   3360
  122.       TabIndex        =   3
  123.       Top             =   120
  124.       Width           =   1245
  125.    End
  126.    Begin Label Label1 
  127.       BackColor       =   &H00C0C0C0&
  128.       Caption         =   "Databases:"
  129.       Height          =   210
  130.       Left            =   120
  131.       TabIndex        =   1
  132.       Top             =   120
  133.       Width           =   1005
  134.    End
  135.    Begin Menu Menu_File 
  136.       Caption         =   "&File"
  137.       Begin Menu Logon_Selection 
  138.          Caption         =   "&Logon"
  139.       End
  140.       Begin Menu Log_Off_Selection 
  141.          Caption         =   "Log &Off"
  142.       End
  143.       Begin Menu Exit_Selection 
  144.          Caption         =   "&Exit"
  145.       End
  146.    End
  147.    Begin Menu Options_Menu 
  148.       Caption         =   "&Options"
  149.       Begin Menu View_Selection 
  150.          Caption         =   "&View Text"
  151.       End
  152.       Begin Menu Insert_Selection 
  153.          Caption         =   "&Insert Text"
  154.       End
  155.       Begin Menu Delete_Selection 
  156.          Caption         =   "&Delete Text"
  157.       End
  158.    End
  159.    Begin Menu About_Menu 
  160.       Caption         =   "&About"
  161.    End
  162. Sub About_Menu_Click ()
  163.     About_Form.Show 1
  164. End Sub
  165. Function CheckForTextTable () As Integer
  166.     Rem Check to see if sample table exits
  167.     Cmd$ = "Select count(*) from sysobjects where name = 'text_table'"
  168.     Results% = SqlCmd(SqlConn%, Cmd$)
  169.     Results% = SqlExec(SqlConn%)
  170.     Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
  171.     Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
  172.         Table_Found$ = Sqldata(SqlConn%, 1)
  173.     Loop
  174.     Loop
  175.     If Val(Table_Found$) = 0 Then
  176.     Results% = MsgBox("Text table not found in " + Database$ + " database." + Chr$(13) + Chr$(10) + "Do you wish to create the table?", 52)
  177.     If Results% = 7 Then
  178.         CheckForTextTable = FAIL
  179.         Exit Function
  180.     Else
  181.         Rem If sample table does not exist, create it
  182.         Cmd$ = "create table text_table (title varchar(30) not null, text_col text null)"
  183.         Results% = SqlCmd(SqlConn%, Cmd$)
  184.         Results% = SqlExec(SqlConn%)
  185.         Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
  186.         Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
  187.         Loop
  188.         Loop
  189.         CheckForTextTable = SUCCEED
  190.     End If
  191.     Else
  192.     CheckForTextTable = SUCCEED
  193.     End If
  194. End Function
  195. Sub ClearTextTitles ()
  196.     Rem Clear all text titles out of list box
  197.     Do While Titles_List.ListCount
  198.         Titles_List.RemoveItem 0
  199.     Loop
  200. End Sub
  201. Sub Database_List_Click ()
  202. Rem Get the database user wants to open
  203. Rem If it doesn't have the text table in it, see if user wants to create one
  204. Rem If it does exist, get all the text titles
  205.     DatabaseSelection$ = Database_list.Text
  206.     Results% = SqlUse(SqlConn%, DatabaseSelection$)
  207.     Results% = CheckForTextTable()
  208.     If Results% = SUCCEED Then
  209.     PrimaryWindow.MousePointer = 11
  210.     RetrieveTextTitles
  211.     View_Selection.Enabled = True
  212.     Insert_Selection.Enabled = True
  213.     Delete_Selection.Enabled = True
  214.     PrimaryWindow.MousePointer = 0
  215.     Else
  216.     ClearTextTitles
  217.     View_Selection.Enabled = False
  218.     Insert_Selection.Enabled = False
  219.     Delete_Selection.Enabled = False
  220.     End If
  221. Rem Display the current database in the title window
  222. Rem clear the text field
  223.     DatabaseName$ = SqlName(SqlConn%)
  224.     ChangePrimaryWindowCaption
  225.     Text_Edit.Text = ""
  226. End Sub
  227. Sub Delete_Selection_Click ()
  228.     Text_Title$ = Titles_List.Text
  229.     If Text_Title$ = "" Then
  230.     Beep
  231.     MsgBox "You must first select a title."
  232.     Else
  233.     Response% = MsgBox("Delete " + Text_Title$ + "?", 49)
  234.     If Response% = 1 Then
  235.         PrimaryWindow.MousePointer = 11
  236.         Results% = ExecuteSQLCommand("Delete from text_table where title = '" + Text_Title$ + "'")
  237.         Results% = SqlResults%(SqlConn%)
  238.         Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
  239.         Loop
  240.         PrimaryWindow.Text_Edit.Text = ""
  241.         RetrieveTextTitles
  242.         PrimaryWindow.MousePointer = 0
  243.     Else
  244.         MsgBox "Delete aborted."
  245.     End If
  246.     End If
  247. End Sub
  248. Sub Dir_Tree_Combo_Change ()
  249.     Text_File_Label.Caption = "(none)"
  250.     Text_File_List.Path = Dir_Tree_Combo.Path
  251. End Sub
  252. Sub Drive_Combo_Change ()
  253.     Text_File_Label.Caption = "(none)"
  254.     Dir_Tree_Combo.Path = Drive_Combo.Drive
  255. End Sub
  256. Sub Exit_Selection_Click ()
  257.     ExitApplication
  258.     End
  259. End Sub
  260. Sub Form_Load ()
  261.     PrimaryWindowTitle = "Text Example"
  262.     ChangePrimaryWindowCaption
  263.     InitializeApplication
  264.     MsgBox DBLIB_VERSION$
  265.     Logon_Selection.Enabled = True
  266.     Log_Off_Selection.Enabled = False
  267.     Exit_Selection.Enabled = True
  268.     View_Selection.Enabled = False
  269.     Insert_Selection.Enabled = False
  270.     Delete_Selection.Enabled = False
  271. End Sub
  272. Sub Insert_Selection_Click ()
  273.     Text_File$ = Text_File_Label.Caption
  274.     Title$ = Title_Edit.Text
  275.     Title$ = PrepareString(Title$)
  276.     If Text_File$ = "(none)" Then
  277.     Beep
  278.     MsgBox "Please select a text file to insert."
  279.     ElseIf Title$ = "" Then
  280.     Beep
  281.     MsgBox "Please enter a title for the text file you wish to insert."
  282.     Else
  283.     PrimaryWindow.MousePointer = 11
  284.     InsertText Title$, Text_File$
  285.     Title_Edit.Text = ""
  286.     Text_File_List.ListIndex = -1
  287.     Text_File_Label.Caption = ""
  288.     RetrieveTextTitles
  289.     PrimaryWindow.MousePointer = 0
  290.     End If
  291. End Sub
  292. Sub InsertText (Title As String, Text_File As String)
  293. Rem This routine will insert the text data into the table
  294. Rem Insert new row with title and token text value
  295.     Results% = ExecuteSQLCommand("Insert into text_table values ('" + Title + "','none')")
  296.     Do While SqlResults(SqlConn%) <> NOMORERESULTS%
  297.     Do While SqlNextRow(SqlConn%) <> NOMOREROWS%
  298.     Loop
  299.     Loop
  300. Rem Get identifier for text column in current row
  301.     Results% = ExecuteSQLCommand("select text_col from text_table where title = '" + Title + "'")
  302.     Do While SqlResults(SqlConn%) <> NOMORERESULTS%
  303.     Do While SqlNextRow(SqlConn%) <> NOMOREROWS%
  304.         SqlPointer$ = SqlTxPtr(SqlConn%, 1)
  305.         SqlTimestamp$ = SqlTxTimeStamp(SqlConn%, 1)
  306.     Loop
  307.     Loop
  308. Rem Open text file to load into SQL Server table
  309.     DataPartLimit& = 8192
  310.     Done% = False
  311.     Open Text_File For Input As #1
  312.     FileLength& = LOF(1)
  313.     If FileLength& > 65536 Then
  314.     MsgBox "This application cannot display text files greater than 64K."
  315.     Else
  316.     FileData$ = ""
  317.     Do While Not EOF(1)
  318.         Input #1, DataPart$
  319.         If Right$(DataPart$, 2) <> Chr$(13) + Chr$(10) Then
  320.         If Right$(DataPart$, 1) = Chr$(13) Then
  321.             FileData$ = FileData$ + Left$(DataPart$, Len(DataPart$) - 1) + Chr$(13) + Chr$(10)
  322.         ElseIf Right$(DataPart$, 1) = Chr$(10) Then
  323.             FileData$ = FileData$ + Left$(DataPart$, Len(DataPart$) - 1) + Chr$(13) + Chr$(10)
  324.         Else
  325.             FileData$ = FileData$ + DataPart$ + Chr$(13) + Chr$(10)
  326.         End If
  327.         Else
  328.         FileData$ = FileData$ + DataPart$
  329.         End If
  330.     Loop
  331. Rem Begin inserting text into text column in DatePartLimit& size chunks
  332.     Table$ = "text_table.text_col"
  333.     DataPos& = 1
  334.     DataLen& = Len(FileData$)
  335.     If SqlWriteText(SqlConn%, Table$, SqlPointer$, SQLTXPLEN%, SqlTimestamp$, 1, DataLen&, "") <> FAIL% Then
  336.         If SqlOk(SqlConn%) <> FAIL% Then
  337.         Results% = SqlResults(SqlConn%)
  338.         Do While Not Done%
  339.             If DataPos& + DataPartLimit& - 1 < DataLen& Then
  340.             DataPart$ = Mid$(FileData$, DataPos&, DataPartLimit&)
  341.             DataPos& = DataPos& + Len(DataPart$)
  342.             Else
  343.             DataPart$ = Mid$(FileData$, DataPos&, DataLen& - DataPos& + 1)
  344.             Done% = True
  345.             End If
  346.         Results% = SqlMoreText%(SqlConn%, Len(DataPart$), DataPart$)
  347.         Loop
  348.         If SqlOk(SqlConn%) <> FAIL% Then
  349.             If SqlResults(SqlConn%) <> FAIL% Then
  350.             MsgBox "Text inserted."
  351.             End If
  352.         End If
  353.         End If
  354.     End If
  355.     End If
  356. Close 1
  357. End Sub
  358. Sub LoadText (Title As String)
  359. Rem This routine will read the text field from the table
  360. Rem Clear Text_Edit box on primary window
  361.     Text_Edit.Text = ""
  362. Rem Get length of text in text column
  363.     Results% = ExecuteSQLCommand("select datalength(text_col) from text_table where title = '" + Title + "'")
  364.     Do While SqlResults(SqlConn%) <> NOMORERESULTS
  365.     Do While SqlNextRow(SqlConn%) <> NOMOREROWS
  366.         TextLen& = Val(Sqldata(SqlConn%, 1))
  367.     Loop
  368.     Loop
  369.     Offset& = 0
  370. Rem Set size limit on chunks of text data
  371.     LoadSizeLimit& = 8192
  372.     If LoadSizeLimit& > TextLen& Then
  373.     LoadSizeLimit& = TextLen&
  374.     End If
  375.     LoadSize& = LoadSizeLimit&
  376. Rem Set size of text returned to LoadSizeLimit&
  377.     Results% = ExecuteSQLCommand("set textsize " + Str$(LoadSizeLimit&))
  378.     Do While SqlResults(SqlConn%) <> NOMORERESULTS
  379.     Do While SqlNextRow(SqlConn%) <> NOMOREROWS
  380.     Loop
  381.     Loop
  382. Rem Begin reading text column in LoadSizeLimit& size chunks
  383.     Cmd$ = "Declare @val varbinary(30)"
  384.     Results% = SqlCmd(SqlConn%, Cmd$)
  385.     Cmd$ = "Select @val = textptr(text_col) from text_table where title = '" + Title + "'"
  386.     Results% = SqlCmd(SqlConn%, Cmd$)
  387.     Done% = False
  388.     Do While Not Done%
  389.         Cmd$ = "READTEXT text_table.text_col @val " + Str$(Offset&) + " " + Str$(LoadSize&)
  390.         Results% = SqlCmd(SqlConn%, Cmd$)
  391.         If Offset& + LoadSize& = TextLen& Then
  392.         Done% = True
  393.         Else
  394.         Offset& = Offset& + LoadSizeLimit&
  395.         If Offset& + LoadSizeLimit& > TextLen& Then
  396.             LoadSize& = TextLen& - Offset&
  397.         End If
  398.         End If
  399.     Loop
  400. Rem Retrieve text data in result rows and place in text_edit box
  401.     FileData$ = ""
  402.     If SqlExec(SqlConn%) <> FAIL% Then
  403.     Do While SqlResults(SqlConn%) <> NOMORERESULTS
  404.         Do While SqlNextRow(SqlConn%) <> NOMOREROWS
  405.         FileData$ = FileData$ + Sqldata(SqlConn%, 1)
  406.         Loop
  407.     Loop
  408.     End If
  409. Rem Load text data into edit box on primary window
  410.     Text_Edit.Text = FileData$
  411. End Sub
  412. Sub Log_Off_Selection_Click ()
  413.     Logoff
  414.     Logon_Selection.Enabled = True
  415.     Log_Off_Selection.Enabled = False
  416.     Exit_Selection.Enabled = True
  417.     View_Selection.Enabled = False
  418.     Insert_Selection.Enabled = False
  419.     Delete_Selection.Enabled = False
  420. End Sub
  421. Sub Logon_Selection_Click ()
  422.     Login.Show 1
  423.     PrimaryWindow.MousePointer = 11
  424.     If CheckServerConnection() = 1 Then
  425.     Results% = GetDatabases(Database_list)
  426.     ChangePrimaryWindowCaption
  427.     Logon_Selection.Enabled = False
  428.     Log_Off_Selection.Enabled = True
  429.     End If
  430.     PrimaryWindow.MousePointer = 0
  431. End Sub
  432. Function PrepareString (String_In As String) As String
  433. Rem This routine will double up the single quotation mark to
  434. Rem avoid syntax errors
  435.     String_Out$ = ""
  436.     For I% = 1 To Len(String_In)
  437.     If Mid$(String_In, I%, 1) = Chr$(39) Then
  438.         String_Out$ = String_Out$ + Chr$(39) + Chr$(39)
  439.     Else
  440.         String_Out$ = String_Out$ + Mid$(String_In, I%, 1)
  441.     End If
  442.     Next
  443.     PrepareString = String_Out$
  444. End Function
  445. Sub RetrieveTextTitles ()
  446. Rem This routine will get all the text titles from the table
  447. Rem Put them in the list box as they are retrieved.
  448.     ClearTextTitles
  449.     Results% = ExecuteSQLCommand("Select title from text_table")
  450.     Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
  451.     Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
  452.         Titles_List.AddItem Sqldata(SqlConn%, 1)
  453.     Loop
  454.     Loop
  455. End Sub
  456. Sub Text_Edit_KeyPress (KeyAscii As Integer)
  457.     If KeyAscii <> 0 Then
  458.     KeyAscii = 0
  459.     End If
  460. End Sub
  461. Sub Text_File_List_Click ()
  462.     If Right$(Dir_Tree_Combo.Path, 1) = "\" Then
  463.     Text_File_Label.Caption = Dir_Tree_Combo.Path + Text_File_List.FileName
  464.     Else
  465.     Text_File_Label.Caption = Dir_Tree_Combo.Path + "\" + Text_File_List.FileName
  466.     End If
  467. End Sub
  468. Sub Title_Edit_KeyPress (KeyAscii As Integer)
  469.     If Len(Title_Edit.Text) = 30 Then
  470.     If KeyAscii <> 8 Then
  471.         KeyAscii = 0
  472.     End If
  473.     End If
  474. End Sub
  475. Sub Titles_List_Click ()
  476.     Text_Edit.Text = ""
  477. End Sub
  478. Sub Titles_List_DblClick ()
  479.     Text_Title$ = Titles_List.Text
  480.     PrimaryWindow.MousePointer = 11
  481.     LoadText Text_Title$
  482.     PrimaryWindow.MousePointer = 0
  483. End Sub
  484. Sub VBSQL1_Error (SqlConn As Integer, Severity As Integer, ErrorNum As Integer, ErrorStr As String, RetCode As Integer)
  485. ' Call the required VBSQL error-handling function
  486. ' OSErr and OSErrStr not used in VBSQL for Windows, but DOS interprets
  487. ' anything other than -1 as an OS error
  488.     OsErr% = -1
  489.     RetCode% = UserSqlErrorHandler%(SqlConn, Severity%, ErrorNum%, OsErr%, ErrorStr$, OsErrStr$)
  490. End Sub
  491. Sub VBSQL1_Message (SqlConn As Integer, Message As Long, State As Integer, Severity As Integer, MsgStr As String)
  492.     UserSqlMsgHandler SqlConn, Message&, State%, Severity%, MsgStr$
  493. End Sub
  494. Sub View_Selection_Click ()
  495.     Text_Title$ = Titles_List.Text
  496.     If Text_Title$ = "" Then
  497.     Beep
  498.     MsgBox "You must first select a title."
  499.     Else
  500.     PrimaryWindow.MousePointer = 11
  501.     LoadText Text_Title$
  502.     PrimaryWindow.MousePointer = 0
  503.     End If
  504. End Sub
  505.