« 2017年3月 | トップページ | 2017年5月 »

2017.04.23

DelphiとLazarusでのドロップファイル処理の違い

ファイルやフォルダの日付を一括変更したくてフリーソフトのTouchを探したのですが、フォルダの日付も変更できるものを見つけることが出来なかったので自力で作成しました。
細かなことが面倒だったので、ファイル・フォルダに関わらずまとめてドロップすれば一気に日付を変更する、ファイル日付は作成・更新・最終アクセス日付を指定した日時で全部変更する、ということにしました。また、実行ファイルのショートカットにファイル・フォルダをドロップしたら、その時点の日時で変更する、日時を指定したい場合は実行ファイルを起動して日時を指定後にそのフォームにドロップする、ということにしました。

Touch

で、今回もDelphiとLazarusの両方で実行ファイルサイズを見比べならが(^^;作成したのですが、Lazarusでのドロップファイル処理の仕方がDelphiとは異なっていたのでメモしておくことにしました。こうやって比べてみると、私的にはLazarusの方がスマートな感じがしていいかなと思います。

Delphiの場合

// ファイル・フォルダがドロップされた際のイベント
procedure TForm1.DropFiles(var Msg: TMsg; var Done: Boolean);
var
nFile, i: integer;
fname: string;
FileName: array[0..260] of char;
DT: TDateTime;
begin
Done := True;
if Msg.message = WM_DROPFILES then
begin
SetForegroundWindow(Application.Handle);
// 変更後の日付と時刻を合成(DateNewの整数部とTimeNewの小数部を足す)
DT := Trunc(DateNew.DateTime) + Frac(TimeNew.DateTime);
try
nFile := DragQueryFile(Msg.wParam, $FFFFFFFF, nil, 0);
for i := 0 to nFile - 1 do
begin
DragQueryFile(Msg.wParam, i, FileName, SizeOf(FileName));
fname := FileName;
if DirectoryExists(fname) then
ChangeDirTime(fname, DT)
else
SetFileDate(fname, DT, DT, DT);
end;
finally
DragFinish(Msg.wParam);
end
end else
Done := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//ドロップファイルイベントの登録
Application.OnMessage := DropFiles;
DragAcceptFiles(Handle, True);

Lazarusの場合

// ファイル・フォルダがドロップされた際のイベント
procedure TForm1.DropFiles(Sender: TObject; const Files:Array of AnsiString);
var
i: integer;
fname: string;
DT: TDateTime;
begin
SetForegroundWindow(Handle);
// 変更後の日付と時刻を合成(DateNewの整数部とTimeNewの小数部を足す)
DT := Trunc(NewDate.Date) + Frac(NewTime.Time);
// Lengthで配列の大きさを取得してリストを取得する
for i := 0 to Length(Files) - 1 do
begin
fname := Files[i];
if DirectoryExists(fname) then
ChangeDirTime(fname, DT)
else
SetFileDate(fname, DT, DT, DT);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Lazarusではファイルドロップイベントを以下のように設定する
Application.AddOnDropFilesHandler(@DropFiles);

procedure TForm1.FormDestroy(Sender: TObject);
begin
// 終了時にイベント解除
Application.RemoveOnDropFilesHandler(@DropFiles);
end;

実行ファイルサイズは
Delphi10.1 Starter   2,167,808 バイト
Lazarus1.7+FPC3.1  2,788,352 バイト

LazarusではDateTimePickerコンポーネントが標準ではインストールされていないので、手動でDateTimeCtrlsパッケージをインストールする必要があります。おそらく、この追加コンポーネントがファイルサイズが大きくなっている原因ではないかと思います。

「touch.zip」をダウンロード

サンプルファイルにはDelphi/LazarusのソースファイルとDelphiで作成した実行ファイルが含まれています。

| | コメント (0) | トラックバック (0)

2017.04.18

Webカメラの映像を表示して、画像をJpegファイルに保存する(Lazarus/Delphiファイルサイズその2)

情報元
Webカメラ インターバル撮影ソフト
開発者:岩手県立総合教育センター奥田昌夫氏

オリジナルソースを元に、ボタンを押したらWebカメラの映像をJpegファイルに保存するだけの機能に絞り込みました。このプログラムは、廉価・簡易型の履歴写真保存システムとしての運用を想定しています(Webカメラで被写体を撮影して、USBフットスイッチ等の信号で随時写真に記録するなど)。
フォルダボタンでJpeg画像フィルの保存先フォルダを指定して、カメラ接続ボタンでWEBカメラに接続し、撮影ボタンで撮影・保存します。Jpeg画像は指定したフォルダに今日の日付のフォルダを作成して、その中に撮影時間をファイル名にして保存します。ファイル名は時分秒m秒で作成しますので、1秒以下の連続撮影でもファイルを上書きすることはありません。

今回は業務目的での使用を想定していますので、Delphi XE10.1 Starter版ではなくDelphi XE2 Pro版とLazarus1.7+FPC3.1で実行ファイルを作成しました。

実行状態
Webcam


で、お約束?の実行ファイルのサイズは以下の通りとなります。

Delphi XE10.1      2,322,432 バイト
Delphi XE2        1,721,344 バイト
Lazarus1.7+FPC3.1   1,724,416 バイト

Delphi XE2 x86_64   2,258,944 バイト
Lazarus1.7 x86_64   2,391,040 バイト

32bit版の実行ファイルサイズはXE2とLazarusでほぼ同等。試しに64bit版の実行ファイルを作成してみたところ、こちらはXE2の方が若干小さいようです。また、やはりXE10.1はちょっと大きいですね。

試しにDelphi7用にソースを一部修正してコンパイルした実行ファイルサイズは

Delphi7 492,544 バイト

Delphi7最強!と言いたいところですが、いかんせんWindowsXP以前の開発環境ですから単純に比較は出来ないんでしょうね。Delphi7で作成た実行ファイルもWIndows7上で問題なく動作しますが、ボタン等のWindowsコントロールデザインがWindows98時代のままだったりします。

今回はDelphi XE2用のプロジェクトソースと実行ファイル、Lazarus用のプロジェクトソースと実行ファイル、Delphi7用のソースファイルを公開します。

尚、LazarusではDelphi用ソースをそのままコンパイルすると撮影した画像が正常にBitBltされずに真っ黒になる問題を修正したため画像の処理が異なっています。また日本語表示で文字化けするため、ソースファイルをUTF8で保存して最初の行に{$CODEPAGE UTF8}を追加しています。

処理の一部

function capCreateCaptureWindowA(WindowName: PChar; dwStyle: Cardinal;
x, y, nWidth,nHeight: Integer;
ParentWin: HWnd; nID: Integer): HWnd; stdcall;
external 'AVICAP32.DLL';

function capGetDriverDescriptionA(wDriverIndex: Short; lpszName: String;
cbName: Integer; lpszVer: String;
cbVer: Integer): Boolean; stdcall;
external 'AVICAP32.DLL';

// Webカメラ接続・解除処理
procedure TForm1.Button1Click(Sender: TObject);
begin
if not CaptureON then
begin
CaptureWnd := capCreateCaptureWindowA('0', WS_CHILD or WS_VISIBLE,
CaptureLeft, CaptureTop,
CaptureWidth, CaptureHeight,
Handle, 0);
if CaptureWnd <> 0 then
begin
//デバイスへの接続
SendMessageA(CaptureWnd, WM_CAP_DRIVER_CONNECT, 0, 0);
//プレビュースケール
SendMessageA(CaptureWnd, WM_CAP_SET_SCALE, -1, 0);
//プレビューのコマ数(ミリ秒)
SendMessageA(CaptureWnd, WM_CAP_SET_PREVIEWRATE, 30, 0);
//プレビュー開始
SendMessageA(CaptureWnd, WM_CAP_SET_PREVIEW, -1, 0);
//
SetWindowPos(CaptureWnd, HWND_BOTTOM, 0, 0,
CaptureImage.Width, CaptureImage.Height,
SWP_NOMOVE or SWP_NOZORDER);
end else begin
raise Exception.Create('Webカメラに接続できません.');
end;
Button1.Caption:= '接続解除(&D)';
CaptureON := True;
end else begin
SendMessage(CaptureWnd,WM_CAP_DRIVER_DISCONNECT, 0, 0);
DestroyWindow(CaptureWnd);
CaptureWnd := 0;
Button1.Caption:= 'カメラ接続(&W)';
CaptureON := False;
end;
Button2.Enabled := CaptureON;
end;

// 写真撮影・保存処理
procedure TForm1.Button2Click(Sender: TObject);
var
srcDC: HDC;
Bmp: TBitmap;
cBMP: HBITMAP; // LazarusのTBitmap不具合対策用
Jpg: TJpegImage;
fname, fldr: string;
i: integer;
begin
// Bitmapを準備
Bmp := TBitmap.Create;
try
srcDC := GetDC(Form1.Handle);
// サイズ設定
// LazarusではBitmapのサイズを直接指定するとうまく動かいないため、Bitmapの
// サイズを指定したハンドルを生成して、それをBitmapハンドルに代入する
cBMP := CreateCompatibleBitmap(srcDC, CaptureWidth, CaptureHeight);
//Bmp.Width := CaptureWidth;
//Bmp.Height := CaptureHeight;
Bmp.Handle := cBMP;
try
// Bitmapに画像をコピー
BitBlt(Bmp.Canvas.Handle, 0, 0,
CaptureWidth, CaptureHeight, srcDC, CaptureLeft, CaptureTop,
SRCCOPY);
// JpegImageを準備
Jpg := TJpegImage.Create;
try
// JpegにBitmap画像をコピー
Jpg.Assign(Bmp);
// 今日の日付でサブフォルダを準備する
DateTimeToString(fldr, 'yyyy-mm-dd', Now);
fldr := SaveFolder + '\' + fldr;
if not DirectoryExists(fldr) then
ForceDirectories(fldr);
// 現在時刻でファイル名を準備する
DateTimeToString(fname, 'hhnnss.zzz', Now);
// Jpeg画像を保存
Jpg.SaveToFile(fldr + '\' + fname + '.jpg');
finally
Jpg.Free;
end;
finally
ReleaseDC(Handle, srcDC);
end;
finally
DeleteObject(cBmp);
Bmp.Free;
end;
end;

「WebCAM.zip」をダウンロード


| | コメント (0) | トラックバック (0)

2017.04.16

MiGrep2その後(3)書庫ファイル内の検索

MiGrepでは書庫ファイル内を検索するために統合アーカイバプロジェクトで公開されている各種DLLを使用していました。その恩恵で様々な種類の書庫ファイル内を検索することが出来ました。
今現在の状況を改めて考えてみると、Windows上の書庫ファイルはZIPが標準となっており、しかもWindowsの標準機能としてZIP書庫の解凍や作成が出来るようになっています。
そこでMiGrep2では、ZIP書庫内が検索できれば良いと割り切ることにしました。ZIP書庫の作成・解凍をエクスプローラから実行出来るということは、Windows(シェル)の標準機能を使えれば余計な外部ライブラリ等も不要になるのではとWeb上を検索して見たところ、Mr-XRAYさんの記事にそのものずばりの譲歩がありました。

Mr-XRAYさん;733_Windows XP 以降の圧縮・展開機能を使う

ここを参考にして、Windowsシェル標準機能を使用した書庫ファイル操作用クラスを作ってみました。MiGrep2内で書庫ファイル内を検索することを前提にしているため、ファイルマスク にマッチしたファイルだけを抽出することや、ファイルをひとつ見つける度にOnFoundEventを発生させて、呼び出し元側でファイル検索毎に何らかの処理を行うことが出来るようになっています(と言いますか、その使い方しかできない)。 また、書庫内のファイル解凍も指定したファイルを指定したフォルダ内に解凍する機能しかありません また、一応書庫ファイルへの圧縮機能もありますが、こちらもテスト用に実装したもので最低限の機能しかありません。Windowsシェルで対応している*.zip, *.cab, *.lzh形式の書庫ファイル内検索およびファイル解凍が可能です。一方、圧縮可能なのはZIP書庫ファイルのみです。
よくよく考えてみると、今までDelphiではコンポーネントしか作成したことがなく、何も継承しないクラスを作るのは初めてですので、これで良いのかどうか自信がありません・・・いっそコンポーネントにした方が使い勝手も含めて良かったかも知れません。

尚、Mr-XRAYさんの記事を参考に、最初にShell32_TLBとScripting_TLBユニットを作成しておく必要がありますが、Delphi10.1Starter版では作成されたScripting_TLB.pasをコンパイルすると
「E2010 'POleVariant1' と 'OleVariant' には互換性がありません」エラーが出ますので、エラー箇所を以下の様に修正します。

//property Key[const Key: OleVariant]: POleVariant1 write Set_Key;
property Key[const Key: OleVariant]: OleVariant write Set_Key;


テストプログラム
Ziptest

unit SHZipUtils;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, System.Masks, Shell32_TLB, Scripting_TLB;
 
type
  // 内部で使用するための構造体
  PZipItem = ^TZipItem;
  TZipItem = record
    SHitem: Shell32_TLB.FolderItem;
    FullPathName: string;
  end;
  // ファイルを見つけた際に発生させるイベント
	TOnFoundEvent = procedure(Found: TZipItem) of object;
  // TSHZipFileクラス
  TSHZipFile = class
  private
    FZipFile,
    FDstFolder,
    FDstZipFile: string;
    FMask: TStrings;
    FBaseLen: integer;
    FOnFound: TOnFoundEvent;
    SHShell: Shell32_TLB.TShell;
    SHSrcFolder: Shell32_TLB.Folder;
    SHDestFolder: Shell32_TLB.Folder;
    procedure SetZipFile(const value: string);
    procedure SetDstFolder(const value: string);
    procedure SetDstZipFile(const value: string);
    procedure CreateNewZIPFile(ZipFile: String);
    procedure SetMask(const Value: TStrings);
    function IsWildMatch(const FName: string): Boolean;
  protected
  public
    constructor Create;
    destructor  Destroy;
    function DoFind(ZipName: string; FindPath: string): Boolean;
    procedure Extract(FileItem: Shell32_TLB.FolderItem; ExtractPath: string);
    procedure Compress(FileName: string; ZipName: string); overload;
    procedure Compress(FileNames: TStrings; ZipName: string); overload;
  published
    property FileMask:	TStrings read FMask write SetMask;            //検索するファイルマスク
    property ZipFile: string read FZipFile write SetZipFile;          //参照するZIPファイル
    property DstFolder: string read FDstFolder write SetDstFolder;    //コピー先のフォルダ
    property DstZipFile: string read FDstZipFile write SetDstZipFile; //ファイルを追加するZIPファイル
    property OnFound: TOnFoundEvent read FOnFound write FOnFound;     //ファイル検索時イベント
  end;
 
implementation
 
 
constructor TSHZipFile.Create;
begin
  FZipFile    := '';
  FDstFolder  := '';
  FMask       := TStringList.Create;
  SHShell     := TShell.Create(nil);
end;
 
destructor TSHZipFile.Destroy;
begin
  FMask.Free;
  FreeAndNil(SHShell);
end;
 
procedure TSHZipFile.SetMask(const Value: TStrings);
begin
	FMask.Assign(Value);
end;
 
procedure TSHZipFile.SetZipFile(const value: string);
begin
  FZipFile := value;
  FBaseLen := Length(value);
  //対象書庫ファイル名をセットする時点でシェルオブジェクトを取得(フォルダ扱い)
  SHSrcFolder := SHShell.NameSpace(value);
end;
 
// ワイルドマッチ確認
function Match(const Name, Mask:string):boolean;
var
	Msk: TMask;
begin
	Msk := TMask.Create(Mask);
	try
		Result := Msk.Matches(Name);
	finally
		Msk.Free;
	end;
end;
 
function TSHZipFile.IsWildMatch(const FName: string): boolean;
var
	i: integer;
begin
	for i := 0 to FMask.Count - 1 do
		if Match(FName, FMask.Strings[i]) then
		begin
			Result := True;
			Exit;
		end;
	Result := False;
end;
 
procedure TSHZipFile.SetDstFolder(const value: string);
begin
  FDstFolder := value;
  //書庫ファイルの解凍先のシェルオブジェクトを取得
  SHDestFolder :=  SHShell.NameSpace(value);
end;
 
procedure TSHZipFile.SetDstZipFile(const value: string);
var
  dstdir: string;
begin
  //書庫ファイルが存在しなければ新たなZIP書庫ファイルを作成する
  if not FileExists(value) then
    CreateNewZIPFile(value);
  SHDestFolder := SHShell.NameSpace(value);
  FDstZipFile := value;
end;
 
// Mr-XRAYさん公開
// 733_Windows XP 以降の圧縮・展開機能を使う
// http://mrxray.on.coocan.jp/Delphi/plSamples/733_ArchiverWindowsZIP.htm
// からそのまま引用
procedure TSHZipFile.CreateNewZIPFile(ZipFile: String);
var
  IDData  : array[0..21] of Byte;
  FStream : TFileStream;
  i       : Integer;
begin
  //ZIPファイルの先頭に書き込むバイトデータ
  ZeroMemory(@IDData, Length(IDData) - 1);
  IDData[0] := Byte('P');
  IDData[1] := Byte('K');
  IDData[2] := $05;
  IDData[3] := $06;
 
  FStream := TFileStream.Create(ZipFile,
                                fmCreate or fmOpenReadWrite,
                                fmShareDenyNone);
  try
    for i := 0 to Length(IDData) - 1 do
    begin
      FStream.Write(IDData[i], 1);
    end;
  finally
    FreeAndNil(FStream);
  end;
end;
 
//書庫内ファイル検索を実行
//  ZipName:書庫ファイル名(*.zip, *.cab, *.lzh)
//  FIndSub:再帰コール検索時のフォルダ名(書庫ファイル名+'\'+サブフォルダ名
function TSHZipFile.DoFind(ZipName: string; FindPath: string): Boolean;
var
  SHFitems: Shell32_TLB.FolderItems;
  SHFitem: Shell32_TLB.FolderItem;
  zitem : TZipItem;
  zpath, lname, fpath: string;
  c, i: integer;
begin
  Result := False;
  //ZipFIleがなければFalseでリターン
  if not FileExists(ZipName) then
    Exit;
 
  try
    if FindPath = '' then
      SHSrcFolder := SHShell.NameSpace(ZipName)
    else
      SHSrcFolder := SHShell.NameSpace(FindPath);
    //書庫ファイル内のアイテム数を取得する
    c := SHSrcFolder.Items.Count;
    //アイテムリストを取得
    SHFitems := SHSrcFolder.Items;
    for i := 0 to c - 1 do
    begin
      //アイテムを一つづつ確認する
      SHFitem := SHFitems.Item(i);
      //フォルダであれば元のファイル名にフォルダ名を追加してDoFondを再帰コール
      if SHFitem.IsFolder then
      begin
        if FindPath = '' then
          //ルートでフォルダを見つけた場合
          fpath := ZipName + '\' + SHFitem.Name
        else
          //再帰コール内でフォルダを見つけた場合
          fpath := FindPath + '\' + SHFitem.Name;
        DoFind(ZipName, fpath);
      //フォルダでなければファイルアイテムとしてその情報を取得する
      end else begin
			  // ファイルマスクが指定されていないかマッチした場合に検索イベント発生
				if (FMask.Count = 0) or IsWildMatch(SHFitem.Name) then
        begin
          zpath := SHFitem.Path;
          //フォルダ名+ファイル名に加工する
          lname := Copy(zpath, FBaseLen + 2, Length(zpath) - FBaseLen);
          zitem.FullPathName := lname;
          //全ての情報を格納
          zitem.SHitem := SHFitem;
          // Shell32_TLB.FolderItemを渡してOnFoundをコール
          if Assigned(FOnFound) then
            FOnFound(zitem);
        end;
      end;
    end;
  except
    raise exception.Create('このシステムではこの機能は使用できません.');
  end;
  Result := True;
end;
 
//書庫内のファイルを指定して解凍
//尚、書庫ファイル内のフォルダ構造は考慮していないのでサブフォルダ作成はしない
//  FileItem: 解凍するファイルのFOlderItem構造体
//  ExtractPath: 解凍先のフォルダ名
procedure TSHZipFile.Extract(Fileitem: Shell32_TLB.FolderItem; ExtractPath: string);
begin
  //解凍先のフォルダパスが指定されている場合はあらためて設定
  //プロパティDstFolderが設定されている場合ExtractPathは''指定で可
  if ExtractPath <> '' then
    SHDestFolder := SHShell.NameSpace(ExtractPath);
  //指定されたファイルをDstFolderに解凍(コピー)する
  SHDestFolder.CopyHere(FileItem, 0);
end;
 
//ファイルを書庫に追加する
//  FileName: 追加するファイルのフルパス名
//  ZipName: 追加先の書庫ファイル名(*.zip)
//  ZipNameが''の場合にはSHDestFolderに設定されている書庫ファイルに追加する
procedure TSHZipFile.Compress(FileName: string; ZipName: string);
begin
  //DstZipFileを指定していない場合はおそらくエラーとなるので、ZipNameを
  //指定して実行するか、事前にDstZipFile := 書庫ファイルのフルパス名で
  //明示的に指定したほうが良い
  if ZipName <> '' then
    SetDstZipFile(ZipName);
 
  SHSrcFolder := SHShell.NameSpace(FileName);
 
  SHDestFolder.CopyHere(SHSrcFolder.Items, 0);
end;
 
//複数のファイルを書庫に追加する
//  FileNames: 追加するファイルのフルパス名を格納したリスト
//  ZipName: 追加先の書庫ファイル名(*.zip)
procedure TSHZipFile.Compress(FileNames: TStrings; ZipName: string);
var
  i: integer;
begin
  for i := 0 to FileNames.Count - 1 do
    Compress(FileNames.Strings[i], ZipName);
end;
 
end.

ソースファイルとサンプルプロジェクトも置いておきます。

「ZipTestUnit.zip」をダウンロード

| | コメント (0) | トラックバック (0)

2017.04.11

MiGrep2 ver1.03

ver1.0を公開する際に、最後に良かれと思って修正した部分に不具合があり、指定したフォルダの「ひとつ上の」フォルダを検索していました。
この不具合と、「検索実行後にファイルメニューの終了メニューがアクティブになりません」の不具合を修正しました。また、フォーム下段のプレビュー部分に検索フォルダの履歴表示を追加しています(今回の検索フォルダ不具合が修正されているか確認する意味もあるのですが・・・)

公開ファイルはMiGrep2.exe本体のみとなっています。MiGrep2 ver1.0をインストールしたフォルダに上書きして下さい。
MiGrep2 ver1.03(本体のみ)のダウンロード

| | コメント (0) | トラックバック (0)

2017.04.09

MiGrep2 ver1.0(試作版)の公開

エクスプローラのシェル拡張機能を含めてだいたい動作するようになったので一旦試作版として公開します。

エクスプローラのコンテキストメニューから「MiGrepでGrep...」を実行
Launcher

検索語やオプションを設定してMiGrep2を起動
Migrep2

MiGrep2が起動したままでもエクスプローラのコンテキストメニューから「MiGrepでGrep...」を実行すれば、そのまま次の検索が開始されます。

動作環境
Windows7/Windows10で動作確認しています。


既知の不具合
・検索実行後にファイルメニューの終了メニューがアクティブになりません。スピードボタンの終了で終了して下さい。
・xdoc2txtライブラリを使用してOfficeファイル(PowepointやExcelファイル)を一度に大量に検索するとファイル数1,600個くらいから検索速度が遅くなります。原因はこれから調査する予定です。尚、検索速度は遅くなりますが、ファイル数3,200個までは正常に終了することがわかっています。

MiGrep2 1.0(試作版)のダウンロード(2,981KB)

インストールファイルになっています。ダウンロードしたZIP書庫ファイルを解凍して出来上がったmigrep2-1.0.exeを実行して下さい。インストール時にシェル拡張プログラムも自動でインストールされます。
尚、アンインストールはコントロールパネルのプログラムのアンインストールから行うことが出来ますが、事前に管理者権限で起動したコマンドプロンプトでMiGrep2をインストールしたフォルダ内にあるUninstall.batを実行して下さい。エクスプローラからこのUninstall.batを実行した場合、見かけ上は正常にアンインストールが終了したように見えますが、実際にはアンインストールされません。

| | コメント (0) | トラックバック (0)

2017.04.03

MiGrep2その後(2)

MiGrep2では検索されたファイルに対して「フォルダーを開く」コマンドが追加されていますが、これを実行するとそのファイルが存在するフォルダーが開いてそのファイルが選択状態になります。

コマンドラインで以下を実行すると
Command

こうなります。
Explorer

これをDelphiで実現するためには、

ShellExecute(Handle, 'open','explorer.exe' , PWideChar('/select,' +ファイルのフルパス名), nil, SW_SHOWDEFAULT);

とします。

ちょっとしたことですが、意外と感動したりします(私だけかも知れませんが・・・)。

| | コメント (0) | トラックバック (0)

2017.04.02

MiBarcode Ver.7フルインストール版

MiBarcode Ver.7.0のヘルプファイルを含めたフルパッケージ版です。
機能的には以前本体だけを公開していたVer.7.0.2と同じですが、今回ヘルプファイルやサンプルファイルを含めたフルパッケージ版にしました。
ダウンロードしたMibar70.zipファイルを解凍してMibar70.exeを実行すればインストールできます。尚、以前のバージョンをインストールしている場合には、事前にコントロールパネルのプログラムのアンインストールからアンインストールして下さい。

MiBarcode Ver7のダウンロード

| | コメント (0) | トラックバック (0)

MiGrep2その後(1)

ひとまずMiGrep2の本体は置いといて・・・シェル拡張部分を作成中です。

シェル拡張用のDLLはだいぶ昔にLazarusで作成した「64bit版TEADで開く」を元に今回もLazarusで32biti版と64bit版を作成しています。Delphi10.1 Starter版は32biti環境のみ、XE2 Pro版(64bit環境あり)はあるものの、Lazarus(FPC)用のソースファイルをDelphi用に修正するのも面倒ですし、Delphiにこだわる理由がなかったもので。

エクスプローラのコンテキストメニューの状態
Migrepexdll

で起動すると・・・
Migrepex

今回はコンテキストメニューから起動するためのアプリケーションを別に作成しています。旧MiGrepではコンテキストメニューから起動した場合、MiGrepそのものが起動して検索専用のダイアログフォームを表示していましたが、別アプリケーションにした方がMiGrep側との情報のやり取りがし易いのではと思ったためです。

で、コンテキストメニューからの起動では複数のファイルやフォルダーを選択して起動できるのですが、ファイルとフォルダー混在でリスト表示する際にフォルダーアイコンの表示でちょっとつまづきました。で、手っ取り早く以下のような処理を行っています。本当はもっとスマートな方法があるかも知れません。

procedure TForm1.LVAddList(FileList: TStringList);
var
  item: TListItem;
  i: integer;
  fname: string;
  sfi: TSHFileInfo;
 
  // ListViewにファイルアイコンを登録する
  procedure LoadShellIcon;
  var
    sfi: TSHFileInfo ;
    ImageListT: HImageList ;
    begin
      // コモンコントロールのイニシャライズ
      InitCommonControls;
      // 小さいイメージのロード
      ImageListT := SHGetFileInfo('', 0,  sfi,sizeof(TSHFileInfo),
                                  SHGFI_SYSICONINDEX or
                                  SHGFI_SMALLICON);
      // ListView 側の SmallImage に小さいアイコンを設定
      ListView_SetImageList(ListView1.handle, ImageListT, LVSIL_SMALL) ;
  end;
begin
  LoadShellIcon;
 
  for i := 0 to FileList.Count - 1 do
  begin                           
    item := ListView1.Items.Add;
    fname :=FileList.strings[i];
    item.Caption := fname;
    ShGetFileInfo(PChar(fname), 0, sfi, SizeOf(sfi),
                  SHGFI_SYSICONINDEX or SHGFI_SMALLICON or
                  SHGFI_USEFILEATTRIBUTES);
    // ファイルアイコンを取得できなかった場合はフォルダーアイコンを取得する
    if sfi.iIcon = 0 then
    ShGetFileInfo(PChar(fname), FILE_ATTRIBUTE_DIRECTORY, sfi, SizeOf(sfi),
                  SHGFI_SYSICONINDEX or SHGFI_SMALLICON or
                  SHGFI_USEFILEATTRIBUTES);
 
    item.ImageIndex := sfi.iIcon;
  end;
end;

それから、折角なのでxdoc2txtのDLLをDelphiで使用する方法を書いておきます。

type
  // xdoc2txtダイナミックリンクライブラリー関数の定義
  TExtractText = function(lpFileName: WideString; // 入力ファイル名
                          bProp: Boolean;         // True:プロパティの抽出 False:本文テキストの抽出
                          lpFileText: PWideString): Integer; cdecl; // BSTRはPWideString
 
// DLL呼び出し用関数を宣言
var
  ExtractText: TExtractText;
 
// DLLの動的ロードと解放
var
  xdocHdl: THandle;
 
xdocHdl := LoadLibrary(PWideChar(xd2txlib.dllのフルパス名));
if xdocHdl = 0 then
  MessageDlg('xdoc2txtのDLLをロード出来ませんでした.'+#13#10+'xdoc2txtライブラリーパスを指定して下さい', mtError, [mbOK], 0)
else
  @ExtractText := GetProcAddress(xdocHdl, 'ExtractText');
 
// ExtractTextの呼び出し
var
  rtxt: WideString;
 
// FileNameにテキストに変換したいファイル名(フルパス名)を入れる
ExtractText(WideString(FileName), False, @rtxt)
 
// DLLの解放
if xdocHdl <> 0 then
  FreeLibrary(xdocHdl);

Delphiからでも簡単に使用することが出来ます。
あらためて開発者のhishidaさんに感謝です。


| | コメント (0) | トラックバック (0)

« 2017年3月 | トップページ | 2017年5月 »