一歩進んだ Rexx

INIファイルの中の巨大なもの -- 2004-03-18

OS/2で保持している情報に, INIファイルってのがある。ソレは, アプリケーションが OSに「保持しといてネ」って感じで要求したものだとか, あるいは OS/2自身が「電源OFFしても情報が失われない」よーに, 退避させた情報だとかさまざま。

そんな INIファイルだけど, @A.Y.DAYOさんとこでは書き込みトラブルが発生したっぽいだよ。肥大したソレは問題ありって感じなのカモ。
で, 巨大な INIファイルと聞いてまず思い浮かべるのは, System INIファイルの WPSに関する情報－－ Handles。現在使用中のものと, そうでないものと, 合わせて二つ分。コレって大きいんだよね。

そんな訳で, 今回, そこに記録されているファイル名の一覧を表示するプログラムを作ってみよう。イェ～ィ。 (←ぉぃ)

/* Handleで参照できるファイル名一覧 */
call RxFuncAdd 'SysLoadFuncs', 'rexxutil', 'SysLoadFuncs'
call SysLoadFuncs

hlist = LkInit()
do i = 1 to length(hlist) by 2
   say lkFileName(substr(hlist, i, 2))
end
exit


LkFileName: procedure expose driv. node. (ESlist)
   parse arg hObj
   if hObj == '0000'x then if symbol('node.hObj') == 'LIT' then return ''
   if length(hObj) \= 2 then hObj = left(hObj, 2, '00'x)
   if symbol('node.hObj') == 'LIT' then return /*''*/ 'LIT' c2x(hObj)
   res = ''
   fDir = c2d(substr(node.hObj, 25, 1))
   do while hObj \= '0000'x
      res = substr(node.hObj, 29)'\'res
      hObj = substr(node.hObj, 5, 2)
   end
return left(res, length(res) -\fDir)

LkInit: procedure expose driv. node. (ESlist)
Inif = 'System'
Appl = SysIni(Inif, 'PM_Workplace:ActiveHandles', 'HandlesAppName')
if Appl == 'ERROR:' then Appl = 'PM_Workplace:Handles0' /* とりあえず */
hObj = ''
do i = 1
   Blk = SysIni(Inif, Appl, 'BLOCK'i)
   if Blk == 'ERROR:' then leave
   hObj = hObj''Blk
end
hlist = ''
p = 5
do while p <= length(hObj)
   s = substr(hObj, p, 4)
   select
      when s == 'DRIV' then do
         parse var hObj =(p) +4 driv +16 drivname '0'x
         n = 0
         driv.n = driv''drivname
         p = p +20 +length(drivname) +1
      end
      when s == 'NODE' then do
         parse var hObj =(p) +4 node +28 -2 ln +1 +1 nodename '0'x
         n = substr(node, 3, 2); if symbol('node.n') \= 'LIT' then say nodename;
         node.n = node''nodename
         p = p +32 +c2d(ln) +1

         if substr(node, 25, 1) == '0'x then
            hlist = hlist ||n
      end
   otherwise say 'Error String='s
   end
end
return hlist

出力されるのは, WPSとして Handleを割り付けられたファイル名。の一覧(リスト)。だから, ファイルシステム上にある実際のものとは異なることもあるかも。
そのリストに項目が現れるのには, たとえば Desktop上で, ファイルアイコンを表示していろいろアレしたときとか, そんなとこ。てことでつまり, この Handle構造を巨大化させないためには, WPS上でフォルダーを開いたりっつーのをなるべく抑えることカナ。一度開いてしまったらもうダメだけど。あはは。

んで, コレって単に出力しただけって感じだから, ソートも何もアレしてなかったりする。 … って, 見りゃ分かるんだけど。

カンマ編集 -- 2003.1.25

いままで公開しててそーで, 公開していなかったもの, そう, ソレはカンマ編集。
数字に, 3桁ずつのとこで ,を付けるってゆー, ただそれだけのことなんだけど, でも先頭から 3桁ずつ取り出しちゃったらダメだし, だからって後ろから取ってくるにはいったん反転させといて, だとか, 考えだすと面倒なのら。

comma: procedure
  n = right(arg(1), 10, ',')
  str = translate('1,234,567,890', n, 1234567890)
  return strip(str, 'L', ',')

てことで, 最初に数字を右寄せしといて, ソレに合わせて ,を付けるって感じにしただよ。
右寄せのとこの余白(？), それから returnのとこの先行文字除去, そーゆーとこに ,を指定してるんだけど, コレは不要な文字がアレしないよーにってことにょ。別の文字を入れてみると, どーゆーアレなのか分かるはずだお。

