「このプログラムは正しくインストールされなかった可能性があります」を回避する方法

Windows 7 + Delphi XE2で開発していますが、以下のメッセージを抑制する方法をメモしておきます。アプリケーションにインストールと思しきキーワードが入っていると、OS側でアンインストールの手順をきちんと登録したか確認してくるのが、以下のダイアログです。

で、いろいろ調べてみてうまくいった方法を書きます。 $(BDS)\bin にあるdefault_app.manifestを探しだして、compatibilityセクションを書き加えてビルドします。下がmanifestのファイル、この15-20行目が追加したセクションです。 manifestにWindows7互換という条件を加えることで、UAC互換性アシスタントを回避しています。

view plainprint?

1. <!--xml version="1.0" encoding="UTF-8" standalone="yes"?-->  
2. <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestversion="1.0">  
3.   <dependency>  
4.     <dependentassembly>  
5.       <assemblyidentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publickeytoken="6595b64144ccf1df" language="*" processorarchitecture="*">  
6.     </assemblyidentity></dependentassembly>  
7.   </dependency>  
8.   <trustinfo xmlns="urn:schemas-microsoft-com:asm.v3">  
9.     <security>  
10.       <requestedprivileges>  
11.         <requestedexecutionlevel level="asInvoker" uiaccess="false">  
12.         </requestedexecutionlevel></requestedprivileges>  
13.     </security>  
14.   </trustinfo>  
15.   <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">  
16.     <application>  
17.       <!--Windows 7-->  
18.       <supportedos id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}">  
19.     </supportedos></application>  
20.   </compatibility>  
21. </assembly>  

NOTE: 要約化中にディスク処理が発生しました。

時間が出来たときに、ツールで以下のメッセージを捕捉するように修正する。

• Processing on disk occurred during summarization. Peak disk usage was approximately nnn Mbytes. Adjusting SUMSIZE may improve performance. 
• NOTE: 要約化中にディスク処理が発生しました。 ディスクの最大使用はおよそ 2454 M バイトです。 SUMSIZE の調整によって、パフォーマンスを改善できるかもしれません。

Calls a specific routine or module that resides in an external dynamic link library (DLL).

SASからWindowsのAPIを呼び出す方法を整理しています。
その理由を列挙しますと

• SASのバージョンアップの作業で、Xステートメントが規制されている
• SASデータセットをCOPYプロシージャで移行するとタイムスタンプが維持できない
• タイムスタンプが変わると元ファイルが更新されたときに再転送が必要かわからない
• DOS窓からの実行だと遅い

VBScriptから制御する手もありますが、古いデータセットから順に移行したり、停止の制御を考えるとSAS1本でやるのが良さそうです。

基本はDLLを呼び出すためのI/Fを"The SASCBTBL Attribute Table"で定義して、MODULE関数で呼び出します。この仕組みが繊細で、定義を間違えるとSAS.EXEが落ちます。WinAPIの型を調べて、変数を割り当てるのは面倒な作業です。

SASからCopyFileAを呼び出して、ファイルをコピー

SASからWindowsのAPIをコールするサンプルコードです。バージョンアップによるデータの引越しで、今回はWinAPIを使ったツールを作る予定です。動作確認したのは、Windows7+SAS9.2です。

ネットにはいくつか見本が転がっていますが、PDFで文字が化けていたり、APIがまったく変わってしまったようなものもあります。素直に動くものが少ないので、いくつかの手本を元に作成しました。APIの定義をテキストで別に用意している例が多いのですが、カタログを使った例がまとまりが良いです。

view plainprint?

1. /*  
2. *++  
3. * WinAPI(CopyFileA)を呼び出して、ファイルをコピー  
4. *--  
5. */  
6.   
7. filename winapi catalog 'WORK.Windows.WINAPI.SOURCE';  
8.   
9. data _null_;  
10.  file winapi;  
11.  input;  
12.  put _infile_;  
13.  cards4;  
14. routine CopyFileA  
15.  module=KERNEL32  
16.  minarg=3 maxarg=3 stackpop=called  
17.  returns=ushort  
18. ;  
19. arg 1 input char format=$cstr200.; * FROM ;  
20. arg 2 input char format=$cstr200.; * TO ;  
21. arg 3 input num format=pib4. byvalue;  
22. * 1=Do Not Overwrite Existing ;  
23. * 0=Overwrite Existing File ;  
24. ;;;;  
25. run;  
26.   
27. filename winapi;  
28. filename sascbtbl catalog 'WORK.Windows.WINAPI.SOURCE';  
29.   
30. data _null_;  
31.  rc = modulen('*e', 'CopyFileA', 'c:\temp\foo.txt', 'c:\temp\foo_copy.txt', 0);  
32.  put _all_;  
33. run;  
34.   
35. filename sascbtbl clear;  

/*
*++
* WinAPI(CopyFileA)を呼び出して、ファイルをコピー
*--
*/

filename winapi catalog 'WORK.Windows.WINAPI.SOURCE';

data _null_;
 file winapi;
 input;
 put _infile_;
 cards4;
routine CopyFileA
 module=KERNEL32
 minarg=3 maxarg=3 stackpop=called
 returns=ushort
;
arg 1 input char format=$cstr200.; * FROM ;
arg 2 input char format=$cstr200.; * TO ;
arg 3 input num format=pib4. byvalue;
* 1=Do Not Overwrite Existing ;
* 0=Overwrite Existing File ;
;;;;
run;

filename winapi;
filename sascbtbl catalog 'WORK.Windows.WINAPI.SOURCE';

data _null_;
 rc = modulen('*e', 'CopyFileA', 'c:\temp\foo.txt', 'c:\temp\foo_copy.txt', 0);
 put _all_;
run;

filename sascbtbl clear;

SASからSetFileTimeを呼び出して、ファイルのタイムスタンプを設定

コードに間違いがあったので修正しました。
SASからWindowsのAPIをコールするサンプルコードです。バージョンアップによるデータの引越しで、今回はWinAPIを使ったツールを作る予定です。動作確認したのは、Windows7+SAS9.2です。ネットにはいくつか見本が転がっていますが、PDFでうまく転記できなかったり、APIがまったく変わってしまったようなものもありました。

