一歩進んだ Rexx

Classic REXX (REstructured eXtended eXecutor)
File #09

pdbの情報を見れ〜 -- 2001.9.20

ジツは, Palmデバイスと母艦とのアレで, Palmデバイスに導入する「pdbファイル」ってのを, 今まさにアレコレしてるとこなのら。 てな訳で, 緊急企画「pdbの情報を見れ〜」。
そんなこんなで ちょっとした関数を紹介してみよー とゆー訳なのだ。

「pdbファイル」てゆーのは, Palmデバイスに導入するときのファイル形式なんだけど, 導入後の Palmデバイスの中でも ソレに近い形式のままみたいにょ。
で, それらはいくつかの種類があって, σ(^^) が聞いたことあるのは .PDB .PQA .PRC の三種類くらいだお。 .prcはリソースで, プログラム(Palmware)なんかはコレなんだな。

こーゆーファイルは形式が決まっていて, すべてのブツにはヘッダーが付いてるのら。 そして その中に, 実際の名前だとか, 最終更新日だとか, ReadOnlyビットだとかが含まれていたりなんかして。 そう, ディレクトリとしての情報みたいなのは, Palmデバイスではこの中に入っているんだお。

てことで, PDBの情報を見てみるプログラム。 ファイル先頭にある, ヘッダーの 78バイトをコレに渡すと内容を表示するのだ。 つってもこの部分は PRCも共通なのでそれのばやいもオッケーにょ。 もひとつの形式のも多分オッケーだと思うんだけど試したことないもん。

PrintPdbHead: procedure   /* 日時表示での timezoneは無視している */
idx = '0010  0020  0040 0001     0002      0004           0008   8000'
str = 'NEWER RESET ???? RESOURCE READ_ONLY APP-INFO-DIRTY BACKUP OPEN'
parse arg name +32 attr +2 ver +2 ct +4 mt +4 bt +4 mn +4 +8 tp +4 cr +4 .
parse var name name '0'x
res = ''
do i = 1 to words(idx)
   bit = x2c(word(idx, i))
   if bitand(attr, bit) \== '0000'x then res = res word(str, i)
end
say 'name: "'name'"'
say 'flags: 0x'c2x(attr)res
say 'version: 'c2d(ver)
say 'creation_time: 'StrPdbTime(ct)
say 'modified_time: 'StrPdbTime(mt)
say 'backup_time: 'StrPdbTime(bt)
say 'modification_number: 'c2d(mn)
say "type: '"tp"', creator: '"cr"'"
say
return

コレ(↓)は, 日時を文字列に変換するブツ。関数 MakeDate が必要にょ。

