logical　error :アーカイブ

Google

<< 2018年11月 | TOP | 2019年01月 >>

2018年12月28日

ドメイン内 Google 検索 : 表示しているサイトで Google 検索を実行するブックマークレット

site:ドメインの 検索を呼び出します

※ Google ヘルプ : ウェブ検索の精度を高める( この中の『 特定のサイトを検索する』 )

最近は、セキュリティに厳密になったサイトが増えたので、そのページに埋め込む事ができなくなりつつあります。なので、windows.prompt で検索文字列を入力させて直接 Google を呼び出すようにしました。

※ 旧式の ページに IFRAME を埋め込むバージョンはこちらから





このブログの記事単体ページで実行すると、以下のようになります
PowerShell site:logicalerror.seesaa.net/article

一番最後の /(スラッシュ) を取り去った状態で、その階層内の検索をする為のの文字列になります


ドメイン内 検索

▼ リンク内コード

<a style='margin-left:60px;' href='javascript:var%20u=(document.URL).replace(/^http(s)?:\/\//g,"");var%20p=u.lastIndexOf("/");var%20u=u.substr(0,p);var%20a=prompt("検索文字列を入力してください","");if(a!=""&&a!=null){a=encodeURIComponent(a);a=a.replace("\u0025\u0032\u0030","+");a="https://www.google.co.jp/search?q="+a+"+site:"+u;window.open(a);}void(0);' onclick=" 
		alert('ブックマークバーまたは、お気に入りバーにドラッグドロップが簡単です'); 
		if (window.navigator.appName.toLowerCase().indexOf('microsoft') > -1) { 
			event.returnValue = false; 
		} 
		event.preventDefault(); 
		event.stopPropagation();
	">ドメイン内 検索</a>


▼ 実行内容を整理

// ********************************************
// 現在の URL から http:// または https:// を取り去ります
// ********************************************
va u = (document.URL).replace(/^http(s)?:\/\//g,"")

// ********************************************
// 最後の / の位置を取得します
// ********************************************
var p = u.lastIndexOf("/");

// ********************************************
// 元の文字列より、最後の / 以降を取り去ります
// ********************************************
var u = u.substr(0,p);

// ********************************************
// prompt で入力文字列を取得します
// ********************************************
var a = prompt("検索文字列を入力してください","");

// ********************************************
// 未入力時と、キャンセル時は何もしません
// ********************************************
if( a! = "" && a != null ) {
	// ********************************************
	// % エンコーディング
	// ********************************************
	a = encodeURIComponent(a);

	// ********************************************
	// encodeURIComponent では 空白は %20
	// 仕様に合わせて、空白は + 文字に変更
	// \u0025\u0032\u0030 は %20
	// ブックマークで %20 はスペースになるので
	// Unicode で指定
	// ********************************************
	a.replace("\u0025\u0032\u0030","+");

	// ********************************************
	// Google 用の検索用の URL を作成
	// ********************************************
	a = "https://www.google.co.jp/search?q="+a+"+site:"+u;

	// ********************************************
	// URL を開く
	// ********************************************
	window.open(a);
}

// ********************************************
// ※ お約束
// このブックマークレットでは必要無いですが
// ( 対話ウインドウが表示されるので )
// 通常はこれを最後に書いておくといいです
// ********************************************
void(0);

posted by lightbox at 2018-12-28 08:23 | ブックマークレット |

2018年12月26日

IE11 から VBScript で ODBCで使用されるデータベース(例えばSQLServer) より Excel でデータをエクスポートする

Microsoft.Jet.OLEDB.4.0 を使用したいので、IE11 を 32 ビットで動作させる事が必要です。Access も Excel も古い拡張子を使用していますが、基本的に昔の処理ですし、Microsoft に邪魔されたく無い( 何勝手にするか解らない )ので、そうしています。

エクスポート用の SQL を使用する為に、接続は Access で行って、Access 内で可能な参照方法(修飾のようなもの)を用いて、SQLServer と Excel に動的にアクセスしています。

IE11 を 32 ビットで動作させる

通常、IE11 は 32ビットで動作しているはずですが、確認の為にF12 キーで開発者ツールを表示させて、コンソールタブに移動します。次に、navigator.userAgent と入力して表示された文字列の中に WOW64 の文字列があれば、32ビットで動作しています。

もし無ければ、64ビットで動作しているので、『インターネットオプション』の『詳細設定』のセキュリティで、【拡張保護モードで 64 ビット プロセッサを有効にする】と【拡張保護モードを有効にする】のチェックを外します。

※ 拡張保護モードに関する詳細は、Microsoft のこちら( E10 & IE11 : 拡張保護モードの実態 )から参照できます。

実行する URL を信頼するサイトに登録



レベルのカスタマイズで、『スクリプトを実行しても安全だとマークされていないActiveX コントロール』を『有効』 にして、『ドメイン間のデータソースのアクセス』も有効にします

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2]
"1201"=dword:00000000
"1406"=dword:00000000