んで, コレは 10桁までの数字にしか対応していないんだけど, 普通は 9桁までだから大丈夫だよね。もしもそれ以上の桁数が必要だってのなら, 1から0までの数字の並びを, アルファベットに置き換えるとオッケー。って, 桁数指定の 10 も変えなきゃだね。

ふと気付いたんだけど, 考えてみると一行でアレすることできるよね, コレ。しかもソレだと, 一時変数も必要ないし, だから procedure の指定も必要なかったりして。・・・その一行はソレなりに長くはなるけどね。

comma: return strip(translate('1,234,567,890', right(arg(1), 10, ','), 1234567890), 'L', ',')

mod_rexx -- 2002.11.4

developerWorks に Rexxのことが載ってただよ。それも, Apacheと組み合わせて Webページをいろいろアレできるってゆーブツにょ。 → 「REXXで乗りこなすApache」
フッフッフ。コレで, Java Servletみたくいろんなことができるってもんよ。

で, ソレはソレとして, RSP(=REXX Server Page) っつーのもそこで紹介されているのら。コレはどんなアレなのかっつーと, 葉山さん作の RLP - ReXX Local Pages のよーなもの。つまり HTMLファイルに Rexx Scriptを組み込んで, 動的なページが作れるっつーものなのら。

ジツは σ(^^) もそーゆーのを持っていて, 一部はそんな感じで変換してアップしてるだよ。でもなんつーか, 機能を付け足し付け足ししてったから, エレガントじゃないってゆーか, みっともないっつーか・・・そんなんで新しい何かを作るか持ってくるかしよっかなーなんて思ってたところだったのら。

さて, Mod_Rexx Project からソレを downloadしてみるっつーと, rspcomp.rexてゆーその処理がみつかるんだけど, そこでいきなし問題にぶち当たってしまうアルヨ。そう, そもそもコレって Object REXXか Regina Rexxが前提みたいだってことにょ。
えー, そんなんアリ？ Classic Rexxだっていーじゃん・・・って叫ぶとこだったけど, よく見たら rspcomp.rexのコード, 少し直せば Classic Rexxでも動くっぽいだよ。
まず動かせるよーに copy rspcomp.rex *.cmdを実行してから修正だお。

retc = stream(rexfilename, 'c', 'open write replace')
        ↓
retc = stream(rexfilename, 'c', 'open write')
call charout rexfilename, '', 1

Classic Rexxには「上書き」がないんだよね。つーか, あるにはあるけど「消してから書き込み」がないとゆーべきかなのかな。だから, 以前書き込んだ内容が今回書き込む内容よりも長かったら, ゴミが残るんだよね。ま, でもいっか。動くはずだし。 (← ぉぃ)
ちなみに Palmの Rexxでは, こんな風に最初の位置から書き込むよーにすると内容をちゃんと消してくれるのら。かしこいじゃん＞ PalmのRexx

んで, RSPコンパイラーの rspcomp, その実行方法は rspcomp Hello.rsp Hello.cmd みたいな感じなのら。するってーと Hello.cmdが作られるので, あとはソレを実行するだけ。実行するときに出力先を変更して Hello >Hello.html な感じにすると目的のページができるって寸法さ。なんだか手順が大変っぽいね。エヘ。
それから WWWSendHTTPHeader.cmd てゆーコメントだけのファイルを用意しておいたほうがよいかも。生成された *.cmdからコレを呼び出すよーになってるんだけど, ヘッダーの指定だから何もしなくてもよい訳なのら。

そーゆー訳で, 計算処理を埋め込んだよーなページ, これからは簡単に作れるね。 (←あんまし簡単じゃないじゃん)

数値文字参照を元に戻す -- 2002.10.12, 10.16

漢字, つーか全角文字を, Numeric character references (数値文字参照) にアレするのは前回紹介したんだけど一度変換しちゃったら, どんな文字が並んでいたか分からないよね。ま, ブラウザーで確認すりゃよいんだけど, ソレだってちょっち手間かも知れない。

そーゆー訳で, その参照をもとの漢字に戻す関数にょ。 10進表現でも 16進表現でも大丈ぶいっ。

FromNumCharRef: procedure
parse arg str
dec = xrange(0, 9)
hex = xrange('A', 'F')xrange('a', 'f')dec
res = ''
p = 1
do forever
   n = pos('&#', str, p)
   if n == 0 then leave
   len = n -p; n = n +2;
   if translate(substr(str, n, 1)) == 'X' then do
      ptr = verify(str';', hex,, n +1)
      val = substr(str, n, ptr -n)
      if ptr -n == 4 +1 then   /* 4桁のもの (16bit) */
         val = x2d(substr(val, 2))
   end
   else do
      ptr = verify(str';', dec,, n)
      val = substr(str, n, ptr -n)
   end

   if datatype(val, 'W') then
      ch = UniXlat(reverse(d2c(val, 2)),, 'UNICODE')
   else ch = '&#'val';'

   res = res ||substr(str, p, len) ||ch
   if substr(str, ptr, 1) == ';' then ptr = ptr +1
   p = ptr