view plainprint?

1. /*  
2. *++  
3. * WinAPI(SetFileTime)を呼び出して、ファイルのタイプスタンプを更新  
4. *--  
5. */  
6. filename winapi catalog 'WORK.Windows.WINAPI.SOURCE';  
7.   
8. data _null_;  
9.   file winapi;  
10.   input;  
11.   put _infile_;  
12.   cards4;  
13. routine CreateFileA  
14.    module=Kernel32  
15.    minarg=7  
16.    maxarg=7  
17.    stackpop=called  
18.    returns=long  
19. ;  
20. arg 1 char input format=$cstr260.; *  LPCTSTR lpFileName;  
21. arg 2 num  input format=pib4. byvalue;  * DWORD dwDesiredAccess;  
22. arg 3 num  input format=pib4. byvalue;  * DWORD dwShareMode;  
23. arg 4 num  input format=pib4. byvalue;  * LPSECURITY_ATTRIBUTES lpSecurityAttributes (set to null,pass 0 byvalue);  
24. arg 5 num  input format=pib4. byvalue;  * DWORD dwCreationDispostion;  
25. arg 6 num  input format=pib4. byvalue;  * DWORD dwFlagsAndAttributes (set to zero);  
26. arg 7 num  input format=pib4. byvalue;  * HANDLE hTemplateFile (ignored);  
27. *-------------------------------------------------------------;  
28.   
29.   
30. routine CloseHandle  
31.    module=Kernel32  
32.    minarg=1  
33.    maxarg=1  
34.    stackpop=called  
35.    returns=long  
36. ;  
37. arg 1 num  input format=pib4. byvalue;  * HANDLE hObject;  
38.   
39. *-------------------------------------------------------------;  
40.   
41. routine SystemTimeToFileTime  
42.  minarg=9   
43.  maxarg=9   
44.  stackpop=called   
45.  module=Kernel32   
46.  returns=long  
47. ;   
48. arg 1 num input  fdstart format=pib2.; * WORD wYear ;   
49. arg 2 num input          format=pib2.; * WORD wMonth ;   
50. arg 3 num input          format=pib2.; * WORD wDayOfWeek ;   
51. arg 4 num input          format=pib2.; * WORD wDay ;   
52. arg 5 num input          format=pib2.; * WORD wHour ;   
53. arg 6 num input          format=pib2.; * WORD wMinute ;   
54. arg 7 num input          format=pib2.; * WORD wSecond ;   
55. arg 8 num input          format=pib2.; * WORD wMilliseconds ;   
56. arg 9 num output fdstart format=pib8.;  
57.   
58. *-------------------------------------------------------------;  
59.   
60. routine LocalFileTimeToFileTime   
61.  minarg=2   
62.  maxarg=2   
63.  stackpop=called   
64.  module=kernel32   
65.  returns=long  
66. ;   
67. arg 1 input  fdstart num format=pib8.; * lpLocalFileTime // converted file time;   
68. arg 2 output fdstart num format=pib8.; * lpFileTime, // UTC file time to convert;   
69.   
70. *-------------------------------------------------------------;  
71.   
72. routine SetFileTime   
73.   minarg=4   
74.   maxarg=4   
75.   stackpop=called   
76.   module=Kernel32   
77.   returns=long  
78. ;   
79. arg 1 num input byvalue format=pib4.; * HANDLE hFindFile // file search handle ;   
80. arg 2 num input fdstart format=pib8.; * CONST FILETIME * lpCreationTime, // pointer to creation file time ;   
81. arg 3 num input fdstart format=pib8.; * CONST FILETIME * lpModifiedTime, // pointer to creation file time ;   
82. arg 4 num input fdstart format=pib8.; * CONST FILETIME * lpAccessedTime, // pointer to creation file time ;   
83. ;;;;  
84. run;  
85.   
86. filename winapi;  
87. filename sascbtbl catalog 'WORK.Windows.WINAPI.SOURCE';  
88.   
89. %macro touch(path=, year=);  
90.  data _null_ ;   
91.   
92.   GENERIC_READ = 080000100x; /* GENRIC_READ + FILE_WRITE_ATTRIBUTES(0x0100) */  
93.   FILE_SHARE_READ = 1;  
94.   OPEN_EXISTING = 3;  
95.   
96.   
97.   length path $260;   
98.   path = "&path";  
99.   HANDLE = modulen('CreateFileA', path, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, 0,0);  
100.   
101.   If HANDLE >= 1 Then Do;   
102.   
103.    cdt_n = datetime();  
104.    MINUTE = Minute( cdt_n);   
105.    HOUR = Hour( cdt_n);   
106.    DAY = DAY( DatePart( cdt_n) );   
107.    DAYOFWK = WeekDay( DatePart( cdt_n) );   
108.    MONTH = MONTH( DatePart( cdt_n) );   
109.    YEAR = &year;  
110.    SECONDS = 0;  
111.    MSECONDS = 0;  
112.    CREATED = .;  
113.    CREATED1 = .;  
114.   
115.    rc = ModuleN('SystemTimeToFileTime', YEAR, MONTH, DAYOFWK,  DAY, HOUR, MINUTE, SECONDS, MSECONDS, CREATED);   
116.    rc = ModuleN('LocalFileTimeToFileTime', CREATED, CREATED1);  
117.    put rc= created= created1=;  
118.   
119.    ACCESSE1 = CREATED1;  
120.    WRITTEN1 = CREATED1;  
121.   
122.    rc = ModuleN('SetFileTime', HANDLE, CREATED1, ACCESSE1, WRITTEN1);  
123.    put rc=;  
124.    rc = Modulen('CloseHandle', HANDLE);   
125.    put rc=;  
126.   end;   
127.  run;   
128. %mend;  
129.   
130. %touch(path=c:\temp\foo.txt, year=2009);  
131.   
132. filename sascbtbl clear;  

/*
*++
* WinAPI(SetFileTime)を呼び出して、ファイルのタイプスタンプを更新
*--
*/
filename winapi catalog 'WORK.Windows.WINAPI.SOURCE';

