SEO-下拉框排名

 

    我们在搜索引擎中输入关键词时，下拉框中会出现相关的关键词，如果用户觉得提示的相关关键词更合适，他选择这个相关关键词的几率会很高，于是很多SEOER就动起了脑筋，让他的关键词出现在下拉框里（最好是第一），其实相关关键词出现的机制并不复杂，搜索引擎会记录用户的每次搜索，以百度为例，用户搜机器人 、扫地机器人等，他都会记录，并根据词的相关性关联，搜索的次数越多，就排前面，因此，只要有足够多的搜索次数（当然同一台电脑某个时间段内搜索多次可能会无效），只要有很多不同IP的用户搜索某两个相关关键词，他们就会关联，并出现在下拉框中，理解这个原理,要实现下拉框排名无非就是模拟真实的IP进行搜索，大约有以下方法

1.频繁使用代理，适合单枪匹马者，但是目前寻找到大量稳定的代理很难很难。

2.频繁利用ADSL拨号，适合单枪匹马者，但是你可能会需要随时中断你的工作。

3.让亲朋好友，七大姑、八大姨都来帮你搜，适合有广泛的人脉关系者。

4.加入一些联盟，盟友们互相帮助，适应范围较广，只是有被一窝端的风险，经过几率很低。

 

我给出使用代理的代码，

模块1

Attribute VB_Name = "Module1"
Public Declare Function GetTickCount Lib "KERNEL32" () As Long

 Public appProfileName As String

Declare Function GetPrivateProfileString Lib "KERNEL32" _
    Alias "GetPrivateProfileStringA" (ByVal lpApplicationName _
    As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, _
    ByVal lpFileName As String) As Long
    
    Declare Function WritePrivateProfileString Lib "KERNEL32" _
    Alias "WritePrivateProfileStringA" (ByVal lpApplicationName _
    As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
    ByVal lpFileName As String) As Long

Function GetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefString As String) As String

Dim ResultString As String * 144, Temp As Integer
Dim s As String, i As Integer
Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, appProfileName)
'检索关键词的值
If Temp% > 0 Then '关键词的值不为空
s = ""
For i = 1 To 144
If Asc(Mid$(ResultString, i, 1)) = 0 Then
Exit For
Else
s = s & Mid$(ResultString, i, 1)
End If
Next
Else
Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, appProfileName)
'将缺省值写入INI文件
s = DefString
End If
GetIniS = s
End Function

 

Sub SetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String)
 Dim res%
 res% = WritePrivateProfileString(SectionName, KeyWord, ValStr, appProfileName)
End Sub

'Sub SetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Integer)
'  Dim res%, s$
'  s$ = Str$(ValInt)
'  res% = WritePrivateProfileString(SectionName, KeyWord, s$, appProfileName)
'End Sub

 

 

Public Sub TimeDeay(TT As Currency)
Dim t As Currency
t = GetTickCount()
Do
DoEvents
If GetTickCount - t < 0 Then t = GetTickCount
Loop Until GetTickCount - t >= TT
End Sub

 模块2

Attribute VB_Name = "Module2"
Public Const internet_option_proxy = 38
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_OPTION_SETTINGS_CHANGED = 39
Type INTERNET_PROXY_INFO
dwAccessType As Long
lpszProxy As String
lpszProxyBypass As String
End Type

