Windows编程

开发平台：
Visual C++

TEXT.FRM：源码内容
							VERSION 2.00
Begin Form PrimaryWindow 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Text"
   ControlBox      =   0   'False
   ForeColor       =   &H00000000&
   Height          =   6585
   Icon            =   TEXT.FRX:0000
   Left            =   630
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5895
   ScaleWidth      =   7815
   Top             =   75
   Width           =   7935
   Begin TextBox Text_Edit 
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   2775
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   2760
      Width           =   7575
   End
   Begin VBSQL VBSQL1 
      Caption         =   "SQL Err/Msg"
      Height          =   272
      Left            =   5580
      Top             =   2430
      Visible         =   0   'False
      Width           =   2055
   End
   Begin ListBox Titles_List 
      Height          =   810
      Left            =   135
      TabIndex        =   9
      Top             =   1410
      Width           =   2415
   End
   Begin DirListBox Dir_Tree_Combo 
      Height          =   1275
      Left            =   3360
      TabIndex        =   5
      Top             =   1155
      Width           =   2055
   End
   Begin FileListBox Text_File_List 
      Height          =   1590
      Left            =   5580
      Pattern         =   "*.txt"
      TabIndex        =   6
      Top             =   840
      Width           =   2055
   End
   Begin DriveListBox Drive_Combo 
      Height          =   357
      Left            =   3360
      TabIndex        =   4
      Top             =   833
      Width           =   2048
   End
   Begin ListBox Database_List 
      Height          =   420
      Left            =   135
      TabIndex        =   11
      Top             =   360
      Width           =   2415
   End
   Begin TextBox Title_Edit 
      Height          =   323
      Left            =   4605
      TabIndex        =   2
      Top             =   75
      Width           =   3075
   End
   Begin Label Label5 
      BackColor       =   &H00C0C0C0&
      Caption         =   "Text in database:"
      Height          =   225
      Left            =   120
      TabIndex        =   12
      Top             =   2520
      Width           =   2055
   End
   Begin Label Label4 
      BackColor       =   &H00C0C0C0&
      Caption         =   "Titles in database:"
      Height          =   225
      Left            =   120
      TabIndex        =   10
      Top             =   1185
      Width           =   2055
   End
   Begin Label Text_File_Label 
      BackColor       =   &H00C0C0C0&
      Caption         =   "(none)"
      Height          =   255
      Left            =   3855
      TabIndex        =   8
      Top             =   480
      Width           =   3870
   End
   Begin Label Label3 
      BackColor       =   &H00C0C0C0&
      Caption         =   "File:"
      Height          =   255
      Left            =   3360
      TabIndex        =   7
      Top             =   480
      Width           =   375
   End
   Begin Label Label2 
      BackColor       =   &H00C0C0C0&
      Caption         =   "Text file title:"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   3360
      TabIndex        =   3
      Top             =   120
      Width           =   1245
   End
   Begin Label Label1 
      BackColor       =   &H00C0C0C0&
      Caption         =   "Databases:"
      Height          =   210
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   1005
   End
   Begin Menu Menu_File 
      Caption         =   "&File"
      Begin Menu Logon_Selection 
         Caption         =   "&Logon"
      End
      Begin Menu Log_Off_Selection 
         Caption         =   "Log &Off"
      End
      Begin Menu Exit_Selection 
         Caption         =   "&Exit"
      End
   End
   Begin Menu Options_Menu 
      Caption         =   "&Options"
      Begin Menu View_Selection 
         Caption         =   "&View Text"
      End
      Begin Menu Insert_Selection 
         Caption         =   "&Insert Text"
      End
      Begin Menu Delete_Selection 
         Caption         =   "&Delete Text"
      End
   End
   Begin Menu About_Menu 
      Caption         =   "&About"
   End
End
Sub About_Menu_Click ()
    About_Form.Show 1
End Sub
Function CheckForTextTable () As Integer
    Rem Check to see if sample table exits
    Cmd$ = "Select count(*) from sysobjects where name = 'text_table'"
    Results% = SqlCmd(SqlConn%, Cmd$)
    Results% = SqlExec(SqlConn%)
    Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
	Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
	    Table_Found$ = Sqldata(SqlConn%, 1)
	Loop
    Loop
	
    If Val(Table_Found$) = 0 Then
	Results% = MsgBox("Text table not found in " + Database$ + " database." + Chr$(13) + Chr$(10) + "Do you wish to create the table?", 52)
	If Results% = 7 Then
	    CheckForTextTable = FAIL
	    Exit Function
	Else
	    Rem If sample table does not exist, create it
	    Cmd$ = "create table text_table (title varchar(30) not null, text_col text null)"
	    Results% = SqlCmd(SqlConn%, Cmd$)
	    Results% = SqlExec(SqlConn%)
	    Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
		Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
		Loop
	    Loop
	    CheckForTextTable = SUCCEED
	End If
    Else
	CheckForTextTable = SUCCEED
    End If
