frmmain.frm

vb中如何进行网络编程的示例,包括:UDP聊天,TCP聊天,UDP,TCP flood攻击等 非常棒

   End
   Begin VB.Frame Frame9 
      Height          =   2655
      Left            =   120
      TabIndex        =   91
      Top             =   5760
      Width           =   9615
      Begin SHDocVwCtl.WebBrowser Web 
         Height          =   2295
         Left            =   120
         TabIndex        =   92
         Top             =   240
         Visible         =   0   'False
         Width           =   9375
         ExtentX         =   16536
         ExtentY         =   4048
         ViewMode        =   0
         Offline         =   0
         Silent          =   0
         RegisterAsBrowser=   0
         RegisterAsDropTarget=   1
         AutoArrange     =   0   'False
         NoClientEdge    =   0   'False
         AlignLeft       =   0   'False
         NoWebView       =   0   'False
         HideFileNames   =   0   'False
         SingleClick     =   0   'False
         SingleSelection =   0   'False
         NoFolders       =   0   'False
         Transparent     =   0   'False
         ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
         Location        =   "http:///"
      End
   End
   Begin VB.Menu mnuMain 
      Caption         =   "&Main"
      Begin VB.Menu mnuProfile 
         Caption         =   "&Select Profile"
      End
      Begin VB.Menu mnuEdit 
         Caption         =   "&Edit Profile"
      End
      Begin VB.Menu sep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuU 
      Caption         =   "Update"
      Begin VB.Menu mnuCheck 
         Caption         =   "Check for new version"
      End
      Begin VB.Menu mnuUpdate 
         Caption         =   "&Live Update"
         Enabled         =   0   'False
      End
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "&About"
      Begin VB.Menu mnuA 
         Caption         =   "About"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'# Copyright C 2000 Vladimir S. Pekulas
'# I don't take any responsibility what
'# so ever for this program.
'# You can use it as long as my credit is
'# included.
'#
'#
'# http://www.BohemiaTrading.com/

Dim ExitSubmition As Integer
Dim TUpdate_I As Integer
Dim EnginesCount As Integer

Private Sub Form_Load()
TUpdate_I = 0

' We need to fill up some of the drop-down combos _
  e.g. Category, head etc.
CoUrl.AddItem "http://"
CoUrl.AddItem "https://"
LoadCategories
LoadAvailableEngines

' For now without a link to web.
picBanner.FileName = App.Path & "\data\banner.gif"

'Start the Report:
Rtf.FileName = App.Path & "\data\rtfload.txt"

End Sub

Private Sub Form_Unload(Cancel As Integer)
'Is it changed ?
If Not txtURL.Text = "" Then

' Do we want to save the profile?
    If MsgBox("Would you like to save the profile?", vbQuestion + vbYesNo, "Save Profile?") = vbYes Then
        
        'Yes
        frmProfiles.Show 1, frmMain
      Else
        
        'No
    End If

End If
End Sub

Private Sub mnuA_Click()
' Easiest way how to make the form stay on top: frmName Modal, Owner
frmAbout.Show 1, frmMain
End Sub

Private Sub mnuCheck_Click()
CheckForNewVersionOnTheNet
End Sub

Private Sub mnuEdit_Click()
frmProfiles.Show 1, frmMain
End Sub

Private Sub mnuProfile_Click()
frmProfiles.Show 1, frmMain
End Sub

Private Sub mnuUpdate_Click()
' This will initialize the download dialog.
' It works togather with Check For update menu item so check
' it out befor you gonna do anything with it.
'
' File is posted it on  my website so PLEASEEEE !!!!!
' CHANGE THAT URL AS SOON AS YOU GONNA USE IT FOR REAL UPDATE.
Scrap.WebDownload.Navigate "http://www.bohemiatrading.com/download/tools/Tool.exe"
End Sub

Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
' Those are Tool Bar & Menu Functions
On Error Resume Next
Select Case Button.Key
    Case "Clear"
ClearAllFields
    Case "Load/Save"
 frmProfiles.Show 1, frmMain
    Case "Exit"
ExitApp
    End Select
End Sub

Private Sub mnuExit_Click()
 ExitApp
End Sub

