ジツは, Palmデバイスと母艦とのアレで, Palmデバイスに導入する「pdbファイル」ってのを, 今まさにアレコレしてるとこなのら。
てな訳で, 緊急企画「pdbの情報を見れ〜」。
そんなこんなで ちょっとした関数を紹介してみよー とゆー訳なのだ。
「pdbファイル」てゆーのは, Palmデバイスに導入するときのファイル形式なんだけど, 導入後の Palmデバイスの中でも ソレに近い形式のままみたいにょ。
で, それらはいくつかの種類があって, σ(^^) が聞いたことあるのは ．ＰＤＢ ．ＰＱＡ ．ＰＲＣ の三種類くらいだお。
.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を生成する時の関数ってのを公開してみよう。コレ, できたてのホヤホヤ。くくくっ。
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) */
年月日と時刻を秒数で表したものを与えっと, それらしい物を返すよーになっている。numeric digits 10 の文が必要。 ま, プログラム先頭にでもアレしておいてくらはい。今度は, レコードヘッダかな？ いや, 全く違うのかも。(^^)
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でも, 日付の計算ができる。レッツ, 日付の計算。 (←なんじゃそら)
日付のアレといえば, 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'日'
ちと替わって, こちらはサブルーチン。
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^)/~
まぁ, 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^)
クリスマス・フライング企画ぅー。 (←？)
さて, 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^)/
えとー, 今回 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 になってリソースとして入ってんだけっちょ, コレで簡単にあれこれできるってもんにゃのだ。
・・いや, その後に分解も待ってるから, コレだけで済む訳じゃないだけどもね。(^^;