End Function
Sub ClearTextTitles ()
	Rem Clear all text titles out of list box
	Do While Titles_List.ListCount
	    Titles_List.RemoveItem 0
	Loop
End Sub
Sub Database_List_Click ()
Rem
Rem Get the database user wants to open
Rem If it doesn't have the text table in it, see if user wants to create one
Rem If it does exist, get all the text titles
Rem
   
    DatabaseSelection$ = Database_list.Text
    Results% = SqlUse(SqlConn%, DatabaseSelection$)
    Results% = CheckForTextTable()
    If Results% = SUCCEED Then
	PrimaryWindow.MousePointer = 11
	RetrieveTextTitles
	View_Selection.Enabled = True
	Insert_Selection.Enabled = True
	Delete_Selection.Enabled = True
	PrimaryWindow.MousePointer = 0
    Else
	ClearTextTitles
	View_Selection.Enabled = False
	Insert_Selection.Enabled = False
	Delete_Selection.Enabled = False
    End If
Rem
Rem Display the current database in the title window
Rem clear the text field
Rem
    DatabaseName$ = SqlName(SqlConn%)
    ChangePrimaryWindowCaption
    Text_Edit.Text = ""
End Sub
Sub Delete_Selection_Click ()
    Text_Title$ = Titles_List.Text
    If Text_Title$ = "" Then
	Beep
	MsgBox "You must first select a title."
    Else
	Response% = MsgBox("Delete " + Text_Title$ + "?", 49)
	If Response% = 1 Then
	    PrimaryWindow.MousePointer = 11
	    Results% = ExecuteSQLCommand("Delete from text_table where title = '" + Text_Title$ + "'")
	    Results% = SqlResults%(SqlConn%)
	    Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
	    Loop
	    PrimaryWindow.Text_Edit.Text = ""
	    RetrieveTextTitles
	    PrimaryWindow.MousePointer = 0
	Else
	    MsgBox "Delete aborted."
	End If
    End If
End Sub
Sub Dir_Tree_Combo_Change ()
    Text_File_Label.Caption = "(none)"
    Text_File_List.Path = Dir_Tree_Combo.Path
End Sub
Sub Drive_Combo_Change ()
    Text_File_Label.Caption = "(none)"
    Dir_Tree_Combo.Path = Drive_Combo.Drive
End Sub
Sub Exit_Selection_Click ()
    ExitApplication
    End
End Sub
Sub Form_Load ()
    PrimaryWindowTitle = "Text Example"
    ChangePrimaryWindowCaption
    InitializeApplication
    MsgBox DBLIB_VERSION$
    Logon_Selection.Enabled = True
    Log_Off_Selection.Enabled = False
    Exit_Selection.Enabled = True
    View_Selection.Enabled = False
    Insert_Selection.Enabled = False
    Delete_Selection.Enabled = False
End Sub
Sub Insert_Selection_Click ()
    Text_File$ = Text_File_Label.Caption
    Title$ = Title_Edit.Text
    Title$ = PrepareString(Title$)
    If Text_File$ = "(none)" Then
	Beep
	MsgBox "Please select a text file to insert."
    ElseIf Title$ = "" Then
	Beep
	MsgBox "Please enter a title for the text file you wish to insert."
    Else
	PrimaryWindow.MousePointer = 11
	InsertText Title$, Text_File$
	Title_Edit.Text = ""
	Text_File_List.ListIndex = -1
	Text_File_Label.Caption = ""
	RetrieveTextTitles
	PrimaryWindow.MousePointer = 0
    End If
End Sub
Sub InsertText (Title As String, Text_File As String)
    
Rem
Rem This routine will insert the text data into the table
Rem Insert new row with title and token text value
Rem
    Results% = ExecuteSQLCommand("Insert into text_table values ('" + Title + "','none')")
    Do While SqlResults(SqlConn%) <> NOMORERESULTS%
	Do While SqlNextRow(SqlConn%) <> NOMOREROWS%
	Loop
    Loop