Public Declare Function internetsetoption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hinternet As Long, ByVal dwoption As Long, ByRef lpbuffer As Any, ByVal dwbufferlength As Long) As Long

 

 新建窗口

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 = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form2
   Caption         =   "刷下拉框"
   ClientHeight    =   9060
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   15240
   LinkTopic       =   "Form2"
   ScaleHeight     =   9060
   ScaleWidth      =   15240
   Begin VB.Frame Frame2
      Caption         =   "刷"
      Height          =   1215
      Left            =   3480
      TabIndex        =   18
      Top             =   6720
      Width           =   11415
      Begin VB.ComboBox Comb_ji
         Height          =   300
         ItemData        =   "Form2.frx":0000
         Left            =   960
         List            =   "Form2.frx":0013
         TabIndex        =   30
         Text            =   "1"
         Top             =   840
         Width           =   1095
      End
      Begin VB.CommandButton Command1
         Caption         =   "开始刷"
         Height          =   735
         Left            =   2520
         TabIndex        =   21
         Top             =   240
         Width           =   1335
      End
      Begin VB.ComboBox Comb_Jg
         Height          =   300
         Left            =   960
         TabIndex        =   20
         Text            =   "5"
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label9
         Caption         =   "刷几遍"
         Height          =   255
         Left            =   120
         TabIndex        =   29
         Top             =   840
         Width           =   735
      End
      Begin VB.Label Label8
         Caption         =   "说明：您必须找到有效的代理可用才行，真正可用的代理服务器很少，也不稳定。不用代理，你可以不停的用ADSL来整或者发给你的朋友们！"
         Height          =   375
         Left            =   4200
         TabIndex        =   26
         Top             =   480
         Width           =   6735
      End
      Begin VB.Label Label7
         Caption         =   "间隔(秒)"
         Height          =   255
         Left            =   120
         TabIndex        =   19
         Top             =   360
         Width           =   735
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "关键词设定"
      Height          =   1335
      Left            =   3480
      TabIndex        =   5
      Top             =   5280
      Width           =   11415
      Begin VB.TextBox Txt_K
         Height          =   375
         Index           =   5
         Left            =   7440
         TabIndex        =   16
         Top             =   840
         Width           =   2055
      End
      Begin VB.TextBox Txt_K
         Height          =   375
         Index           =   4
         Left            =   4200
         TabIndex        =   15
         Top             =   840
         Width           =   2055
      End
      Begin VB.TextBox Txt_K
         Height          =   375
         Index           =   3
         Left            =   1080
         TabIndex        =   13
         Top             =   840
         Width           =   2055
      End
      Begin VB.TextBox Txt_K
         Height          =   375
         Index           =   2
         Left            =   7440
         TabIndex        =   11
         Top             =   240
         Width           =   2055
      End
      Begin VB.TextBox Txt_K
         Height          =   375
         Index           =   1
         Left            =   4200
         TabIndex        =   9
         Top             =   240
         Width           =   2055
      End
      Begin VB.TextBox Txt_K
         Height          =   375
         Index           =   0
         Left            =   1080
         TabIndex        =   7
         Top             =   240
         Width           =   2055
      End
      Begin VB.Label Label6
         Caption         =   "关键词5"
         Height          =   375
         Left            =   6600
         TabIndex        =   17
         Top             =   840
         Width           =   735
      End
      Begin VB.Label Label5
         Caption         =   "关键词4"
         Height          =   255
         Left            =   3360
         TabIndex        =   14
         Top             =   840
         Width           =   855
      End
      Begin VB.Label Label4
         Caption         =   "关键词3"
         Height          =   375
         Left            =   120
         TabIndex        =   12
         Top             =   840
         Width           =   1215
      End
      Begin VB.Label Label3
         Caption         =   "关键词2"
         Height          =   255
         Left            =   6600
         TabIndex        =   10
         Top             =   360
         Width           =   855
      End
      Begin VB.Label Label2
         Caption         =   "关键词1"
         Height          =   375
         Left            =   3360
         TabIndex        =   8
         Top             =   360
         Width           =   735
      End
      Begin VB.Label Label1
         Caption         =   "主关键词"
         Height          =   375
         Left            =   120
         TabIndex        =   6
         Top             =   360
         Width           =   975
      End
   End
   Begin SHDocVwCtl.WebBrowser Web
      Height          =   4695
      Left            =   3480
      TabIndex        =   4
      Top             =   360
      Width           =   11535
      ExtentX         =   20346
      ExtentY         =   8281
      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
   Begin VB.Frame FramMemberID
      Height          =   8415
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   3015
      Begin VB.CommandButton cMD_del
         Caption         =   "单个删除"
         Height          =   375
         Left            =   1680
         TabIndex        =   28
         Top             =   7920
         Width           =   1215
      End
      Begin VB.CommandButton Cmd_yz
         Caption         =   "验证代理"
         Height          =   375
         Left            =   240
         TabIndex        =   27
         Top             =   7920
         Width           =   1215
      End
      Begin VB.CommandButton Cmd_Agent
         Caption         =   "应用该代理"
         Height          =   465
         Left            =   240
         TabIndex        =   25
         Top             =   7320
         Width           =   1215
      End
      Begin VB.CommandButton Cmd_Cancel
         Caption         =   "取消该代理"
         Height          =   465
         Left            =   1680
         TabIndex        =   24
         Top             =   7320
         Width           =   1215
      End
      Begin VB.CommandButton Command2
         Caption         =   "手工添加"
         Height          =   375
         Left            =   2040
         TabIndex        =   23
         Top             =   6840
         Width           =   855
      End
      Begin VB.TextBox Txt_Agent
         Height          =   375
         Left            =   240
         TabIndex        =   22
         Text            =   "xx.xx.xx.xx:xx"
         Top             =   6840
         Width           =   1815
      End
      Begin VB.CommandButton Cmd_ClearAgent
         Caption         =   "清除代理列表"
         Height          =   375
         Left            =   1680
         TabIndex        =   3
         Top             =   6360
         Width           =   1215
      End
      Begin VB.CommandButton Cmd_ImportAgent
         Caption         =   "导入代理列表"
         Height          =   375
         Left            =   240
         TabIndex        =   2
         Top             =   6360
         Width           =   1335
      End
      Begin VB.ListBox Lst_Agent
         Height          =   6000
         ItemData        =   "Form2.frx":0026
         Left            =   240
         List            =   "Form2.frx":0028
         Sorted          =   -1  'True
         TabIndex        =   1
         Top             =   240
         Width           =   2655
      End
      Begin MSComDlg.CommonDialog Cmd
         Left            =   840
         Top             =   480
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      End
      Begin InetCtlsObjects.Inet Inet
         Left            =   1920
         Top             =   840
         _ExtentX        =   1005
         _ExtentY        =   1005
         _Version        =   393216
      End
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

 

