FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

何で検索/訪問? 


ブログに訪問される方がいて、いろいろと励みにもなりますが・・・・
どのような「語彙」「内容」で、検索された結果、訪問されているのだろうか・・・

FC2 でのアクセス解析を付けていますが、いまいちさっぱりわかりません。

例えば、
http://search.yahoo.co.jp/search?p=%E3%83%A1%E3%82%A4%E3%83%B3%E3%83%9
5%E3%82%A9%E3%83%BC%E3%83%A0%E3%80%80%E5%B8%B3%E7%A5%A8&aq=-1&
oq=&ei=UTF-8&fr=top_ga1_sa_122&x=wrt
とかが記録されています。

yahoo の場合は、「p=」の後「&」までが、検索に使った「語彙」になるのでしょうか・・・

google の場合には、
http://www.google.co.jp/url?sa=t&rct=j&q=%E3%82%B5%E3%83%96%E3
%83%95%E3%82%A9%E3%83%BC%E3%83%A0%E3%80%80%E6%9C%AA%E5%85%A5%E5%8A%9B%
E3%83%81%E3%82%A7%E3%83%83%E3%82%AF&source=web&cd=25&ved=0
とかになっていて、「q=」の後「&」までが、検索に使った「語彙」になるのでしょうか・・・

google は、「?」 の前が「search」であればその画面が見れるようですが、上記の様に「url」であると
訪問された私の記事に飛んできてしまい、「語彙」等わからずじまいになります。

このままでは、わけが分からないので漢字に変換しようと・・・・

kEnt117

上側のテキストボックスに、記録されたものを転記(人力でのコピー&貼り付け操作で)して
どのキー部分を解釈するか・・・・これをオプショングループで選択しておいて
改行を削除(この時空白1文字分付加するか指定できるように)
「抽出・変換」ボタンで解釈した結果を下のテキストボックスに表示。

実際にはどの様な検索結果の中で来られたのか・・・・
解釈した検索結果で、実際の検索状況を表示してみる・・・・・
(この部分は透明表示のラベルをダブルクリックした時に実行するように)

・・・・透明なラベルは、ボタンの間に配置。
操作がわかっていれば、使える・・・・ってな機能レベルにて、
 
フォームは非連結で、見た目は上記の図の通りです。
基本的なものだけ配置しています。

VBAで記述したのは以下
Dim sHttp As String
Dim sSource As String

Private Sub Form_Load()
  Me.op1 = 1
  Me.txtop = "MT="
  Call op1_Click
  Me.tg1 = False
  Call tg1_Click
End Sub

Private Sub op1_Click()
  Select Case Me.op1
    Case 1, 2
      Me.txtop.Enabled = False
    Case 3
      Me.txtop.Enabled = True
  End Select
End Sub

Private Sub tg1_Click()
  Const bFalse As String = "空白" & vbCrLf & "0"
  Const bTrue As String = "空白" & vbCrLf & "1"

  If (Me.tg1) Then
    Me.tg1.Caption = bTrue
  Else
    Me.tg1.Caption = bFalse
  End If
End Sub

Private Function Moji2(sSrc As String, iPos As Long) As String
  Dim i As Long

  On Error Resume Next
  i = CLng(Replace(Mid(sSrc, iPos, 3), "%", "&H"))
  Select Case Mid(sSrc, iPos + 1, 1)
    Case "E"
      i = (i And &HF) * &H1000
      i = i + ((CLng(Replace(Mid(sSrc, iPos + 3, 3), "%", "&H")) And &H3F) * &H40)
      i = i + (CLng(Replace(Mid(sSrc, iPos + 6, 3), "%", "&H")) And &H3F)
      iPos = iPos + 9
    Case Is >= "A"
      i = (i And &H1F) * &H40
      i = i + (CLng(Replace(Mid(sSrc, iPos + 3, 3), "%", "&H")) And &H3F)
      iPos = iPos + 6
    Case Else
      iPos = iPos + 3
  End Select
  Moji2 = ChrW(i)
End Function

Private Function MojiMoji(sSrc As String) As String
  Dim sS As String
  Dim i As Long

  On Error Resume Next
  sS = ""
  i = 1
  While (i <= Len(sSrc))
    Select Case Mid(sSrc, i, 1)
      Case "%"
        sS = sS & Moji2(sSrc, i)
      Case Else
        sS = sS & Mid(sSrc, i, 1)
        i = i + 1
    End Select
  Wend
  MojiMoji = sS
End Function


Private Sub btn1_Click()
  Dim sS As String
  Dim sAry() As String
  Dim sChk As String, iChk As Long
  Dim i As Long

  sHttp = ""
  Me.txt2 = "?????"
  Select Case Me.op1
    Case 1
      iChk = 2: sChk = "q="
    Case 2
      iChk = 2: sChk = "p="
    Case 3
      If (Len(Nz(Me.txtop, "")) = 0) Then Exit Sub
      iChk = Len(Me.txtop): sChk = Me.txtop
    Case Else
      Exit Sub
  End Select
  If (IsNull(Me.txt1)) Then Exit Sub
  sS = Replace(Me.txt1, vbCrLf, Space(Abs(Me.tg1)))
  sS = Replace(sS, "?", "&")
  sAry = Split(sS & "&", "&")

  sHttp = sAry(0)
  For i = 1 To UBound(sAry)
    If (Left(sAry(i), iChk) = sChk) Then
      sSource = sAry(i)
      Me.txt2 = MojiMoji(Mid(sSource, iChk + 1))
      Exit For
    End If
  Next