Rem Get identifier for text column in current row
    Results% = ExecuteSQLCommand("select text_col from text_table where title = '" + Title + "'")
    Do While SqlResults(SqlConn%) <> NOMORERESULTS%
	Do While SqlNextRow(SqlConn%) <> NOMOREROWS%
	    SqlPointer$ = SqlTxPtr(SqlConn%, 1)
	    SqlTimestamp$ = SqlTxTimeStamp(SqlConn%, 1)
	Loop
    Loop
Rem Open text file to load into SQL Server table
    DataPartLimit& = 8192
    Done% = False
    
    Open Text_File For Input As #1
    FileLength& = LOF(1)
    If FileLength& > 65536 Then
	MsgBox "This application cannot display text files greater than 64K."
    Else
	FileData$ = ""
	Do While Not EOF(1)
	    Input #1, DataPart$
	    If Right$(DataPart$, 2) <> Chr$(13) + Chr$(10) Then
		If Right$(DataPart$, 1) = Chr$(13) Then
		    FileData$ = FileData$ + Left$(DataPart$, Len(DataPart$) - 1) + Chr$(13) + Chr$(10)
		ElseIf Right$(DataPart$, 1) = Chr$(10) Then
		    FileData$ = FileData$ + Left$(DataPart$, Len(DataPart$) - 1) + Chr$(13) + Chr$(10)
		Else
		    FileData$ = FileData$ + DataPart$ + Chr$(13) + Chr$(10)
		End If
	    Else
		FileData$ = FileData$ + DataPart$
	    End If
	Loop
Rem Begin inserting text into text column in DatePartLimit& size chunks
	Table$ = "text_table.text_col"
	DataPos& = 1
	DataLen& = Len(FileData$)
	If SqlWriteText(SqlConn%, Table$, SqlPointer$, SQLTXPLEN%, SqlTimestamp$, 1, DataLen&, "") <> FAIL% Then
	    If SqlOk(SqlConn%) <> FAIL% Then
		Results% = SqlResults(SqlConn%)
		Do While Not Done%
		    If DataPos& + DataPartLimit& - 1 < DataLen& Then
			DataPart$ = Mid$(FileData$, DataPos&, DataPartLimit&)
			DataPos& = DataPos& + Len(DataPart$)
		    Else
			DataPart$ = Mid$(FileData$, DataPos&, DataLen& - DataPos& + 1)
			Done% = True
		    End If
		Results% = SqlMoreText%(SqlConn%, Len(DataPart$), DataPart$)
		Loop
		If SqlOk(SqlConn%) <> FAIL% Then
		    If SqlResults(SqlConn%) <> FAIL% Then
		    MsgBox "Text inserted."
		    End If
		End If
	    End If
	End If
    End If
Close 1
End Sub
Sub LoadText (Title As String)
    
Rem
Rem This routine will read the text field from the table
Rem Clear Text_Edit box on primary window
Rem
    Text_Edit.Text = ""
Rem Get length of text in text column
    Results% = ExecuteSQLCommand("select datalength(text_col) from text_table where title = '" + Title + "'")
    Do While SqlResults(SqlConn%) <> NOMORERESULTS
	Do While SqlNextRow(SqlConn%) <> NOMOREROWS
	    TextLen& = Val(Sqldata(SqlConn%, 1))
	Loop
    Loop
    Offset& = 0
	
Rem Set size limit on chunks of text data
    LoadSizeLimit& = 8192
    If LoadSizeLimit& > TextLen& Then
	LoadSizeLimit& = TextLen&
    End If
    
    LoadSize& = LoadSizeLimit&
Rem Set size of text returned to LoadSizeLimit&
    Results% = ExecuteSQLCommand("set textsize " + Str$(LoadSizeLimit&))
    Do While SqlResults(SqlConn%) <> NOMORERESULTS
	Do While SqlNextRow(SqlConn%) <> NOMOREROWS
	Loop
    Loop
Rem Begin reading text column in LoadSizeLimit& size chunks
    Cmd$ = "Declare @val varbinary(30)"
    Results% = SqlCmd(SqlConn%, Cmd$)
    Cmd$ = "Select @val = textptr(text_col) from text_table where title = '" + Title + "'"
    Results% = SqlCmd(SqlConn%, Cmd$)
    Done% = False
	Do While Not Done%
	    Cmd$ = "READTEXT text_table.text_col @val " + Str$(Offset&) + " " + Str$(LoadSize&)
	    Results% = SqlCmd(SqlConn%, Cmd$)
	    If Offset& + LoadSize& = TextLen& Then
		Done% = True
	    Else
		Offset& = Offset& + LoadSizeLimit&
		If Offset& + LoadSizeLimit& > TextLen& Then
		    LoadSize& = TextLen& - Offset&
		End If
	    End If
	Loop
