公開日:2014/10/09
速度改善その2。
HTMLファイルを圧縮してコンテンツのダウンロード速度を改善しよう作戦。
HTMLファイルやCSSファイルの中の改行やタブはブラウザでは表示されないのでリリース時には削除してファイルサイズを小さくしてやる。
そうとうテキストぎっしりのページじゃない限り体感はできそうにないけど(:3_ヽ)_
既存のツールやオンラインサービスはあえて使わずにVBAツールをつくってみたのでメモ。
Excelシート
圧縮前のフォルダと圧縮後のフォルダを指定して圧縮ボタン押すだけ。
プログラム
圧縮ボタンのClickイベント。
Private Sub CommandButton1_Click()
'変数の宣言
Dim rowNo As Integer 'Excel行
Dim dirSource As String '圧縮前ルートフォルダ
Dim dirCompress As String '圧縮後ルートフォルダ
Dim dirSub() As String 'サブフォルダ配列
Dim pos As Integer 'サブフォルダ配列の検索位置
Dim file As String 'ファイル検索戻り値
Dim buf As String '圧縮作業用文字列
Dim strCompress As String '圧縮後文字列
Dim flg As Integer '1以上の場合は圧縮しない
Dim bin() As Byte 'BOMなしバイナリ一時保存用配列
Dim FSO As New FileSystemObject 'サブフォルダ作成用FSO
Dim strm As New ADODB.Stream '入出力用Stream
'初期設定
dirSource = Range("B2").Value '圧縮前ルートフォルダを設定
dirCompress = Range("B5").Value '圧縮後ルートフォルダを設定
Application.Cursor = xlWait '砂時計カーソルを表示
rowNo = 10 'Excel行を設定
ReDim dirSub(0) '初期要素数を設定
'前回圧縮結果の削除
Range("B" & rowNo & ":E" & Rows.Count).ClearContents
'全てのサブフォルダをループ
Do While pos <= UBound(dirSub)
'最初の検索
file = Dir(dirSource & dirSub(pos) & "\", vbDirectory)
'検索結果がなくなるまでループ
Do While file <> ""
'フォルダの場合
If file <> "." And file <> ".." And GetAttr(dirSource & dirSub(pos) & "\" & file) = vbDirectory Then
'検索フォルダ配列を拡張
ReDim Preserve dirSub(UBound(dirSub) + 1)
'検索フォルダ配列に追加
dirSub(UBound(dirSub)) = dirSub(pos) & "\" & file
'圧縮対象ファイルの場合
ElseIf Right(file, 4) = ".php" Or Right(file, 4) = ".css" Or Right(file, 3) = ".js" Then
'ファイル名をB列に出力
Range("B" & rowNo).Value = dirSub(pos) & "\" & file
'テキスト(UTF-8)で全行読込
strm.Type = adTypeText
strm.Charset = "UTF-8"
strm.Open
strm.LoadFromFile dirSource & dirSub(pos) & "\" & file
buf = strm.ReadText
'圧縮前のファイルサイズをC列に出力
Range("C" & rowNo).Value = strm.Size
'変数の初期化
flg = 0
strCompress = ""
'1文字ずつループ
For i = 1 To Len(buf)
'pre開始タグまたはphp開始タグが完成する場合
If Right(strCompress, 4) & Mid(buf, i, 1) = "<pre>" Or Right(strCompress, 4) & Mid(buf, i, 1) = "<?php" Then
'圧縮を中断
flg = flg + 1
'pre終了タグまたはphp終了タグが完成する場合
ElseIf Right(strCompress, 5) & Mid(buf, i, 1) = "</pre>" Or Right(strCompress, 1) & Mid(buf, i, 1) = "?>" Then
'圧縮を再開
flg = flg - 1
End If
'改行でもタブでもないまたは圧縮を中断している場合
If Mid(buf, i, 1) <> vbCr And Mid(buf, i, 1) <> vbLf And Mid(buf, i, 1) <> vbTab Or flg > 0 Then
'圧縮後文字列に追加
strCompress = strCompress & Mid(buf, i, 1)
End If
Next
'圧縮後の文字型Stream
strm.Close
strm.Open
strm.WriteText strCompress, adWriteChar
'BOMなしバイナリ(バイナリ先頭4文字目以降)をバイト配列に一時保存
strm.Position = 0
strm.Type = adTypeBinary
strm.Position = 3
bin = strm.Read
'圧縮後のBOMなしバイナリ型Stream
strm.Close
strm.Open
strm.Write bin
'圧縮後のファイルサイズをD列に出力
Range("D" & rowNo).Value = strm.Size
'比率(%)をE列に出力
Range("E" & rowNo).Value = strm.Size / Range("C" & rowNo).Value * 100
'圧縮後フォルダを作成
If Not (FSO.FolderExists(dirCompress & dirSub(pos))) Then FSO.CreateFolder (dirCompress & dirSub(pos))
'ファイルに出力
strm.SaveToFile dirCompress & dirSub(pos) & "\" & file, adSaveCreateOverWrite
'Streamをクローズ
strm.Close
'Excel行を移動
rowNo = rowNo + 1
End If
'次を検索
file = Dir()
Loop
'検索対象フォルダを移動
pos = pos + 1
Loop
'砂時計カーソルを戻す
Application.Cursor = xlDefault
'終了メッセージ
MsgBox "圧縮しました。"
End Sub
サブフォルダの作成にFileSystemObjectを、ファイルの入出力にADODB.Streamを使う。
参照設定に追加したのは2つ。
｢Microsoft ActiveX Data Objects｣(今回は6.1を選択)と｢Microsoft Scripting Runtime｣。
Dir関数の結果がファイルの場合はその場で処理、フォルダの場合は配列に記憶しといて順次検索する感じ。
BOMの削除はいろんな記事を参考にして一番シンプルに書いた。
もっといい方法はないものか。
完成
実行するとこんな感じ。
圧縮前のテキスト。
圧縮後のテキスト。
C#でつくろうかと思ったけどプロジェクトつくらないとだしVisual Studio重いしVBAを採用した。
自分しか使わないしExcelあればいいし手軽に書くならやっぱりVBA。
実行結果も直接Excelシートに出力できるし便利。
そのまま印刷もできるし資料も作れる。
てかExcelシートはデータベース。
Excel最強説。