※ 関連する Microsoft ドキュメント(上級ユーザー向けの Internet Explorer セキュリティ ゾーン関連のレジストリ エントリ)
※ IEのセキュリティゾーン関連のレジストリエントリ


IE11 を IE10 として実行してエクスポート

<!DOCTYPE html>
<html>
<head>
<meta http-equiv="X-UA-Compatible" content="IE=10">
<meta http-equiv="Content-type" content="text/html; charset=shift_jis">
<script language="VBScript">

' ***********************
' 必要なオブジェクト作成
' ***********************
on error resume next

' ファイル削除用
Set Fso = CreateObject( "Scripting.FileSystemObject" )
if Err.Number <> 0 then
	alert("Fso:"&Err.Description)
end if

' エクスポート実行用
Set Cn = CreateObject( "ADODB.Connection" )
if Err.Number <> 0 then
	alert("Cn:"&Err.Description)
end if
Cn.CursorLocation = 3

' ダミー Access 作成用
Set Adox = CreateObject( "ADOX.Catalog" )
if Err.Number <> 0 then
	alert("Adox:"&Err.Description)
end if

' ディレクトリ参照と OS パス取得用
Set Shell = CreateObject( "Shell.Application" )
if Err.Number <> 0 then
	alert("Shell:"&Err.Description)
end if
on error goto 0

Function Export()

	' ***********************
	' 2回目の実行
	' ***********************
	if Cn is nothing then
		Set Cn = CreateObject( "ADODB.Connection" )
		Cn.CursorLocation = 3
	end if

	' ***********************
	' 実行確認
	' ***********************
	if not confirm( "エクスポートを実行しますか?" ) then
		Exit Function
	end if

	Dim obj

	' ***********************
	' ディレクトリ選択
	' フラグは https://docs.microsoft.com/ja-jp/windows/desktop/api/shlobj_core/ns-shlobj_core-_browseinfoa
	' ***********************
	on error resume next 
	Set obj = Shell.BrowseForFolder( 0, "出力先のディレクトリを選択して下さい", 11+&H40, 0 )
	if Err.Number <> 0 then
		alert(Err.Description)
	end if
	on error goto 0

	' ***********************
	' キャンセル
	' ***********************
	if obj is nothing then
		Exit Function
	end if

	' ***********************
	' 一応チェック
	' ※ フラグ使用しているので必要無いはず
	' ***********************
	if not obj.Self.IsFileSystem then
		alert( "ファイルシステムではありません" )
		Exit Function
	end if

	' ***********************
	' 選択してフォルダのパス
	' ***********************
	SelectDir = obj.Self.Path

	' ***********************
	' ダミー用のパス
	' C:\Users\lightbox\AppData\Temp\dummy.mdb
	' ***********************
	Set objFolder = Shell.Namespace(&H1c)
	Set objFolderItem = objFolder.Self
	strPath = objFolderItem.Path & "\Temp\dummy.mdb"

	' ***********************
	' 既存のダミー削除
	' ***********************
	on error resume next 
	Fso.DeleteFile(strPath)
	on error goto 0

	' ***********************
	' 出力 Excel 削除
	' ***********************
	on error resume next 
	Fso.DeleteFile(SelectDir & "\Export.xls")
	on error goto 0

	' ***********************
	' ダミー用 mdb 作成
	' ***********************
	on error resume next
	Adox.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & strPath & ";"
	if Err.Number <> 0 then
		alert(strPath & " : " & Err.Description)
	end if
	on error goto 0

	' ***********************
	' MDB 接続用文字列
	' ***********************
	ConnectionString = _
		"Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & strPath & ";"

	on error resume next
	Cn.Open ConnectionString
	if Err.Number <> 0 then
		alert(ConnectionString & " : " & Err.Description)
		Exit Function
	end if
	on error goto 0

	' ***********************
	' エクスポート用 SQL
	' ***********************
	Query = "select * "
	Query = Query & "into [Excel 8.0;DATABASE=" & SelectDir & "\Export.xls].[出力データ] "
	Query = Query & " from [ODBC;Driver={SQL Server};SERVER=サーバ;Database=データベース;UID=sa;PWD=パスワード].テーブル名"

	on error resume next
	Cn.Execute Query
	if Err.Number <> 0 then
		Call Cn.Close()
		alert(Err.Description)
		Exit Function
	end if
	on error goto 0

	alert("処理が終了しました")

	Call Cn.Close()

	Set Cn = Nothing