end
return res ||substr(str, p)

あははははー。また時間がなくなったんで, 解説は次回に。(^^)/~

◇

てことで解説。
まずは "&#" の文字列を探して, そのつぎに "X"があるかどーかで 10進数/16進数を判断してるにょ。
んで, 数字として判断できないよーな文字が現われるとこまで取り出してるだよ。たとえば ";"があったりしたらそこまでってこと。
もしも取り出した数字が変ってばーいは, 元に戻すよーになっているので多少変なアレでも大丈夫なはずだお。

さ, コレで EPMマクロを組むもよし, Webページを公開するのにファイルサイズを大きくするもよし, (← ぉぃ)
いろいろ便利に使えるかもだお。(^^)

HTMLの文字参照を扱ってみる -- 2002.10.7, 10.9

Webページをアレしよーってとき HTMLと格闘したりすんだけど, 中にはやっかいなのもあったりするよね。 Mozillaのま〜りんちゃん問題もそのひとつ。そのまま打ち込んでもまともに表示してくんない, そんな文字がいくつかあったりするにょ。
そんなときの解決策, ソレは 〜 みたいな文字参照を使うってことだお。くわしくはらぶりぃ掲示板に流れた情報みてけろ。って, そこの何番なのか分かんないんだけどね。えっへっへー。

でも HTMLならまだよい方で, XMLだともっと大変なこともあるだよ。てゆーのも UTF-8か UTF-16が標準になっていて, ブラウザーによっては Shift_JISがサポートされていないこともあるかもなのら。(T-T)
つまりソレの応用の XHTML とか SVG にも関係があって, Unicodeで書き込まなきゃなんないかもってことにょ。ぐはー, あんな変なコードなんてヤダー・・・などとゆっても今のとこ仕方がない。(T-T)

XMLにもジツは文字参照があって, ってゆーか SGMLでそゆこと決まってるらしいけど, ま, ソレは置いといて, この「文字参照」に着目してみよーと思うにょ。
先ほどの番号 12316てゆーのは HTML 4.01のとこにある Character references (文字参照), その Numeric character references (数値文字参照) のとこに書いてあるのら。和訳ページを探して読んでみるっつーと, 文書を Shift_JISで書いてあっても EUC-JPであっても, ほかどんなアレであっても, ソレとは関係なく Unicodeでアレするってことだお。

てことで, (Rexxで)全角文字を Unicodeに変換, 文字参照にしてしまうんだけど, ソレ使うばーい RexxUni てのがあるみたいだお。んじゃ早速使ってみよー。

/* 全角文字を文字参照に変換してみる */

Call RxFuncAdd 'UniLoadFuncs', 'RexxUni', 'UniLoadFuncs'
Call UniLoadFuncs

txt = 'コレは漢字を含む stringでげす。'
res = ToNumCharRef(txt)
say str'=('res')'

exit

ToNumCharRef: procedure   /* arg(3)に 'd'とか指定すると10進形式で返すとか */
if arg(2, 'E') then return ToNumCharRefCh(arg(1), arg(2), arg(3))
parse arg str
res = ''
p = 1
len = length(str)
do while p <= len
   do n = p to len while DBValidate(substr(str, n, 1)); end; /* ←(1) */
   if n -p > 0 then
      res = res ||substr(str, p, n -p)                       /* ←(2) */

   do n = n by 2 while \DBValidate(substr(str, n, 1))        /* ←(3) */
      ch = UniXlat(substr(str, n, 2), 'UNICODE')
      res = res ||'&#x'c2x(reverse(ch))';'
   end
   p = n
end
return res

なんだか解説してるアレじゃなくなったので, 続きは次回ってことにするにょ。(^o^)/~ (←ぉぃ)

◇

・・・解説。
ジツは前回のソースとちょっち違うんだけど, 分かるかな。って分かんないよね。(^^)
前回のは 10進数の数値文字参照だったんだけど, ソレを 16進数でアレするよーに修正したのら。 W3Cでのソレ見てみると, 16進数が望ましいっぽく書いてあったからだお。

んで, この関数が行っていること・・・ソレはもちろん Unicodeにして '&#xHHHH;' みたいな文字列に加工しているだけなんだども, 分かりにくそーだから番号ふっただよ。 (1)の処理は, DBCSが始まる直前を探しているとこ。 (2)の処理はソレを戻り値の変数 resに付け加えているとこ。で, (3)の処理は, 半角文字が始まるまで 2バイトずつ取り出し変換しているとこ。

