home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL" Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX" Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX" Begin VB.Form frmDoorToTheNet BackColor = &H00000000& Caption = "The DoorWay To The Net" ClientHeight = 7935 ClientLeft = 150 ClientTop = 720 ClientWidth = 10530 Icon = "frmDoorToTheNet.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 7935 ScaleWidth = 10530 ShowInTaskbar = 0 'False Begin MSComctlLib.ProgressBar PBar Height = 255 Left = 120 TabIndex = 10 Top = 7560 Width = 1695 _ExtentX = 2990 _ExtentY = 450 _Version = 393216 Appearance = 0 End Begin VB.Timer Timer1 Interval = 1000 Left = 9360 Top = 120 End Begin MSComDlg.CommonDialog dlgEdit Left = 9960 Top = 840 _ExtentX = 847 _ExtentY = 847 _Version = 393216 End Begin VB.Timer tmrWinClass Interval = 1000 Left = -240 Top = 7920 End Begin VB.TextBox txtStatus BackColor = &H80000001& Enabled = 0 'False Height = 285 Left = 2640 TabIndex = 7 Top = 7560 Width = 6255 End Begin VB.ComboBox txtAddress BackColor = &H80000001& ForeColor = &H000000FF& Height = 315 Left = 1080 Sorted = -1 'True TabIndex = 6 Top = 960 Width = 4935 End Begin VB.OptionButton optexcite BackColor = &H80000012& Caption = "HotBot" ForeColor = &H000000FF& Height = 255 Left = 8520 MousePointer = 10 'Up Arrow TabIndex = 4 ToolTipText = "Excite Search Engine" Top = 1080 Width = 255 End Begin VB.OptionButton optLycos BackColor = &H80000012& Caption = "Lycos" ForeColor = &H000000FF& Height = 375 Left = 8520 MousePointer = 10 'Up Arrow TabIndex = 3 ToolTipText = "Lycos Search Engine" Top = 600 Width = 255 End Begin VB.OptionButton optNetscape BackColor = &H80000012& Caption = "Netscape" ForeColor = &H000000FF& Height = 255 Left = 6960 MousePointer = 10 'Up Arrow TabIndex = 2 ToolTipText = "Netscape Search Engine" Top = 1080 Width = 255 End Begin VB.OptionButton optYahoo BackColor = &H80000007& Caption = "Yahoo" ForeColor = &H000000FF& Height = 255 Left = 6960 MousePointer = 10 'Up Arrow TabIndex = 1 ToolTipText = "Yahoo Search Engine" Top = 600 Width = 255 End Begin InetCtlsObjects.Inet Inet1 Left = 120 Top = 1440 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 End Begin SHDocVwCtl.WebBrowser WebBrowser1 Height = 5895 Left = 120 TabIndex = 0 Top = 1440 Width = 10335 ExtentX = 18230 ExtentY = 10398 ViewMode = 1 Offline = 0 Silent = 0 RegisterAsBrowser= 0 RegisterAsDropTarget= 1 AutoArrange = -1 'True NoClientEdge = 0 'False AlignLeft = 0 'False ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}" Location = "" End Begin VB.Label Label2 Caption = "Label2" Height = 255 Left = -600 TabIndex = 11 Top = 7920 Width = 615 End Begin VB.Label lblStatus BackColor = &H80000012& Caption = "Status:" ForeColor = &H000000FF& Height = 255 Left = 2040 TabIndex = 9 Top = 7560 Width = 615 End Begin VB.Label lblSearchit BackColor = &H80000015& Caption = "Search On Yahoo!" BeginProperty Font Name = "Lucida Sans" Size = 12 Charset = 0 Weight = 400 Underline = 0 'False Italic = -1 'True Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 375 Left = 7260 MousePointer = 10 'Up Arrow TabIndex = 8 ToolTipText = "Search Yahoo Search Engine" Top = 180 Width = 2415 End Begin VB.Image imgLycosSearch Height = 330 Left = 8520 Picture = "frmDoorToTheNet.frx":08CA Top = 6120 Width = 1260 End Begin VB.Line Line4 BorderColor = &H000000FF& X1 = 9840 X2 = 10560 Y1 = 735 Y2 = 735 End Begin VB.Image imgNetscape Height = 330 Left = 7155 Picture = "frmDoorToTheNet.frx":1444 Top = 1020 Width = 1185 End Begin VB.Image imgYahoo Height = 285 Left = 7200 Picture = "frmDoorToTheNet.frx":1F66 Top = 645 Width = 1305 End Begin VB.Image imgexcite Height = 390 Left = 8760 Picture = "frmDoorToTheNet.frx":2A30 Top = 960 Width = 975 End Begin VB.Image ImgLycos Height = 375 Left = 8760 Picture = "frmDoorToTheNet.frx":355A Top = 600 Width = 945 End Begin VB.Image Image3 Height = 495 Left = 4680 Top = 3480 Width = 1215 End Begin VB.Image imgYahooChat Height = 270 Left = 5200 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":3FDC ToolTipText = "Yahoo Chat" Top = 315 Width = 1515 End Begin VB.Image imgYahoomail Height = 315 Left = 3190 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":4B6E ToolTipText = "Yahoo Mail" Top = 300 Width = 1110 End Begin VB.Image imgHotmail Height = 540 Left = 4440 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":55EC ToolTipText = "MSN HotMail" Top = 240 Width = 720 End Begin VB.Image ImgExitDoor Height = 555 Left = 9960 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":60EE Stretch = -1 'True ToolTipText = "Exit DoorWay" Top = 120 Width = 495 End Begin VB.Image imgOpenDoor Height = 480 Left = 6120 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":621E ToolTipText = "Open DoorWay" Top = 840 Width = 495 End Begin VB.Image imgHome Height = 480 Left = 2640 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":632A ToolTipText = "Home ""www.Yahoo.com""" Top = 165 Width = 480 End Begin VB.Image imgConnect Height = 480 Left = 9960 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":6729 ToolTipText = "Connect" Top = 7440 Width = 480 End Begin VB.Image imgReload Height = 525 Left = 1320 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":6F6B ToolTipText = "Reload" Top = 195 Width = 540 End Begin VB.Image imgfoward Height = 375 Left = 720 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":7899 Stretch = -1 'True ToolTipText = "Foward" Top = 240 Width = 540 End Begin VB.Image imgBack Height = 345 Left = 120 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":80CB Stretch = -1 'True ToolTipText = "Back" Top = 240 Width = 540 End Begin VB.Image Image2 Height = 495 Left = 4680 Top = 3480 Width = 1215 End Begin VB.Line Line3 BorderColor = &H000000FF& X1 = 9840 X2 = 9840 Y1 = 120 Y2 = 1320 End Begin VB.Line Line2 BorderColor = &H000000FF& X1 = 6840 X2 = 6840 Y1 = 120 Y2 = 1320 End Begin VB.Line Line1 X1 = 4680 X2 = 5880 Y1 = 3240 Y2 = 3720 End Begin VB.Label Label1 BackColor = &H80000007& Caption = "Address :" ForeColor = &H000000FF& Height = 255 Left = 360 TabIndex = 5 Top = 960 Width = 735 End Begin VB.Image imgExit Height = 480 Left = 1920 MousePointer = 10 'Up Arrow Picture = "frmDoorToTheNet.frx":88FD ToolTipText = "Stop" Top = 180 Width = 480 End Begin VB.Image Image1 Height = 495 Left = 8280 Top = 600 Width = 615 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuNew Caption = "&New" Begin VB.Menu mnuDorWay Caption = "DoorWay" End End Begin VB.Menu mnuOpen Caption = "&Open" Shortcut = ^O End Begin VB.Menu mnuClose Caption = "&Close" Shortcut = ^W End Begin VB.Menu mnuLine1 Caption = "-" End Begin VB.Menu mnuSave Caption = "&Save" Shortcut = ^S End Begin VB.Menu mnuSaveAs Caption = "Save &As" Shortcut = ^A End Begin VB.Menu mnuLine2 Caption = "-" End Begin VB.Menu mnuPrint Caption = "&Print" Shortcut = ^P End Begin VB.Menu mnuline3 Caption = "-" End Begin VB.Menu mnuExit Caption = "E&xit" Shortcut = ^Q End End Begin VB.Menu mnuEdit Caption = "&Edit" Begin VB.Menu mnuCut Caption = "Cu&t" Shortcut = ^X End Begin VB.Menu mnuCopy Caption = "&Copy" Shortcut = ^C End Begin VB.Menu mnuPaste Caption = "&Paste" Shortcut = +{INSERT} End Begin VB.Menu mnuLine4 Caption = "-" End Begin VB.Menu mnuSelectall Caption = "Select &All" Shortcut = +{DEL} End Begin VB.Menu mnulines Caption = "-" End Begin VB.Menu mnuFind Caption = "&Find" Shortcut = ^F End Begin VB.Menu mnuFindNext Caption = "Find &Next" Shortcut = {F3} End End Begin VB.Menu mnuFavorites Caption = "Favorites" Begin VB.Menu mnuAddToFavorites Caption = "Add to Favorites" Shortcut = {F9} End Begin VB.Menu mnuViewFavorites Caption = "View Favorites" Shortcut = {F11} End Begin VB.Menu mnuDeleteFavorite Caption = "Delete Favorite" Shortcut = {F12} End End Begin VB.Menu mnuView Caption = "&View" Begin VB.Menu mnuReload Caption = "Reload" End Begin VB.Menu mnuRefresh Caption = "Re&fresh" End Begin VB.Menu linea Caption = "-" End Begin VB.Menu mnuViewSource Caption = "Page Source" End Begin VB.Menu line11 Caption = "-" End Begin VB.Menu mnuPreferences Caption = "&Preferences" Shortcut = {F2} End End Begin VB.Menu mnuGo Caption = "&Go" Begin VB.Menu MnuSearch Caption = "&Search Engines" Begin VB.Menu mnuSmfSearchengine Caption = "SMF Search Engine" End Begin VB.Menu mnuYahoo Caption = "Yahoo" End Begin VB.Menu mnuAskJeeves Caption = "Ask Jeeves" End Begin VB.Menu mnuHotBot Caption = "Hot Bot" End Begin VB.Menu mnuLycos Caption = "Lycos" End Begin VB.Menu mnuExcite Caption = "Excite" End Begin VB.Menu mnuNetscape Caption = "Netscape" End Begin VB.Menu mnuDogPile Caption = "Dog Pile" End Begin VB.Menu mnuMSN Caption = "MSN" End Begin VB.Menu mnuAltaVista Caption = "Alta Vista" End Begin VB.Menu mnuGoto Caption = "Goto" End Begin VB.Menu mnuthunderstone Caption = "ThunderStone" End Begin VB.Menu mnulookSmart Caption = "Look Smart" End Begin VB.Menu mnuDirectHit Caption = "Direct Hit" End Begin VB.Menu mnuAboutcom Caption = "About" End Begin VB.Menu mnuInfoSeek Caption = "Info Seek" End End Begin VB.Menu mnuline34 Caption = "-" End Begin VB.Menu mnuBack Caption = "Back" End Begin VB.Menu mnuFoward Caption = "Foward" End Begin VB.Menu mnuHome Caption = "Home" End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuAbout Caption = "About " Begin VB.Menu mnuMacrosoft Caption = "MacroSoft DoorWays" End End Begin VB.Menu mnuHelpOn Caption = "Help On" Shortcut = ^H End End Attribute VB_Name = "frmDoorToTheNet" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'Bouncing exit vairables and declarations------------- Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Dim What As RECT '----------------------------------------------------- Private Sub Form_Activate() mnuFind.Enabled = False mnuFindNext = False Do Until Me.Left <= 0 If Left > 12000 Then Me.Width = Me.Width + 1 Me.Left = Me.Left - 1 DoEvents Do Until Me.Top <= 0 Me.Top = Me.Top - 1 Loop Do Until Me.Height >= 9000 Me.Height = Me.Height + 1 End Sub Private Sub Form_GotFocus() Do Until Me.Left <= 0 Me.Width = Me.Width + 1 Me.Left = Me.Left - 1 DoEvents Do Until Me.Height >= 8700 Me.Height = Me.Height + 1 Loop End Sub Private Sub Form_Load() rs = 0 'txtAddress.Clear Dim recentsites(1000) As String Open App.Path + "\recent" For Input As #1 Do While Not EOF(1) Input #1, recentsites(rs) txtAddress.AddItem recentsites(rs) rs = rs + 1 Close #1 Open App.Path + "\Favorites" For Append As #1 Close #1 On Error Resume Next Dim rln rln = Shell("C:\rln95\rlnuserw.exe") frmDoorToTheNet.Left = 0 'frmDoorToTheNet.Width = 1000 frmDoorToTheNet.Height = 0 Me.Top = 500 Me.Left = 12000 Open App.Path + "\HomePage" For Input As #1 Input #1, homepage Close #1 txtAddress.Text = homepage WebBrowser1.Navigate txtAddress.Text imgHome.ToolTipText = homepage End Sub Private Sub cmdHotMail_Click() txtAddress.Text = "www.Hotmail.com" Call cmdOpenDoor_Click End Sub Private Sub imgBack_Click() On Error Resume Next WebBrowser1.GoBack End Sub Private Sub imgConnect_Click() On Error Resume Next Dim x x = Shell("C:\rln95\rlnuserw.exe") End Sub Private Sub ImgExitDoor_Click() 'txtAddress.Text = WebBrowser1.Document On Error Resume Next frmExitDoorWay.Show End Sub Private Sub imgfoward_Click() On Error Resume Next WebBrowser1.GoForward End Sub Private Sub imgHome_Click() Open App.Path + "\HomePage" For Input As #1 Input #1, homepage Close #1 On Error Resume Next txtAddress.Text = homepage Call cmdOpenDoor_Click End Sub Private Sub imgHotmail_Click() txtAddress.Text = "www.hotMail.com" Call cmdOpenDoor_Click End Sub 'txtAddress.AddItem txtAddress.Text 'txtAddress.Text = txtAddress 'End Sub Private Sub imgOpenDoor_Click() txtAddress.AddItem txtAddress.Text txtAddress.Text = txtAddress WebBrowser1.Navigate txtAddress.Text 'Goes to the website entered in the TextBox End Sub Private Sub imgReload_Click() WebBrowser1.Refresh End Sub Private Sub lblSearchit_Click() If optYahoo.Value = True Then txtAddress.Text = "www.Yahoo.com" If optNetscape.Value = True Then txtAddress.Text = "www.Netscape.com" If optLycos.Value = True Then txtAddress.Text = "www.Lycos.com" If optexcite.Value = True Then txtAddress.Text = "www.excite.com" Call cmdOpenDoor_Click End Sub Private Sub imgYahooChat_Click() txtAddress.Text = "http://login.yahoo.com/?.src=chat&.done=http://chat.yahoo.com/" Call cmdOpenDoor_Click End Sub Private Sub imgYahoomail_Click() txtAddress.Text = "login.yahoo.com/config/login?.src=ym&.lg=us&.done=http://edit.yahoo.com/config/mail%3f.intl=" Call cmdOpenDoor_Click End Sub Private Sub lblExit_Click() End Sub Private Sub mnuAboutcom_Click() txtAddress.Text = "www.About.com" Call cmdOpenDoor_Click End Sub Private Sub mnuAddToFavorites_Click() FavoriteAddress = txtAddress.Text Open App.Path + "\Favorites" For Append As #1 Write #1, FavoriteAddress Close #1 End Sub Private Sub mnuAltaVista_Click() txtAddress.Text = "www.altavista.com" Call cmdOpenDoor_Click End Sub Private Sub mnuAskJeeves_Click() txtAddress.Text = "www.askjeeves.com" Call cmdOpenDoor_Click End Sub Private Sub mnuBack_Click() On Error Resume Next WebBrowser1.GoBack End Sub Private Sub mnuClose_Click() frmDoorToTheNet.Hide End Sub Private Sub mnuCopy_Click() Clipboard.Clear Me.WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER 'Clipboard.SetText = txtAddress.Text End Sub Private Sub mnuCut_Click() Clipboard.Clear Me.WebBrowser1.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DONTPROMPTUSER End Sub Private Sub mnuDeleteFavorite_Click() On Error GoTo errorhandler Dim favorites(1000) Open App.Path + "\Favorites" For Input As #1 Do While Not EOF(1) Input #1, favorites(x) frmDeleteFavorite.List1.AddItem favorites(x) x = x + 1 Close #1 frmDeleteFavorite.Show frmDeleteFavorite.cmdDelete.Enabled = False errorhandler: Exit Sub End Sub Private Sub mnuDirectHit_Click() txtAddress.Text = "www.DirectHit.com" Call cmdOpenDoor_Click End Sub Private Sub mnuDogPile_Click() txtAddress.Text = "www.Dogpile.com" Call cmdOpenDoor_Click End Sub Private Sub mnuDorWay_Click() On Error Resume Next Dim x x = Shell(App.Path + "\DoorWayToTheNet.exe", vbNormalFocus) 'When DoorWay Is executeable then open DoorWay Shell End Sub Private Sub mnuEdit_Click() On Error Resume Next If txtAddress.SelText = "" Then 'mnuCut.Enabled = False ' mnuCopy.Enabled = False Else 'mnuCut.Enabled = True ' mnuCopy.Enabled = True End If If Clipboard.GetText() = "" Then mnuPaste.Enabled = False Else mnuPaste.Enabled = True End If End Sub Private Sub mnuExcite_Click() txtAddress.Text = "www.excite.com" Call cmdOpenDoor_Click End Sub Private Sub mnuExit_Click() frmExitDoorWay.Show End Sub Private Sub mnuFind_Click() Me.WebBrowser1.ExecWB OLECMDID_FIND, OLECMDEXECOPT_DONTPROMPTUSER End Sub Private Sub mnuFoward_Click() On Error Resume Next WebBrowser1.GoForward End Sub Private Sub mnuGoto_Click() txtAddress.Text = "www.Goto.com" Call cmdOpenDoor_Click End Sub Private Sub mnuHelpOn_Click() On Error Resume Next frmHElp.Show End Sub Private Sub mnuHome_Click() Open App.Path + "\HomePage" For Input As #1 Input #1, homepage Close #1 On Error Resume Next txtAddress.Text = homepage Call cmdOpenDoor_Click End Sub Private Sub mnuHotBot_Click() txtAddress.Text = "www.HotBot.com" Call cmdOpenDoor_Click End Sub Private Sub mnuInfoSeek_Click() txtAddress.Text = "www.InfoSeek.com" Call cmdOpenDoor_Click End Sub Private Sub mnulookSmart_Click() txtAddress.Text = "www.LookSmart.com" Call cmdOpenDoor_Click End Sub Private Sub mnuLycos_Click() txtAddress.Text = "www.Lycos.com" Call cmdOpenDoor_Click End Sub Private Sub mnuMacrosoft_Click() frmAbout.Show End Sub Private Sub mnuMSN_Click() txtAddress.Text = "www.Msn.com" Call cmdOpenDoor_Click End Sub Private Sub mnuNetscape_Click() txtAddress.Text = "www.netscape.com" Call cmdOpenDoor_Click End Sub Private Sub mnuOpen_Click() Dim srtaddress As String Const conMsg As String = "Enter the address you want to open" Const contitle As String = "Address Opener" straddress = InputBox(conMsg, contitle) txtAddress.Text = straddress Call cmdOpenDoor_Click End Sub Private Sub mnuPaste_Click() Me.WebBrowser1.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DONTPROMPTUSER End Sub Private Sub mnuPreferences_Click() frmPreferences.Show End Sub Private Sub mnuPrint_Click() Me.WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER End Sub Private Sub mnuRefresh_Click() WebBrowser1.Refresh2 End Sub Private Sub mnuReload_Click() WebBrowser1.Refresh End Sub Private Sub mnuSave_Click() On Error Resume Next Call mnuSaveAs_Click End Sub Private Sub mnuSaveAs_Click() 'Dim intFreeFile As Integer 'D'im strTempString As String 'Dim strLocation As String 'path of HTML file to save local ' intFreeFile = FreeFile address = txtAddress.Text On Error GoTo savehandler ' Call mnuViewSource_Click dlgEdit.Flags = cd10fnoverwriteprompt + cdlOFNPathMustExist dlgEdit.Filter = "HTML Files(*.html)|*.html" dlgEdit.ShowSave Open dlgEdit.FileName For Output As #1 Print #1, WebBrowser1.Document Close #1 'Open dlgEdit.FileName For Output As #intFreeFile ' Print #intFreeFile, frmHtmlSource.Text1.Text 'Close #intFreeFile blnChange = False Exit Sub savehandler: blnCancelSave = True Exit Sub End Sub Private Sub mnuSelectall_Click() Clipboard.Clear Me.WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER End Sub Private Sub mnuSmfSearchengine_Click() On Error Resume Next Dim search search = Shell(App.Path + "\SMF Search engine.exe", vbNormalFocus) End Sub Private Sub mnuthunderstone_Click() txtAddress.Text = "www.thunderstone.com" Call cmdOpenDoor_Click End Sub Private Sub mnuViewFavorites_Click() On Error GoTo errorhandler FrmFavorites.List1.Clear Dim favorites(1000) Open App.Path + "\Favorites" For Input As #1 Do While Not EOF(1) Input #1, favorites(x) FrmFavorites.List1.AddItem favorites(x) x = x + 1 Close #1 FrmFavorites.Show FrmFavorites.cmdGotoFavorite.Enabled = False errorhandler: Exit Sub End Sub Private Sub mnuViewSource_Click() On Error Resume Next 'frmHtmlSource.Text1.Text = getsourcecode(txtAddress.Text) Dim strTempData As String With Inet1 .AccessType = icUseDefault frmHtmlSource.Text1 = .OpenURL(txtAddress.Text) End With frmHtmlSource.Show End Sub Function getsourcecode(URL As String) As String getsourcecode = Inet1.OpenURL(URL) End Function Private Sub mnuYahoo_Click() txtAddress.Text = "www.yahoo.com" Call cmdOpenDoor_Click End Sub '-------------------------------------------------------------------------------- Private Sub optexcite_dblClick() lblSearchit.Caption = "Search On Excite!" lblSearchit.ToolTipText = "Search Excite Search Engine" txtAddress.Text = "www.Excite.com" lblSearchit.ToolTipText = "Search Excite Search Engine" Call cmdOpenDoor_Click End Sub Private Sub optexcite_Click() lblSearchit.Caption = "Search On Excite!" lblSearchit.ToolTipText = "Search Excite Search Engine" End Sub '------------------------------------------------------------------------------- Private Sub optLycos_dblClick() lblSearchit.Caption = "Search On Lycos!" lblSearchit.ToolTipText = "Search Lycos Search Engine" txtAddress.Text = "www.Lycos.com" lblSearchit.ToolTipText = "Search Lycos Search Engine" Call cmdOpenDoor_Click End Sub Private Sub optLycos_Click() lblSearchit.Caption = "Search On Lycos!" lblSearchit.ToolTipText = "Search Lycos Search Engine" End Sub '------------------------------------------------------------------------------- Private Sub optNetscape_dblClick() lblSearchit.Caption = "Search On Netscape!" lblSearchit.ToolTipText = "Search Netscape Search Engine" txtAddress.Text = "www.Netscape.com" lblSearchit.ToolTipText = "Search Netscape Search Engine" Call cmdOpenDoor_Click End Sub Private Sub optNetscape_Click() lblSearchit.Caption = "Search On Netscape!" lblSearchit.ToolTipText = "Search Netscape Search Engine" End Sub '---------------------------------------------------------------------- Private Sub optYahoo_dblClick() lblSearchit.Caption = "Search On Yahoo!" lblSearchit.ToolTipText = "Search Yahoo Search Engine" txtAddress.Text = "www.yahoo.com" lblSearchit.ToolTipText = "Search Yahoo Search Engine" Call cmdOpenDoor_Click End Sub Private Sub optYahoo_Click() lblSearchit.Caption = "Search On Yahoo!" lblSearchit.ToolTipText = "Search Yahoo Search Engine" End Sub '---------------------------------------------------------------------- Private Sub ProgressBar2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) End Sub Private Sub tmrWinClass_Timer() ' Dim recentsites(1000) ' Open app.path+"\recent" For Append As #1 ' Do While Not EOF(1) ' Input #1, recentsites(rs) ' txtAddress.AddItem recentsites(rs) ' rs = rs + 1 ' Loop ' Close #1 End Sub Private Sub txtAddress_Click() rownumber = txtAddress.ListIndex txtAddress.Text = txtAddress.List(rownumber) WebBrowser1.Navigate txtAddress.Text End Sub Private Sub txtAddress_GotFocus() imgOpenDoor.BorderStyle = 0 End Sub Private Sub txtAddress_KeyPress(KeyAscii As Integer) rs = 0 On Error Resume Next If KeyAscii = vbKeyReturn Then Do Until rs = 100 recentsites = txtAddress.List(rs) If txtAddress.Text = recentsites Then txtAddress.Text = txtAddress WebBrowser1.Navigate txtAddress.Text Exit Sub ': imgOpenDoor_Click End If rs = rs + 1 Loop recentsites = txtAddress.Text Open App.Path + "\recent" For Append As #1 Write #1, recentsites Close #1 imgOpenDoor_Click End If 'WebBrowser1.Navigate txtAddress.Text End Sub Private Sub WebBrowser1_GotFocus() imgOpenDoor.BorderStyle = 0 End Sub 'Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long) 'Static x 'x = x + 1 'If Progress > ProgressMax Then Progress = ProgressMax 'If Progress < ProgressBar1.Max Then ' ProgressBar1.Max = ProgressMax ' ProgressBar1.Value = Progress + 1 'Else ' ProgressBar1.Max = Progress ' ProgressBar1.Value = ProgressBar1.Value ' End If 'If ProgressBar1.Max > Progress Then ProgressBar1.Value = Progress + 1 'Text1.Text = Progress 'Text2.Text = ProgressMax 'If Progress <> -1 And ProgressBar1.Max > Progress Then ProgressBar1.Value = Progress 'End Sub Private Sub WebBrowser1_ProgressChange(ByVal progress As Long, ByVal ProgressMax As Long) 'On Error GoTo progressERR 'PBar.Max = progress + 10000 If progress = -1 Then Exit Sub If ProgressMax = 0 Then Exit Sub If progress > ProgressMax Then Exit Sub PBar.Max = ProgressMax PBar.Value = progress If progress >= ProgressMax Then WebBrowser1.Stop Label2.Caption = Str$(progress) & "%" ' Exit Sub 'progressERR: End Sub Private Sub WebBrowser1_StatusTextChange(ByVal Text As String) txtStatus.Text = Text txtAddress.Text = WebBrowser1.LocationURL ' Do Until txtAddress.Text = "Done" ' ImgExitDoor.Visible = False 'ImgExitDoor.Visible = True ' Loop End Sub Private Sub cmdOpenDoor_Click() 'txtAddress.AddItem txtAddress.Text 'txtAddress.Text = txtAddress WebBrowser1.Navigate txtAddress.Text 'Goes to the website entered in the TextBox End Sub Private Sub WebBrowser1_BeforeNavigate(ByVal URL As Variant, ByVal Cancel As Boolean) txtAddress.AddItem URL End Sub Private Sub imgExit_Click() WebBrowser1.Stop End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) lblSearchit.BorderStyle = 0 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgConnect.BorderStyle = 0 ImgExitDoor.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgConnect_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgConnect.BorderStyle = 1 End Sub Private Sub imgReload_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgReload.BorderStyle = 1 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgYahooChat_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgYahooChat.BorderStyle = 1 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgYahoomail_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgYahoomail.BorderStyle = 1 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgBack_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgBack.BorderStyle = 1 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgExit_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgExit.BorderStyle = 1 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgfoward_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgfoward.BorderStyle = 1 imgBack.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgHome_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgHome.BorderStyle = 1 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgHotmail_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgHotmail.BorderStyle = 1 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgYahooChat.BorderStyle = 0 imgReload.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub ImgExitDoor_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) ImgExitDoor.BorderStyle = 1 lblSearchit.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub Private Sub imgOpenDoor_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) imgOpenDoor.BorderStyle = 1 imgBack.BorderStyle = 0 imgfoward.BorderStyle = 0 imgExit.BorderStyle = 0 imgHome.BorderStyle = 0 imgYahoomail.BorderStyle = 0 imgHotmail.BorderStyle = 0 imgReload.BorderStyle = 0 imgHotmail.BorderStyle = 0 lblSearchit.BorderStyle = 0 End Sub Private Sub lblSearchit_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) lblSearchit.BorderStyle = 1 imgOpenDoor.BorderStyle = 0 imgOpenDoor.BorderStyle = 0 End Sub 'Code For Bouncing Exit----------------------------------- Private Sub Form_Unload(Cancel As Integer) frmDoorToTheNet.Caption = "Now Closing The DoorWay To The Net" If Me.WindowState <> 0 Then Me.WindowState = 0 End If Cancel = -1 Dim HeightOfStartMenu As Long Dim Speed As Long Dim StartAt As Long For i = 1 To 999 '// The start menu never uses a HWND higher than 1000 z$ = Space$(128) y = GetClassName(i, z$, 128) x = Left$(z$, y) If LCase(x) = "shell_traywnd" Then GoTo JumpOut: End If Next i JumpOut: GetWindowRect i, What '// Get the top pos of the Start Menu HeightOfStartMenu = What.Top + 8300 If HeightOfStartMenu <= 0 Then HeightOfStartMenu = Screen.Height '// If some smart guy moves the start-menu, to say '// the top, left or right bounce at the bottom of '// the screen End If '// Turn the value into twips (more commonly used) StartAt = HeightOfStartMenu - 4000 If StartAt < Me.Top Then StartAt = Me.Top '// This code prevents the form from bouncing '// higher than itself (not logical, the start menu isn't made '// of rubber you now) End If '// How many "bounces?" Speed = 60 '// How fast should this go? 'Me.Height = 0 'Me.Width = 4000 num = 1 'Width = 10920 For i = 0 To Me.Height Me.Height = Me.Height - num DoEvents Next i For i = 0 To 5900 Me.Width = Me.Width - num DoEvents Next i For i = 0 To 500 Me.Top = Me.Top + num DoEvents Next i For i = 0 To 12000 Me.Left = Me.Left + num DoEvents Next i End Sub Private Sub form_linkclose() GoAgain: Do Until Me.Top >= HeightOfStartMenu DoEvents Me.Top = Me.Top + Speed Me.Left = Me.Left + 15 '<--- Remove the " ' " to make the window bounce sideways! Loop Do Until Me.Top <= StartAt DoEvents Me.Top = Me.Top - Speed Me.Left = Me.Left + 15 '<--- Remove the " ' " to make the window bounce sideways! Loop If StartAt >= 10000 And Me.Top >= HeightOfStartMenu Then Do Until Me.Top >= HeightOfStartMenu + 15000 Me.Top = Me.Top + Speed Loop End Exit Sub End If StartAt = StartAt + 1000 Speed = Speed - 5 '// Decrease speed with 5 after each "bounce", '// You can change the value all ya want :) If Speed <= 0 Then Speed = 5 '// If the Speed value gets under zero i will '// automatically turn into 5 (cause if it don't '// It will stop or do something crazy End If GoTo GoAgain: End Sub 
(.txt)