End Function

</script>
</head>
<body>
<input id="export" type="button" value="エクスポート" language="VBScript" onclick="Call Export()">
</body>
</html>


本当は、このページを window.open で開けて、終了したら close させます。そうすれば、dummy.mdb がアプリケーションから解放されます。


補足

Windows7 で実際に運用しているコードです。Windows10 に完全対応する為に、今回コードを整備して Windows10 でテストを行いました。この次の段階としては、VBScript やめて JScript で書いて処理します( そうすると、jQuery 使えますし )

posted by lightbox at 2018-12-26 14:36 | IE |

2018年12月21日

VBScript : Excel.Application でファイルを複数選択する

VBScript で使用可能な Windows の標準のオブジェクトだけではファイルの参照ダイアログを使え無いので、Excel.Application を使うのが比較的近道です。( Excel がインストールされている環境 )

ここでは、複数のファイルを選択して配列内にあるパスをループで参照しています。

Application.GetOpenFilename メソッド (Excel)

' ****************************
' Excel オブジェクト作成
' ****************************
Set App = CreateObject("Excel.Application")

' ****************************
' 警告を出さないようにする
' ****************************
App.DisplayAlerts = False

' ****************************
' ファイル参照( 複数 )
' ▼ 1ファイル選択では、戻り値は文字列で、キャンセルだと False
' Path = App.GetOpenFilename("テキストファイル,*.txt,全て,*.*", , "ファイルを選択して下さい")
' ****************************
Path = App.GetOpenFilename("テキストファイル,*.txt,全て,*.*", , "ファイルを選択して下さい", , True )

' ****************************
' キャンセルで終了
' ****************************
if not IsArray( Path ) then
	Wscript.Quit
end if

' ****************************
' 選択したパスを表示
' ****************************
For I = 1 to Ubound( Path )
	MsgBox( Path( I ) )
Next

' ****************************
' Excel をアプリケーションとして終了
' ****************************
App.Quit()

' ****************************
' Excel を VBScript から開放
' ****************************
Set App = Nothing

' ****************************
' オブジェクト変数を初期化
' ( 初期化しないとオブジェクト扱いされる )
' ****************************
App = Empty


MsgBox( "処理が終了しました" )

【VBScript関連のカテゴリ】

posted by lightbox at 2018-12-21 17:20 | VBS + オブジェクト |

2018年12月20日

VBA : 一ヶ月の予定リストの作成して、csv を読み込んでデータを表示する



概要

"対象" という名前のシートがあればそれを使い、無ければ "テンプレート" シートをコピーして、"対象" と言う名前に変更します。そのシートに対して、指定した年月の 1日から 末日までの年月表示を縦に作成し、その横に曜日を表示します。

この後、ファイル参照ダイアログで csv データを選択し、csv の 最初と２番目の列のデータを各日付用データとして表示します。

▼ ここからボタンをクリックすると


▼ こんな感じになります


ボタンの追加は、フォーム コントロールでは無く、ActiveX コントロールを使用しています。こうする事によって、イベントがこのシートの中に作成されて管理がしやすいですし、デザインモードで切り替えて編集するので、通常時はすぐ実行できます。( フォームコントロールでは、モジュール内にイベントが作成され、『マクロの登録』という悲しい処理をしなくてはいけません )