この RexxUni外部関数パッケージは, 上位バイトと下位バイトを反転させないとちゃんとアレできないってとこがちょっち問題かも。つっても実害ないけどね。 (← だったらゆーな)

効果音をためしてみよー -- 2002.9.26

MMPM/2とかゆっても, コマンドラインからでも使うことのできる機能, その waveaudioってのを前回紹介したんだけっちょ, でもオンラインマニュアル見ないとなんだか分かんないよね。
オンラインマニュアルどこかのフォルダーに落としちゃった, とか, そんなときでも今回のソレを見れば大丈夫にょ。わっはっはー。

open waveaudio alias w shareable wait
load w sound.wav wait
set w time format ms wait
setpositionadvise w on every 500 wait
play
seek w to 0 wait
play
close w wait

その解説によると digital audio 再生はこんな感じ(↑)みたいだお。でも早まってはいけない。コマンドラインでコレ叩いても「実行可能なプログラム名／バッチ・ファイルのいずれでもありません」・・とか文句言われるだけだもん。そう, コレは mciRxSendString に与える文字列なのら。

/* MMPM/2 (Multimedia REXX support) *//*
   解説＆サンプルは view mcirexx で調べるとよいかも
*/

mmb = initMMRexx()

DevID = mciRxGetDeviceID('wave')
say 'DevID =' DevID

call SysFileTree mmb'sounds/*.wav', 'file', 'fo'
do cnt = 1 to file.0
   say file.cnt
   call mciRxSendString 'load wave "'file.cnt'" wait', 'RetStr', 0, 0
   call mciRxSendString 'set wave time format ms', 'RetStr', 0, 0
   call mciRxSendString 'play wave', 'RetStr', 0, 0
   call charout , '...'
   if SysGetKey() == '1b'x then leave
end

call exitMMRexx mmb
exit

initMMRexx: procedure
   mmb = value('MMBASE',, 'OS2ENVIRONMENT')
   if mmb == '' then return ''

   parse var mmb res';'
   if DBRight(res, 1) \== '\' then res = res'\'
   if stream(res'dll/MCIAPI*', 'c', 'query exists') == '' then
      return ''

   call RxFuncAdd 'mciRxInit','MCIAPI','mciRxInit'
   call mciRxInit

   Rc = mciRxSendString('open waveaudio alias wave shareable wait', 'RetStr', 0, 0)
   if Rc \== 0 then do
      MacRC = mciRxGetErrorString(Rc, 'ErrStVar')
      say 'Rc =' Rc ', ErrStVar =' ErrStVar
   end
   return res

exitMMRexx: procedure
   parse arg mmb
   if mmb \== '' then do
      call mciRxSendString 'close wave wait', 'RetStr', 0, 0
      call mciRxExit
   end
   return

MMPM/2の中の soundsディレクトリに入ってるブツを鳴らしてみるサンプルにょ。さらにその下のディレクトリにも wavファイルは入ってんだけど, そっちは見てないアルヨ。

さ, コレでコマンドラインゲーム作るのにも恐いもんなしって感じだお。てことで, 誰かゲーム作ってけろ。 (← ぉぃ)

効果音の鳴らし方 (と, しらべ方) -- 2002.9.23

コマンドライン版のゲーム「snake」がもう少しでできそーなんだけど, あとは飾りつけって段階で止まってるだよ。わはは。ホントは動きを見るてーどで, 完成させるつもりもなかったんだけっちょ, ここまできたらもちっとアレしてみよーかなって感じだお。

んで, ソレで使っている効果音は, MMPM/2 の Multimedia REXX supportってのでアレしてるだよ。解説＆サンプルはオンラインヘルプのが充実していて分かりやすいかも。 view mcirexx で見ることできるにょ。

でも MMPM/2導入していなかったらソレって使えないよね。で, 導入していないからっつってプログラムが動かなくなるよーじゃアレだし。てなことで, 導入されているか／使えるよーになっているのか・・・ソレを調べる方法をアレしてみるにょ。

signal on syntax name NoMCIAPI
  call RxFuncAdd 'mciRxInit','MCIAPI','mciRxInit'
  call mciRxInit

if 1 then           fMCIAPI = 1
     else NoMCIAPI: fMCIAPI = 0

signal off syntax

say fMCIAPI

コレは call mciRxInit を実行してみて実行できないよーなら使えない, つまり外部関数パッケージが見つからないってことなのら。でもちょっちトリッキーかも。(^^)

それから, もうひとつの方法は正統派って感じアルヨ。

mmb = value('MMBASE',, 'OS2ENVIRONMENT')
if mmb == '' then return ''