data _null_;
  file winapi;
  input;
  put _infile_;
  cards4;
routine CreateFileA
   module=Kernel32
   minarg=7
   maxarg=7
   stackpop=called
   returns=long
;
arg 1 char input format=$cstr260.; *  LPCTSTR lpFileName;
arg 2 num  input format=pib4. byvalue;  * DWORD dwDesiredAccess;
arg 3 num  input format=pib4. byvalue;  * DWORD dwShareMode;
arg 4 num  input format=pib4. byvalue;  * LPSECURITY_ATTRIBUTES lpSecurityAttributes (set to null,pass 0 byvalue);
arg 5 num  input format=pib4. byvalue;  * DWORD dwCreationDispostion;
arg 6 num  input format=pib4. byvalue;  * DWORD dwFlagsAndAttributes (set to zero);
arg 7 num  input format=pib4. byvalue;  * HANDLE hTemplateFile (ignored);
*-------------------------------------------------------------;


routine CloseHandle
   module=Kernel32
   minarg=1
   maxarg=1
   stackpop=called
   returns=long
;
arg 1 num  input format=pib4. byvalue;  * HANDLE hObject;

*-------------------------------------------------------------;

routine SystemTimeToFileTime
 minarg=9 
 maxarg=9 
 stackpop=called 
 module=Kernel32 
 returns=long
; 
arg 1 num input  fdstart format=pib2.; * WORD wYear ; 
arg 2 num input          format=pib2.; * WORD wMonth ; 
arg 3 num input          format=pib2.; * WORD wDayOfWeek ; 
arg 4 num input          format=pib2.; * WORD wDay ; 
arg 5 num input          format=pib2.; * WORD wHour ; 
arg 6 num input          format=pib2.; * WORD wMinute ; 
arg 7 num input          format=pib2.; * WORD wSecond ; 
arg 8 num input          format=pib2.; * WORD wMilliseconds ; 
arg 9 num output fdstart format=pib8.;

*-------------------------------------------------------------;

routine LocalFileTimeToFileTime 
 minarg=2 
 maxarg=2 
 stackpop=called 
 module=kernel32 
 returns=long
; 
arg 1 input  fdstart num format=pib8.; * lpLocalFileTime // converted file time; 
arg 2 output fdstart num format=pib8.; * lpFileTime, // UTC file time to convert; 

*-------------------------------------------------------------;

routine SetFileTime 
  minarg=4 
  maxarg=4 
  stackpop=called 
  module=Kernel32 
  returns=long
; 
arg 1 num input byvalue format=pib4.; * HANDLE hFindFile // file search handle ; 
arg 2 num input fdstart format=pib8.; * CONST FILETIME * lpCreationTime, // pointer to creation file time ; 
arg 3 num input fdstart format=pib8.; * CONST FILETIME * lpModifiedTime, // pointer to creation file time ; 
arg 4 num input fdstart format=pib8.; * CONST FILETIME * lpAccessedTime, // pointer to creation file time ; 
;;;;
run;

filename winapi;
filename sascbtbl catalog 'WORK.Windows.WINAPI.SOURCE';

%macro touch(path=, year=);
 data _null_ ; 

  GENERIC_READ = 080000100x; /* GENRIC_READ + FILE_WRITE_ATTRIBUTES(0x0100) */
  FILE_SHARE_READ = 1;
  OPEN_EXISTING = 3;


  length path $260; 
  path = "&path";
  HANDLE = modulen('CreateFileA', path, GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, 0,0);

  If HANDLE >= 1 Then Do; 

   cdt_n = datetime();
   MINUTE = Minute( cdt_n); 
   HOUR = Hour( cdt_n); 
   DAY = DAY( DatePart( cdt_n) ); 
   DAYOFWK = WeekDay( DatePart( cdt_n) ); 
   MONTH = MONTH( DatePart( cdt_n) ); 
   YEAR = &year;
   SECONDS = 0;
   MSECONDS = 0;
   CREATED = .;
   CREATED1 = .;

   rc = ModuleN('SystemTimeToFileTime', YEAR, MONTH, DAYOFWK,  DAY, HOUR, MINUTE, SECONDS, MSECONDS, CREATED); 
   rc = ModuleN('LocalFileTimeToFileTime', CREATED, CREATED1);
   put rc= created= created1=;

   ACCESSE1 = CREATED1;
   WRITTEN1 = CREATED1;

   rc = ModuleN('SetFileTime', HANDLE, CREATED1, ACCESSE1, WRITTEN1);
   put rc=;
   rc = Modulen('CloseHandle', HANDLE); 
   put rc=;
  end; 
 run; 
%mend;

%touch(path=c:\temp\foo.txt, year=2009);

filename sascbtbl clear;

Delphi for Lex(6)

メモです。

集合型の演算でマッチングの文字列を計算していることがわかり、Unicodeの多彩な文字をどうやって吸収するか検討しています。アイディアとしては、

• パターンを保持する集合型を文字列に変える
• パターンを保持する集合型を正規表現に変える
• 今のCClassを拡張して日本語の文字を識別する部分を作る

Unicodeの文字を判定する、IsControlやIsNumberを試してみたが、"１"も"1"同じ数値として判定されてしまう。if ByteType(S, i) <> mbSingleByte という条件判定で使うが、SをAnsiStringに型変換する必要がある。

Lex for Delphi(5)

忙しいなかやる気を持続させるために、まめにBlogに書き込んでします。いま一度、字句解析のコードを修正前後で比較します。文字の集合型で表している部分を、文字列に直します。元のプログラムはASCIIで#0...#255の範囲を想定しています。Unicode対応するときに、集合型から文字列に置き換えるだけでよいのか、検証していきます。

109行目の部分は、NOT(数字、英字、空白、改行（CR)）の文字を表しています。状態（STATE）0から3に遷移する文字セットを表していますが、255以上あるUnicodeの文字を表すためにはどうしたら良いのか？これNUL文字の判定が無いけど良いのか？

正規表現で「以下の文字を含まない」とか「改行以外の文字」を表すときに、Unicodeだとうまく集合型に収まらないのでなんらか工夫が必要だと認識しました。