End Sub

Private Sub btn2_Click()
  DoCmd.Close acForm, Me.Name, acSaveNo
End Sub

Private Sub lab1_DblClick(Cancel As Integer)
  Dim vVocHttp As Variant
  Dim i As Long

  If (Len(sHttp) = 0) Then Exit Sub

  vVocHttp = Array( _
      Array("google.", "http://www.google.co.jp/search?") _
      , Array("yahoo.", "http://search.yahoo.co.jp/search?") _
      , Array("goo.", "http://search.goo.ne.jp/web.jsp?IE=UTF-8&") _
      , Array("nifty.", "http://search.nifty.com/websearch/search?") _
      , Array("rakuten.", "http://websearch.rakuten.co.jp/Web?") _
      , Array("babylon.", "http://search.babylon.com/?") _
      )

  For i = 0 To UBound(vVocHttp)
    If (InStr(sHttp, vVocHttp(i)(0)) > 0) Then
      Call appShellExecute(vVocHttp(i)(1) & sSource)
      Exit For
    End If
  Next
End Sub

 
標準モジュールに検索サイトを起動する為の以下を記述
Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
  (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Const SW_SHOWNORMAL = 1   ' 正常

Public Sub appShellExecute(sPath As String)
  Call apiShellExecute(0, "OPEN", sPath, "", "", SW_SHOWNORMAL)
End Sub

 
やっていることと言えば、

・上側テキストボックスの内容を1行にする
その際、空白(スペース)を1つ入れるか/入れないかを指定して
・1行になったら、「?」を「&」に置換えてから、「&」で Split
すると、2行目からは ★★=▲▲▲▲▲▲・・・・・ の並びになるので、
「語彙」の欲しい ★★= を指定しておいて、「抽出・変換」ボタンで実行
・この解釈の時に、1行目と ★★= 部分全部を覚えておいて、
ボタン間にある透明ラベルのダブルクリックで
  vVocHttp = Array( _
      Array("google.", "http://www.google.co.jp/search?") _
      , Array("yahoo.", "http://search.yahoo.co.jp/search?") _
      , Array("goo.", "http://search.goo.ne.jp/web.jsp?IE=UTF-8&") _
      , Array("nifty.", "http://search.nifty.com/websearch/search?") _
      , Array("rakuten.", "http://websearch.rakuten.co.jp/Web?") _
      , Array("babylon.", "http://search.babylon.com/?") _
      )

  For i = 0 To UBound(vVocHttp)
    If (InStr(sHttp, vVocHttp(i)(0)) > 0) Then
      Call appShellExecute(vVocHttp(i)(1) & sSource)
      Exit For
    End If
  Next
にて、
1行目にサイトのパターンがあったら、検索用のアドレスを ★★=▲▲▲▲▲▲・・・・・ の前に
付加して ShellExecute で開く・・・・
実際に見たいサイトが増えたら、データを追加して・・・・

なので、テキストボックスに貼り付ける際には、先頭にあるサイトのパターンを含んでいる必要があります。
(http://・・・ から綺麗に必要なわけではありません)
先頭同様、後半も見たいところ以降に「&」があれば途中でもかまいません。

goo では、「IE=UTF-8」を指定しないと文字化けするようです。
yahoo の方でも、「ei=UTF-8」等アクセス解析に残っているようですが、付加しなくてもよいみたいです。

サイトによっては、「IE」であったり「ei」であったり、いろいろあるようです。

※ そうそう、1行にする時空白(スペース)を1つ付加する/しない 機能ですが、
FC2 のアクセス解析の表示画面で適当に改行を入れて表示しているようです。
今のところ、Replace(Me.txt1, vbCrLf, Space(Abs(Me.tg1))) で統一して置換えしているので、
1行目は空白(スペース)削除で改行され、解釈部分で単に改行・・・・のように混在して表示されていたら・・・
変な解釈になると思います。
ま、その時にはスペースを付加しないで1行にした解釈結果をコピーし、
ターゲットのサイト上で貼り付け、その後でスペースを挿入してやると、そこそこに・・・・

※ 後は、この「語彙」をテーブルに追加したり、自分なりに解析して、
もうチョッと1つのサンプルに入れ込む内容を吟味してみたり・・・・・
サンプルの作り方を見直してみたり・・・・・

・・・・できれば良いかな・・・・・と、思っているだけでした。

訂正 2/20

Function Moji2 内の Select Case の Case Is >= "A" は Case Is >= "C" でしたね。
そこそこ動いた後って、動いていない部分を見逃す傾向にありますね。
(実際、今回のものでは動いた形跡はありませんでしたが・・・)

こういうのがバグで、どんどん残っていくんでしょうね・・・・・

悩ましいことに Excite のコードは、今回のではまともな漢字に変換できないようです。

皆さんは、どうやって、判別して・・・・やっているのでしょうか・・・・・


※ サンプルファイルはそのままで、修正していません。


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt117_2000.zipkEnt117_2003.zipkEnt117_2007.zip
 サイズ 23,03623,85625,095
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2012/02/19

Category: 使えたら

TB: 0  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △

トラックバック

トラックバックURL
→http://kikutips.blog13.fc2.com/tb.php/117-7d865228
この記事にトラックバックする(FC2ブログユーザー)

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。