parse var mmb res';'
if DBRight(res, 1) \== '\' then res = res'\'
if stream(res'dll/MCIAPI.*', 'c', 'query exists') == '' then
   return ''

call RxFuncAdd 'mciRxInit','MCIAPI','mciRxInit'
call mciRxInit

コレは環境変数を調べて, 外部関数パッケージのアレ, DLLを探してみよってことなのら。この方法は σ(^^) がアレしたんじゃなくて, Meteor っつープログラムで使われている方法だお。作者は Jeff Byrdさん。

◇

オンラインマニュアルにもある通り, 音を出すときにはまず "load wave ファイル名" みたいな文字列を送り付けることでソレを読み込んで, んで "play wave" の文字列を送り付けて再生するってことなのら。けど毎回コレだと, そのたびにファイルアクセスするっぽいにょ。雰囲気的に。(^^)
つーことで, 前回と同じ音を出すばーい, "seek" 使って巻き戻す。ソレがリサイクルってものなのかも。

キー入力 -- 2002.9.12

VREXXとゆーのが OS/2にはあるんだけど (J_Pocketに), 単純な, それも極々単純なGUIにソレを使うことができるのら。 Dr.Rexx(Dr.Dialog)と VREXX ・・・アプリケーションを作るのなら前者で, ダイアログを軽～く出すっつったら後者かな。
けどほかに, 片方しかできないっつーのもあるだよ。・・・ソレは線を引くこと。 Dr.Rexxでもタートルグラフィックでなんとかできなくもないけど, やっぱ難しいのら。何が問題かっつーと, 勝手に塗りつぶしてくれちゃうとこなんだけどね。

そんな訳で, Palmデバイスのいくつかのビュワーは VREXXで作ったりしてるんだけど, 使ってるとソレなりに問題もちらほら見えてくる訳にょ。
ジツはコレ, VREXXの使用と同時に VREXX.EXEが起動したりして, Rexxから指示する描画命令はソレに対して行われているって感じなのら。フロントエンドとバックエンドってことなのかも。

で, 線を引くのに手一杯でもコマンド窓は相変わらずそこにあって, なんだか手持ちぶさたな感じだお。でもだからってキーボードをたたいてみても, そのデータはキーバッファに溜まるばかり。(T-T)
なんとかソレを有効利用することできないけ？・・・あるんだなソレが。ぐふふ。

OS/2版 Rexxには, SysGetKey()てゆー外部関数パッケージ「rexxutil」に含まれているブツがあるだよ。 PC-DOS版のソレにも RxGetKey()っつーのがあるにょ。じゃコレ使やパーペキ・・・ではない。まだ少し足りないのがあるのら。ソレはオツム？ (←ぉぃ)

do forever
   call SysSleep 1
   call charout , '*'

   do while chars() > 0
      ch = SysGetKey('NoEcho')
      call charout , '['ch']'
   end
end

chars() の引数を省略して STDIN: つまり標準入力にすっと, キーバッファにデータが溜まっているかどーか調べることができるのら。なかなか盲点だと思うにょ, コレ。
コレでゲーム作ったりもできるね, Rexxで。さぁみんなで挑戦してみよー。(^o^)

環境の違い・Rexxの違い -- 2002.9.7

Palmデバイスでも Rexxが動くよーになったってことで, Rexxの互換性について, ここらでひとつ考えてみるってのもよいかも。そんなアレだお。

Rexxの仕様, ソレはいつ・どこで決定されているのかっつーと・・・よぐ分かんね。 (← ぉぃ)
でもたぶん Rexx Symposium とか, そーゆーアレだよね, きっと。
ところが, IBM製のRexxでは他のRexx, たとえば Regina とは, 使える関数が微妙に異なっていたりするのら。
参照している仕様は同じはずだと思うのに・・・。それとも, ソレが IBM版 Rexxのアドバンテージってことなのかな？ (よく分かんないけど)

で, IBM版のソレで特別に使える関数とゆーのは, DBright/DBleftをはじめとする DBCS関数 (約12種類) にょ。そしてソレは OS/2版でも PC-DOS版でも変わりなく使えるもん。たぶん Linux版でも使えるはずだお。
DBCS間数については前にも扱ったことがあるので, 興味あるってばーいは見れ。

こーゆー関数, それから parse value with VerA VerB (ホントは valueと withの間に ''ってのが必要) が使えないってことで, Reginaって変・・・とか思ってたんだけっちょ, ソレは Rexx for Palm OS でも同じだったのら。てことは何？ IBM版が特別だったってこと？・・・ついに知る, 驚愕の事実 !

つーことで, 簡単にだけど調べたことをまとめてみただよ。もっと知りたかったら料金払ってちょ。(ウソ)