Lex for Delphi(4)

考えを整理するために、修正すべきコードwriteccを貼り付けます。

view plainprint?

1. function charStr(c: char): string;  
2. begin  
3.   case c of  
4.     #0..#31,     (* nonprintable characters *)  
5.     #127..#255: Result := '#' + intStr(Ord(c));  
6.     '''': Result := '''''''''';  
7.     else  Result := '''' + c + '''';  
8.   end;  
9. end(*charStr*);  
10.   
11. procedure writecc(var f: Text; cc: CClass);  
12. (* print the given character class *)  
13. const  
14.   MaxChar = #255;  
15. var  
16.   c1, c2: char;  
17.   col:    integer;  
18.   tag:    string;  
19.   Quit:   boolean;  
20. begin  
21.   Write(f, '[ ');  
22.   col  := 0;  
23.   c1   := chr(0);  
24.   Quit := False;  
25.   while not Quit do  
26.   begin  
27.     if c1 in cc then  
28.     begin  
29.       if col > 0 then  
30.       begin  
31.         Write(f, ',');  
32.         Inc(col);  
33.       end;  
34.       if col > 40 then  
35.         { insert line break }  
36.       begin  
37.         writeln(f);  
38.         Write(f, ' ': 12);  
39.         col := 0;  
40.       end;  
41.       c2 := c1;  
42.       while (c2 < MaxChar) and (succ(c2) in cc) do  
43.         c2 := succ(c2);  
44.       if c1 = c2 then  
45.         tag := charStr(c1)  
46.       else if c2 = succ(c1) then  
47.         tag := charStr(c1) + ',' + charStr(c2)  
48.       else  
49.         tag := charStr(c1) + '..' + charStr(c2);  
50.       Write(f, tag);  
51.       col := col + length(tag);  
52.       c1  := c2;  
53.     end;  
54.     Quit := c1 = MaxChar;  
55.     if not Quit then  
56.       c1 := Succ(c1);  
57.   end; { of while }  
58.   Write(f, ' ]');  
59. end(*writecc*);  

  function charStr(c: char): string;
  begin
    case c of
      #0..#31,     (* nonprintable characters *)
      #127..#255: Result := '#' + intStr(Ord(c));
      '''': Result := '''''''''';
      else  Result := '''' + c + '''';
    end;
  end(*charStr*);

  procedure writecc(var f: Text; cc: CClass);
  (* print the given character class *)
  const
    MaxChar = #255;
  var
    c1, c2: char;
    col:    integer;
    tag:    string;
    Quit:   boolean;
  begin
    Write(f, '[ ');
    col  := 0;
    c1   := chr(0);
    Quit := False;
    while not Quit do
    begin
      if c1 in cc then
      begin
        if col > 0 then
        begin
          Write(f, ',');
          Inc(col);
        end;
        if col > 40 then
          { insert line break }
        begin
          writeln(f);
          Write(f, ' ': 12);
          col := 0;
        end;
        c2 := c1;
        while (c2 < MaxChar) and (succ(c2) in cc) do
          c2 := succ(c2);
        if c1 = c2 then
          tag := charStr(c1)
        else if c2 = succ(c1) then
          tag := charStr(c1) + ',' + charStr(c2)
        else
          tag := charStr(c1) + '..' + charStr(c2);
        Write(f, tag);
        col := col + length(tag);
        c1  := c2;
      end;
      Quit := c1 = MaxChar;
      if not Quit then
        c1 := Succ(c1);
    end; { of while }
    Write(f, ' ]');
  end(*writecc*);

引数ccで渡された集合型の文字を、印字可能なものならばそのまま出力、印字できない文字ならば数値化しています。 文字の範囲を0から255のコードを前提とした実装です。ASCIIで連続したコード値であれば、'A'...'Z'の形式で出力します。

実装でわかっていないのは、字句定義で"\t"としたときに、引数ccにはどのようなコード値で表されるかです。集合型から文字列に変えるのですが、ASCIIのコード値(#9)は、そのままUnicodeのコード値と同じで良いのか？BOMとか、非表示の文字を読み込んだらどうなるのか？さっぱりわかっていません。週末にでも、テストコードを書いて検証します。

Lex for Delphi(3)

連休の合間を使って字句解析のプログラム(dlex.exe)を調べています。
文字を保持する型が集合型(CClass)なので、Unicodeの文字を格納することができません。ここは、安直にString型に置き換えてみます。問題なのが、以下の部分です。

• 集合型の演算（和集合、差集合、積集合）
• 定数の連続値（1...128)

集合型であれば要素の順番に気を配る必要はありません。しかし、文字列に置き換えると、重複を除く必要があります。また、集合型であれば、#1...#128と短く書けますが、文字列で扱うとなると記述が長くなり、文字列定数の長さ制限に引っかかります。

騙しだましにプログラムを直して字句解析のパーサ(dlex.exe)をビルドして、サンプルの字句解析プログラムを生成してみました。しかし、サンプルとして出力されたコードと比較すると、微妙に差が出ています。惜しい！

文字列の重複を排除するためにTStringListを使っていますが、英字の大文字/小文字を無視しているように見えます。CaseSensitiveのプロパティをTrueにして、まだコード生成、比較をします。これで差異を生じている部分は残り2箇所になりました。

さらに、Unicodeの字句定義が通るか検証します。exprlex,lを修正して、指数表現の[eE]の部分をひらがなの”あ”に置き換えます。

dlex.exeで字句定義からコードを生成します。

字句定義を修正する前後で、コードと比較します。 右側の集合型の定数部部分にひらがな”あ”の文字がありません。うまくすれば、"あ"の文字が入るかと思いましたが、いずれにしろ集合型だと日本語の判定は正しく判定されないので、これで当面はOKです。

残りの作業を整理します。

• コード生成でcc:の集合型の部分を出力している箇所を突き止める。
• サンプルの出力コードと一致するように調整する。
• 出力されるコードを集合型から文字列に直す。
• 文字コードの判定で#128...#255までの指定が意味あるか調べる。