Rem Retrieve text data in result rows and place in text_edit box
    
    FileData$ = ""
    If SqlExec(SqlConn%) <> FAIL% Then
	Do While SqlResults(SqlConn%) <> NOMORERESULTS
	    Do While SqlNextRow(SqlConn%) <> NOMOREROWS
		FileData$ = FileData$ + Sqldata(SqlConn%, 1)
	    Loop
	Loop
    End If
Rem Load text data into edit box on primary window
    Text_Edit.Text = FileData$
End Sub
Sub Log_Off_Selection_Click ()
    Logoff
    Logon_Selection.Enabled = True
    Log_Off_Selection.Enabled = False
    Exit_Selection.Enabled = True
    View_Selection.Enabled = False
    Insert_Selection.Enabled = False
    Delete_Selection.Enabled = False
End Sub
Sub Logon_Selection_Click ()
    Login.Show 1
    PrimaryWindow.MousePointer = 11
    If CheckServerConnection() = 1 Then
	Results% = GetDatabases(Database_list)
	ChangePrimaryWindowCaption
	Logon_Selection.Enabled = False
	Log_Off_Selection.Enabled = True
    End If
    PrimaryWindow.MousePointer = 0
End Sub
Function PrepareString (String_In As String) As String
Rem
Rem This routine will double up the single quotation mark to
Rem avoid syntax errors
Rem
    String_Out$ = ""
    For I% = 1 To Len(String_In)
	If Mid$(String_In, I%, 1) = Chr$(39) Then
	    String_Out$ = String_Out$ + Chr$(39) + Chr$(39)
	Else
	    String_Out$ = String_Out$ + Mid$(String_In, I%, 1)
	End If
    Next
    PrepareString = String_Out$
End Function
Sub RetrieveTextTitles ()
Rem
Rem This routine will get all the text titles from the table
Rem Put them in the list box as they are retrieved.
Rem
    ClearTextTitles
    Results% = ExecuteSQLCommand("Select title from text_table")
    Do While (SqlResults%(SqlConn%) <> NOMORERESULTS)
	Do While (SqlNextRow(SqlConn%) <> NOMOREROWS)
	    Titles_List.AddItem Sqldata(SqlConn%, 1)
	Loop
    Loop
End Sub
Sub Text_Edit_KeyPress (KeyAscii As Integer)
    If KeyAscii <> 0 Then
	KeyAscii = 0
    End If
End Sub
Sub Text_File_List_Click ()
    If Right$(Dir_Tree_Combo.Path, 1) = "" Then
	Text_File_Label.Caption = Dir_Tree_Combo.Path + Text_File_List.FileName
    Else
	Text_File_Label.Caption = Dir_Tree_Combo.Path + "" + Text_File_List.FileName
    End If
End Sub
Sub Title_Edit_KeyPress (KeyAscii As Integer)
    If Len(Title_Edit.Text) = 30 Then
	If KeyAscii <> 8 Then
	    KeyAscii = 0
	End If
    End If
    
End Sub
Sub Titles_List_Click ()
    Text_Edit.Text = ""
End Sub
Sub Titles_List_DblClick ()
    Text_Title$ = Titles_List.Text
    PrimaryWindow.MousePointer = 11
    LoadText Text_Title$
    PrimaryWindow.MousePointer = 0
End Sub
Sub VBSQL1_Error (SqlConn As Integer, Severity As Integer, ErrorNum As Integer, ErrorStr As String, RetCode As Integer)
' Call the required VBSQL error-handling function
' OSErr and OSErrStr not used in VBSQL for Windows, but DOS interprets
' anything other than -1 as an OS error
    OsErr% = -1
    RetCode% = UserSqlErrorHandler%(SqlConn, Severity%, ErrorNum%, OsErr%, ErrorStr$, OsErrStr$)
End Sub
Sub VBSQL1_Message (SqlConn As Integer, Message As Long, State As Integer, Severity As Integer, MsgStr As String)
    UserSqlMsgHandler SqlConn, Message&, State%, Severity%, MsgStr$
End Sub
Sub View_Selection_Click ()
    Text_Title$ = Titles_List.Text
    If Text_Title$ = "" Then
	Beep
	MsgBox "You must first select a title."
    Else
	PrimaryWindow.MousePointer = 11
	LoadText Text_Title$
	PrimaryWindow.MousePointer = 0
    End If
End Sub

						