※ デザインモードでは、コントロールを選択すると『=EMBED("Forms.CommandButton.1","")』と表示されます

対象月は、データの入力規則を使用してコンボボックス形式で選択するようにしています。

VBA 実行部分のソースコード

Private Sub CommandButton1_Click()

    ' データ処理をする Sheet
    Dim sheet As Worksheet
    
    ' "対象" Sheet の取得
    On Error Resume Next
    Set sheet = Worksheets("対象")
    On Error GoTo 0
    
    ' "対象" Sheet が無い場合は テンプレート をコピーして作成
    If sheet Is Nothing Then
        Call Worksheets("テンプレート").Copy(, Worksheets("年月入力"))
        ' コピーした Sheet の名前を変更
        Application.ActiveSheet.Name = "対象"
        ' 変数にコピーした Sheet をセット
        Set sheet = Application.ActiveSheet
    End If
    
    ' 曜日文字列の用意
    Dim Youbi(8) As String
    Youbi(1) = "日曜"
    Youbi(2) = "月曜"
    Youbi(3) = "火曜"
    Youbi(4) = "水曜"
    Youbi(5) = "木曜"
    Youbi(6) = "金曜"
    Youbi(7) = "土曜"

    Dim dtValue As Date
    Dim startDate As Date
    Dim endDate As Date
    
    ' 入力値から日付データの作成
    Dim s1 As String
    Dim s2 As String
    s1 = CStr(Worksheets("年月入力").Cells(2, 1).Value)
    s2 = CStr(Worksheets("年月入力").Cells(2, 2).Value)
    dtValue = CDate(s1 & "/" & s2 & "/1")
    
    ' 月のはじめ
    startDate = DateSerial(Year(dtValue), Month(dtValue), 1)
    ' 月末
    endDate = DateSerial(Year(dtValue), Month(dtValue) + 1, 0)
    
    ' ひと月ぶんの初期化
    For I = 1 To 31
        
        sheet.Cells(I + 1, 1).Value = ""
        sheet.Cells(I + 1, 2).Value = ""
        
    Next
    
    ' ひと月ぶんのデータの作成
    Dim row As Integer: row = 0
    For dtValue = startDate To endDate

        row = row + 1
        sheet.Cells(row + 1, 1).Value = CStr(dtValue)
        sheet.Cells(row + 1, 2).Value = Youbi(Weekday(dtValue))

    Next

    Call sheet.Activate
    
    
    ' ********************
    ' ファイルを開く
    ' ********************
    Dim Path As String
    Path = Application.GetOpenFilename("CSV,*.csv,全て,*.*", , "CSVファイルを選択して下さい")
    If Path = "False" Then
        Exit Sub
    End If
    
    ' ********************
    ' オープン
    ' ********************
    On Error Resume Next
    Set InObj = ThisWorkbook.Fs.OpenTextFile(Path, 1)
    If Err.Number <> 0 Then
        MsgBox (Err.Description)
        Exit Sub
    End If
    On Error GoTo 0
    
    Dim Buffer As String
    Dim Data() As String
    ' ********************
    ' CSV ファイルより
    ' データを読み込み
    ' ********************
    
    row = 0
    Do While Not InObj.AtEndOfStream
        Buffer = InObj.ReadLine
        Data = Split(Buffer, ",")
        
        row = row + 1
        sheet.Cells(row + 1, 3).Value = Data(0)
        sheet.Cells(row + 1, 4).Value = Data(1)
    
    Loop

End Sub

ファイルアクセス用のオブジェクト作成

シートを開いた時に一度だけ実行するように、ThisWorkBook に作成しています。


Public Fs As Object

Private Sub Workbook_Open()

    Set Fs = CreateObject("Scripting.FileSystemObject")

End Sub


On Error Resume Next

VB と名の付く処理では伝統的なエラーの対処方法です。指定した名前のシートを取得する方法としては、シートのコレクションのループ内で一致する名前を探すのが VBA 界隈では一般的なようですが、VB アプリケーションとしてはこのほうが汎用性があります。

Call でシートのコピー

VBA のマクロが作成するコードは、これとは違うものだと思いますが、VB アプリケーションでメソッドの実行は Call で呼び出します。戻り値のある場合は Call を使わずに左辺に変数を置きます。