Private Sub Cmd_Agent_Click() '应用代理格式 xx.xx.xx.xx:xx
Set reg = CreateObject("Wscript.Shell")
a = reg.regwrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyServer", Lst_Agent.List(Lst_Agent.ListIndex))
a = reg.regwrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 1, "REG_DWORD")
internetsetoption 0, INTERNET_OPTION_SETTINGS_CHANGED, 0, 0
DoEvents
End Sub

 

Private Sub Cmd_Cancel_Click()'取消应用代理
Set reg = CreateObject("Wscript.Shell")
a = reg.regwrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ProxyEnable", 0, "REG_DWORD")
internetsetoption 0, INTERNET_OPTION_SETTINGS_CHANGED, 0, 1
DoEvents
End Sub

Private Sub Cmd_ClearAgent_Click()
Lst_Agent.Clear
End Sub

 

Private Sub cMD_del_Click()
With Lst_Agent
t = .ListIndex
    If t >= 0 Then
     .RemoveItem t
     If t < .ListCount Then
      .ListIndex = t
     Else
      .ListIndex = t - 1
     End If
    End If
End With
End Sub

Private Sub Cmd_ImportAgent_Click() '导入代理列表
  On Error Resume Next
    With Cmd
     .CancelError = True
     .InitDir = GetIniS("导出路径", "topath", App.Path)
     .DialogTitle = "导入"
     .FileName = ""
     .Filter = "文本文件(.txt)|*.txt"
     .Flags = cdlOFNLongNames + cdlOFNOverwritePrompt + cdlOFNHideReadOnly
     .ShowOpen
    
     If .FileName <> "" Then
            Dim oFSO As FileSystemObject
            Dim oTextStream As TextStream
            Set oFSO = CreateObject("scripting.filesystemobject")
           Call SetIniS("导出路径", "topath", oFSO.GetParentFolderName(.FileName))
            Set oTextStream = oFSO.OpenTextFile(.FileName, ForReading, False, TristateUseDefault)
            Do
              Lst_Agent.AddItem oTextStream.ReadLine
            Loop Until oTextStream.AtEndOfStream
          Set oTextStream = Nothing
          Set oFSO = Nothing
       End If
    End With
   
    If Err = cdlCancel Then Exit Sub
End Sub

Private Sub Cmd_yz_Click() ‘简单的验证代理，直接连百度，能上就行，不能上就不用说还用他搜了。
Call Cmd_Agent_Click
TimeDeay Val(Comb_Jg.Text) * 1000
Web.Navigate "http://www.baidu.com/"
End Sub

Private Sub Command1_Click()
If Lst_Agent.ListCount = 0 Then
 MsgBox "您没有使用代理，将只使用您的当前IP刷。"
 Call Refreshbaidu
 Exit Sub
End If

With Lst_Agent
For i = 0 To .ListCount - 1
 .ListIndex = i
   Call Cmd_Agent_Click
    TimeDeay Val(Comb_Jg.Text) * 1000
    Call Refreshbaidu
 DoEvents
Next i
DoEvents
End With

End Sub

Sub Refreshbaidu() '依次按关键词搜索，可以设定搜索次数
For t = 1 To Val(Comb_ji.Text)
    For j = 0 To 5
    Web.Navigate "http://www.baidu.com/s?wd=" & Txt_K(j).Text
    TimeDeay Val(Comb_Jg.Text) * 1000
    Next
Next
End Sub

Private Sub Command2_Click() ‘手工添加代理
Lst_Agent.AddItem Txt_Agent.Text
End Sub

Private Sub Form_Load() '载入预设的关键词
    Me.WindowState = 2
    appProfileName = App.Path & "/keyword.txt"
    For i = 0 To 5
    Txt_K(i).Text = GetIniS("关键词", "K" & i + 1, "")
    Next

   With Comb_Jg
   For i = 0 To 100
    Comb_Jg.AddItem i
   Next
   End With

   Web.Navigate "http://www.baidu.com/"
End Sub

 

 

Private Sub Form_Unload(Cancel As Integer) ‘退出保存关键词
For i = 0 To 5
SetIniS "关键词", "K" & i + 1, Txt_K(i).Text
Next
End Sub

 

说明，代码很简单
1.对使用本程序造成的后果(包括不限于被K)不负任何责任，本人不提倡,也不使用这种手法!