続きはまた来週

Lex for Delphi(2)

字句解析のプログラム生成を検討し始めたばかりで、考えを整理します。生成されたコードを改変して動きを検証した後は、コードを生成するツールの直し方を考えます。生成されたコードと同じく課題は集合型で実装されたコードです。字句の情報を保持するlexbase.pasの中で、修正すべき部分を示します。

view plainprint?

1. type  
2.   (* String and character class pointers: *)  
3.   StrPtr    = PString;  
4.   CClass    = set of char;  
5.   CClassPtr = ^CClass;  

type
  (* String and character class pointers: *)
  StrPtr    = PString;
  CClass    = set of char;
  CClassPtr = ^CClass;

この集合型を使うと重複無く文字を足し引き出来るのが利点です。dlex.exeの実装を調べると、集合型を使った演算がいくつかあります。

• 和集合(+)
• 差集合(-)
• 積集合(*)

しかしながら、Unicodeの文字を保持できない。型CClassをString型に変えて、参照、操作の仕方を片っ端から変えればいけるのか試してみます。

Lex for Delphi(1)

ぼちぼち、Delphiで使える字句解析のコードが必要になってきました。ツールを使っていくうちに、処理の遅さが気になってきました。原因パターンマッチの遅さです。このパターンをコンパイルして速度を稼ぐために、字句解析のプログラムが必要になってきたのです。

調べてみると、Unicode未対応のプログラム(dyacclex-1.4)を見つけました。これを自分で直せないか思案しています。 いきなりLexのコードを修正するまえに、出力された字句解析のコードをどのように変えたら、Unicode対応できるか考えます

。課題は集合型で実装している部分です。集合型で文字のパターンを保持すると、Unicodeの文字列はcharに切り捨てられてしまいます。Lexが生成しコードのうち、判定の文字列を保持するレコード型を示します。

view plainprint?

1. type YYTRec = record  
2.                 cc : set of char;  
3.                 s  : Integer;  
4.               end;  

type YYTRec = record
                cc : set of char;
                s  : Integer;
              end;

ccの型を集合型から文字列に変え、ccを参照するときの方法を変えてあげればUnicode対応のコードになりそうだ。

view plainprint?

1. type YYTRec = record  
2.                 cc : String;  
3.                 s  : Integer;  
4.               end;  

type YYTRec = record
                cc : String;
                s  : Integer;
              end;

検証するためにサンプルプログラムを改変しました。サンプルプログラム(expr.exe)は数値を入力して、小数点の形式で数値を表示するプログラムです。指数表現1.25E+3のEの文字を無理くり、”あ”に変えます。つまり、1.25あ+3と入力します。"あ"には特別な意味はありません。ただ生成された字句解析のコードで、指数表現の部分が簡単に特定できたからです。

試してみると、字句解析はすんなり通りました。字句が切り出せて、コード値が帰ればOKです。実装がうまい具合に１つのモジュールに閉じていて、型と判定の修正だけでうまくいきます。

次なる課題は、字句解析のコードを生成するプログラムの方です。これも集合型を使っているため、Unicodeの文字はbyte charに縮小されてしまいます。

データセットのI/Oを補足するコード（私家版#2）

これ自分用のコードです。

view plainprint?

1. function libname(dsn)  
2. {  
3.         i = index(dsn, ".");  
4.         if (i > 0) {  
5.                 tmp = substr(dsn, 1, i - 1);  
6.         }  
7.         else {  
8.                 tmp = "WORK";  
9.         }  
10.         return toupper(tmp);  
11. }  
12.   
13. function memname(dsn)  
14. {  
15.         i = index(dsn, ".");  
16.         if (i > 0) {  
17.                 tmp = substr(dsn, i + 1, length(dsn));  
18.         }  
19.         else {  
20.                 tmp = dsn;  
21.         }  
22.         return toupper(tmp);  
23. }  
24.   
25. function ilog(path, dsn)  
26. {  
27.         printf("R,%s,%s,%d,%s,%d\n", path, dsn, FNR, FILENAME, NR);  
28.         return 1;  
29. }  
30.   
31. function olog(path, dsn)  
32. {  
33.         printf("W,%s,%s,%d,%s,%d\n", path, dsn, FNR, FILENAME, NR);  
34.         return 1;  
35. }  
36.   
37. /NOTE: ライブラリ参照名/ && /を次のように割り当てました。/ {  
38.         libref = $3;  
39.         getline;  
40.         while ($1 != "物理名") {  
41.                 getline;  
42.         }  
43.         lib[libref] = $3;  
44.   
45. }  
46.   
47. $1 ~ /NOTE:/ && $2 ~ /データセット/ && $NF ~ /オブザベーションを読み込みました。/ {  
48.         dsn = $3;  
49.         libref = libname(dsn);  
50.         mem = memname(dsn);  
51.   
52.         if (libref != "WORK" && libref != "SASHELP") {  
53.                 dir = lib[libref];  
54.                 if (dir != "") {  
55.                         tmp = sprintf("%s/%s.sas7bdat", dir, tolower(mem));  
56.                         status = ilog(tmp, dsn);  
57.                 }  
58.                 else {  
59.                         printf("ERROR %s\n", dsn);  
60.                         exit;  
61.                 }  
62.         }  
63. }  
64.   
65. $1 ~ /NOTE:/ && $2 ~ /データセット/ && $NF ~ /変数です。/ {  
66.         dsn = $3;  
67.         libref = libname(dsn);  
68.         mem = memname(dsn);  
69.   
70.         if (libref != "WORK" && libref != "SASHELP") {  
71.                 dir = lib[libref];  
72.                 if (dir != "") {  
73.                         tmp = sprintf("%s/%s.sas7bdat", dir, tolower(mem));  
74.                         status = olog(tmp, dsn);  
75.                 }  
76.                 else {  
77.                         printf("ERROR %s\n", dsn);  
78.                         exit;  
79.                 }  
80.         }  
81. }  
82.   
83. $1 ~ /MPRINT\([A-Z0-9_]+\):/ && $2 ~ /^set$/ {  
84.         match($3, /([a-zA-Z0-9_]+\.)?[a-zA-Z0-9_]+/);  
85.         if (RLENGTH > 0) {  
86.                 dsn = substr($3, RSTART, RLENGTH);  
87.                 libref = libname(dsn);  
88.                 mem = memname(dsn);  
89.                 if (libref != "WORK" && libref != "SASHELP") {  
90.                         dir = lib[libref];  
91.                         if (dir != "") {  
92.                                 tmp = sprintf("%s/%s.sas7bdat", dir, tolower(mem));  
93.                                 status = ilog(tmp, dsn);  
94.                         }  
95.                         else {  
96.                                 printf("ERROR %s\n", dsn);  
97.                                 exit;  
98.                         }  
99.                 }  
100.         }  
101. }  
102.   
103. END {  
104.         print "_EOF_";  
105. }  

