Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / intext1a / frmgolba.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1999-10-05 | 24.7 KB | 655 lines

VERSION 5.00 Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX" Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX" Begin VB.Form frmGlobal Caption = "Autex. Global In Text Search. copyright(c) Neil Etherington 1999" ClientHeight = 8310 ClientLeft = 60 ClientTop = 630 ClientWidth = 11880 LinkTopic = "Form1" ScaleHeight = 8310 ScaleMode = 0 'User ScaleWidth = 11880 StartUpPosition = 2 'CenterScreen WindowState = 2 'Maximized Begin ComctlLib.Toolbar Toolbar1 Align = 1 'Align Top Height = 420 Left = 0 TabIndex = 18 Top = 0 Width = 11880 _ExtentX = 20955 _ExtentY = 741 ButtonWidth = 635 ButtonHeight = 582 Appearance = 1 ImageList = "ImageList1" _Version = 327682 BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7} NumButtons = 7 BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "Find" Object.ToolTipText = "Multiple Search" Object.Tag = "" ImageKey = "Find" EndProperty BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "FindSingle" Object.ToolTipText = "Single Search" Object.Tag = "" ImageKey = "FindSingle" EndProperty BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "Clear" Object.ToolTipText = "Clear Data Fields" Object.Tag = "" ImageKey = "Clear" EndProperty BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7} Object.Tag = "" Style = 3 MixedState = -1 'True EndProperty BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7} Key = "TxtSearch" Object.ToolTipText = "Search For Next Occurrence" Object.Tag = "" ImageKey = "TxtSearch" EndProperty EndProperty BorderStyle = 1 End Begin VB.TextBox txtCount Height = 285 Left = 4680 TabIndex = 19 Text = "0" Top = 3000 Width = 1095 End Begin ComctlLib.StatusBar StatusBar1 Align = 2 'Align Bottom Height = 375 Left = 0 TabIndex = 17 Top = 7935 Width = 11880 _ExtentX = 20955 _ExtentY = 661 SimpleText = "" _Version = 327682 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 2 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 6 Alignment = 1 Object.Width = 1764 MinWidth = 1764 TextSave = "10/5/99" Object.Tag = "" Object.ToolTipText = "Date" EndProperty BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7} Style = 5 Alignment = 1 Object.Width = 1764 MinWidth = 1764 TextSave = "10:35 PM" Object.Tag = "" Object.ToolTipText = "Time" EndProperty EndProperty End Begin VB.ComboBox Combo1 BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3300 Left = 2760 Style = 1 'Simple Combo TabIndex = 6 Top = 4320 Width = 3015 End Begin VB.FileListBox File1 Height = 3210 Left = 360 System = -1 'True TabIndex = 5 Top = 4440 Width = 2175 End Begin VB.DirListBox Dir1 Height = 2790 Left = 360 TabIndex = 1 Top = 1560 Width = 2175 End Begin VB.DriveListBox Drive1 Height = 315 Left = 360 TabIndex = 0 Top = 1080 Width = 2175 End Begin VB.Frame fmeSearch Caption = "Global In Text Search" Height = 7095 Left = 240 TabIndex = 9 Top = 720 Width = 5655 Begin VB.TextBox txtSngCount Height = 285 Left = 4440 TabIndex = 21 Text = "0" Top = 3000 Width = 1095 End Begin ComctlLib.ProgressBar ProgressBar1 Height = 135 Left = 2520 TabIndex = 15 Top = 600 Width = 3015 _ExtentX = 5318 _ExtentY = 238 _Version = 327682 Appearance = 1 Max = 1000 End Begin VB.TextBox txtFilespec Height = 285 Left = 2520 TabIndex = 4 Text = "*.txt" Top = 1560 Width = 3015 End Begin VB.CheckBox chkMatchCase Caption = "Match Case." Height = 375 Left = 2520 TabIndex = 3 ToolTipText = "Check This Box If You Want To Match Case" Top = 840 Width = 1455 End Begin VB.TextBox txtFilesFound Height = 285 Left = 2520 TabIndex = 7 TabStop = 0 'False Text = "0" Top = 2280 Width = 1095 End Begin VB.TextBox txtFilesSearched Height = 285 Left = 2520 TabIndex = 8 TabStop = 0 'False Text = "0" Top = 3000 Width = 1095 End Begin VB.TextBox txtSearchString Height = 285 Left = 2520 TabIndex = 2 ToolTipText = "Please Enter String" Top = 240 Width = 3015 End Begin VB.Label lblSngCount AutoSize = -1 'True Caption = "Single Count" Height = 195 Left = 4440 TabIndex = 22 Top = 2760 Width = 900 End Begin VB.Label lblTxtCount AutoSize = -1 'True Caption = "String Count" Height = 195 Left = 4440 TabIndex = 20 Top = 2040 Width = 870 End Begin VB.Label lblFilespec Caption = "FileList (FileSpec)." Height = 255 Left = 2520 TabIndex = 14 Top = 1320 Width = 1575 End Begin VB.Line Line2 BorderColor = &H80000005& X1 = 2400 X2 = 2400 Y1 = 7080 Y2 = 120 End Begin VB.Line Line1 BorderColor = &H80000003& X1 = 2390 X2 = 2390 Y1 = 120 Y2 = 7080 End Begin VB.Label lblFilesFound AutoSize = -1 'True Caption = "Files Found." Height = 195 Left = 2520 TabIndex = 13 Top = 2040 Width = 855 End Begin VB.Label lblFilesSearched AutoSize = -1 'True Caption = "Files In List." Height = 195 Left = 2520 TabIndex = 12 Top = 2760 Width = 825 End Begin VB.Label lblSearchString Caption = "Search For. (Enter String)." Height = 255 Left = 2520 TabIndex = 11 Top = 0 Width = 2175 End Begin VB.Label lblFiles AutoSize = -1 'True Caption = "Files Found With String." Height = 195 Left = 2520 TabIndex = 10 Top = 3360 Width = 1680 End End Begin RichTextLib.RichTextBox rtBoxMain Height = 6975 Left = 6000 TabIndex = 16 Top = 840 Width = 5655 _ExtentX = 9975 _ExtentY = 12303 _Version = 393217 ScrollBars = 3 TextRTF = $"frmGolbal.frx":0000 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin ComctlLib.ImageList ImageList1 Left = 6000 Top = 360 _ExtentX = 1005 _ExtentY = 1005 BackColor = -2147483643 ImageWidth = 16 ImageHeight = 16 MaskColor = 12632256 _Version = 327682 BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} NumListImages = 4 BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmGolbal.frx":00AE Key = "Find" EndProperty BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmGolbal.frx":01C0 Key = "FindSingle" EndProperty BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmGolbal.frx":0452 Key = "TxtSearch" EndProperty BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} Picture = "frmGolbal.frx":06E4 Key = "Clear" EndProperty EndProperty End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuhyphen Caption = "-" End Begin VB.Menu mnuFileMultipleSearch Caption = "Multiple &Search" Shortcut = ^S End Begin VB.Menu mnuFileSingleSearch Caption = "S&ingle Search" Shortcut = ^I End Begin VB.Menu mnuhyphen3 Caption = "-" Index = 3 End Begin VB.Menu mnuFileExit Caption = "E&xit" Shortcut = ^X End End Begin VB.Menu mnuEdit Caption = "&Edit" Begin VB.Menu mnuhyphen1 Caption = "-" Index = 1 End Begin VB.Menu mnuEditFFlist Caption = "&Clear Field Lists" Shortcut = ^C End End Begin VB.Menu mnuFind Caption = "Find" Begin VB.Menu mnuhyphen5 Caption = "-" Index = 5 End Begin VB.Menu mnuFindSFNO Caption = "Search For Next Occurrence" Shortcut = ^N End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuhyphen2 Caption = "-" Index = 2 End Begin VB.Menu mnuHelpAbout Caption = "&About" Shortcut = ^A End End Attribute VB_Name = "frmGlobal" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'Programmer Neil Etherington 'Program Type Windows Search Engine 'Program Name Autex. In File Searcher 'Commence Date 26.9.99 'Version No. v1.1 'Description This program will search through a directory of selected files.' ' Search within those selected files and add the names of the files ' to a combobox if the string that you want to search for is found ' within those files. You can then load the files into a richtextbox ' by clicking on the selected file. The string that you ' searched for will then be selected in the richtextbox. ' You can then search for the next string within the richtextbox. 'If you can understand that description, then have a pint on me, because i can`t and i wrote it. Option Explicit 'Sets variables before their used Dim strGsearch As String 'variable for rtboxsearch.text Dim strFound As String 'Variable that holds the string thats found at gfindposition& Dim intFileCount As Integer 'Variable that holds the val() of files in the file1.listcount Dim intListCount As Integer 'Variable that holds the val() of files in the file1.listindex -1 Dim strSearchFor As String 'Variable that holds the string to search for Dim gCount As Long Dim gFindrtBox As Long 'Variable that holds the position when searching through the rtboxmain.text Dim gFindPosition As Long 'Variable that holds the position when searching through the rtboxsearch.text Private Sub Combo1_Click() File1.FileName = Combo1.Text 'Sets the filename of file1.filename (Only this name will appear) txtSngCount.Text = Val(1) End Sub Private Sub Dir1_Change() On Error Resume Next 'Stops error occuring when no cdrom is in the drive File1.Path = Dir1.Path 'Updates file1.path End Sub Private Sub Drive1_Change() On Error Resume Next 'Stops error occuring when no cdrom is in the drive Dir1.Path = Drive1.Drive 'Updates dir1.path End Sub Private Sub File1_DblClick() gFindrtBox = Val(0) 'Sets the variable back to val(0) when loading new file into rtboxmain If File1.ListIndex = -1 Then 'When no file is selected in the file1.list then MsgBox "Please Select A File To Start The Search From", vbOKOnly, "Autex. In File Searcher." Else 'If file is selected then rtBoxMain.LoadFile modGlobalSearch.GetSelectedFile(Dir1.Path) End If txtCount.Text = Val(CountString%) 'Retrieves the value of the countstring function rtBoxMain.SetFocus End Sub Private Sub Form_Load() File1.Pattern = "*.txt" 'Sets default pattern of file1 'Combo1.FontBold = True 'Pretty obvious really rtBoxMain.SelIndent = 50 'Sets a default left indent of rtboxmain End Sub Private Sub Form_Resize() On Error Resume Next 'Stops error occurring when minimize button is clicked 'Keeps rtboxmain in proportion with frmglobal With rtBoxMain .Height = frmGlobal.Height - 2000 .Width = frmGlobal.Width - 6500 End With End Sub Private Sub mnuEditFFlist_Click() txtSngCount.Text = Val(0) 'Clears txtsngcount.text txtCount.Text = Val(0) 'Clears txtcount.text txtSearchString.Text = "" 'Clears txtsearchstring.text txtFilesFound.Text = Val(0) 'Clears txtfilesfound.text txtFilesSearched.Text = Val(0) 'Clears txtfilessearched.text Combo1.Clear 'Clears combobox rtBoxMain.Text = "" 'Clears rtboxmain.text 'These variables are cleared because they will hold their value until the 'end of the application strGsearch$ = "" 'Clears strgsearch strFound$ = "" 'Clears strfound intFileCount% = Val(0) 'Clears intfilecount intListCount% = Val(0) 'Clears intlistcount strSearchFor$ = "" 'Clears strsearchfor gCount& = Val(0) 'Sets gcount val(0) gFindrtBox = Val(0) 'Sets gfindrtbox val(0) gFindPosition = Val(0) 'Sets gfindposition val(0) File1.Pattern = txtFilespec.Text 'Sets file1.pattern End Sub Private Sub mnuFileExit_Click() Unload Me 'Unload from memory Close 'Close program End Sub Private Sub mnuFileMultipleSearch_Click() On Error Resume Next 'Stops error occuring when no files are in the file1.listindex If txtSearchString.Text <= "" Then 'If no string is entered to search for then MsgBox "No String Entered Into.(Search For).", vbOKOnly, "Autex. In File Searcher." Exit Sub End If If File1.ListIndex <= -1 Then 'If no file is selected to search from then start at val(0) File1.ListIndex = 0 End If On Error Resume Next 'I`ve tested the program throughly, but you never know 'Dim strFilesFound As Integer 'Dim strFilesSearched As Integer strSearchFor$ = txtSearchString.Text 'AS above For intFileCount% = 0 To File1.ListCount - 1 'Count how many files are in the filelist Next intFileCount% intListCount% = File1.ListIndex - 1 'As above Do 'The best bit ProgressBar1.Max = Val(intFileCount%) ProgressBar1.Value = Val(intListCount%) 'Updates progressbar Open modGlobalSearch.GetSelectedFile(Dir1.Path) For Binary As 1 'Loadfile into strgsearch$ strGsearch$ = String(LOF(1), Chr$(0)) Get 1, , strGsearch$ Close 1 If chkMatchCase.Value = vbChecked Then 'If matchcase checkbox is cheched then strGsearch$ = strGsearch$ Else 'If it`s not checked then strGsearch$ = LCase(strGsearch$) End If gFindPosition& = InStr(strGsearch$, strSearchFor$) 'Find position of strsearchfor$ in rtboxsearch$ strFound$ = Mid(strGsearch$, gFindPosition&, Len(strSearchFor$)) 'If string found the extract string into strfound$ 'For newbies, Like me. This code does not physicaly remove the string from the file If strFound$ = strSearchFor$ Then 'If the string is found then Combo1.AddItem File1.FileName End If intListCount% = intListCount% + 1 'Couldn`t get it to search the last file in the file1.list so i added this code File1.ListIndex = File1.ListIndex + 1 'Couldn`t get it to search the last file in the file1.list so i added this code strGsearch$ = "" 'Clear the variable for the next file strFound$ = "" 'Clear the variable for the next file DoEvents Loop Until intListCount% >= intFileCount% - 1 'Do until no more files are in the file1.list txtFilesFound = Val(Combo1.ListCount) 'Count how many files are in the combo1 and enter into txtfilesfound txtFilesSearched = Val(File1.ListCount) 'Count how many files are in the file1 and enter into txtfilessearched ProgressBar1.Value = 0 'Sets progressbar to val(0) when search finished File1.ListIndex = 0 MsgBox "Search Completed", vbOKOnly, "Autex. In File Searcher." 'Tells you when all files have been searched End Sub 'This is the same as above but searches through the selected file only Private Sub mnuFileSingleSearch_Click() On Error Resume Next If txtSearchString.Text <= "" Then MsgBox "No String Entered Into.(Search For).", vbOKOnly, "Autex. In File Searcher." Exit Sub End If If File1.ListIndex <= -1 Then File1.ListIndex = 0 End If On Error Resume Next strSearchFor$ = txtSearchString.Text For intFileCount% = 0 To File1.ListCount - 1 Next intFileCount% intListCount% = File1.ListIndex - 1 Open modGlobalSearch.GetSelectedFile(Dir1.Path) For Binary As 1 strGsearch$ = String(LOF(1), Chr$(0)) Get 1, , strGsearch$ Close 1 If chkMatchCase.Value = vbChecked Then strGsearch$ = strGsearch$ Else strGsearch$ = LCase(strGsearch$) End If gFindPosition& = InStr(strGsearch$, strSearchFor$) strFound$ = Mid(strGsearch$, gFindPosition&, Len(strSearchFor$)) If strFound$ = strSearchFor$ Then Combo1.AddItem File1.FileName End If intListCount% = intListCount% + 1 File1.ListIndex = File1.ListIndex + 1 strGsearch$ = "" strFound$ = "" txtFilesFound = Combo1.ListCount txtFilesSearched = File1.ListCount ProgressBar1.Value = 0 If intListCount% >= intFileCount% - 1 Then MsgBox "Search Completed", vbOKOnly, "Autex. In File Searcher." End If End Sub Private Sub mnuFindSFNO_Click() rtBoxMain_GotFocus 'Goto rtboxmain_change(Below) txtSngCount.Text = txtSngCount.Text + Val(1) End Sub Private Sub mnuHelpAbout_Click() frmAbout.Show End Sub Private Sub rtBoxMain_GotFocus() On Error Resume Next Dim strStringFor As String 'Variable that holds txtsearchstring Dim strStringThrough As String 'Variable that holds rtboxmain.text strStringFor$ = txtSearchString.Text 'As above If chkMatchCase.Value = vbChecked Then 'If chkmatchcase.value = vbchecked then strStringThrough$ = rtBoxMain.Text Else 'If it isn`t checked then strStringThrough$ = LCase(rtBoxMain.Text) End If gFindrtBox& = InStr(gFindrtBox& + 1, strStringThrough$, strStringFor$) 'Finds position (As above) If gFindrtBox& <= 0 Then 'If no more strings are found then MsgBox "Sorry: Their Are No More Occurrence Of The Word. " & vbCrLf & vbCrLf _ & " ----- " & strStringFor$ & " -----", vbOKOnly, "Autex. In File Searcher" txtSngCount.Text = Val(-1) Exit Sub End If rtBoxMain.SelStart = gFindrtBox& - 1 'Sets the start position in rtboxmain rtBoxMain.SelLength = Len(strStringFor$) 'Sets the length of text to be highlighted in rtboxmain rtBoxMain.SetFocus End Sub 'This code just operates the buttons on the toolbar Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button) Select Case Button.Key Case "Find" mnuFileMultipleSearch_Click Case "FindSingle" mnuFileSingleSearch_Click Case "Clear" mnuEditFFlist_Click Case "TxtSearch" rtBoxMain_GotFocus If Toolbar1.Buttons("TxtSearch").Value = tbrUnpressed Then txtSngCount.Text = txtSngCount.Text + Val(1) End If End Select End Sub Private Sub txtFilespec_Change() File1.Pattern = txtFilespec.Text End Sub Private Sub txtSearchString_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then mnuFileMultipleSearch_Click End If End Sub 'This function will search the the text file while it loads into the 'richtextbox and count how many occurrance of the word you searched for are 'in the string. Its very similar to the code in the global search so i won`t 'add comments Private Function CountString() As Integer Dim intStringCount As Integer Dim strStringA As String Dim strStringB As String strStringA$ = LCase(rtBoxMain.Text) strStringB$ = txtSearchString.Text txtCount.Text = "" gCount& = Val(0) gCount& = InStr(gCount& + 1, strStringA$, strStringB$) If gCount& <= 0 Then Exit Function End If strFound$ = Mid(rtBoxMain.Text, gCount&, Len(txtSearchString.Text)) If strFound$ >= " " Then intStringCount% = intStringCount% + 1 End If CountString% = Val(intStringCount%) DoEvents End Function