Private Sub Add_Click()
' Rearanger The engines from one obj to another
Ind = SelectedEngines.ListIndex
SelectedEngines.AddItem AvailableEngines.Text
Call LBDupe(SelectedEngines)
lblSel.Caption = SelectedEngines.ListCount & " out of 8"
lblLeft.Caption = AvailableEngines.ListCount - SelectedEngines.ListCount
ToSubmit.AddItem AvailableEngines.Text
E_Left.Caption = ToSubmit.ListCount
End Sub

Private Sub Add_all_Click()
' Loads the list of categories
SelectedEngines.AddItem "Altavista.com"
SelectedEngines.AddItem "AllAmericasBest.com"
SelectedEngines.AddItem "DirectHit.com"
SelectedEngines.AddItem "EuroSeek.com"
SelectedEngines.AddItem "Excite.com"
SelectedEngines.AddItem "HotBot.com"
SelectedEngines.AddItem "InfoSeek.com"
SelectedEngines.AddItem "Lycos.com"
SelectedEngines.AddItem "MSN.com"
SelectedEngines.AddItem "WebCrawler.com"

'Other LisBox
ToSubmit.AddItem "Altavista.com"
ToSubmit.AddItem "AllAmericasBest.com"
ToSubmit.AddItem "DirectHit.com"
ToSubmit.AddItem "EuroSeek.com"
ToSubmit.AddItem "Excite.com"
ToSubmit.AddItem "HotBot.com"
ToSubmit.AddItem "InfoSeek.com"
ToSubmit.AddItem "Lycos.com"
SelectedEngines.AddItem "MSN.com"
SelectedEngines.AddItem "WebCrawler.com"

' Make sure that there are no double entries
Call LBDupe(ToSubmit)
Call LBDupe(SelectedEngines)
lblSel.Caption = ""
lblSel.Caption = SelectedEngines.ListCount & " out of 10"
lblLeft.Caption = 0
E_Left.Caption = ToSubmit.ListCount
End Sub
Private Sub AvailableEngines_DblClick()
' Double Click Add Engines
 Add_Click
End Sub
Private Sub cmdCancel_Click()
 ExitSubmition = 0
End Sub
Private Sub ToolbarEngines_ButtonClick(ByVal Button As MSComctlLib.Button)
 On Error Resume Next
Select Case Button.Key
    Case "Move"
Add_Click
    Case "Move All"
Add_all_Click
    Case "Major"
'Temporarly
Add_all_Click
    End Select
End Sub
Private Sub Command1_Click() '(sorry about the name)
' This is where most of the work is done. This sub sends info to the
' search engine, then waits for 5 seconds (Has to wait!!!) and skips
' to next engine.
' Between there are simple statistics (JunkAndStats).
' I'm plan on using ini files in the next version, but for now let's
' just use these calls.


' We need to check at least for two main components of submiting.
' Those are: WebSite URL (txtURL.Text) and e-mail (txtMail.Text).
If txtURL.Text = "" Then
    MsgBox "WebSite Data Missing!"
    SSTab1.Tab = 0
    Exit Sub
End If

If txtMail.Text = "" Then
    MsgBox "WebSite Data Missing!"
    SSTab1.Tab = 0
    Exit Sub
End If


'Dims and stuff
Dim I As Integer, IndexNum As Integer, ExitSubmition As Integer
IndexNum = ToSubmit.ListCount

' In case there is no engines, exit sub.
    If IndexNum = -1 Then
      MsgBox "No selection has been made."
      SSTab1.Tab = 1
      Exit Sub
    End If

' What procentage should we add for each engine ?
' EnginesCount is and integer so no decimal junk.
EnginesCount = (100 / ToSubmit.ListCount)

For I = 0 To IndexNum

 If ToSubmit.List(I) = "Altavista.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://add-url.altavista.digital.com/cgi-bin/newurl?ad=1&q=http%3A%2F%2F" & frmMain.txtURL.Text
JunkAndStats
End If

 If ToSubmit.List(I) = "AllAmericasBest.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://www.allamericasbest.com/cgi-local/addurl.pl?Name?" & frmMain.CoUrl.Text & frmMain.txtURL.Text & "?Des?" & frmMain.k1.Text & "?" & frmMain.txtMail.Text & "?" & frmMain.CoCategory.Text