function libname(dsn)
{
        i = index(dsn, ".");
        if (i > 0) {
                tmp = substr(dsn, 1, i - 1);
        }
        else {
                tmp = "WORK";
        }
        return toupper(tmp);
}

function memname(dsn)
{
        i = index(dsn, ".");
        if (i > 0) {
                tmp = substr(dsn, i + 1, length(dsn));
        }
        else {
                tmp = dsn;
        }
        return toupper(tmp);
}

function ilog(path, dsn)
{
        printf("R,%s,%s,%d,%s,%d\n", path, dsn, FNR, FILENAME, NR);
        return 1;
}

function olog(path, dsn)
{
        printf("W,%s,%s,%d,%s,%d\n", path, dsn, FNR, FILENAME, NR);
        return 1;
}

/NOTE: ライブラリ参照名/ && /を次のように割り当てました。/ {
        libref = $3;
        getline;
        while ($1 != "物理名") {
                getline;
        }
        lib[libref] = $3;

}

$1 ~ /NOTE:/ && $2 ~ /データセット/ && $NF ~ /オブザベーションを読み込みました。/ {
        dsn = $3;
        libref = libname(dsn);
        mem = memname(dsn);

        if (libref != "WORK" && libref != "SASHELP") {
                dir = lib[libref];
                if (dir != "") {
                        tmp = sprintf("%s/%s.sas7bdat", dir, tolower(mem));
                        status = ilog(tmp, dsn);
                }
                else {
                        printf("ERROR %s\n", dsn);
                        exit;
                }
        }
}

$1 ~ /NOTE:/ && $2 ~ /データセット/ && $NF ~ /変数です。/ {
        dsn = $3;
        libref = libname(dsn);
        mem = memname(dsn);

        if (libref != "WORK" && libref != "SASHELP") {
                dir = lib[libref];
                if (dir != "") {
                        tmp = sprintf("%s/%s.sas7bdat", dir, tolower(mem));
                        status = olog(tmp, dsn);
                }
                else {
                        printf("ERROR %s\n", dsn);
                        exit;
                }
        }
}

$1 ~ /MPRINT\([A-Z0-9_]+\):/ && $2 ~ /^set$/ {
        match($3, /([a-zA-Z0-9_]+\.)?[a-zA-Z0-9_]+/);
        if (RLENGTH > 0) {
                dsn = substr($3, RSTART, RLENGTH);
                libref = libname(dsn);
                mem = memname(dsn);
                if (libref != "WORK" && libref != "SASHELP") {
                        dir = lib[libref];
                        if (dir != "") {
                                tmp = sprintf("%s/%s.sas7bdat", dir, tolower(mem));
                                status = ilog(tmp, dsn);
                        }
                        else {
                                printf("ERROR %s\n", dsn);
                                exit;
                        }
                }
        }
}

END {
        print "_EOF_";
}

SASデータセットのI/Oを捕捉するコード（私家版）

SASログからI/Oを追いかける私家版のSASプログラム。入力のCSVファイルはAWKで作成しています。お客様先で大量のSASログから、入力と出力を特定するためのものです。入力ファイルで1件もデータを読まないで、僅かにMPRINTのログにしか手掛かりがないものが厄介です。
その他に、SASHELP.VTABLEを通してファイルの存在チェックをしているものなど、SASログには現れない入力があります。

view plainprint?

1. /*  
2. *++  
3. * import io log-file  
4. *--  
5. */  
6.   
7. data iods;  
8.  infile "c:\temp\iods.csv" dsd firstobs=2;  
9.  attrib RW length=$1;  
10.  attrib FILENAME length=$64;  
11.  attrib DSN length=$32;  
12.  attrib FNR length=8;  
13.  attrib LOG length=$61;  
14.  attrib NR length=8;  
15.  input rw filename dsn fnr log nr;  
16. run;  
17.   
18. /*  
19. *++  
20. * input data-set  
21. *--  
22. */  
23.   
24. proc sort data=iods out=ids;  
25.  by filename nr rw;  
26. run;  
27.   
28. data ids;  
29.  set ids;  
30.  by filename nr rw;  
31.  if first.filename and rw eq 'R' then output;  
32. run;  
33.   
34. proc sort data=ids;  
35.  by nr;  
36. run;  
37.   
38.   
39. /*  
40. *++  
41. * output data-set  
42. *--  
43. */  
44.   
45. proc sort data=iods out=ods;  
46.  where rw eq 'W';  
47.  by filename nr;  
48. run;  
49.   
50. data ods;  
51.  set ods;  
52.  by filename nr;  
53.  if last.filename then output;  
54. run;  
55.   
56. proc sort data=ods;  
57.  by nr;  
58. run;  
59.   
60. /*  
61. *++  
62. * make compare procedure statement  
63. *--  
64. */  
65.   
66. data _null_;  
67.  set ods;  
68.  attrib comment length=$256;  
69.  attrib libstat length=$256;  
70.  attrib titstat length=$256;  
71.  attrib comproc length=$256;  
72.  attrib mem length=$32;  
73.   
74.  basedir = "/sumdata/bk02";  
75.   
76.  comment = "/* dsn=" || compress(upcase(dsn)) || " logfile=" || compress(log) || " line=" || compress(put(fnr, best.)) || " */";  
77.  put comment;  
78.   
79.  i = 1;  
80.  imax = length(filename);  
81.  pos = 0;  
82.   
83.  do i=1 to imax;  
84.   if substr(filename, i, 1) eq '/' then pos = i;  
85.  end;  
86.   
87.  put "options nocenter;";  
88.  libstat = "libname tmp1 '" || compress(basedir) || substr(filename, 1, pos-1) || "' access=readonly;";  
89.  put libstat;  
90.   
91.  libstat = "libname tmp2 '" || substr(filename, 1, pos-1) || "' access=readonly;";  
92.  put libstat;  
93.   
94.  titstat = "title 'dsn=" || compress(upcase(dsn)) || " log=" || compress(log) || "';";  
95.  put titstat;   
96.   
97.  mem = substr(dsn, index(dsn, ".")+1);  
98.  comproc = "proc compare base=tmp1." || compress(mem) || " compare=tmp2." || compress(mem) || " maxprint=5;";  
99.  put comproc;  
100.  put "run;";  
101.  put "title;";  
102.  put ;  
103.   
104. run;  