それぞれの Rexxの違い (分かっているとこだけ)
Rexxの種類	/	内容
Reginaあたりの, IBM系じゃないRexx	×	DBCS関数は全滅。 (でも options 'EXMODE'は調べていない)
Classic Rexx for OS/2	○	こんな関数が使える。 RxMessageBox RxQueue Beep Directory FileSpec SetLocal EndLocal
Classic Rexx for OS/2	○	ORexxの外部関数パッケージ「RexxUtil」と同等の関数が使える。もしかして同じもの？それとも別物？
Classic Rexx for OS/2	○	マクロスペースも使える
Classic Rexx	×	それなのに ChangeStr(), CountStr() は, いまだに使えない
Rexx for Palm OS	○	マクロスペースじゃないけど, 別のプログラムを実行時に組み込んだりできる
-	-	OSの制限で, Lines は行数を返さないものもある。1 か 0のみ。それから Stream も OSによっていろいろのはず。

ファイルの数が多過ぎるー -- 2002.8.15

ぐふふ。最近 σ(^^) は HDDを増設してウハウハなのだよ。なにがどーウハウハなのか, ソレは VirtualPC使ってると数GB単位でディスク容量が減っていくところ, それに歯止めがかかったかもってことなのら。
しかもバックアップ媒体としても使えるし, こりゃもう矢でも鉄砲でももってこいって感じにょ。・・・値段は高いけどね。(T-T)

さっそく xcopyコマンド使ってコピーしてみる・・・と, すぐに問題発生してみたりなんかして。あはは。
っつーのも, コピーの検査は /V の指定でできるけど, そーゆーんじゃなくて全体を比較したい, そんなばーいちょいと大変っぽいのら。
xcopyコマンドに, コピーだけじゃなく比較の機能が付いてたらよいんだけど, ソレもダメ。うーん, Vzエディターの zcopyコマンドみたく, 複写・移動・比較の機能がついてたらとっても便利だったんだけどねぇ。

てなことで, ディレクトリを手繰ってファイル一覧を取得して, んで compコマンドでアレしてみる・・・と, 今度はいつまで経っても終わんない。(T-T)
作りながら試してみてプログラム完成にこぎ着けよーにも, こんなことじゃうかつに動かせないじゃん。

ファイルの数が多過ぎると処理が止まっちゃって先に進まない。そう, 今回のアレはそーゆーときに便利な裏技なのら。・・・てほどでもないかもね。(^^)
その方法は rxqueue 経由でファイル一覧をアレするんだけど, ソレを本体プログラムと同時に動かすって訳なのら。方や黙々とファイル一覧を作り出し, もう一方ではソレを順次取り出していろいろアレするってことにょ。

でも, startコマンドじゃ rxqueue と併用したときに止まってしまうのら。パイプは使えないってことなのかな？
そーゆー訳で, こんな方法で動かしたあるよ。

target = '*.cmd *.com *.exe'
'detach dir 'target' /b /s |rxqueue'

do while queued() == 0; end;

say 'Start'
do while queued() > 0
   /* 取り出して, 比較とかいろいろ ・・・ */
end

ま, ほかにもっとよい方法があるかもだけど, とりあえずコレで並行動作できるって訳だお。

ところで queueに溜まってしまったファイル一覧をクリアしたいとき, さて, どーすんだっけ。チャレンジャーな方は調べてみよー。でも, けして σ(^^) が手を抜きたい訳じゃないからね。なーんてウソ。 (←ぉぃ)

PMView スライドショー -- 2002.7.30

サブディレクトリ以下も検索してファイルを見つけ, それから, 日付でソートする。・・・前回のはそこまでだったんだけど, でも目的がないのもアレだから, そのファイル名一覧を使って PMViewのスライドショーを作ってみよー。とって付けたよーな目的かもだけど。

つっても前回のプログラムに多少手を加えるだけでソレは出来上がったりするのら。グフフ。

/* PMViewスライドショーを作ってみる */
options translate('ETmode')

call RxFuncAdd 'SysLoadFuncs', 'rexxutil', 'SysLoadFuncs'
call SysLoadFuncs

extlist = 'BMP  CUR  DCX  EPS  FIT  FITS G3   GIF ICO IFF',
          'ILBM LBM  IMG  JPG  JPEG JIF  JFIF LGO MAC MSP',
          'PCD  PCX  PIC  PBM  PGM  PPM  PNM  PNG PSD PTR',
          'RAS  RLE  SFF  SFW  SGI  RGB  RGBA BW  SHW TIF',
          'TIFF TGA  WBMP WPG  XBM  XPM  XWD'

call SysFileTree './', 'file.', 'sfo'

