作ろうと思っているのは、これ。のつづき。postgresのlog編集。「SQLログ取得.xls」
【0】作ろうと思っているのは、これ。のつづき。2010/02/01完成しました。（「SQLログ取得.xls」）http://d.hatena.ne.jp/kazpgm/20100130/1264876192に完成内容があります。と思ったがまだやることがあったみたいで2/1、2/2修正中。2/3修正完了。ぜひ使ってください。と言ったが、02/04使いやすいようにまた修正した。さらによくなったとおもう。
１．postgresを使っている既存ACCESSのやWEBの実行時SQLを解析したい。
２．業務画面を実際に動かしてそのSQL結果から手がかりを得よう。と考えた。
* ACCESSやWEBを実行する。（解析したいプログラムの単位）
* postgresのlogから指定時間から現在時間までの指定DBを抜き取って、SQLを人間が見れるきれいなフォーマットに編集してエクセルに貼り付ける。取得した時間をエクセルに保存しておく。
* これを繰り返す。
【1】プログラム
１．エクセルのVBSマクロ部分を作った。動く。完成品になった。
- SQLログ取得()を動かすとエクセルシートにSQLログを貼り付ける。（1列）＜＝2/3整形するのは、手動にした。
- SQLConvert.exeはWEBからとってきたユーティリティ。クリップボードのSQL文をきれいに成型してくれるもの。
- 詳しい説明はダウンロード「SQL_Log_Get.zip」の「SQLログ取得.xls」・「環境設定」シートに書いた。
- なかなか面白いプログラムになった。（InternetExplorerを使ってWEBデータを取得した。クリップボードを作成、取得した。SQLConvert.exeをVBAから使った。エクセルシートを人が見やすいようにフォーマットした。メニューを出した。）。phpではlogファイルを後ろから読んでいる。
- 出力されたpostgresのSQLLOGのフォーマットは設定によって違うのでそこは変更しないとならない。
【2】以降はプログラムの抜粋や、このツールの製作日記
'■Module2
Option Explicit
Sub メニューの登録()
Dim Menu5 As Object
Dim Menu4 As Object
Dim Menu3 As Object
Dim Menu2 As Object
Dim Menu1 As Object
Dim S1_Menu1 As Object
'まずﾒﾆｭｰを追加します．---
Set Menu2 = CommandBars("Worksheet Menu bar").Controls.Add _
(Type:=msoControlButton, Temporary:=False)
Menu2.BeginGroup = True
Menu2.Caption = "マシン日時取得" ' --- (1)
Menu2.OnAction = "マシン日時取得"
Menu2.Enabled = True
Menu2.Visible = True
Menu2.Style = msoButtonCaption
Menu2.BeginGroup = True
Set Menu4 = CommandBars("Worksheet Menu bar").Controls.Add _
(Type:=msoControlButton, Temporary:=False)
Menu4.Caption = "SQLログ取得" ' --- (2)
Menu4.OnAction = "SQLログ取得"
Menu4.Enabled = True
Menu4.Visible = True
Menu4.Style = msoButtonCaption
Menu2.BeginGroup = True
Set Menu5 = CommandBars("Worksheet Menu bar").Controls.Add _
(Type:=msoControlButton, Temporary:=False)
Menu5.Caption = "SQL整形" ' --- (3)
Menu5.OnAction = "SQL整形"
Menu5.Enabled = True
Menu5.Visible = True
Menu5.Style = msoButtonCaption
Menu2.BeginGroup = True
Set Menu3 = CommandBars("Worksheet Menu bar").Controls.Add _
(Type:=msoControlButton, Temporary:=False)
Menu3.Caption = "フォーマット" ' --- (4)
Menu3.OnAction = "フォーマット"
Menu3.Enabled = True
Menu3.Visible = True
Menu3.Style = msoButtonCaption
' 2010/03/01 edit start 「SQLConvert.exe」の常駐化はやめた
'Menu2.BeginGroup = True
'Set Menu1 = CommandBars("Worksheet Menu bar").Controls.Add _
'(Type:=msoControlButton, Temporary:=False)
'Menu1.Caption = "【SQLConvert常駐化（起動/終了）】" ' --- (5)
'Menu1.OnAction = "SQLConvert_start"
'Menu1.Enabled = True
'Menu1.Visible = True
'Menu1.Style = msoButtonCaption
''SQLConvertを起動する
'Call SQLConvert_start
' 2010/03/01 edit end 「SQLConvert.exe」の常駐化はやめた
End Sub
'--------------------------------------------------
Sub メニューの削除()
On Error Resume Next '--- エラーが出たらその行は飛ばす。
CommandBars("Worksheet Menu bar").Controls("マシン日時取得").Delete ' --- (1)
CommandBars("Worksheet Menu bar").Controls("SQLログ取得").Delete ' --- (2)
CommandBars("Worksheet Menu bar").Controls("SQL整形").Delete ' --- (3)
CommandBars("Worksheet Menu bar").Controls("フォーマット").Delete ' --- (4)
' 2010/03/01 edit start 「SQLConvert.exe」の常駐化はやめた
'CommandBars("Worksheet Menu bar").Controls("【SQLConvert常駐化（起動/終了）】").Delete ' --- (5)
' 2010/03/01 edit end 「SQLConvert.exe」の常駐化はやめた
' 2010/03/01 edit start 「SQLConvert.exe」の常駐化はやめた
''SQLConvertを終了する
'Call SQLConvert_end
' 2010/03/01 edit end 「SQLConvert.exe」の常駐化はやめた
End Sub
Sub フォーマット()
Dim rowIdx
Dim colIdx
rowIdx = ActiveCell.Row
colIdx = ActiveCell.Column
ActiveWindow.Zoom = 75
Range("B2").Select
Columns("A:A").ColumnWidth = 6#
Columns("B:I").Select
Selection.ColumnWidth = 18.5
Cells(rowIdx, 1).Activate ' 次の項目をアクティブにする
Cells(rowIdx, colIdx).Activate ' 次の項目をアクティブにする
End Sub'■Module7
'// =============================================================
'// 2009 kaz PHP自動作成お助けTOOL.(http://kazpgm.ddo.jp/) Start
'// 修正BSDライセンス。
'// =============================================================
Option Explicit
Public ウインドウ数 As Integer
Dim 対象URL As String
Dim HTMLソース As String
Dim IEバージョン As String
Dim IEオブジェクト As Object
Dim Shellオブジェクト As Object
'文字列にしか対応してません
'VBではクリップボード関数を使いましょう
Private Const GHND = &H42
Private Const CF_TEXT = 1
'private Const MAXSIZE = 4096
Private Const MAXSIZE = 4096000
'クリップボードを開く
Declare Function OpenClipboard Lib "User32" (ByVal hWnd As Long) As Long
'クリップボードを閉じる
Declare Function CloseClipboard Lib "User32" () As Long
'メモリのロックを解除
Declare Function GlobalUnlock Lib "KERNEL32" (ByVal hMem As Long) As Long
'メモリをロック
Declare Function GlobalLock Lib "KERNEL32" (ByVal hMem As Long) As Long
'メモリ割り当て
Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'文字列をグローバル メモリへコピー
Declare Function lstrcpy Lib "KERNEL32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
'クリップボードハンドル取得
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
'クリップボードの内容を消去
Declare Function EmptyClipboard Lib "User32" () As Long
'データをクリップボードへコピー
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Sub マシン日時取得()
On Error GoTo Errマシン日時取得
Call InternetExplorerのバージョンを調べる(IEバージョン)
'Shell.Applicationオブジェクトの作成
Set Shellオブジェクト = CreateObject("Shell.Application")
'IEオブジェクトの作成(ダミー)
Set IEオブジェクト = CreateObject("InternetExplorer.Application")
IEオブジェクト.Visible = False 'IEウィンドウを表示しない
対象URL = "http://" & Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(3, 3) & "?mode=nowtime"
Call HTMLソース取得(対象URL, HTMLソース)
Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(5, 3) = HTMLソース '検索指定日時
Errマシン日時取得:
IEオブジェクト.Quit
Set IEオブジェクト = Nothing
Set Shellオブジェクト = Nothing
End Sub
Sub SQLログ取得()
Dim 文字配列
Dim ページ行数 As Integer
Dim 行数 As Integer
Dim 作品URL As String
Dim strFrst As String
Dim editStr() As String 'ログ１行分
Dim editStrIdx As Integer ' editStr()のインデックス
Dim str As String
Dim idx As Integer
Dim lastDateTime As String '検索日時のmax
Dim ignorSqls() As String '読み飛ばしたいSQL
Dim ignorGlg As Boolean '読み飛ばしたいSQLのときTrue
Dim tmpStr As String
Dim i As Integer
On Error GoTo ErrSQLログ取得
str = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(3, 5)
ignorSqls = Split(str, vbLf) '読み飛ばしたいSQL
ReDim editStr(4000)
Application.ScreenUpdating = False
editStrIdx = 0
Call InternetExplorerのバージョンを調べる(IEバージョン)
'Shell.Applicationオブジェクトの作成
Set Shellオブジェクト = CreateObject("Shell.Application")
'IEオブジェクトの作成(ダミー)
Set IEオブジェクト = CreateObject("InternetExplorer.Application")
IEオブジェクト.Visible = False 'IEウィンドウを表示しない
対象URL = "http://" & Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(3, 3) & "?dbname=" & _
Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(4, 3) & "&Y_m_d_H_i_s=" & _
Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(5, 3)
lastDateTime = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(5, 3) '検索日時のmax
Call HTMLソース取得(対象URL, HTMLソース)
' 2010/02/17 add start SQL中の”--”コメント文以降が変になるので修正した。
HTMLソース = Replace(HTMLソース, "<br><br>", vbNewLine) ' セルの中の改行
HTMLソース = Replace(HTMLソース, "<br/><br/>", vbNewLine) ' セルの中の改行
HTMLソース = Replace(HTMLソース, "<BR><BR>", vbNewLine) ' セルの中の改行
HTMLソース = Replace(HTMLソース, "<BR/><BR/>", vbNewLine) ' セルの中の改行
' 2010/02/17 add end SQL中の”--”コメント文以降が変になるので修正した。
' 2010/02/17 add start SQL中の”--”コメント文以降が変になるので修正した。
'HTMLソース = Replace(HTMLソース, "<br>", vbNewLine)
'HTMLソース = Replace(HTMLソース, "<br/>", vbNewLine)
HTMLソース = Replace(HTMLソース, "<br>", vbLf)
HTMLソース = Replace(HTMLソース, "<br/>", vbLf)
' 2010/02/17 add end SQL中の”--”コメント文以降が変になるので修正した。
HTMLソース = Replace(HTMLソース, "<", "<")
HTMLソース = Replace(HTMLソース, ">", ">")
HTMLソース = Replace(HTMLソース, "&", "&")
HTMLソース = Replace(HTMLソース, " ", " ")
' 2010/02/17 add start SQL中の”--”コメント文以降が変になるので修正した。
'HTMLソース = Replace(HTMLソース, "<BR>", vbNewLine)
'HTMLソース = Replace(HTMLソース, "<BR/>", vbNewLine)
HTMLソース = Replace(HTMLソース, "<BR>", vbLf)
HTMLソース = Replace(HTMLソース, "<BR/>", vbLf)
' 2010/02/17 add end SQL中の”--”コメント文以降が変になるので修正した。
HTMLソース = Replace(HTMLソース, "<", "<")
HTMLソース = Replace(HTMLソース, ">", ">")
HTMLソース = Replace(HTMLソース, "&", "&")
HTMLソース = Replace(HTMLソース, "&NBSP;", " ")
'1行ずつに分割
文字配列 = Split(HTMLソース, vbNewLine)
'全体行数を取得
ページ行数 = UBound(文字配列)
'1行目から順に、最後の行まで
strFrst = ""
str = ""
For 行数 = 0 To ページ行数 - 1
If Len(文字配列(行数)) > 30 And Mid(文字配列(行数), 5, 1) = "-" And _
Mid(文字配列(行数), 8, 1) = "-" And _
Mid(文字配列(行数), 14, 1) = ":" And _
Mid(文字配列(行数), 17, 1) = ":" Then
If (strFrst <> "") Then 'strFrstに" statement: "が入っているとき以外は対象外
tmpStr = Trim(Replace(str, vbNewLine, ""))
If tmpStr <> "" Then ' 値が入っている場合
ignorGlg = False
If UBound(ignorSqls) > -1 Then
For i = 0 To UBound(ignorSqls)
If ignorSqls(i) = tmpStr Then '読み飛ばしたいSQLと同じ
ignorGlg = True
Exit For
End If
Next
End If
If ignorGlg = False Then
editStr(editStrIdx) = strFrst & str
editStrIdx = editStrIdx + 1
lastDateTime = Left(strFrst, 19) '検索日時のmax
End If
End If
End If
idx = InStr(30, 文字配列(行数), " statement: ")
If idx > 0 Then ' " statement: "が入っていたとき
strFrst = Left(文字配列(行数), (idx + Len(" statement: ") - 1)) & vbNewLine
str = Mid(文字配列(行数), (idx + Len(" statement: "))) & vbNewLine
Else
strFrst = ""
str = 文字配列(行数) & vbNewLine
End If
Else
str = str & 文字配列(行数) & vbNewLine
End If
'Debug.Print 文字配列(行数)
Next 行数
If (strFrst <> "") Then 'strFrstに" statement: "が入っているとき以外は対象外
If Trim(Replace(str, vbNewLine, "")) <> "" Then ' 値が入っている場合
editStr(editStrIdx) = strFrst & str
editStrIdx = editStrIdx + 1
lastDateTime = Left(strFrst, 19) '検索日時のmax
End If
End If
Application.ScreenUpdating = True
'Debug.Print editStr
ReDim Preserve editStr(editStrIdx)
If UBound(editStr) < 1 Then
MsgBox "LOGデータはありませんでした。"
Else
SQL整形設定_一列用 (editStr)
End If
Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(5, 3) = lastDateTime '検索日時のmax
ErrSQLログ取得:
IEオブジェクト.Quit
Set IEオブジェクト = Nothing
Set Shellオブジェクト = Nothing
End Sub
Sub SQL整形()
Dim firstRow As Integer
Dim lastRow As Integer
Dim foundFlg As Boolean
Dim cIdx As Integer
Dim rIdx As Integer
Dim i As Integer, j As Integer, k As Integer
Dim str As String
Dim editStr() As String 'ログ１行分
Dim editStrIdx As Integer ' editStr()のインデックス
Dim bytesu '1秒に何文字のSQL整形ができるか
Dim kaisekiMin As Integer 'SQL整形に何秒かけるか
Dim rtn
Dim objWSHshell As Object
Dim objWSHrtn As Variant
On Error GoTo ErrSQL整形
ReDim editStr(4000)
cIdx = 2 ' カラムは必ず2列から始める。
rIdx = ActiveCell.Row
foundFlg = False
For i = rIdx To 0 Step -1
If Cells(i, 2) <> "" And IsNumeric(Cells(i, 2)) Then ' 数字が入っているものを対象とする
If foundFlg = False Then
lastRow = i
firstRow = i
foundFlg = True
Else
firstRow = i
End If
Else
If foundFlg = True Then 'すでに対象データを見つけた
Exit For
Else
If Cells(i, 2) <> "" Then '数字が見つからない
Exit For
End If
End If
End If
Next
If foundFlg = False Then
MsgBox ("カーソル位置からさかのぼって2列目に数字以外の文字が入っているか、" & vbCrLf & "値が入っていないみたいです。SQL整形を行えません。")
Exit Sub
End If
For i = firstRow To lastRow
If Cells(i, 3) <> "" Then ' 「SQL整形する」と入っていることを想定している
' クリップボードに保存する
' 2010/02/17 add start SQL中の”--”コメント文以降が変になるので修正した。
'ClipBoard_SetData (Cells(i, 5))
str = Replace(Cells(i, 5), vbLf, vbNewLine) ' セルの中の改行を通常の改行にする
ClipBoard_SetData (str)
' 2010/02/17 add end SQL中の”--”コメント文以降が変になるので修正した。
' 2010/02/17 add start 参照しているセル位置が間違っていた
'bytesu = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(6, 6)
bytesu = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(6, 5)
' 2010/02/17 add end 参照しているセル位置が間違っていた
If bytesu <> "" And IsNumeric(bytesu) Then
Else
bytesu = 400 'デフォルト。1秒400文字のSQL整形できるとした。
End If
kaisekiMin = Len(Cells(i, 5)) / bytesu
If kaisekiMin < 1 Then
kaisekiMin = 1
End If
If kaisekiMin > 60 Then
kaisekiMin = 60 '１SQL整形に1分以上かかるのはデータが変だからだと考える。
End If
' SQL整形
'SQLConvertを実行する
' 2010/03/01 edit start 「SQLConvert.exe」の常駐化はやめた
'Call SQLConvert_convert(kaisekiMin)
Set objWSHshell = CreateObject("WScript.Shell")
objWSHrtn = objWSHshell.Run("C:\\PROGRA~1\\NodaSoft@\\SQLConvert\\SQLConvert.exe /s", 7, True)
Set objWSHshell = Nothing
' 2010/03/01 edit end 「SQLConvert.exe」の常駐化はやめた
' クリップボードからデータを取得する
str = ClipBoard_GetData
editStr(editStrIdx) = Cells(i, 2) & vbNewLine & Cells(i, 4) & vbNewLine & str
editStrIdx = editStrIdx + 1
If (editStrIdx Mod 16) = 0 Then
rtn = MsgBox(editStrIdx & "件整形しました。まだ続けますか？いいえのときはここまでで終わりにします。", vbYesNo)
If rtn = vbNo Then
Exit For
End If
End If
End If
Next
ReDim Preserve editStr(editStrIdx)
SQL整形設定 (editStr)
ErrSQL整形:
End Sub
Private Sub SQL整形設定_一列用(editStr)
Dim rIdxBase As Integer
Dim rIdx As Integer
Dim rIdxSave As Integer
Dim cIdx As Integer
Dim MaxRow As Integer
Dim ttlRow
Dim i As Integer, j As Integer, k As Integer
Dim valss
Dim vals As String
Dim str As String
Dim colIdx As Integer
On Error GoTo ErrSQL整形設定_一列用
cIdx = 2 ' カラムは必ず2列から始める。
rIdx = ActiveCell.Row
For i = 0 To UBound(editStr) - 1
If i = 0 Then
Cells(rIdx, cIdx + 1) = "↓ここで「SQL整形する」を選んで、LOG行後のカラムでメニュー「SQL整形」を動かすときれいに見れます。B列に値があるものを対象とします"
Cells(rIdx, cIdx + 1).Font.ColorIndex = 3
Cells(rIdx, cIdx + 1).Font.Bold = True
End If
If i Mod 2 = 0 Then
colIdx = 34
Else
colIdx = 35
End If
'1行ずつに分割
valss = Split(editStr(i), vbNewLine)
rIdx = rIdx + 1
Range(Cells(rIdx, cIdx), Cells(rIdx, 10)).Interior.ColorIndex = colIdx
Cells(rIdx, cIdx).Interior.Pattern = xlSolid
Cells(rIdx, cIdx).HorizontalAlignment = xlCenter
Cells(rIdx, cIdx).VerticalAlignment = xlCenter
Cells(rIdx, cIdx).Font.Bold = True
Call setCells(rIdx, cIdx, (i + 1))
With Cells(rIdx, cIdx + 1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="SQL整形する"
.IgnoreBlank = False
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
Cells(rIdx, cIdx + 1).Interior.ColorIndex = 0
Cells(rIdx, cIdx + 1).Font.ColorIndex = 3
With Cells(rIdx, cIdx + 1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Range(Cells(rIdx, cIdx), Cells(rIdx, 10)).Borders(xlEdgeTop)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range(Cells(rIdx, cIdx), Cells(rIdx, 10)).Borders(xlEdgeBottom)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Cells(rIdx, cIdx + 1).Borders(xlEdgeLeft)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Cells(rIdx, cIdx + 1).Borders(xlEdgeRight)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
For j = 0 To UBound(valss) - 1
str = valss(j)
If j = 0 Then
Call setCells(rIdx, 4, str)
Else
' 2010/02/24 修正 start SQL的には変でも1行で見れるものがほしい。直接修正した。
Range(Cells(rIdx, 5), Cells(rIdx, 6)).Interior.ColorIndex = 36
Range(Cells(rIdx, 5), Cells(rIdx, 6)).Interior.Pattern = xlSolid
' 2010/02/17 add start SQL中の”--”コメント文以降が変になるので修正した。
With Range(Cells(rIdx, 5), Cells(rIdx, 6))
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
' 2010/02/17 add end SQL中の”--”コメント文以降が変になるので修正した。
rIdxSave = rIdx
rIdx = setCells(rIdx, 5, str)
rIdx = rIdxSave
Range(Cells(rIdx, 7), Cells(rIdx, 10)).Interior.ColorIndex = 19
Range(Cells(rIdx, 7), Cells(rIdx, 10)).Interior.Pattern = xlSolid
With Range(Cells(rIdx, 7), Cells(rIdx, 10))
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
rIdx = setCells(rIdx, 7, Trim(Replace(str, vbLf, " ")))
' 2010/02/24 修正 end SQL的には変でも1行で見れるものがほしい。直接修正した。
End If
Next j
rIdx = rIdx - 1
Next i
ActiveWindow.Zoom = 75
Range("B2").Select
Columns("A:A").ColumnWidth = 6#
Columns("B:I").Select
Selection.ColumnWidth = 18.5
Cells(rIdx + 1, 1).Activate ' 次の項目をアクティブにする
Cells(rIdx + 1, 2).Activate ' 次の項目をアクティブにする
Exit Sub
ErrSQL整形設定_一列用:
MsgBox ("SQL整形設定_一列用に失敗しました" & Chr(13) & Chr(13) & "原因は " & Chr(13) & Err.Description)
End Sub
Private Sub SQL整形設定(editStr)
Dim rIdxBase As Integer
Dim rIdx As Integer
Dim cIdx As Integer
Dim MaxRow As Integer
Dim ttlRow
Dim i As Integer, j As Integer
Dim valss
Dim vals As String
Dim str As String
Dim rIdxSave As Integer
Dim editStrSize()
Dim kensu
Dim MaxRowIns
Dim Point
On Error GoTo ErrSQL整形設定
' 2010/02/25 追加 start 編集する行数分エクセル行を挿入。
ReDim editStrSize(UBound(editStr))
For i = 0 To UBound(editStr) - 1
editStrSize(i) = UBound(Split(editStr(i), vbNewLine))
Next i
' 2010/02/25 追加 end 編集する行数分エクセル行を挿入。
rIdxBase = ActiveCell.Row
MaxRow = rIdxBase
cIdx = 1 ' カラムは必ず左端から始める。
rIdx = ActiveCell.Row
For i = 0 To UBound(editStr) - 1
'1行ずつに分割
valss = Split(editStr(i), vbNewLine)
If UBound(valss) > -1 Then ' データあり
If cIdx > 8 Then
cIdx = 1
rIdxBase = MaxRow + 2
End If
cIdx = cIdx + 1
rIdx = rIdxBase
' 2010/02/25 追加 start 編集する行数分エクセル行を挿入。
If cIdx = 2 Then
If Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(1, 1) <> "" Then '日本語SQL整形作成の場合
kensu = 4
Else
kensu = 8
End If
Point = i
MaxRowIns = 0
Do While kensu > 0 And Point < UBound(editStr)
If editStrSize(Point) > -1 Then ' データあり
kensu = kensu - 1
If editStrSize(Point) > MaxRowIns Then
MaxRowIns = editStrSize(Point)
End If
End If
Point = Point + 1
Loop
If MaxRowIns > 0 Then
Rows(rIdx & ":" & (rIdx + MaxRowIns + 2)).Select ' 編集する行数分エクセル行を挿入
Selection.Insert Shift:=xlDown
End If
End If
' 2010/02/25 追加 end 編集する行数分エクセル行を挿入。
ttlRow = UBound(valss) + 1
If ttlRow > MaxRow Then
MaxRow = ttlRow
End If
rIdx = rIdxBase + 1
Cells(rIdx, cIdx).Interior.ColorIndex = 34
Cells(rIdx, cIdx).Interior.Pattern = xlSolid
Cells(rIdx, cIdx).HorizontalAlignment = xlCenter
Cells(rIdx, cIdx).VerticalAlignment = xlCenter
Cells(rIdx, cIdx).Font.Bold = True
' 2010/02/24 修正 start 日本語SQL整形作成。直接修正した。
If Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(1, 1) <> "" Then '日本語SQL整形作成の場合
Cells(rIdx, cIdx + 1).Interior.ColorIndex = 34
Cells(rIdx, cIdx + 1).Interior.Pattern = xlSolid
Cells(rIdx, cIdx + 1).HorizontalAlignment = xlCenter
Cells(rIdx, cIdx + 1).VerticalAlignment = xlCenter
Cells(rIdx, cIdx + 1).Font.Bold = True
End If
For j = 0 To UBound(valss)
str = valss(j)
If Len(str) > 1 Then
If Left(str, 1) = "'" Then
str = " " & str 'エクセルは”'”から始まると'が見えなくなるので空白からはじめる。
End If
End If
rIdxSave = rIdx
rIdx = setCells(rIdxSave, cIdx, str)
If Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(1, 1) <> "" Then '日本語SQL整形作成の場合
rIdx = setCells(rIdxSave, cIdx + 1, rtnJpnSQL(str))
End If
Next j
If Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(1, 1) <> "" Then '日本語SQL整形作成の場合
cIdx = cIdx + 1 '日本語SQLの分
End If
' 2010/02/24 修正 end 日本語SQL整形作成。直接修正した。
rIdx = rIdx - 1
If rIdx > MaxRow Then
MaxRow = rIdx
End If
End If
Next i
ActiveWindow.Zoom = 75
Range("B2").Select
Columns("A:A").ColumnWidth = 6#
Columns("B:I").Select
Selection.ColumnWidth = 18.5
Cells(rIdx + 1, 1).Activate ' 次の項目をアクティブにする
Cells(rIdx + 1, 2).Activate ' 次の項目をアクティブにする
Exit Sub
ErrSQL整形設定:
MsgBox ("SQL整形設定に失敗しました" & Chr(13) & Chr(13) & "原因は " & Chr(13) & Err.Description)
End Sub
Private Function setCells(rIdx As Integer, cIdx As Integer, val As String)
If Len(val) < 127 Then
Cells(rIdx, cIdx).NumberFormatLocal = "@"
Else
Cells(rIdx, cIdx).NumberFormatLocal = "G/標準"
End If
Cells(rIdx, cIdx) = val
setCells = rIdx + 1
End Function
Private Sub InternetExplorerのバージョンを調べる(IEバージョン)
Dim ファイルシステムオブジェクト As Object
Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
IEバージョン = ファイルシステムオブジェクト.GetFileVersion _
("C:\Program Files\Internet Explorer\IEXPLORE.EXE ")
IEバージョン = Left(IEバージョン, InStr(IEバージョン, ".") - 1)
Set ファイルシステムオブジェクト = Nothing
End Sub
Private Sub HTMLソース取得(対象URL, HTMLソース)
On Error GoTo ErrHTMLソース取得
If IEバージョン > "6" Then
IEオブジェクト.Navigate2 対象URL '★IE7の場合、既存or新しいウィンドウで表示される
Else
IEオブジェクト.Navigate 対象URL '★IE6以前の場合
End If
'前の画面から、新しい対象URLの画面に切り替わるまで、1秒間待つ
Application.wait Now + TimeValue("00:00:01")
'ページの読み込みが終わるまでココでグルグル回る
Do Until IEオブジェクト.Busy = False
'空ループだと無駄にCPUを使うので1秒のインターバルを置く
Application.wait Now + TimeValue("00:00:01")
Loop '
'①表示したページの<BODY>部のHTMLを取得し画面に表示
HTMLソース = IEオブジェクト.document.Body.InnerHtml
Exit Sub
ErrHTMLソース取得:
MsgBox ("HTMLソース取得に失敗しました" & Chr(13) & Chr(13) & "原因は " & Chr(13) & Err.Description)
End Sub
Private Function ClipBoard_GetData()
'クリップボードから情報を取り出す
Dim hClipMemory As Long, lpClipMemory As Long, MyString As String, RetVal As Long
If OpenClipboard(0&) = 0 Then
MsgBox "他のアプリケーションが使用しているため、クリップボードを開けません。", vbCritical
Exit Function
End If
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "クリップボードハンドル取得に失敗しました", vbCritical
GoTo OutOfHere
End If
lpClipMemory = GlobalLock(hClipMemory)
If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
On Error Resume Next
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
If Err Then 'text以外のデータ
MsgBox "クリップボードのデータはテキストでありません", vbCritical
Err.Clear
MyString = ""
End If
On Error GoTo 0
Else
MsgBox "クリップボード メモリをロックできません", vbCritical
End If
OutOfHere:
RetVal = CloseClipboard()
If MyString = "" Then
ClipBoard_SetData MyString
Else
ClipBoard_GetData = MyString
End If
End Function
Private Function ClipBoard_SetData(MyString As String)
'クリップボードへ情報を送信
Dim hGlobalMemory As Long, lpGlobalMemory As Long, hClipMemory As Long, X As Long
hGlobalMemory = GlobalAlloc(GHND, LenB(StrConv(MyString, vbFromUnicode)) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "メモリのロックを解除できません。処理が失敗しました。", vbCritical
GoTo OutOfHere2
End If
If OpenClipboard(0&) = 0 Then
MsgBox "クリップボードを開くことができません。処理が失敗しました。", vbCritical
Exit Function
End If
X = EmptyClipboard()
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "クリップボードを閉じることができません。", vbCritical
End If
End Function
' 2010/02/24 追加 start 日本語SQL整形作成。直接修正した。
' SQLを日本語にする
Private Function rtnJpnSQL(arg_str)
Dim out_str, idx, 項目フラグ, str0
Dim str, str2
out_str = ""
idx = 1
str = Mid(arg_str, 1, 1)
If "A" <= UCase(str) And UCase(str) <= "Z" Then
項目フラグ = "ITEM"
ElseIf str = "'" Then
項目フラグ = "LITERAL"
ElseIf str2 = "--" Then
項目フラグ = "COMMENT"
Else
項目フラグ = "OTHER"
End If
Do While (idx < Len(arg_str) + 1)
If 項目フラグ = "ITEM" Then
str0 = ""
Do While (idx < Len(arg_str) + 1)
str = Mid(arg_str, idx, 1)
str2 = Mid(arg_str, idx, 2)
If (0 <= str And str <= 9) Or ("A" <= UCase(str) And UCase(str) <= "Z") _
Or "_" = str Then
str0 = str0 & str
idx = idx + 1
ElseIf str = "'" Then
項目フラグ = "LITERAL"
Exit Do
ElseIf str2 = "--" Then
項目フラグ = "COMMENT"
Exit Do
Else
項目フラグ = "OTHER"
Exit Do
End If
Loop
out_str = out_str & tblItemJpn(str0) '日本語名
ElseIf 項目フラグ = "LITERAL" Then
str0 = ""
Do While (idx < Len(arg_str) + 1)
str = Mid(arg_str, idx, 1)
str2 = Mid(arg_str, idx, 2)
If str2 = "''" Then ' リテラルの中
str0 = str0 & str
idx = idx + 1
ElseIf str = "'" Then ' リテラルの終了
str0 = str0 & str
idx = idx + 1
項目フラグ = "OTHER"
Exit Do
ElseIf str2 = "--" Then
項目フラグ = "COMMENT"
Exit Do
Else ' リテラルの中
str0 = str0 & str
idx = idx + 1
End If
Loop
out_str = out_str & str0 'リテラル
ElseIf 項目フラグ = "COMMENT" Then
out_str = out_str & Mid(arg_str, idx)
idx = Len(arg_str) + 1 ' 終了
Else ' OTHER
str0 = ""
Do While (idx < Len(arg_str) + 1)
str = Mid(arg_str, idx, 1)
str2 = Mid(arg_str, idx, 2)
If "A" <= UCase(str) And UCase(str) <= "Z" Then ' 項目発見
項目フラグ = "ITEM"
Exit Do
ElseIf str = "'" Then
項目フラグ = "LITERAL"
Exit Do
ElseIf str2 = "--" Then
項目フラグ = "COMMENT"
Exit Do
Else
str0 = str0 & str
idx = idx + 1
End If
Loop
out_str = out_str & str0 'リテラル
End If
Loop
rtnJpnSQL = out_str
End Function
'「TBL項目名たち」シートをVLookupして日本語項目名を取得する。
Private Function tblItemJpn(item)
Dim itemL
itemL = LCase(item)
Dim MyVariant As Variant
MyVariant = Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Application.VLookup(itemL, Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Range("A:B"), 2, False)
If IsError(MyVariant) Then
tblItemJpn = item
Else
tblItemJpn = MyVariant
End If
End Function
Sub TBL項目名たちクリア()
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Columns("A:D").Clear
Workbooks("SQLログ取得.xls").Sheets("環境設定").Activate
End Sub
Sub TBL項目名たち作成()
Dim i, j, Name, Name2
Dim pkeyCount, outIdx
Dim 解析するテーブル一覧のエクセル名 As String
Dim テーブル英語名_row
Dim テーブル英語名_col
Dim テーブル日本語名_kbn
Dim テーブル日本語名_row
Dim テーブル日本語名_col
Dim テーブル項目の開始位置_row
Dim 項目英語名_col
Dim 項目日本語名_col
Dim 属性_col
Dim 読み飛ばしたいシートたち() As String
Dim str As String
Dim ignorFlg As Boolean
解析するテーブル一覧のエクセル名 = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(10, 4)
If 解析するテーブル一覧のエクセル名 = "" Then
MsgBox ("解析するテーブル一覧のエクセル名を指定してください。")
Exit Sub
End If
テーブル英語名_row = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(12, 5)
If テーブル英語名_row = "" Then
MsgBox ("テーブル英語名_rowを指定してください。")
Exit Sub
End If
テーブル英語名_col = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(12, 6)
If テーブル英語名_col = "" Then
MsgBox ("テーブル英語名_colを指定してください。")
Exit Sub
End If
テーブル日本語名_kbn = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(13, 4)
If テーブル日本語名_kbn = "" Then
MsgBox ("テーブル日本語名_kbnを指定してください。")
Exit Sub
End If
If テーブル日本語名_kbn <> "シート名使用" Then
テーブル日本語名_row = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(13, 5)
If テーブル日本語名_row = "" Then
MsgBox ("指定セル使用のときは、テーブル日本語名_rowを指定してください。")
Exit Sub
End If
テーブル日本語名_col = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(13, 6)
If テーブル日本語名_col = "" Then
MsgBox ("指定セル使用のときは、テーブル日本語名_colを指定してください。")
Exit Sub
End If
End If
テーブル項目の開始位置_row = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(14, 4)
If テーブル項目の開始位置_row = "" Then
MsgBox ("テーブル項目の開始位置_rowを指定してください。")
Exit Sub
End If
項目英語名_col = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(15, 6)
If 項目英語名_col = "" Then
MsgBox ("項目英語名_colを指定してください。")
Exit Sub
End If
項目日本語名_col = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(16, 6)
If 項目日本語名_col = "" Then
MsgBox ("項目日本語名_colを指定してください。")
Exit Sub
End If
属性_col = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(17, 6)
If 属性_col = "" Then
MsgBox ("属性_colを指定してください。")
Exit Sub
End If
str = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(18, 4)
読み飛ばしたいシートたち = Split(str, vbLf) '読み飛ばしたいシート
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Columns("A:D").Clear
Workbooks.Open Filename:=解析するテーブル一覧のエクセル名
outIdx = 1
DoEvents
For i = 1 To Sheets.count
Sheets(i).Select
Sheets(i).Activate
ignorFlg = False
If UBound(読み飛ばしたいシートたち) > -1 Then
For j = 0 To UBound(読み飛ばしたいシートたち)
If 読み飛ばしたいシートたち(j) = Sheets(i).Name Then '読み飛ばしたいシートと同じ
ignorFlg = True
Exit For
End If
Next
End If
If ignorFlg = False Then 'テーブル定義シートの場合
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 1) = LCase(Cells(テーブル英語名_row, テーブル英語名_col)) 'テーブル英語名
If テーブル日本語名_kbn = "シート名使用" Then
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 2) = Sheets(i).Name 'テーブル日本語名
Else
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 2) = Cells(テーブル日本語名_row, テーブル日本語名_col) 'テーブル日本語名
End If
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 3) = "" '属性
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 4) = LCase(Cells(テーブル英語名_row, テーブル英語名_col)) 'テーブル名
outIdx = outIdx + 1
j = 10
Do While Cells(j, 3) <> "" '項目名が入っている内
If 重複チェック(LCase(Cells(j, 項目英語名_col)), Cells(j, 項目日本語名_col), LCase(Cells(j, 属性_col))) = 0 Then '項目英語名, 項目日本語名, 属性
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 1) = LCase(Cells(j, 項目英語名_col)) '項目英語名
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 2) = Cells(j, 項目日本語名_col) '項目日本語名
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 3) = LCase(Cells(j, 属性_col)) '属性
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(outIdx, 4) = LCase(Cells(テーブル英語名_row, テーブル英語名_col)) 'テーブル名
outIdx = outIdx + 1
End If
j = j + 1
Loop
End If
Next
ActiveWorkbook.Close (False)
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Activate
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Key3:=Range("B1"), Order3:=xlAscending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
, SortMethod:=xlPinYin, DataOption1:=xlSortNormal, DataOption2:= _
xlSortNormal, DataOption3:=xlSortNormal
Range("F29").Select
Workbooks("SQLログ取得.xls").Sheets("環境設定").Activate
End Sub
'同じものがすでに登録されていたら行番号を戻す。無かったら0を戻す
Private Function 重複チェック(項目英語名, 項目日本語名, 属性)
Dim i
重複チェック = 0
i = 1
Do While Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(i, 1) <> "" '項目英語名が入っている内
If Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(i, 1) = 項目英語名 And _
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(i, 2) = 項目日本語名 And _
Workbooks("SQLログ取得.xls").Sheets("TBL項目名たち").Cells(i, 3) = 属性 Then
重複チェック = i
Exit Do
End If
i = i + 1
Loop
End Function
' 2010/02/24 追加 end 日本語SQL整形作成。直接修正した。
'// =============================================================
'// 2009 kaz PHP自動作成お助けTOOL.(http://kazpgm.ddo.jp/) End
'// 修正BSDライセンス。
'// =============================================================２．php側”getSqlLog.php”を作って動かした。ログのパス”C:\Tools\XAMPP\xampplite\htdocs\samples\phptail\logsample_honmono.log”はまだサンプル。（実際に使おうと思っているサーバは/var/log/・・・にLOGがあるEUCのpostgres。phpもEUCだったので、mb_convert_encoding()いらなかった。）
<?php
// ■getsqlLog.php
// =============================================================
// 2009 kaz PHP自動作成お助けTOOL.(http://kazpgm.ddo.jp/) Start
// 修正BSDライセンス。
// =============================================================
header('Content-type:text/html; charset=UTF-8');
// postgreログ
//$logpath = '/var/log/postgres'; // postgreログ
$logpath = 'C:\Tools\XAMPP\xampplite\htdocs\samples\phptail\logsample_honmono.log'; // postgreログ
//$logpath = 'C:\xampp\htdocs\samples\phptail\logsample_honmono.log'; // postgreログ
if (!file_exists($logpath)){ // 対象のファイルがない場合
die($logpath.' is not found'); // ファイルがないというメッセージを戻す。
}
// モード 'nowtime':マシン日付取得、'get':LOGを取得。mode指定がない場合'get'となる。
$mode = 'get'; // モード デフォルトは'get':LOGを取得。
if (isset($_GET['mode'])){ // GETで'mode'パラメータがある場合
$mode = $_GET['mode']; // GETで'mode'を取得。
if ($mode != 'nowtime' && $mode != 'get') { // modeパラメータエラーの場合
die("please input mode 'nowtime' or 'get'."); // メッセージを戻す。
}
}
if ($mode == 'get') { // LOGを取得
// 取得する末尾の行数のMAX。（大量データを戻さないため。）
$lines = 3000;
$dbname = $_GET['dbname']; // GETで'dbname'を取得
if ($dbname == '') { // dbnameパラメータエラーの場合
die('please input dbname.'); // メッセージを戻す。
}
$hizuke = $_GET['Y_m_d_H_i_s']; // GETで'Y_m_d_H_i_s'を取得
if ($dbname == '' || strlen($hizuke) <> strlen('yyyy-mm-dd hh:nn:ss')) { // 日時パラメータチェックエラーの場合
die('please input yyyy-mm-dd hh:nn:ss.'); // メッセージを戻す。
}
foreach (read_tail_sql_log($logpath, $lines, $dbname, $hizuke) as $i => $line){ // ログをファイルから指定行数読み出した行ごとの配列を読み込む。
$line = rtrim($line,"\r\n"); // 文字列の末尾から"\r\n"を削除する
// 行中の特殊文字を HTML エンティティに変換する。タブは' 'に変換する。
// 2010/02/17 add start SQL中の”--”コメント文以降が変になるので修正した。
//echo strtr(htmlspecialchars($line,ENT_QUOTES),array("\t" => ' '));
echo strtr(htmlspecialchars($line,ENT_QUOTES),array("\t" => ' ',"\r" => '',"\n" => '<br />'));
// 2010/02/17 add end SQL中の”--”コメント文以降が変になるので修正した。
//if ($i <($lines - 1)){ // 最終行以外の場合
// 2010/02/17 add start SQL中の”--”コメント文以降が変になるので修正した。
// echo '<br />'; // HTML改行を出す。
echo '<br /><br />'; // HTML改行を出す。
// 2010/02/17 add end SQL中の”--”コメント文以降が変になるので修正した。
//}
}
} else { // マシン日付取得
$hizukeData = date("Y-m-d")." ".date("H:i:s"); // 読み込みできなかった場合マシン日付を返す。
echo htmlspecialchars($hizukeData,ENT_QUOTES);
}
/**
* ログをファイルから指定行数読み出す
*
* @param string $file ファイルパス
* @param int $lines 行数
* @param string $dbname DB名
* @param string $hizuke 日時
* @return array 行ごとの配列
*/
function read_tail_sql_log($file, $lines, $dbname, $hizuke) {
//global $fsize;
$handle = fopen($file, "r"); // 読み込み。ポインタは先頭。
$linecounter = $lines; // 未読み込みカウンタ
$pos = -2; // シークバイト（初期値はファイル終点から-2バイト（\r\nぶん））
$beginning = false; // ファイル先頭フラグ。false：先頭ではない。
$text = array(); // 行ごとの配列
$linesub = array(); // 続きデータ配列
while ($linecounter> 0) { // 読み込み行数までループ
$t = " "; // 1文字（初期値）
while ($t != "\n") { // 1文字が"\n"になるまでループ
if(fseek($handle, $pos, SEEK_END) == -1) { // ファイルの終端からシークバイトぶん移動させる。
$beginning = true; // ファイル先頭まで来た
break;
}
$t = fgetc($handle); // 1文字読み込み
$pos --; // シークバイトを1バイト1つ前にする。
}
if ($beginning) { // ファイル先頭なら
rewind($handle); // ファイルポインタの位置を先頭に戻す。
}
$linedata = fgets($handle);
if (preg_match("/^([0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2}) [^ ]+ [^ ]+ [^ ]+ " . $dbname . " [^ ]+ [^ ]+[ ]+statement:/i", $linedata, $matches) ) { // DB名が指定のもののとき出力
$hizukeData = $matches[1];
if ($hizuke < $hizukeData) { // ログ日時が指定日時より大きい場合
$linecounter --;// 未読み込みカウンタを-1する。
$linesub = array_reverse($linesub); // 続きデータ配列の順番を逆順にする。
$text[$lines-$linecounter-1] = $linedata . implode(' ', $linesub); // 行ごとの配列に1行ぶん入れる。（新しいものがインデックス0）
$linesub = array();
} else {
break;
}
} else if (preg_match("/^([0-9]{4}-[0-9]{2}-[0-9]{2} [0-9]{2}:[0-9]{2}:[0-9]{2}) [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+ [^ ]+[ ]+/", $linedata, $matches) ) { // DB名が指定以外の場合
$hizukeData = $matches[1];
if ($hizuke < $hizukeData) { // ログ日時が指定日時より大きい場合
// 読み飛ばし
$linesub = array();
} else {
break;
}
} else {
$linesub[] = $linedata; // 続きデータ配列に続きデータを入れる。
}
if ($beginning) break; // ファイル先頭なら終わり。
}
fclose ($handle); // ファイルを閉じる
$text = array_reverse($text); // 行ごとの配列の順番を逆順（古いものがインデックス0）にして戻す。
if ($linecounter < 1) { // 取得する末尾の行数のMAXまでいってしまった場合
$text[] ='★MAX line ' . $lines . ' over.';
}
return $text;
}
// =============================================================
// 2009 kaz PHP自動作成お助けTOOL.(http://kazpgm.ddo.jp/) End
// 修正BSDライセンス。
// =============================================================
３．サンプルpostgresLOG
2010-01-22 14:51:24 JST 4b593cdc.1580 5504 testdb 192.168.1.x LOG: statement:
2010-01-22 14:51:24 JST 4b593cdc.1580 5504 testdb 192.168.1.x LOG: statement: select oid from pg_type where typname='lo'
2010-01-22 14:51:24 JST 4b593cdc.1580 5504 testdb 192.168.1.x LOG: statement: select version()
2010-01-22 14:51:24 JST 4b593cdc.1580 5504 testdb 192.168.1.x LOG: statement: insert into t_mpk (mpk_num,mpk_a_class,mpk_w_name,mpk_w_class,mpk_e_code,mpk_w_num,mpk_e_code,mpk_rmk,mpk_dt)values(NEXTVAL('t_s'),'3','ログアウト','','','','0088','',CURRENT_TIMESTAMP);
2010-01-22 14:51:24 JST 4b593cdc.1580 5504 testdb 192.168.1.x LOG: statement:
2010-01-23 02:30:01 JST 4b59e099.2f41 12097 testdb [local] LOG: statement: DELETE FROM t_xxxxxxxxx_meisai_tran
WHERE
sekm_id IN (
SELECT
M.sekm_id
FROM
t_xxxxxxxxx_tran AS H
,t_xxxxxxxxx_meisai_tran AS M
,t_xxxxxx_master AS E
WHERE
H.s_id = M.s_id
AND
H.e_code = E.e_code
AND
H.s_date <= (current_timestamp + '-3 month') AND
E.e_nohin < (current_timestamp + '-3 month') AND
(sekm_p_qty IS NULL OR sekm_p_qty = 0) AND
(sekm_p_amt IS NULL OR sekm_p_amt = 0) AND
(sekm_g_amt IS NULL OR sekm_g_amt = 0) );
４．エクセルマクロ実行後のエクセルシート。どうだろ、なかなかいいものができそう。SQLConvert.exeの実力はかなりのものだ。SQLは横8個書き込むようにした。
５．作ったphpのURL”//localhost/samples/phptail/getsqllog.php?dbname=testdb&Y_m_d_H_i_s=2010-01-22%2013:03:05”もWEB表示できる。ちょっと便利。
01/25 22:00-03:30
01/26 22:00-03:00 テストのため 対象URL = "//localhost/samples/phptail/getsqllog.php?dbname=testdb&Y_m_d_H_i_s=2010-01-22%2013:03:05"にしてPHPを呼んだ。
01/27 22:00-24:30 php側で”testdb”と指定しても”xxxxdb”のログが混じってしまうバグを修正した。vba側で”statement:”の後が空のときその行を無視するように修正した。php側の”$line = mb_convert_encoding($line, "UTF-8", "EUC-JP");”をやめた。vba側でLogを一度小文字にしていたが、SQL内リテラルが小文字になってしまうので、やめた。
01/28 22:30-01:00 vbaからエクセルに貼り付けるとき横8個のSQLを書き込むように修正した。これにより縦の長さが８分の１になるはず。1つづつだとかなりみづらかったので修正した。番号も振った。番号があれば何番目のあれ。って言えるので。
01/30 21:00-03:00 完成形にした。VBAのマクロと環境設定を「SQLログ取得.xls」においた。「環境設定」シートに「URL」「DB名」「検索指定日時」を持つようにした。さらに「エクセル側セットアップ」「php側セットアップ」、「使用法」など記述した。使用法ブログに載せる。
02/01 20:30-24:00
・getSqlLog.phpのこのあたりを修正。
$lines = 400; <=４００行まで取得するようにした。 ^echo '<br />;'; // HTML改行を出す。 ＜＝すべてのラインで改行するようにした。 '★MAX line ' . $lines . ' over.'; ＜＝わかりやすいように★をつけた
・エクセルマクロを修正した。LOGの先頭をエクセルに書き込まなかったおで修正した。SQLのリテラル'aaa'などがエクセルのセルに入ると先頭の'が見えなくなるので。空白を入れて見えるようにした。
For 行数 = 1 To ページ行数
をこれにした。
For 行数 = 0 To ページ行数 - 1
・・・
rIdx = setCells(rIdx, cIdx, Trim(valss(j)))
をこれにした。
str = Trim(valss(j))
If Len(str) > 0 Then
If Left(str, 1) = "'" Then
str = " " & str 'エクセルは”'”から始まると'が見えなくなるので空白からはじめる。
End If
End If
rIdx = setCells(rIdx, cIdx, str)02/03 02：10-02：10 エクセルVBAのSQL取得ロジック周りを大きく変えた。
2010/02/04 23:30-23:30 エクセルVBA。いちいちマクロー＞マクロー＞XXXは使いづらいのでメニューにした。”set DateStyle to 'ISO'”みたいなものを読み飛ばしできるようにした。
02/07 12:00-12:20 エクセルVBAの「SQLログ取得()」に変数が定義されていなかったのでコンパイルエラーになっていた。今入れた。「Dim i As Integer」
02/07 21:40-21:50 SQLConvert.exeの常駐化に成功した。Module8を参照
02/09 21:00-21:10 getsqlLog.phpにエラーハンドリング（set_error_handler）を入れた。
02/17 01:20-01:30 SQL中の”--”コメント文以降が変になるので修正した。
02/24 22:30-22:40 SQL的には変でも1行で見れるものも出すようにした。日本語SQL整形作成。
02/25 22:50-22:55 「set_error_handler」がphp4ではうまく動かないことがわかった。削除した。 「SQL整形」するときは必ず編集する行数分エクセル行を挿入してから編集する。
03/01 00:00-00:15 SQLConvert.exeの常駐化はやめた。Module8削除