/*
*++
* import io log-file
*--
*/

data iods;
 infile "c:\temp\iods.csv" dsd firstobs=2;
 attrib RW length=$1;
 attrib FILENAME length=$64;
 attrib DSN length=$32;
 attrib FNR length=8;
 attrib LOG length=$61;
 attrib NR length=8;
 input rw filename dsn fnr log nr;
run;

/*
*++
* input data-set
*--
*/

proc sort data=iods out=ids;
 by filename nr rw;
run;

data ids;
 set ids;
 by filename nr rw;
 if first.filename and rw eq 'R' then output;
run;

proc sort data=ids;
 by nr;
run;


/*
*++
* output data-set
*--
*/

proc sort data=iods out=ods;
 where rw eq 'W';
 by filename nr;
run;

data ods;
 set ods;
 by filename nr;
 if last.filename then output;
run;

proc sort data=ods;
 by nr;
run;

/*
*++
* make compare procedure statement
*--
*/

data _null_;
 set ods;
 attrib comment length=$256;
 attrib libstat length=$256;
 attrib titstat length=$256;
 attrib comproc length=$256;
 attrib mem length=$32;

 basedir = "/sumdata/bk02";

 comment = "/* dsn=" || compress(upcase(dsn)) || " logfile=" || compress(log) || " line=" || compress(put(fnr, best.)) || " */";
 put comment;

 i = 1;
 imax = length(filename);
 pos = 0;

 do i=1 to imax;
  if substr(filename, i, 1) eq '/' then pos = i;
 end;

 put "options nocenter;";
 libstat = "libname tmp1 '" || compress(basedir) || substr(filename, 1, pos-1) || "' access=readonly;";
 put libstat;

 libstat = "libname tmp2 '" || substr(filename, 1, pos-1) || "' access=readonly;";
 put libstat;

 titstat = "title 'dsn=" || compress(upcase(dsn)) || " log=" || compress(log) || "';";
 put titstat; 

 mem = substr(dsn, index(dsn, ".")+1);
 comproc = "proc compare base=tmp1." || compress(mem) || " compare=tmp2." || compress(mem) || " maxprint=5;";
 put comproc;
 put "run;";
 put "title;";
 put ;

run;

TExcelApplicationでExcelの書式設定を行う

Officeを2007から2013にアップグレードしたため、いくつかのアプリケーションを点検しています。そんな中で、TExcelApplicationを使ったサンプルを見つけ、Office2013で動くか試してみました。問題なく動いています。

元ネタは、Delphi-Fanの「Excelの書式設定を行う」を利用させていただきました。Excel絡みのアプリケーションを組むことがあるので、大変勉強になるコードです。ブログにコメントが残せないので、ここでお礼申し上げます。

自宅PCをSSD化

連休は、自宅PCのハードディスクをSSDに換装しました。今のところ特段問題もなく、快適に動いています。入れ替えたのは、インテル Boxed SSD 335 Series 240GB MLC 2.5inch 9.5mm Jay Crest Reseller BOX SSDSC2CT240A4K5です。換装の手順は

1. 筐体を開けて、SSDをセカンダリのディスクとして接続
2. 起動してクローンのディスク作成のプログラムをインスト＆実行
3. 再起動してHDDからSSDへコピーされるのを待つ
4. シャットダウンされたらセカンダリをプライマリのディスクとして入れ替え

換装前後で、ディスクのI/O性能を測って比較してみました。使ったのはCrystalDiskMarkです。なんだか、萌え絵がついたスペシャルバージョンをインストールしてしまいました。値をExcel2013でまとめて、グラフにしています。

HDDとSSDの比較

換装前

SSD換装後

年齢の計算

YRDIFを年齢の計算に使っていましたが、不具合があることに気がつきました。結局、古典的なコードを引っ張り出して計算しています。

view plainprint?

1. data _null_;  
2.         format start end yymmdds10.;  
3.   
4.         start = '01mar1992'd;  
5.         end = '01mar1999'd;  
6.   
7.         /* BUG */  
8.         dif = yrdif(start,end,'ACT/ACT');  
9.         put _all_;  
10.   
11.         dif = intck('YEAR', start, end);  
12.   
13.         /* 今年の誕生日がまだ来ていない場合は、数え年から1を引きます */  
14.         if (month(end) < month(start)) then  
15.                 dif = dif - 1;  
16.         else if (month(end) = month(start)) and day(end) < day(start) then  
17.                 dif = dif - 1;  
18.   
19.         put _all_;  
20. run;  

data _null_;
        format start end yymmdds10.;

        start = '01mar1992'd;
        end = '01mar1999'd;

        /* BUG */
        dif = yrdif(start,end,'ACT/ACT');
        put _all_;

        dif = intck('YEAR', start, end);

        /* 今年の誕生日がまだ来ていない場合は、数え年から1を引きます */
        if (month(end) < month(start)) then
                dif = dif - 1;
        else if (month(end) = month(start)) and day(end) < day(start) then
                dif = dif - 1;

        put _all_;
run;

Peek at your data using VBScript, OLE DB, and the SAS local data provider