parse value '' with list addr
do i = 1 to file.0
   if i //5 == 0 then call charout , '0d'x i'/'file.0' '
   fname = FileSpec('N', file.i)
   ext = translate(substr(fname, lastpos('.', fname) +1))
   if wordpos(ext, extlist) == 0 then iterate

   ts = stream(file.i, 'c', 'query timestamp')
   list = list translate(space(ts), '_', ' ')
   addr = addr i
end
parse value QuSort_A(list, addr) with list':'
call charout , '0d'x'1b'x'[2K'

/* 前回からの続き ↓↓↓ */
shwfile = 'PMV_'FileSpec('N', Directory())'.shw'
'@if exist 'shwfile' erase 'shwfile
call lineout shwfile, 'PMView SlideShow'
call lineout shwfile, 'BeginShow'

do i = 1 to words(list)
   n = word(list, i)
   call lineout shwfile, '  BeginImage'
   call lineout shwfile, '    FileName 'file.n
   call lineout shwfile, '  EndImage'
end

call lineout shwfile, 'EndShow'
call lineout shwfile
exit

こーゆー表現してるとこが追加した部分だお。
拡張子を調べて, PMViewで扱えないっぽいブツはしりぞけるって部分。それに, スライドショーファイルを作る部分・・・コレを追加したってことなのら。
スライドショーファイルの拡張子は *.shw, んで, ファイル名にはディレクトリ名を加工して作ってみたにょ。

そしてコレ(↓)がソートの部分だお。

QuSort_A: procedure
parse arg lst, addr
parse value with le gr ale agr
p = random(1, words(lst))
val = word(lst, p)
do i = 1 to words(lst)
   if i == p then iterate
   v = word(lst, i)
   if v < val
      then do; le = le v; ale = ale word(addr, i); end;
      else do; gr = gr v; agr = agr word(addr, i); end;
end
addr = word(addr, p)
if words(le) > 1 then parse value QuSort_A(le, ale) with ale':' le
if words(gr) > 1 then parse value QuSort_A(gr, agr) with agr':' gr
return space(ale addr agr)':'space(le val gr)

多分コレでファイルの日時順に並ぶよーになると思うんだけっちょ, 確認していないから失敗している可能性もあるかも。あははのは。 (←ぉぃ)

もし, 日付の逆順でアレするばーいは, スライドショーファイルを作っているループのとこを変更するとよいかも。って, コレも確認していないからうまく動くか分かんないんだけどね。(^o^)

  do i = 1 to words(list)
        ↓
  do i = words(list) to 1 by -1

ディレクトリを手繰ってみる -- 2002.7.21

ディレクトリを手繰って, ファイル名をアレしてソートし, 一覧を作ってみる。そーゆーのを作ってみよう。

どこぞから downloadしたのはよいけど, バラバラに散らかったので, zip/lzhのカタログを作りたい
デジカメの写真, ここいらのディレクトリに置いといたんだけど, 内容の確認が面倒だしぃー
最近貧乏だし, どこかのディレクトリにお金, 落ちていないかな？ (←んなことない)

きっとみんなも, こーゆー事態のひとつやふたつあるかも知んない。・・・お金は別として。
てな訳で, さっそくアレしてみよー。

/* rxqueueを使ってみる */
'dir *.cmd /s /b | rxqueue'

do n = 1 while queued() > 0
   txt = linein('queue:')
   say right(n, 5)': 'txt
end

まずは, ファイル名を得る部分だお。とりあえずこんな方法もあるってことで紹介してみたんだけっちょ, 今回は SysFileTree を使ってみるもん。
ではなぜ dir＆rxqueue を紹介したかとゆーと, 単なる気まぐれ。あははははー。 (←ぉぃ)

さてー SysFileTree を使うと決めても, ソレにはいくつかオプションがあったりする。今回のソレは日時でソートしてみるつもりなので, んじゃ 's'(サブディレクトリー), 'f'(ファイルのみを探索) の指定でバッチリだね・・・と思いきや時間のフィールドは '時', '分' までしかなかったりする。ダメじゃんソレ。

つー訳で, ファイル名から時・分・秒を取り出すことにして, SysFileTree では 'o'(完全修飾ファイル名のみ) も指定することにしただよ。

/* SysFileTree を使った方法 */
options translate('ETmode')

call RxFuncAdd 'SysLoadFuncs', 'rexxutil', 'SysLoadFuncs'
call SysLoadFuncs

call SysFileTree './', 'file.', 'sfo'

parse value '' with list addr
do i = 1 to file.0
   if i //5 == 0 then call charout , '0d'x i'/'file.0' '

   ts = stream(file.i, 'c', 'query timestamp')
   list = list translate(space(ts), '_', ' ')
   addr = addr i
