イベントの再入防止
どこかにTipsとかでありそうなネタだけど。
イベントに入ってきた所で最初にイベントに対してnilを代入する。
処理が終わったらイベントにメソッドを設定し直す。
procedure TForm1.Button1Click(Sender: TObject); begin TControl(Sender).OnClick := Nil; // なにか処理 // TControl(Sender).OnClick := Button1Click; end;
同じような感じで、起動時に一回だけ処理を実行したいとかの場合。
FormのOnCreateだと具合が悪い時は、OnShowイベントかOnActivateイベントを使ってイベントの中でNilを設定する。
procedure TForm1.FormShow(Sender: TObject); begin Self.OnShow := Nil; // 何か処理 end;
TreeView項目のD&D移動
こちらの掲示板の話題です。
使用するイベントは、TreeViewのOnDragDrop,OnDragOver,OnMouseDown,OnStartDragの4つです。
usesにWinapi.CommCtrl(XE以前の場合はCommCtrl)を追加。
項目の移動先が下記のように表示されます。移動先の表示はTVM_SETINSERTMARKメッセージをTreeViewに送る事で実現しています。
TVM_SETINSERTMARKCOLORメッセージで色を変えることも出来るようですが試していません。
TForm1 = class(TForm) TreeView1: TTreeView; procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TreeView1StartDrag(Sender: TObject; var DragObject: TDragObject); private FDragNode: TTreeNode; FDragMode: Integer; public end; procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer); var Node: TTreeNode; begin Node := (Sender as TTreeView).DropTarget; if Assigned(Node) And Assigned(FDragNode) then begin if FDragMode = 1 then begin // 子の一番最後に移動 FDragNode.MoveTo(Node, naAddChild); end else if FDragMode = 2 then begin // ターゲットの前に同レベルのアイテムとして移動 FDragNode.MoveTo(Node, naInsert); end else if FDragMode = 3 then begin // ターゲットの同レベル次のアイテムがあればそのアイテムの前に移動 // 無ければ同レベルの最後に移動 Node := Node.getNextSibling; if Assigned(Node) then begin FDragNode.MoveTo(Node, naInsert); end else begin Node := (Sender as TTreeView).DropTarget; FDragNode.MoveTo(Node, naAdd); end; end; // ドロップ処理が終わったら挿入マークを消す SendMessage((Sender as TTreeView).Handle, TVM_SETINSERTMARK, 1, 0); end; end; procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var Node: TTreeNode; DragM: Integer; rc: TRect; ht: THitTests; begin Node := (Sender as TTreeView).GetNodeAt(X, Y); Accept := (Sender = Source) And Assigned(Node) And (Node <> FDragNode); if Accept then begin ht := (Sender as TTreeView).GetHitTestInfoAt(X, Y); if htOnLabel in ht then begin DragM := 1; end else begin rc := Node.DisplayRect(False); InflateRect(rc, -1, -1); if (rc.Top + rc.Bottom) div 2 > Y then begin DragM := 2; end else begin DragM := 3; end; end; if DragM = 1 then begin // 子に追加するので挿入マークを消す SendMessage((Sender as TTreeView).Handle, TVM_SETINSERTMARK, 1, 0); end else if DragM = 2 then begin // ターゲットの上側に挿入マークを表示 SendMessage((Sender as TTreeView).Handle, TVM_SETINSERTMARK, 0, LPARAM(Node.ItemId)); end else if DragM = 3 then begin // ターゲットの下側に挿入マークを表示 SendMessage((Sender as TTreeView).Handle, TVM_SETINSERTMARK, 1, LPARAM(Node.ItemId)); end; FDragMode := DragM; end else begin SendMessage((Sender as TTreeView).Handle, TVM_SETINSERTMARK, 1, 0); FDragMode := 0; end; end; procedure TForm1.TreeView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Node: TTreeNode; begin if Button = mbLeft then begin FDragNode := (Sender as TTreeView).GetNodeAt(X, Y); (Sender as TTreeView).BeginDrag(False, 5); end; end; procedure TForm1.TreeView1StartDrag(Sender: TObject; var DragObject: TDragObject); begin FDragMode := 0; end;
Unicode版TEditor の上書きモードの処理修正
Unicode版のTEditor 利用させてもらってるんですが、先日上書きモードで編集してるときに文字が余分に上書きされると報告があがって来ました。
とりあえずの修正でまともに動くようになったようなのでメモ。
HEditor.pasのTEditor.PutStringToLineメソッドで、変数にAttr2:Stringを追加
12074行辺りの
Attr := StrToAttributes(S);
の下に
Attr2 := StrToAttributes(Source);
を追加。12083行辺りの
if FOverWrite then begin Buf := Copy(S, 1, Si) + Source; // Source 終端の文字インデックスを取得 I := FCol + L;
のI := FCol + L;の行を
I := FCol + Length(Attr2);
に変更。12100行辺りの
Si := I - IncludeCharCount(Attr, caTabSpace, I + 1);
の行を
Si := I - IncludeCharCount(Attr, caTabSpace, I + 1) - IncludeCharCount(Attr, caFullWidth2, I + 1) - IncludeCharCount(Attr, caSFullWidth2, I + 1);
に変更。以上で、上書きモードで文字入力したときの動作が改善されました。
追記
この修正はDEKOさんのところからダウンロード出来るバージョンに対する修正です。何に対する修正なのか書くのをすっかり忘れておりました。
FirebirdとUDF
思い出したのでメモ。
Firebird1.5でUDF作成して使ってたんですが、環境のアップデートで2.5にバージョンアップする事になり確認してたんですが自作のUDFを呼ぶとサーバーが落ちるという現象に遭遇。
で、色々調べて行き着いた結論が呼び出し規約が違う。ネットで調べてもWindowsではstdcallを使うというのが結構ヒットしてて1.5まではstdcallで問題無かったんですが、2.5はstdcallではエラーになりますcdeclを使ったらokでした。
色々調べて見つかったのはこれくらいでした、なんか昔からUNIX、Windowsどっちもcdeclだよって書いてあるようにも読めるんですが詳細は不明。
私の体験から言えるのは1.5はstdcallで問題なし、2.5はstdcallだとエラーになりcdeclにしないと駄目。2.0、2.1はどうなのかは使ってないので不明です。
TZipFile に BZip2 サポートを追加する
前の記事で書きましたがTZipFileは圧縮方法として0(store)と8(deflate)のみサポートしていますが、後から追加することが可能になっています。そこで、BZip2のサポートを追加してみました。
内容としては、System.ZLibを元にBZip2のメソッドを呼ぶように修正していっただけ。どちらかと言うと、スタティックリンクするためのObjファイルのリンクに苦労しました。スタティックリンクは、Win32/Win64で軽く確認した所だと圧縮・解凍共に動作しています。
Objファイルとソースファイルはここにおいておきます。
Win32/Win64フォルダの下のlibbz2フォルダにobjファイルを置いてあるのでWin32/Win64フォルダをライブラリパスに追加してください。
Win32はC++BuilderXE2でWin64はVC2010でコンパイルしてあります。bzip2のソースはこちら。
ユニットを追加するだけでBZip2サポートが追加されますのでユニットを追加した後、圧縮方法にzcBZIP2を指定するだけです。
ユニットは以下。
unit au2010.Compression.BZip2; { ------------------------------------------------------------------ This file is part of bzip2/libbzip2, a program and library for lossless, block-sorting data compression. bzip2/libbzip2 version 1.0.6 of 6 September 2010 Copyright (C) 1996-2010 Julian Seward <jseward@bzip.org> Please read the WARNING, DISCLAIMER and PATENTS sections in the README file. This program is released under the terms of the license contained in the file LICENSE. ------------------------------------------------------------------ Header conversion of bzlib.h } interface uses System.Types, System.SysUtils, System.Classes, System.Zip; { DLL 使用時は'.'を削除 } {.$DEFINE USE_DLL} {$IFDEF USE_DLL} const libbz2 = 'libbz2.dll'; {$ENDIF} {$REGION 'bzlib.h translation'} const BZ_RUN = 0; BZ_FLUSH = 1; BZ_FINISH = 2; BZ_OK = 0; BZ_RUN_OK = 1; BZ_FLUSH_OK = 2; BZ_FINISH_OK = 3; BZ_STREAM_END = 4; BZ_SEQUENCE_ERROR = (-1); BZ_PARAM_ERROR = (-2); BZ_MEM_ERROR = (-3); BZ_DATA_ERROR = (-4); BZ_DATA_ERROR_MAGIC = (-5); BZ_IO_ERROR = (-6); BZ_UNEXPECTED_EOF = (-7); BZ_OUTBUFF_FULL = (-8); BZ_CONFIG_ERROR = (-9); type bzalloc_func = function(opaque: Pointer; Items, Size: Integer): Pointer; cdecl; bzfree_func = procedure(opaque, address: Pointer); cdecl; bz_stream = record next_in: PByte; avail_in: Cardinal; total_in_lo32: Cardinal; total_in_hi32: Cardinal; next_out: PByte; avail_out: Cardinal; total_out_lo32: Cardinal; total_out_hi32: Cardinal; state: Pointer; bzalloc: bzalloc_func; bzfree: bzfree_func; opaque: Pointer; end; (*-- Core (low-level) library functions --*) function BZ2_bzCompressInit(var strm: bz_stream; blockSize100k, verbosity, workFactor: Integer): Integer; stdcall; external {$IFDEF USE_DLL}libbz2{$ENDIF}; function BZ2_bzCompress(var strm: bz_stream; action: Integer): Integer; stdcall; external {$IFDEF USE_DLL}libbz2{$ENDIF}; function BZ2_bzCompressEnd(var strm: bz_stream): Integer; stdcall; external {$IFDEF USE_DLL}libbz2{$ENDIF}; function BZ2_bzDecompressInit(var strm: bz_stream; verbosity, small: Integer): Integer; stdcall; external {$IFDEF USE_DLL}libbz2{$ENDIF}; function BZ2_bzDecompress(var strm: bz_stream): Integer; stdcall; external {$IFDEF USE_DLL}libbz2{$ENDIF}; function BZ2_bzDecompressEnd(var strm: bz_stream): Integer; stdcall; external {$IFDEF USE_DLL}libbz2{$ENDIF}; {$ENDREGION 'bzip2.h translation'} type TBZAlloc = bzalloc_func; TBZFree = bzfree_func; TBZStreamRec = bz_stream; {** TCustomBZStream ********************************************************} TCustomBZStream = class(TStream) private FStream: TStream; FStreamStartPos: Int64; FStreamPos: Int64; FOnProgress: TNotifyEvent; FZStream: TBZStreamRec; FBuffer: array[Word] of Byte; protected constructor Create(stream: TStream); procedure DoProgress; dynamic; property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; end; {** TZCompressionStream ***************************************************} TBZCompressionStream = class(TCustomBZStream) private function GetCompressionRate: Single; public constructor Create(dest: TStream); overload; destructor Destroy; override; function Read(var buffer; count: Longint): Longint; override; function Write(const buffer; count: Longint): Longint; override; function Seek(offset: Longint; origin: Word): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; property CompressionRate: Single read GetCompressionRate; property OnProgress; end; {** TZDecompressionStream *************************************************} TBZDecompressionStream = class(TCustomBZStream) public constructor Create(source: TStream); overload; constructor Create(source: TStream; WindowBits: Integer); overload; destructor Destroy; override; function Read(var buffer; count: Longint): Longint; override; function Write(const buffer; count: Longint): Longint; override; function Seek(offset: Longint; origin: Word): Longint; override; function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; property OnProgress; end; function bzAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl; procedure bzFreeMem(AppData, Block: Pointer); cdecl; type EBZError = class(Exception); EBZCompressionError = class(EBZError); EBZDecompressionError = class(EBZError); const {** return code messages **************************************************} _bz_errmsg: array [0..14] of PAnsiChar = ( 'stream end', // BZ_STREAM_END (4) //do not localize '', // BZ_FINISH_OK (3) //do not localize '', // BZ_FLUSH_OK (2) //do not localize '', // BZ_RUN_OK (1) //do not localize '', // BZ_OK (0) //do not localize 'sequence error', // BZ_SEQUENCE_ERROR (-1) //do not localize 'parameter error', // BZ_PARAM_ERROR (-2) //do not localize 'insufficient memory', // BZ_MEM_ERROR (-3) //do not localize 'data error', // BZ_DATA_ERROR (-4) //do not localize 'magic bytes error', // BZ_DATA_ERROR_MAGIC (-5) //do not localize 'io error', // BZ_IO_ERROR (-6) //do not localize 'unexpected EOF', // BZ_UNEXPECTED_EOF (-7) //do not localize 'out buffer full', // BZ_OUTBUFF_FULL (-8) //do not localize 'config error', // BZ_CONFIG_ERROR (-9) //do not localize '' //do not localize ); SBZInvalid = 'Invalid BZStream operation!'; implementation {$IFDEF MSWINDOWS} {$IFNDEF USE_DLL} uses System.Win.crtl; {$L libbz2\bzlib.obj} {$L libbz2\blocksort.obj} {$L libbz2\huffman.obj} {$L libbz2\compress.obj} {$L libbz2\decompress.obj} {$IF defined(WIN32)} const _BZ2_crc32Table: Array[0..255] of UInt32 = ( $00000000, $04c11db7, $09823b6e, $0d4326d9, $130476dc, $17c56b6b, $1a864db2, $1e475005, $2608edb8, $22c9f00f, $2f8ad6d6, $2b4bcb61, $350c9b64, $31cd86d3, $3c8ea00a, $384fbdbd, $4c11db70, $48d0c6c7, $4593e01e, $4152fda9, $5f15adac, $5bd4b01b, $569796c2, $52568b75, $6a1936c8, $6ed82b7f, $639b0da6, $675a1011, $791d4014, $7ddc5da3, $709f7b7a, $745e66cd, $9823b6e0, $9ce2ab57, $91a18d8e, $95609039, $8b27c03c, $8fe6dd8b, $82a5fb52, $8664e6e5, $be2b5b58, $baea46ef, $b7a96036, $b3687d81, $ad2f2d84, $a9ee3033, $a4ad16ea, $a06c0b5d, $d4326d90, $d0f37027, $ddb056fe, $d9714b49, $c7361b4c, $c3f706fb, $ceb42022, $ca753d95, $f23a8028, $f6fb9d9f, $fbb8bb46, $ff79a6f1, $e13ef6f4, $e5ffeb43, $e8bccd9a, $ec7dd02d, $34867077, $30476dc0, $3d044b19, $39c556ae, $278206ab, $23431b1c, $2e003dc5, $2ac12072, $128e9dcf, $164f8078, $1b0ca6a1, $1fcdbb16, $018aeb13, $054bf6a4, $0808d07d, $0cc9cdca, $7897ab07, $7c56b6b0, $71159069, $75d48dde, $6b93dddb, $6f52c06c, $6211e6b5, $66d0fb02, $5e9f46bf, $5a5e5b08, $571d7dd1, $53dc6066, $4d9b3063, $495a2dd4, $44190b0d, $40d816ba, $aca5c697, $a864db20, $a527fdf9, $a1e6e04e, $bfa1b04b, $bb60adfc, $b6238b25, $b2e29692, $8aad2b2f, $8e6c3698, $832f1041, $87ee0df6, $99a95df3, $9d684044, $902b669d, $94ea7b2a, $e0b41de7, $e4750050, $e9362689, $edf73b3e, $f3b06b3b, $f771768c, $fa325055, $fef34de2, $c6bcf05f, $c27dede8, $cf3ecb31, $cbffd686, $d5b88683, $d1799b34, $dc3abded, $d8fba05a, $690ce0ee, $6dcdfd59, $608edb80, $644fc637, $7a089632, $7ec98b85, $738aad5c, $774bb0eb, $4f040d56, $4bc510e1, $46863638, $42472b8f, $5c007b8a, $58c1663d, $558240e4, $51435d53, $251d3b9e, $21dc2629, $2c9f00f0, $285e1d47, $36194d42, $32d850f5, $3f9b762c, $3b5a6b9b, $0315d626, $07d4cb91, $0a97ed48, $0e56f0ff, $1011a0fa, $14d0bd4d, $19939b94, $1d528623, $f12f560e, $f5ee4bb9, $f8ad6d60, $fc6c70d7, $e22b20d2, $e6ea3d65, $eba91bbc, $ef68060b, $d727bbb6, $d3e6a601, $dea580d8, $da649d6f, $c423cd6a, $c0e2d0dd, $cda1f604, $c960ebb3, $bd3e8d7e, $b9ff90c9, $b4bcb610, $b07daba7, $ae3afba2, $aafbe615, $a7b8c0cc, $a379dd7b, $9b3660c6, $9ff77d71, $92b45ba8, $9675461f, $8832161a, $8cf30bad, $81b02d74, $857130c3, $5d8a9099, $594b8d2e, $5408abf7, $50c9b640, $4e8ee645, $4a4ffbf2, $470cdd2b, $43cdc09c, $7b827d21, $7f436096, $7200464f, $76c15bf8, $68860bfd, $6c47164a, $61043093, $65c52d24, $119b4be9, $155a565e, $18197087, $1cd86d30, $029f3d35, $065e2082, $0b1d065b, $0fdc1bec, $3793a651, $3352bbe6, $3e119d3f, $3ad08088, $2497d08d, $2056cd3a, $2d15ebe3, $29d4f654, $c5a92679, $c1683bce, $cc2b1d17, $c8ea00a0, $d6ad50a5, $d26c4d12, $df2f6bcb, $dbee767c, $e3a1cbc1, $e760d676, $ea23f0af, $eee2ed18, $f0a5bd1d, $f464a0aa, $f9278673, $fde69bc4, $89b8fd09, $8d79e0be, $803ac667, $84fbdbd0, $9abc8bd5, $9e7d9662, $933eb0bb, $97ffad0c, $afb010b1, $ab710d06, $a6322bdf, $a2f33668, $bcb4666d, $b8757bda, $b5365d03, $b1f740b4 ); _BZ2_rNums: Array[0..511] of Int32 = ( 619, 720, 127, 481, 931, 816, 813, 233, 566, 247, 985, 724, 205, 454, 863, 491, 741, 242, 949, 214, 733, 859, 335, 708, 621, 574, 73, 654, 730, 472, 419, 436, 278, 496, 867, 210, 399, 680, 480, 51, 878, 465, 811, 169, 869, 675, 611, 697, 867, 561, 862, 687, 507, 283, 482, 129, 807, 591, 733, 623, 150, 238, 59, 379, 684, 877, 625, 169, 643, 105, 170, 607, 520, 932, 727, 476, 693, 425, 174, 647, 73, 122, 335, 530, 442, 853, 695, 249, 445, 515, 909, 545, 703, 919, 874, 474, 882, 500, 594, 612, 641, 801, 220, 162, 819, 984, 589, 513, 495, 799, 161, 604, 958, 533, 221, 400, 386, 867, 600, 782, 382, 596, 414, 171, 516, 375, 682, 485, 911, 276, 98, 553, 163, 354, 666, 933, 424, 341, 533, 870, 227, 730, 475, 186, 263, 647, 537, 686, 600, 224, 469, 68, 770, 919, 190, 373, 294, 822, 808, 206, 184, 943, 795, 384, 383, 461, 404, 758, 839, 887, 715, 67, 618, 276, 204, 918, 873, 777, 604, 560, 951, 160, 578, 722, 79, 804, 96, 409, 713, 940, 652, 934, 970, 447, 318, 353, 859, 672, 112, 785, 645, 863, 803, 350, 139, 93, 354, 99, 820, 908, 609, 772, 154, 274, 580, 184, 79, 626, 630, 742, 653, 282, 762, 623, 680, 81, 927, 626, 789, 125, 411, 521, 938, 300, 821, 78, 343, 175, 128, 250, 170, 774, 972, 275, 999, 639, 495, 78, 352, 126, 857, 956, 358, 619, 580, 124, 737, 594, 701, 612, 669, 112, 134, 694, 363, 992, 809, 743, 168, 974, 944, 375, 748, 52, 600, 747, 642, 182, 862, 81, 344, 805, 988, 739, 511, 655, 814, 334, 249, 515, 897, 955, 664, 981, 649, 113, 974, 459, 893, 228, 433, 837, 553, 268, 926, 240, 102, 654, 459, 51, 686, 754, 806, 760, 493, 403, 415, 394, 687, 700, 946, 670, 656, 610, 738, 392, 760, 799, 887, 653, 978, 321, 576, 617, 626, 502, 894, 679, 243, 440, 680, 879, 194, 572, 640, 724, 926, 56, 204, 700, 707, 151, 457, 449, 797, 195, 791, 558, 945, 679, 297, 59, 87, 824, 713, 663, 412, 693, 342, 606, 134, 108, 571, 364, 631, 212, 174, 643, 304, 329, 343, 97, 430, 751, 497, 314, 983, 374, 822, 928, 140, 206, 73, 263, 980, 736, 876, 478, 430, 305, 170, 514, 364, 692, 829, 82, 855, 953, 676, 246, 369, 970, 294, 750, 807, 827, 150, 790, 288, 923, 804, 378, 215, 828, 592, 281, 565, 555, 710, 82, 896, 831, 547, 261, 524, 462, 293, 465, 502, 56, 661, 821, 976, 991, 658, 869, 905, 758, 745, 193, 768, 550, 608, 933, 378, 286, 215, 979, 792, 961, 61, 688, 793, 644, 986, 403, 106, 366, 905, 644, 372, 567, 466, 434, 645, 210, 389, 550, 919, 135, 780, 773, 635, 389, 707, 100, 626, 958, 165, 504, 920, 176, 193, 713, 857, 265, 203, 50, 668, 108, 645, 990, 626, 197, 510, 357, 358, 850, 858, 364, 936, 638 ); function _BZ2_indexIntoF: integer; cdecl; external; procedure _BZ2_hbMakeCodeLengths; external; procedure _BZ2_hbAssignCodes; external; procedure _BZ2_hbCreateDecodeTables; external; procedure _BZ2_blockSort; external; procedure _bz_internal_error(errcode: Integer); cdecl; begin end; {$ELSEIF defined(WIN64)} const BZ2_crc32Table: Array[0..255] of UInt32 = ( $00000000, $04c11db7, $09823b6e, $0d4326d9, $130476dc, $17c56b6b, $1a864db2, $1e475005, $2608edb8, $22c9f00f, $2f8ad6d6, $2b4bcb61, $350c9b64, $31cd86d3, $3c8ea00a, $384fbdbd, $4c11db70, $48d0c6c7, $4593e01e, $4152fda9, $5f15adac, $5bd4b01b, $569796c2, $52568b75, $6a1936c8, $6ed82b7f, $639b0da6, $675a1011, $791d4014, $7ddc5da3, $709f7b7a, $745e66cd, $9823b6e0, $9ce2ab57, $91a18d8e, $95609039, $8b27c03c, $8fe6dd8b, $82a5fb52, $8664e6e5, $be2b5b58, $baea46ef, $b7a96036, $b3687d81, $ad2f2d84, $a9ee3033, $a4ad16ea, $a06c0b5d, $d4326d90, $d0f37027, $ddb056fe, $d9714b49, $c7361b4c, $c3f706fb, $ceb42022, $ca753d95, $f23a8028, $f6fb9d9f, $fbb8bb46, $ff79a6f1, $e13ef6f4, $e5ffeb43, $e8bccd9a, $ec7dd02d, $34867077, $30476dc0, $3d044b19, $39c556ae, $278206ab, $23431b1c, $2e003dc5, $2ac12072, $128e9dcf, $164f8078, $1b0ca6a1, $1fcdbb16, $018aeb13, $054bf6a4, $0808d07d, $0cc9cdca, $7897ab07, $7c56b6b0, $71159069, $75d48dde, $6b93dddb, $6f52c06c, $6211e6b5, $66d0fb02, $5e9f46bf, $5a5e5b08, $571d7dd1, $53dc6066, $4d9b3063, $495a2dd4, $44190b0d, $40d816ba, $aca5c697, $a864db20, $a527fdf9, $a1e6e04e, $bfa1b04b, $bb60adfc, $b6238b25, $b2e29692, $8aad2b2f, $8e6c3698, $832f1041, $87ee0df6, $99a95df3, $9d684044, $902b669d, $94ea7b2a, $e0b41de7, $e4750050, $e9362689, $edf73b3e, $f3b06b3b, $f771768c, $fa325055, $fef34de2, $c6bcf05f, $c27dede8, $cf3ecb31, $cbffd686, $d5b88683, $d1799b34, $dc3abded, $d8fba05a, $690ce0ee, $6dcdfd59, $608edb80, $644fc637, $7a089632, $7ec98b85, $738aad5c, $774bb0eb, $4f040d56, $4bc510e1, $46863638, $42472b8f, $5c007b8a, $58c1663d, $558240e4, $51435d53, $251d3b9e, $21dc2629, $2c9f00f0, $285e1d47, $36194d42, $32d850f5, $3f9b762c, $3b5a6b9b, $0315d626, $07d4cb91, $0a97ed48, $0e56f0ff, $1011a0fa, $14d0bd4d, $19939b94, $1d528623, $f12f560e, $f5ee4bb9, $f8ad6d60, $fc6c70d7, $e22b20d2, $e6ea3d65, $eba91bbc, $ef68060b, $d727bbb6, $d3e6a601, $dea580d8, $da649d6f, $c423cd6a, $c0e2d0dd, $cda1f604, $c960ebb3, $bd3e8d7e, $b9ff90c9, $b4bcb610, $b07daba7, $ae3afba2, $aafbe615, $a7b8c0cc, $a379dd7b, $9b3660c6, $9ff77d71, $92b45ba8, $9675461f, $8832161a, $8cf30bad, $81b02d74, $857130c3, $5d8a9099, $594b8d2e, $5408abf7, $50c9b640, $4e8ee645, $4a4ffbf2, $470cdd2b, $43cdc09c, $7b827d21, $7f436096, $7200464f, $76c15bf8, $68860bfd, $6c47164a, $61043093, $65c52d24, $119b4be9, $155a565e, $18197087, $1cd86d30, $029f3d35, $065e2082, $0b1d065b, $0fdc1bec, $3793a651, $3352bbe6, $3e119d3f, $3ad08088, $2497d08d, $2056cd3a, $2d15ebe3, $29d4f654, $c5a92679, $c1683bce, $cc2b1d17, $c8ea00a0, $d6ad50a5, $d26c4d12, $df2f6bcb, $dbee767c, $e3a1cbc1, $e760d676, $ea23f0af, $eee2ed18, $f0a5bd1d, $f464a0aa, $f9278673, $fde69bc4, $89b8fd09, $8d79e0be, $803ac667, $84fbdbd0, $9abc8bd5, $9e7d9662, $933eb0bb, $97ffad0c, $afb010b1, $ab710d06, $a6322bdf, $a2f33668, $bcb4666d, $b8757bda, $b5365d03, $b1f740b4 ); BZ2_rNums: Array[0..511] of Int32 = ( 619, 720, 127, 481, 931, 816, 813, 233, 566, 247, 985, 724, 205, 454, 863, 491, 741, 242, 949, 214, 733, 859, 335, 708, 621, 574, 73, 654, 730, 472, 419, 436, 278, 496, 867, 210, 399, 680, 480, 51, 878, 465, 811, 169, 869, 675, 611, 697, 867, 561, 862, 687, 507, 283, 482, 129, 807, 591, 733, 623, 150, 238, 59, 379, 684, 877, 625, 169, 643, 105, 170, 607, 520, 932, 727, 476, 693, 425, 174, 647, 73, 122, 335, 530, 442, 853, 695, 249, 445, 515, 909, 545, 703, 919, 874, 474, 882, 500, 594, 612, 641, 801, 220, 162, 819, 984, 589, 513, 495, 799, 161, 604, 958, 533, 221, 400, 386, 867, 600, 782, 382, 596, 414, 171, 516, 375, 682, 485, 911, 276, 98, 553, 163, 354, 666, 933, 424, 341, 533, 870, 227, 730, 475, 186, 263, 647, 537, 686, 600, 224, 469, 68, 770, 919, 190, 373, 294, 822, 808, 206, 184, 943, 795, 384, 383, 461, 404, 758, 839, 887, 715, 67, 618, 276, 204, 918, 873, 777, 604, 560, 951, 160, 578, 722, 79, 804, 96, 409, 713, 940, 652, 934, 970, 447, 318, 353, 859, 672, 112, 785, 645, 863, 803, 350, 139, 93, 354, 99, 820, 908, 609, 772, 154, 274, 580, 184, 79, 626, 630, 742, 653, 282, 762, 623, 680, 81, 927, 626, 789, 125, 411, 521, 938, 300, 821, 78, 343, 175, 128, 250, 170, 774, 972, 275, 999, 639, 495, 78, 352, 126, 857, 956, 358, 619, 580, 124, 737, 594, 701, 612, 669, 112, 134, 694, 363, 992, 809, 743, 168, 974, 944, 375, 748, 52, 600, 747, 642, 182, 862, 81, 344, 805, 988, 739, 511, 655, 814, 334, 249, 515, 897, 955, 664, 981, 649, 113, 974, 459, 893, 228, 433, 837, 553, 268, 926, 240, 102, 654, 459, 51, 686, 754, 806, 760, 493, 403, 415, 394, 687, 700, 946, 670, 656, 610, 738, 392, 760, 799, 887, 653, 978, 321, 576, 617, 626, 502, 894, 679, 243, 440, 680, 879, 194, 572, 640, 724, 926, 56, 204, 700, 707, 151, 457, 449, 797, 195, 791, 558, 945, 679, 297, 59, 87, 824, 713, 663, 412, 693, 342, 606, 134, 108, 571, 364, 631, 212, 174, 643, 304, 329, 343, 97, 430, 751, 497, 314, 983, 374, 822, 928, 140, 206, 73, 263, 980, 736, 876, 478, 430, 305, 170, 514, 364, 692, 829, 82, 855, 953, 676, 246, 369, 970, 294, 750, 807, 827, 150, 790, 288, 923, 804, 378, 215, 828, 592, 281, 565, 555, 710, 82, 896, 831, 547, 261, 524, 462, 293, 465, 502, 56, 661, 821, 976, 991, 658, 869, 905, 758, 745, 193, 768, 550, 608, 933, 378, 286, 215, 979, 792, 961, 61, 688, 793, 644, 986, 403, 106, 366, 905, 644, 372, 567, 466, 434, 645, 210, 389, 550, 919, 135, 780, 773, 635, 389, 707, 100, 626, 958, 165, 504, 920, 176, 193, 713, 857, 265, 203, 50, 668, 108, 645, 990, 626, 197, 510, 357, 358, 850, 858, 364, 936, 638 ); function BZ2_indexIntoF: integer; cdecl; external; procedure BZ2_hbMakeCodeLengths; external; procedure BZ2_hbAssignCodes; external; procedure BZ2_hbCreateDecodeTables; external; procedure BZ2_blockSort; external; procedure bz_internal_error(errcode: Integer); cdecl; begin end; {$IFEND} {$ENDIF} {$ENDIF} function BZCompressCheck(code: Integer): Integer; begin result := code; if code < 0 then begin raise EBZCompressionError.Create(string(_bz_errmsg[4 - code])); end; end; function BZDecompressCheck(code: Integer): Integer; begin Result := code; if code < 0 then begin raise EBZDecompressionError.Create(string(_bz_errmsg[4 - code])); end; end; function bzAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; begin Result := AllocMem(Items * Size); end; procedure bzFreeMem(AppData, Block: Pointer); begin FreeMem(Block); end; { TCustomBZStream } constructor TCustomBZStream.Create(stream: TStream); begin inherited Create; FStream := stream; FStreamStartPos := Stream.Position; FStreamPos := FStreamStartPos; end; procedure TCustomBZStream.DoProgress; begin if Assigned(FOnProgress) then FOnProgress(Self); end; { TBZCompressionStream } constructor TBZCompressionStream.Create(dest: TStream); begin inherited Create(dest); FZStream.opaque := Nil; FZStream.bzalloc := Nil; FZStream.bzfree := Nil; FZStream.next_out := @FBuffer; FZStream.avail_out := SizeOf(FBuffer); BZCompressCheck(BZ2_bzCompressInit(FZStream, 9, 0, 30)); end; destructor TBZCompressionStream.Destroy; begin FZStream.next_in := nil; FZStream.avail_in := 0; try if FStream.Position <> FStreamPos then FStream.Position := FStreamPos; while BZCompressCheck(BZ2_bzCompress(FZStream, BZ_FINISH)) <> BZ_STREAM_END do begin FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out); FZStream.next_out := @FBuffer; FZStream.avail_out := SizeOf(FBuffer); end; if FZStream.avail_out < SizeOf(FBuffer) then begin FStream.WriteBuffer(FBuffer, SizeOf(FBuffer) - FZStream.avail_out); end; finally BZ2_bzCompressEnd(FZStream); end; inherited Destroy; end; function TBZCompressionStream.GetCompressionRate: Single; var TotalIn: UInt64; TotalOut: UInt64; begin TotalIn := (FZStream.total_in_hi32 Shl 32) + FZStream.total_in_lo32; TotalOut := (FZStream.total_out_hi32 Shl 32) + FZStream.total_out_lo32; if TotalIn = 0 then result := 0 else result := (1.0 - (TotalOut / TotalIn)) * 100.0; end; function TBZCompressionStream.Read(var buffer; count: Integer): Longint; begin raise EBZCompressionError.Create(SBZInvalid); end; function TBZCompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; begin if (offset = 0) and (origin = soCurrent) then begin result := FZStream.total_in_hi32 Shl 32 + FZStream.total_in_lo32; end else raise EBZCompressionError.Create(SBZInvalid); end; function TBZCompressionStream.Seek(offset: Integer; origin: Word): Longint; begin if (offset = 0) and (origin = soFromCurrent) then begin result := FZStream.total_in_hi32 Shl 32 + FZStream.total_in_lo32; end else raise EBZCompressionError.Create(SBZInvalid); end; function TBZCompressionStream.Write(const buffer; count: Integer): Longint; begin FZStream.next_in := @buffer; FZStream.avail_in := count; if FStream.Position <> FStreamPos then FStream.Position := FStreamPos; while FZStream.avail_in > 0 do begin BZCompressCheck(BZ2_bzCompress(FZStream, BZ_RUN)); if FZStream.avail_out = 0 then begin FStream.WriteBuffer(FBuffer, SizeOf(FBuffer)); FZStream.next_out := @FBuffer; FZStream.avail_out := SizeOf(FBuffer); FStreamPos := FStream.Position; DoProgress; end; end; result := Count; end; { TBZDecompressionStream } constructor TBZDecompressionStream.Create(source: TStream); begin Create(source, 15); end; constructor TBZDecompressionStream.Create(source: TStream; WindowBits: Integer); begin inherited Create(source); FZStream.next_in := @FBuffer; FZStream.avail_in := 0; FZStream.opaque := Nil; FZStream.bzalloc := Nil; FZStream.bzfree := Nil; BZDecompressCheck(BZ2_bzDecompressInit(FZStream, 0, 0)); end; destructor TBZDecompressionStream.Destroy; begin BZ2_bzDecompressEnd(FZStream); inherited; end; function TBZDecompressionStream.Read(var buffer; count: Integer): Longint; var zresult: Integer; begin FZStream.next_out := @buffer; FZStream.avail_out := count; if FStream.Position <> FStreamPos then FStream.Position := FStreamPos; zresult := BZ_OK; while (FZStream.avail_out > 0) and (zresult <> BZ_STREAM_END) do begin if FZStream.avail_in = 0 then begin FZStream.avail_in := FStream.Read(FBuffer, SizeOf(FBuffer)); if FZStream.avail_in = 0 then begin result := NativeUInt(count) - FZStream.avail_out; Exit; end; FZStream.next_in := @FBuffer; FStreamPos := FStream.Position; DoProgress; end; zresult := BZDecompressCheck(BZ2_bzDecompress(FZStream)); end; if (zresult = BZ_STREAM_END) and (FZStream.avail_in > 0) then begin FStream.Position := FStream.Position - FZStream.avail_in; FStreamPos := FStream.Position; FZStream.avail_in := 0; end; result := NativeUInt(count) - FZStream.avail_out; end; function TBZDecompressionStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; var buf: array[0..8191] of Char; i: Integer; vOffset: Int64; begin vOffset := Offset; if (vOffset = 0) and (origin = soBeginning) then begin BZDecompressCheck(BZ2_bzDecompressEnd(FZStream)); FZStream.next_in := @FBuffer; FZStream.avail_in := 0; FStream.Position := FStreamStartPos; FStreamPos := FStreamStartPos; BZDecompressCheck(BZ2_bzDecompressInit(FZStream, 0, 0)); end else if ((vOffset >= 0) and (origin = soCurrent)) or (((NativeUInt(vOffset) - (FZStream.total_out_lo32 Shl 32) + FZStream.total_out_lo32) > 0) and (origin = soBeginning)) then begin if origin = soBeginning then Dec(vOffset, (FZStream.total_out_lo32 Shl 32) + FZStream.total_out_lo32); if vOffset > 0 then begin for i := 1 to vOffset div SizeOf(buf) do ReadBuffer(buf, SizeOf(buf)); ReadBuffer(buf, vOffset mod SizeOf(buf)); end; end else if (vOffset = 0) and (origin = soEnd) then begin while Read(buf, SizeOf(buf)) > 0 do ; end else raise EBZDecompressionError.Create(SBZInvalid); result := (FZStream.total_out_lo32 Shl 32) + FZStream.total_out_lo32; end; function TBZDecompressionStream.Seek(offset: Integer; origin: Word): Longint; var buf: array[0..8191] of Char; i: Integer; begin if (offset = 0) and (origin = soFromBeginning) then begin BZDecompressCheck(BZ2_bzDecompressEnd(FZStream)); FZStream.next_in := @FBuffer; FZStream.avail_in := 0; FStream.Position := FStreamStartPos; FStreamPos := FStreamStartPos; BZDecompressCheck(BZ2_bzDecompressInit(FZStream, 0, 0)); end else if ((offset >= 0) and (origin = soFromCurrent)) or (((NativeUInt(offset) - (FZStream.total_out_lo32 Shl 32) + FZStream.total_out_lo32) > 0) and (origin = soFromBeginning)) then begin if origin = soFromBeginning then Dec(offset, (FZStream.total_out_lo32 Shl 32) + FZStream.total_out_lo32); if offset > 0 then begin for i := 1 to offset div SizeOf(buf) do ReadBuffer(buf, SizeOf(buf)); ReadBuffer(buf, offset mod SizeOf(buf)); end; end else if (offset = 0) and (origin = soFromEnd) then begin while Read(buf, SizeOf(buf)) > 0 do ; end else raise EBZDecompressionError.Create(SBZInvalid); result := (FZStream.total_out_lo32 Shl 32) + FZStream.total_out_lo32; end; function TBZDecompressionStream.Write(const buffer; count: Integer): Longint; begin raise EBZDecompressionError.Create(SBZInvalid); end; initialization TZipFile.RegisterCompressionHandler(zcBZIP2, function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream begin Result := TBZCompressionStream.Create(InStream); end, function(InStream: TStream; const ZipFile: TZipFile; const Item: TZipHeader): TStream begin Result := TBZDecompressionStream.Create(InStream); end); end.
バージョン情報の問題 その2
前回は自前のリソーススクリプトをプロジェクトに追加して問題を回避する方法をとりましたが、その後根本的に対策するにはMSBuildのカスタムタスクを作成してタスク「CreateRcFile」を置き換えてしまうのが一番かなと言う事を考えてまして一応形になったぽいので公開します。初めてのC#と格闘してる間にDEKOさんが別の方法を公開されました。
作成したバイナリとソースをここ(2011/9/29更新しました)に置いておきます。
なにぶんC#使ったのが初めてなので、色々変なことやってる可能性もありますが指摘して頂ければ幸いです。
使い方としては、
- RCCreateTask.dllをどこか適当な場所に置きます。
- XE2インストールフォルダ\binにあるCodeGear.Common.Targetsファイルをバックアップします。
- CodeGear.Common.Targetsを開いて28行目辺りにある「
」を「 」に変更して保存します。
以上でvrcファイルを作成するタスクが純正のものからRCCreateTask.dllのものに変わります。
Win32、Win64では確認しましたが、ターゲットがMACの時に関してはよく判らんので純正の処理を実行するようにしてあります。
やってる内容としては、言語コードを出力してリソースデータが指定の言語リソースになるようにしてある事と、ファイルバージョン、製品バージョンに数字以外が指定されてる場合はFILEVERSION、PRODUCTVERSIONに出力する時に0を出力してエラーが出ないようにしてある事くらいのはずです。
カスタムタスク作ってみて判ったんですが、オプションのバージョン情報で設定してる「モジュールのバージョン番号」って渡って来て無いんですよね。
なので、下のグリッドで設定してるファイルバージョンとか製品バージョンとかを使ってます。これは多分純正の処理でも同じ。
バージョン情報の辺りは色々と問題が潜んでそうな感じです。
using System; using System.IO; using System.Text; using System.Text.RegularExpressions; using System.Collections.Generic; using Microsoft.Build.Utilities; using Microsoft.Build.Framework; using Borland.Build.Tasks.Shared; namespace RCCreateTask { public class CreateRcFile : Task { // IDEから情報を受け取るプロパティ public ITaskItem OutputFile { get; set; } public bool IncludeVerInfo { get; set; } public bool AutoGenVersion { get; set; } public int MajorVer { get; set; } public int MinorVer { get; set; } public int Release { get; set; } public int Build { get; set; } public bool Debug { get; set; } public bool PreRelease { get; set; } public bool Special { get; set; } public bool Private { get; set; } public bool DLL { get; set; } public int Locale { get; set; } public string KeysString { get; set; } public string ManifestFile { get; set; } public string VCLCustomStyles { get; set; } public string Icon { get; set; } public string ResourcePlatform { get; set; } public string OSXOutputDir { get; set; } public int TargetedPlatforms { get; set; } public string ProjectName { get; set; } public override bool Execute() { if (IncludeVerInfo && OutputFile != null) { if (ResourcePlatform.Equals("Win32") || ResourcePlatform.Equals("Win64")) { using (StreamWriter sw = new StreamWriter(OutputFile.ToString(), false, Encoding.Unicode)) { sw.WriteLine("/* ----- VS_VERSION.dwFileFlags ----- */"); // DEFINE定義の出力のため割愛 sw.WriteLine(""); // 言語情報の出力 int LangId = Locale & 0xFFFF; sw.WriteLine("LANGUAGE 0x{0:X2}, 0x{1:X2}", LangId & 0x3ff, LangId >> 10); sw.WriteLine(""); // グリッドで設定した情報が';'区切りのデータで入ってるのでそれを分割 // バージョン情報の名前と値をDictionaryに入れる if (KeysString != null) { Dictionary<string, string> VersionInfos = new Dictionary<string, string>(); foreach (string item in versions) { string[] values = item.Split('='); VersionInfos.Add(values[0], values[1]); } } sw.WriteLine("1 VERSIONINFO LOADONCALL MOVEABLE DISCARDABLE IMPURE"); // MajorVer等の値が渡されてたらそれを使用してFILEVERSION を出力 if ((MajorVer+MinorVer+Build+Release)>0) sw.Write("FILEVERSION {0}, {1}, {2}, {3}", MajorVer, MinorVer, Release, Build); else if (VersionInfos["FileVersion"] != null) { // MajorVer等が0の場合、ファイルバージョンから値を取ってくる // '.'で値を分割して、数字以外が使われてたら削除する Regex re = new Regex("[^0-9]+"); string[] vernum = VersionInfos["FileVersion"].Split('.'); sw.Write("FILEVERSION {0}", vernum[0]); for (int idx = 1; idx < vernum.Length; idx++) { int i; string s = re.Replace(vernum[idx], ""); int.TryParse(s, out i); sw.Write(", {0}", i); } sw.WriteLine(""); } else sw.WriteLine("FILEVERSION 0, 0, 0, 0"); if (Debug || Special || PreRelease || Private) { int flags = 0; if (Debug) flags |= 0x01; if (Special) flags |= 0x20; if (PreRelease) flags |= 0x02; if (Private) flags |= 0x08; sw.Write("FILEFLAGS {0:X2}", flags); } else sw.WriteLine("FILEFLAGS 0x0L"); if ((MajorVer + MinorVer + Build + Release) > 0) sw.Write("PRODUCTVERSION {0}, {1}, {2}, {3}", MajorVer, MinorVer, Release, Build); else if (VersionInfos["ProductVersion"] != null) { Regex re = new Regex("[^0-9]+"); string[] vernum = VersionInfos["ProductVersion"].Split('.'); sw.Write("PRODUCTVERSION {0}", vernum[0]); for (int idx = 1; idx < vernum.Length; idx++) { int i; string s = re.Replace(vernum[idx], ""); int.TryParse(s, out i); sw.Write(", {0}", i); } sw.WriteLine(""); } else sw.WriteLine("PRODUCTVERSION 0, 0, 0, 0"); sw.WriteLine("FILEOS VOS__WINDOWS32"); if (DLL) sw.WriteLine("FILETYPE VFT_DLL"); else sw.WriteLine("FILETYPE VFT_APP"); sw.WriteLine("{"); sw.WriteLine(" BLOCK \"StringFileInfo\""); sw.WriteLine(" {"); sw.WriteLine(" BLOCK \"{0:X4}{1:X4}\"", Locale, 1200); sw.WriteLine(" {"); foreach (KeyValuePair<string, string> item in VersionInfos) { if (item.Value.Length > 0) sw.WriteLine(" VALUE \"" + item.Key + "\", \"" + item.Value + "\\0\""); } sw.WriteLine(" }"); sw.WriteLine(" }"); sw.WriteLine(" BLOCK \"VarFileInfo\""); sw.WriteLine(" {"); sw.WriteLine(" VALUE \"Translation\", {0:D}, 1200", Locale); sw.WriteLine(" }"); sw.WriteLine("}"); sw.WriteLine(""); if (Icon != null) sw.WriteLine("MAINICON ICON \"" + Icon.Replace("\\", "\\\\") + "\""); if (ManifestFile != null) sw.WriteLine("1 24 \"" + ManifestFile.Replace("\\", "\\\\") + "\""); if (VCLCustomStyles != null) { string[] Styles = VCLCustomStyles.Split(';'); sw.WriteLine("PLATFORMTARGETS RCDATA {{{0}}}", Styles.Length + 1); foreach (string item in Styles) { string[] vals = item.Trim('\"').Split('|'); sw.WriteLine("{0} {1} \"{2}\"", vals[0].Replace(" ", ""), vals[1], vals[2].Replace("\\", "\\\\")); } } else sw.WriteLine("PLATFORMTARGETS RCDATA {1}"); sw.Close(); } } else { Borland.Build.Tasks.Shared.CreateRcFile rc = new Borland.Build.Tasks.Shared.CreateRcFile(); rc.AutoGenVersion = AutoGenVersion; rc.Debug = Debug; rc.Icon = Icon; rc.OutputFile = OutputFile; rc.IncludeVerInfo = IncludeVerInfo; rc.MajorVer = MajorVer; rc.MinorVer = MajorVer; rc.Release = Release; rc.Build = Build; rc.PreRelease = PreRelease; rc.Special = Special; rc.Private = Private; rc.DLL = DLL; rc.Locale = Locale; rc.KeysString = KeysString; rc.ManifestFile = ManifestFile; rc.VCLCustomStyles = VCLCustomStyles; rc.ResourcePlatform = ResourcePlatform; rc.OSXOutputDir = OSXOutputDir; rc.TargetedPlatforms = TargetedPlatforms; rc.ProjectName = ProjectName; rc.Execute(); } } return true; } } }
2011/9/29追記
nullチェックをちゃんとやってなかった為、DLL作成時にエラーが出てvrcファイル作成出来なくなっていたので修正しました。ファイル名 RCCreateTask_20110929.zip でアップし直して有ります。