SAS Local Data Providerを使って、SASデータセットの情報を読み取るサンプルコードです。元ネタはココですが、貼り付けるときにバックスラッシュが化けたのかそのままでは動きませんでした。少し手直ししています。SAS.EXEを起動しなくてもOKというのが軽くて良いのですが、果たして何に使うかは思案中です。Delphiで作るツールに役立つかも。

view plainprint?

1. path = "C:\Program Files\SASHome\x86\SASEnterpriseGuide\4.3\Sample\Data"  
2. filename = "Candy_Sales_Summary"  
3.   
4. WScript.Echo "Path specified: " & path  
5. WScript.Echo "File name : " & filename  
6.   
7. ' Check registry for SAS Local Provider  
8. Set WSHShell = CreateObject("WScript.Shell")  
9. clsID = WSHShell.RegRead("HKEY_CLASSES_ROOT\sas.LocalProvider\CLSID\")  
10. 'clsID = WSHShell.RegRead("HKCRSAS.LocalProviderCLSID")  
11. WScript.Echo "DIAGNOSTICS: SAS.LocalProvider CLSID is " & clsID  
12. inProcServer = WSHShell.RegRead("HKCR\CLSID\" & clsID & "\InprocServer32\")  
13. WScript.Echo "DIAGNOSTICS: Registered InprocServer32 DLL is " & inProcServer  
14.   
15. ' Constants for ADO calls  
16. Const adOpenDynamic = 2  
17. Const adLockOptimistic = 3  
18. Const adCmdTableDirect = 512  
19.   
20. ' Instantiate the provider object  
21. Set obConnection = CreateObject("ADODB.Connection")  
22. Set obRecordset = CreateObject("ADODB.Recordset")  
23.   
24. obConnection.Provider = "SAS.LocalProvider"  
25. obConnection.Properties("Data Source") = path  
26. obConnection.Open  
27. obRecordset.Open filename, obConnection, adOpenDynamic, adLockOptimistic, adCmdTableDirect  
28.   
29. 'Report on Fields in this data set  
30. WScript.Echo ""  
31. WScript.Echo "Opened data " & filename & ", Record count: " & obRecordset.RecordCount  
32. For Each Field In obRecordset.Fields  
33. If Field.Type = 5 Then pType = "Numeric"  
34. If Field.Type = 200 Then pType = "Character"  
35. WScript.Echo Field.Name & " " & pType  
36. Next  
37.   
38. obRecordset.Close  
39. obConnection.Close  

path = "C:\Program Files\SASHome\x86\SASEnterpriseGuide\4.3\Sample\Data"
filename = "Candy_Sales_Summary"

WScript.Echo "Path specified: " & path
WScript.Echo "File name : " & filename

' Check registry for SAS Local Provider
Set WSHShell = CreateObject("WScript.Shell")
clsID = WSHShell.RegRead("HKEY_CLASSES_ROOT\sas.LocalProvider\CLSID\")
'clsID = WSHShell.RegRead("HKCRSAS.LocalProviderCLSID")
WScript.Echo "DIAGNOSTICS: SAS.LocalProvider CLSID is " & clsID
inProcServer = WSHShell.RegRead("HKCR\CLSID\" & clsID & "\InprocServer32\")
WScript.Echo "DIAGNOSTICS: Registered InprocServer32 DLL is " & inProcServer

' Constants for ADO calls
Const adOpenDynamic = 2
Const adLockOptimistic = 3
Const adCmdTableDirect = 512

' Instantiate the provider object
Set obConnection = CreateObject("ADODB.Connection")
Set obRecordset = CreateObject("ADODB.Recordset")

obConnection.Provider = "SAS.LocalProvider"
obConnection.Properties("Data Source") = path
obConnection.Open
obRecordset.Open filename, obConnection, adOpenDynamic, adLockOptimistic, adCmdTableDirect

'Report on Fields in this data set
WScript.Echo ""
WScript.Echo "Opened data " & filename & ", Record count: " & obRecordset.RecordCount
For Each Field In obRecordset.Fields
If Field.Type = 5 Then pType = "Numeric"
If Field.Type = 200 Then pType = "Character"
WScript.Echo Field.Name & " " & pType
Next

obRecordset.Close
obConnection.Close

SAS Log Inspector Version 1.2.0.0 リリース

3連休の間に機能追加しました。マッチングのパターンを画面上から追加、修正して、INIファイルに上書き保存することができるようにしました。INIファイルの書式の問合せが来ても面倒と考えての機能追加です。

この1.2.0.0は、IDEの環境を英語版にスイッチして、ビルドしています。Exportしたときのダイアログは何故か、日本語のままです。それと、ビルドの番号が自動的に上がらない現象がでています。

英語版のサイトに載せて公開することを検討しています。

SAS Log Inspectorの機能

• 複数のログファイルからエラー、バグに繋がるNOTEを集計
• 日本語と英語版のメッセージに対応
• Excelファイルにログをチェックした結果をエクスポート
• 任意のチェック項目を検査対象から外すことができる
• Notepadを起動して、該当のログファイルを参照できる
• マッチングパターンを画面から追加、修正できるように機能を追加

Delphi XE2でIDEが起動しない問題

開発環境のメモ書きです。

Delphi 2009からXE2に切り替えたときに、IDEが起動しない問題に出くわしました。タスクマネージャでbds.exeを見ると、プロセスはありますが、入出力のカウンタは止まったままです。その他のI/Oだけが、ときおりカウントアップしていました。

テクニカルサポートに確認が取れたわけではないので私の推測ですが、McAfee Host Intrusion Preventionのチェックに引っ掛かっていたようです。McAfeeのActivity Logにブロックの記録が残っていました。

そこで、bds.exeをIPS Policy, Firewall Policy, Application Policyに登録したら、IDEが起動しました。それでも、起動まで1分以上時間がかかることもあり、なんいがなんだかよく分からないまま、やり過ごしています。

追記: 2013/01/14
McAfeeのポリシーが変わったのか、またIDEが起動できなくなりました。結果としてIPS Policyにbds.exeを登録して問題は解決しました。