end
parse value QuSort_A(list, addr) with list':'
call charout , '0d'x'1b'x'[2K'

/* つづく */

'query timestamp' の指定は, 古い Rexxでは使えないかも。でも, そんなときには 'query datetime' を使うことである程度ソレの代用できるだよ。年は 2桁しかないけどね。(T-T)
QuSort_A は次回に持ち越しにょ。てゆーか, てっきりどこかで紹介してたと思ってたんだけっちょ, ないね。どこにも。(^o^)

URL を部品に分ける -- 2002.6.19

URLに加工を加え, 新しいURLを作り出そうかなとか思っても, なかなかうまくできない。そんなばーい, 一度分解してからアレすると案外うまくいったりするのかも。なーんてことで, そーゆーのをアレしてみるにょ。

Javaにも URL Classっつーのがあって, いろいろ便利なことできるんだども, 今回のコレ, Javaのソレに幾分合わせてみただよ。

参考： Java プラットフォーム 1.2 API 仕様: クラス URL

getProtocol
getHost
getPort
getFile
getRef

getURL: procedure
   parse arg URL, cmd
   cmd = translate(cmd)
   parse var URL proto'://'host '/'+0 file'#'ref
   parse var host host':'port
   if \datatype(port, 'W') then port = -1
   if file == '' then file = '/'
   select
      when abbrev('PROTOCOL', cmd) then res = proto
      when abbrev('HOST', cmd) then res = host
      when abbrev('PORT', cmd) then res = port
      when abbrev('FILE', cmd) then res = file
      when abbrev('REF', cmd) then res = ref
   otherwise
      say '# getURL Error'
   end
   return res

んで, 使い方はこんな(↓)感じ。結果はみてのお楽しみ。フフフのフ。

url = 'http://hostname:8080/directory/free.file#123'
say 'Protocol ='getURL(url, 'p')
say 'Host     ='getURL(url, 'h')
say 'Port     ='getURL(url, 'port')
say 'File     ='getURL(url, 'f')
say 'Ref      ='getURL(url, 'r')

◇

ちょっち前に, 「こんな関数あったら便利かも」とかゆーことで URL Classアレしたことあるんだけど, そんな話を振っておきながら勝手に作って公開しちゃったりなんかして。＞σ(^^) わはは。

Drag＆Drop -- 2002.5.7

GUIな操作・・・。 Rexxのばーい GUIつったら Dr.Rexxがあるんだけど, そーゆーのではなく単に Drag＆Dropなのなら Workplace shellでどーにかアレしてくれるのら。
Drag＆Drop, つまり「マウスでファイルを掴んで」「目的のとこまで引っ張って(Drag)いき」「離す(Drop)」。
「目的のとこ」がプログラムのアイコンなら, 該当するプログラムが自動的に起動されるっつー寸法にょ。

起動されるプログラムには, 引数が与えられたりする。もちろんソレは Dropしたブツ, そのファイル名なのら。
でもそこに, 微妙な操作が必要になるなんてことはどこにも書いてなかったよーな, 書いてあったよーな, 見たことないからよく分かんない, ・・って感じ。 (←？)

/* Drag and Drop test */
parse arg filename

say '['filename']'
pull .

コレを Desktopに置いて, そこに何らかのファイルを Dropすると, うまく動いてる・・・よーに見えるよね。
ところで, arg filename じゃなくて parse arg filename にしているのは, ファイル名が大文字に変換されてしまうから。
いーじゃん, FATでも HPFSでも, 大文字小文字の区別なんてないしぃ～・・・なーんてゆってるアレじゃない。アルファベットなら問題ないんだけっちょ, ファイル名が漢字だったら文字が化けちゃうのら。2バイト目がアルファベットだったりするとそーなったはず。たぶん。

さて, 一見問題なさそげな部分なんだけど, 特殊な文字を含むファイル名だったら困ったことになるだよ。特殊な文字が紛れ込んだりすると酔って自分を見失うだとか, (←なぜ？)
そーゆーんじゃないけど, ファイル名の渡され方が微妙なのら。たとえば test file みたいに途中にスペースを含むファイル名, ソレを(↑)のプログラムに Dropしてみるっつーと, これがあーたファイル名の前後に「"」が付いたりするっちゅー訳よ。

/* Drag and Drop test */
parse arg filename

filename = strip(filename)
if left(filename, 1) == '"' then parse arg ch+1 filename (ch)

say '['filename']'
pull .

さて, コレでうまく動くと思うんだけっちょ, ふと気付いたことがあるにょ。
ソレは・・・コレって以前にも取り上げたよーな気がする・・・んだけど, どーだっけ？ (^^;
ま, いっか。