引数が一つの場合は、Call を使わずに実行でき、その際引数をかっこでは囲いません。しかし、引数が二つ以上の場合は Call を使って引数をかっこで囲います。ここでは、expression.Copy(Before, After) の文法にのっとって、第一引数を省略して、第二引数を指定してコピーしています。

タグ：VBA VB EXCEL

posted by lightbox at 2018-12-20 15:34 | VBA |

2018年12月07日

TCPDF を使用してフリーフォントを選択して『FAX 送信案内』の PDF をそのフォントで出力します

とりあえずテストとして『トガリテ』というフリーフォントを使用してみると、Light でいい感じでした。フォントはライセンスを再度確認して追加していきます。
( TCPDF のサンプル作るのに比較的作るのが楽な FAX送信案内で試しました )

※ 出力した PDF はご自由にお使い下さい。

▼ 実行




JavaScript での URL の呼び出しは jQuery で以下のようにして行っています。

<select id="fonts">
	<option value="togalite-black" >トガリテ Black</option>
	<option value="togalite-heavy" >トガリテ Heavy</option>
	<option value="togalite-bold" >トガリテ Bold</option>
	<option value="togalite-medium" >トガリテ Medium</option>
	<option value="togalite-regular" >トガリテ Regular</option>
	<option value="togalite-light" >トガリテ Light</option>
</select>
<input type="button" value="実行" id="fax_guide">

<script>

	$("#fax_guide").on("click", function(){
		var download = $("<a></a>").appendTo("body").css("display","none");
		download.prop({"href" : "http://webapp.winofsql.jp/phplib/fax_guide.php?font=" + $("#fonts").val(), "target": "_blank" });
		download.get(0).click();
		download.remove();
	});

</script>


トガリテのフォント使用許諾範囲
FZイモケンピ(Font Zone 108) Faq
fub工房 注意事項
Tフォント利用規定
ニコモジ＋（プラス）
851チカラヅヨク
Oradano明朝フォント
ラノベPOP
おつとめフォント
GN-キルゴU-NA
自家製 Rounded M+ フォント ライセンス
源真ゴシック (げんしんゴシック)

posted by lightbox at 2018-12-07 16:13 | PHP + PDF |

Seesaa の各ページの表示について

Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定＞ 詳細設定＞ ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>

この記述は、以下の場所で使用します

Seesaa ブログ

	SQLServer の BCP で INT IDENTITY 列に csv からリストアする
	MySQL に PIPES_AS_CONCAT を設定して、CSV を出力する SQL
	Chrome ポリシー : レジストリ : ( ChatGPT 解説 )
	PL/SQL : 最も簡単な CSV 出力の記述
	VBScript を『管理者として実行する』には、Shell の runas ( 右クリックメニューの実行と同等 ) で実現します / Jscript も追加
	fake sendmail for windows を使って、PHP でごく普通に( mb_send_mail で )メール送信
	TCPDF をダウンロードして、Windows の任意のフォルダで TCPDF 同梱のサンプルを実行する為の設定
	JavaScript : window オブジェクトのプロパティとしてグローバル変数を定義する
	TCPDF をダウンロードして、フリーフォントを埋め込み型で使用する方法
	汎用型 : JSON データより履歴書のフォームを出力するサンプル
	ChatGPT でトップまでスクロールするブックマークレット
	Replit : cs-list
	Replit : js-web-speech
	Replit : js-csv-read-utf8
	Replit : text-editor
	指定した位置でレジストリエディタを開く為の VBScript をダウンロードします
	JScript / VBScript : 指定したフォルダ内のフォルダ毎の使用済みサイズを読める範囲でレポートする
	デスクトップを部分キャプチャした時に切り取り&スケッチを起動してキャプチャ画像に枠線を付加させる。
	#Zoom の必殺技 : 相手に自分の Zoom 関連のウインドウを見せる
	GAS でユーザ作成 : 組織は "orgUnitPath": "/組織名A/組織名B"

	一部のファイル形式がブロックされる(GMail)
	Creating Shortcut Menu Handlers
	Microsoft Word のキーボードショートカット
	Excel のショートカットキーとファンクションキー
	サイトへの不自然なリンクを否認する新しいツールの提供を開始しました

logical error