StrPdbTime: procedure
   parse arg bin
   n = c2d(bin)
   tm = n //86400
   res = right(tm %3600, 2, 0)
   tm = tm //3600
   res = res':'right(tm %60, 2, 0)':'right(tm //60, 2, 0)
   parse value MakeDate(n %86400 +695055) with y m d
   return y'-'right(m, 2, 0)'-'right(d, 2, 0) res

この中に出てくる, 4バイトのデータを c2d()で数値になおすとこ。 こーゆー 4バイト以上のアレを扱うとき, しかも, 日時情報のよーなぎっしり詰まったブツのばやい, numeric digits 10 の宣言(?) がプログラム先頭に必要だもん。 忘れちゃだめだお。
10で足りなきゃ 20くらいかな。 (←なんだか適当っぽいゾ)


新規に pdbを作る (1) -- 2000.6.3

さて, 白龍シリーズとして幾つかのプログラムを公開して, はや幾歳月。ってそんなに長いことやってないけど。 でも, それなりに長い気がする。 (←どっちだ)

今回, 新規に pdbを生成する時の関数ってのを公開してみよう。コレ, できたてのホヤホヤ。くくくっ。

MakePdbHead: procedure
   parse arg name, tp, cr, attr, ver, ct, mt, bt, mn
   if \datatype(attr, 'W') then attr = 0
   if \datatype(ver, 'W') then ver = 0
   if \datatype(ct, 'W') then ct = NewPdbTime()
   if \datatype(mt, 'W') then mt = ct
   if \datatype(bt, 'W') then bt = mt
   if \datatype(mn, 'W') then mn = 0
   return left(name, 32, '0'x)d2c(attr, 2)d2c(ver, 2),
        ||d2c(ct, 4)d2c(mt, 4)d2c(bt, 4)d2c(mn, 4),
        ||d2c(0,4)d2c(0,4)left(tp, 4)left(cr, 4)d2c(0,4)d2c(0,6)
まずは, pdbヘッダを作り出すもの (↑)。 コレってずいぶん引き数が多いけど, ほとんどデフォルトで構わないみたい。 なんたって, 時刻をセットして Palmデバイスに導入しても, Palmデバイス側で勝手に変更してるみたいだし。

使い方はこう → Info._HEAD = MkPdbHead('MailDB', 'DATA', 'mail') あとは, WritePDB で書き出そうとすっと, app_infoやら レコード数やらの情報がくっつくのだ。

次に, 日時を求めるもの。Palmデバイスの日付ってば, UNIXなんかのと違って 1904年からの秒数になってるのだ。

NewPdbTime: procedure
   parse arg y, m, d, s
   parse value right(date('S'), 8) with yy +4 mm +2 dd
   if \datatype(y, 'W') then y = yy
   if \datatype(m, 'W') then m = mm
   if \datatype(d, 'W') then d = dd
   if \datatype(s, 'W') then s = time('S')
   return (BaseDay(y, m, d) -695055) *86400 +s   /* 695055 == BaseDay(1904,1,1) */
年月日と時刻を秒数で表したものを与えっと, それらしい物を返すよーになっている。
そだ, この値って 10桁くらいになっちゃうので, numeric digits 10 の文が必要。 ま, プログラム先頭にでもアレしておいてくらはい。
4バイトの最大の 0xffffffffを 10進数に直しても 10桁まで(4294967295)なので, (↑)で指定する桁数は, その物ズバリの 10でよいのだ。

今度は, レコードヘッダかな? いや, 全く違うのかも。(^^)


オブジェクトRexx互換っぽい Date関数 -- 2000.1.18

date関数って, 色々と便利なことに, その日の日付をいろんな書式で表すことができる。 だけど, そんだけ。
昨日が何日なのか とか, 10日後は何月何日 とか, 卵焼きは作れるか とか, りんごポリフェノールは含まれているのか とかは分かんない。

てことで, オブジェクト Rexx互換の Date関数を公開してみよう。

Date: procedure
parse arg opt, sdate, fmt
if arg() == 0 then return 'DATE'()
if arg() == 1 then return 'DATE'(opt)
weekdayList = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday '
fmt = translate(left(fmt'N', 1))
select
   when fmt == 'B' then parse value MakeDate(sdate) with y m d
   when fmt == 'E' then parse var sdate d'/'m'/'y
   when fmt == 'N' then parse var sdate d m y
   when fmt == 'O' then parse var sdate y'/'m'/'d
   when fmt == 'S' then parse value right(sdate, 8) with y +4 m +2 d
   when fmt == 'U' then parse var sdate m'/'d'/'y
otherwise
   trace ???R
   fmt = fmt
end
if pos(fmt, 'EOU') > 0 then do
   parse value right(word('DATE'(), 3) -50, 4, 0) with n +2 yy
   y = (n +(y < yy))*100 +y
end
if \datatype(m, 'W') then m = StrMonth(m)
opt = translate(left(opt'N', 1))
select
   when opt == 'B' then res = BaseDay(y, m, d)
   when opt == 'D' then res = BaseDay(y, m, d) -BaseDay(y, 1, 0)
   when opt == 'E' then res = right(d, 2, 0)'/'right(m, 2, 0)'/'right(y, 2, 0)
   when opt == 'L' then res = +d StrMonth(m) y
   when opt == 'M' then res = StrMonth(m)
   when opt == 'N' then res = +d left(StrMonth(m), 3) y
   when opt == 'O' then res = right(y, 2, 0)'/'right(m, 2, 0)'/'right(d, 2, 0)
   when opt == 'S' then res = y''right(m, 2, 0)right(d, 2, 0)
   when opt == 'U' then res = right(m, 2, 0)'/'right(d, 2, 0)'/'right(y, 2, 0)
   when opt == 'W' then res = word(weekdayList, BaseDay(y, m, d) //7 +1)
otherwise
   trace ???R
   opt = opt
end
return res

って, 主要な部分はこんだけだったりする。
そして, (↑)で使われる幾つかのアレが (↓)コレ。そう, 天空の城ラピュタでゆーところの, 城の上の部分と下の部分。 もちろん, (↓)の部分は下の部分だ。コレって説明になってるのか?

StrMonth: procedure expose monthList
monthList = 'January   February  March     April     May       June      ',
          ||'July      August    September October   November  December  '
parse arg month
if datatype(month, 'W')
   then res = word(monthList, month)
   else res = (pos(month, monthList) -1)%10 +1
return res

MakeDate: procedure
   parse arg base
   do y = (base +306 +1) %365.24 by -1 until day <= base
      day = BaseDay(y, 3, 1)
   end
   n = base -day
   m = (n +.5) %30.6
   d = n -format(m*30.6,, 0) +1
   if m > 9 then do; m = m -9; y = y +1; end; else m = m +3;
return y m d

BaseDay: procedure
   parse arg y, m, d
   m = m -2 -1
   if m < 0 then do; m = m +12; y = y -1; end;
return y*365 +y%4 -y%100 +y%400 +format(m*30.6,, 0) +d -307

MakeDate() ってのが, 雑記でもアレしてた, 逆算の関数。
実は, ここだけの話, コレって幾つかのバリエーションがあるのにゃ。 つーのも, ここに至るまでには 永〜い道のりがあって, んで, その間に進化をとげてきたって訳なのだ。 ちなみに, ここでのソレは 『少し遅いけど分かりやすいっぽいかな』バージョン。

さぁ, これで Classic Rexxでも, 日付の計算ができる。レッツ, 日付の計算。 (←なんじゃそら)


日付な感じ -- 2000.1.7

日付のアレといえば, OREXXだったら date() なんかが強化されている。 ソレっちゅーのは, 与えられた各種のフォーマットの日付を読み取って, 別のフォーマットに変換するってヤツだ。 けど, Classic Rexxだとそーはいかない。 ・・ てことで, Classic Rexxで行うソレなのにゃ。
その前に, OREXXでの日付の取扱いを参考にしといてちょ。

日付の比較とか
 today = date('Base')
 if today >= BaseDay(2000, 1, 1) then say '今日は 2000年以降です'
その日は何曜日か

これも簡単。7で割って余りを求めるだけ。うはは。

 dayOfWeek = BaseDay(2000, 2, 11) //7
 say word('Monday Tuesday Wednesday Thursday Friday Saturday Sunday ', dayOfWeek +1)
その月の日数

これもいたって簡単。 13月とかなっても計算上は大丈夫。ちなみに範囲は -9月から 14月まで (^o^)

 pull year month
 d = BaseDay(year, month +1, 1) -BaseDay(year, month, 1)
 say year'年' month'月は' d'日あります。'
その日は, その年の何日目か
 first = BaseDay(2000, 1, 1)-1
 say BaseDay(2000, 3, 20) -first '日目'
その年の何日目は何月か
 pull d
 day = BaseDay(year, 1, 1)-1 +d
 do i = 12 to 1 by -1
    n = BaseDay(year, i, 1)-1
    if day > n then leave
 end
 say i'月' day -n'日'
成人の日, 体育の日は, それぞれ何日か

ま, ソレって, 1月と 10月の第二月曜なんだけど, その日を求めるってヤツだね。

 parse arg year
 if \datatype(year, 'W') then year = word(date(), 3)

 day = BaseDay(year, 1, 1)-1
 say year'年' 1'月' 14 -day //7'日'

 day = BaseDay(year, 10, 1)-1
 say year'年' 10'月' 14 -day //7'日'
UNIXの time_t型への変換

ちと替わって, こちらはサブルーチン。

ToUxTime: procedure expose TZsec
   if arg() > 1 then parse arg y, m, d, sec
   else parse arg y m d sec
   base = 719162   /* BaseDay(1970, 1, 1) */
   if \datatype(TZsec, 'W') then TZsec = GetTZsec()
   return (BaseDay(y, m, d) -base) *24*3600 +sec -TZsec

TZsec はタイムゾーンの部分。こちらは, また別の機会にでも ・・ てへっ (^^)
うじゃ (^o^)/~


インターネットの日付の書式 -- '99.12.29

まぁ, 2000年がどうだからって訳じゃ ・・ あるけど, (^^;
今回, 日付のフォーマットについてのプログラムをアレしてみよう。

その表現が幾つか現れるのが RFC 2068の HTTP/1.1。ちなみに, こんなだ (↓)。

RFC 822では 2桁となってた 「年」が, RFC 1123では, 4桁にすべきだ ってことになっちった。 てことで, メールの日付部分なんかをよくみると, 新しいのはちゃんと 4桁になってるよね。
ちなみに, σ(^^) 作の, 全く進展のない WWWサーバー も, きちんと(?)この書式に乗っ取ってアレしている。

StdFullDate: procedure
weekdayList = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday '
monthList = 'January February March April May June July August',
            'September October November December'
   parse arg y, m, d
   if y < 1000 then y = y +word(1900 2000, (y <= 50) +1)
   base = BaseDay(y, m, d)
   wkday = left(word(weekdayList, base //7 +1), 3)
   month = left(word(monthList, m), 3)
return wkday',' right(d, 2, 0) month right(y, 4, 0)

(↑)コレは, 年月日を与えると, RFC 1123のフォーマットでソレを返すヤツ。ただし, 時刻とタイムゾーンは別。うはは。
だから, 今日の日時っつーばやいは, こう (↓)

now: procedure
parse value right(date('S'), 8) with y +4 m +2 d +2
return StdFullDate(y, m, d) time() 'JST'

で, この StdFullDate では, 「年」を 2桁で与えても, ソレなりの 4桁の年に変換してくれるし, 100とかって指定してもだいじょぶ, ってゆー すぐれもん。 どだ? (^o^)


PDB ファイルの組み立て方 -- '99.12.23

クリスマス・フライング企画ぅー。 (←?)
さて, Palmデバイス関係のアレ としては, 第二段てことになるけど, 今度は分解した .pdbを組み立てるヤツ。 今回のも, .prcの形式に対応してるんで, フォントファイルなんかの組み立ても大丈ぶいっ。(^o^)v

使い方は, 分解と全く同じで Rc = WritePDB('MemoDBnew.pdb', 'Info. Rec.') ってな感じ。
あ, もちろん, それぞれの項目には正しい値をセットしておかないと, 無茶苦茶な内容になるんで注意してくらはい。

プログラムの中身のについてのことだけんど, 全部連結して一挙に書き出すってのもアリかなって思ったけど, 件数が多くなってくっと, 何だかやたら遅くなるんで, 各箇所でちまちま書き出すようにしてる訳なのだ。
それから, 内部で Compound Symbols (複合記号) 使ってるのは, やっぱしこれも高速化を目指してのこと。 だから主記憶大目に消費するかもしんない。うへへ。
複合記号ってのは, 配列みたいなヤツのこと。念のため。

WritePDB: parse arg , WritePDB; return WritePDBCore(arg(1));
WritePDBCore: procedure expose (WritePDB)
parse var WritePDB PdbInfo PdbRec .
parse arg fname
cnt = value(PdbRec'0')
Head = overlay(d2c(cnt, 2), value(PdbInfo'_HEAD'), 77)
Head = overlay(d2c(0, 8), Head, 53)
flgs = x2b(c2x(substr(Head, 33, 2)))
n = word(8 10, substr(flgs, 16, 1) +1)
p = length(Head) +cnt*n +2
recs = ''
if symbol(PdbInfo'_APP')  \== 'LIT' & value(PdbInfo'_APP')  \== '' then do
   recs = value(PdbInfo'_APP')
   Head = overlay(d2c(p, 4), Head, 53)
   p = p +length(recs)
end
if symbol(PdbInfo'_SORT') \== 'LIT' & value(PdbInfo'_SORT') \== '' then do
   recs = recs''value(PdbInfo'_SORT')
   Head = overlay(d2c(p, 4), Head, 53 +4)
   p = p +length(value(PdbInfo'_SORT'))
end
call charout fname, Head, 1
if substr(flgs, 16, 1)
   then do i = 1 to cnt
      n = PdbRec''i'._HEAD'
      if symbol(n) \== 'LIT' then hd = value(n)
      else hd = d2c(0, 6)
      call charout fname, left(hd, 6)d2c(p, 4)
      _rec.i = value(PdbRec''i)
      p = p +length(_rec.i)
   end
   else do i = 1 to cnt
      n = PdbRec''i'._HEAD'
      if symbol(n) \== 'LIT' then hd = value(n)
      else hd = d2c(0, 4)
      call charout fname, d2c(p, 4)left(hd, 4)
      _rec.i = value(PdbRec''i)
      p = p +length(_rec.i)
   end
call charout fname, '00 00'x||recs
do i = 1 to cnt
   call charout fname, _rec.i
end
call stream fname, 'c', 'close'
return ''

ところで, なじぇに今まで白龍シリーズに, (↑)コレが現れなかったのか。 ・・ そりは, この度よーやく完成したから。 (←だからフライング?)

っつーことで, これで白龍シリーズも, も少し扱いやすくなるかもしれない。(^o^)/


PDB アクセス -- '99.11.1

えとー, 今回 Palmデバイス関係のを扱ってみたいにょー。
これは, Pilot-Link で取り込んだ *.pdb を, いろいろアレするものなにょだ。

まず第一回目は, コレ (↓) ・・・ pdb を読み込んで分解するもの。 こりは, 白龍シリーズ として出している最新方式のヤツ。うはは。

ReadPDB: parse arg , ReadPDB; return ReadPDBCore(arg(1));
ReadPDBCore: procedure expose True False (ReadPDB)
parse var ReadPDB PdbInfo PdbRec .
parse arg fname
call stream fname, 'c', 'open read'
val = charin(fname,, chars(fname))
call stream fname, 'c', 'close'
if val == '' then return False
Head = left(val, 78)
cnt = c2d(right(Head, 2))
call value PdbInfo'_HEAD', Head
call value PdbRec'0', cnt
p = length(Head)
flgs = x2b(c2x(substr(Head, 33, 2)))
if substr(flgs, 16, 1)
   then do i = 1 to cnt
      parse var val +(p) hd +6 pr.i +4
      call value PdbRec''i'._HEAD', hd
      p = p +10
   end
   else do i = 1 to cnt
      parse var val +(p) pr.i +4 hd +4
      call value PdbRec''i'._HEAD', hd
      p = p +8
   end
p = length(val) +1
do i = cnt to 1 by -1
   n = c2d(pr.i) +1
   call value PdbRec''i, substr(val, n, p -n)
   p = n
end
v = substr(Head, 57, 4)   /* -- sort field */
if v \== '00000000'x then do
   n = c2d(v) +1
   call value PdbInfo'_SORT', substr(val, n, p -n)
   p = n
end
v = substr(Head, 53, 4)   /* -- app field */
if v \== '00000000'x then do
   n = c2d(v) +1
   call value PdbInfo'_APP', substr(val, n, p -n)
   p = n
end
return True

Rc = ReadPDB('MemoDB.pdb', 'Info. Rec.') とか指定すると, 各レコードが Rec.1 〜 に入るわーけ。 もちろん, Rec.0 がその件数。

んで, 全体的な情報ってのが, (↑)この場合, こーゆーふーにセットされるのさっっ。

ヘッダーInfo._HEAD
カテゴリーInfo._APP
ソート情報Info._SORT

もう一つの大きな機能。実はコレ, *.prc も読み込む事ができるのじゃ。
J-OS のフォントとかって *.prc になってリソースとして入ってんだけっちょ, コレで簡単にあれこれできるってもんにゃのだ。 ・・いや, その後に分解も待ってるから, コレだけで済む訳じゃないだけどもね。(^^;

構造の解説はココを見てけろ


Copyright (C) 1998-2004 Rexx使いの織華
email: ori@drive.co.jp