JunkAndStats
 End If

 If ToSubmit.List(I) = "DirectHit.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://www.directhit.com/fcgi-bin/DirectHitWeb.fcg?fmt=disp&template=addurl&src=DH_ADDURL&URL=http%3A%2F%2F" & frmMain.txtURL.Text & "&email=" & frmMain.txtMail.Text & "&keys=" & frmMain.k1.Text & "," & frmMain.k2.Text & "&submit=Submit%21"
JunkAndStats
 End If
 
 If ToSubmit.List(I) = "EuroSeek.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://addsite.euroseek.com/page.php?url=" & frmMain.CoUrl.Text & frmMain.txtURL.Text & "?"
JunkAndStats
 End If

 If ToSubmit.List(I) = "Excite.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://www.excite.com/info/add_url/thanks/?url=" & frmMain.CoUrl.Text & frmMain.txtURL.Text & "&email=" & frmMain.txtMail.Text & "&country=US&brand=excite"
JunkAndStats
 End If

 If ToSubmit.List(I) = "HotBot.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://hotbot.lycos.com/addurl.asp?MM=1&success_page=http%3A%2F%2Fhotbot.lycos.com%2Faddurl.asp&failure_page=http%3A%2F%2Fhotbot.lycos.com%2Fhelp%2Foops.asp&ACTION=subscribe&SOURCE=hotbot&ip=24.66.63.44&redirect=http%3A%2F%2Fhotbot.lycos.com%2Faddurl2.html&newurl=http%3A%2F%2F" & frmMain.txtURL.Text & "&email=" & frmMain.txtMail.Text & "&send=Submit+my+site"
JunkAndStats
 End If

 If ToSubmit.List(I) = "InfoSeek.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://www.go.com/AddUrl/AddingURL?url=http%3A%2F%2F" & frmMain.txtURL.Text & "&CAT=Add%2FUpdate+Site&sv=AD&lk=noframes"
JunkAndStats
 End If

 If ToSubmit.List(I) = "Lycos.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://www.lycos.com/cgi-bin/spider_now.pl?query=http%3A%2F%2F" & frmMain.txtURL.Text & "&email=" & frmMain.txtMail.Text
JunkAndStats
 End If

 If ToSubmit.List(I) = "MSN.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://submitit.linkexchange.com/system/msnaddpublicbeta.cfm?delete=0&localetag=en-us&url=http%3A%2F%2F" & frmMain.txtURL.Text & "&category=1266857&email=" & frmMain.txtMail.Text & "&title=" & frmMain.txtTitle.Text & "&description=" & frmMain.k1.Text & "+" & frmMain.k2.Text & "+" & frmMain.k3.Text & "+"
JunkAndStats
 End If

 If ToSubmit.List(I) = "WebCrawler.com" Then
   lblEngine.Caption = ToSubmit.List(I)
   Web.Navigate "http://www.webcrawler.com/info/add_url/thanks/?url=" & frmMain.CoUrl.Text & frmMain.txtURL.Text & "&email=" & frmMain.txtMail.Text & "&country=US&brand=webcrawler"
JunkAndStats
 End If
 



Next I

' On the end we need to fix some labels.
    Succes.Caption = "All Done!"
    lblEngine.Caption = "None"
    Procent.Caption = "100"

End Sub

Function JunkAndStats()
   Succes.Caption = "Working ..."
Call WaitASec(5)
   Submited.AddItem ToSubmit.List(I)
   ToSubmit.RemoveItem (I)
   E_Left.Caption = ToSubmit.ListCount
   E_done.Caption = Submited.ListCount
   Procent.Caption = Procent.Caption + EnginesCount
   Succes.Caption = "Done"
' Report Creation:
   Rtf.Text = Rtf.Text & ToSubmit.List(I) & ":" & vbCrLf
   Rtf.Text = Rtf.Text & "Completed sucessfuly." & vbCrLf & vbCrLf



End Function

Private Sub txtDes_Change()
Label1(22).Caption = "(Characters = " & Len(txtDes.Text) & ")"
End Sub