小物ソフト

/* socket list */
/* 98.8.10 ori */
/*
98.8.11
   確認できた最高値 1972
   monitor としては、現在値の +10くらいまでを調べるとよいかもしれない
   (さらに、時間が空いている時に 500socket/1秒 くらいでチェックとか)
*/
options 'ETmode'

parse source OS EV PG
if OS == 'OS/2' then do
   if RxFuncQuery('SockLoadFuncs') then do
      call RxFuncAdd 'SockLoadFuncs', 'rxsock', 'SockLoadFuncs'
      call SockLoadFuncs
   end
end
if OS == 'AIX/6000' then do /* RxSockより */
   rc = SysAddFuncPkg("rxsock.dll")
end

do sk = 0 to 2048 -1 /* 256; \emx\include\sys\select.h */
   Rc = SockGetSockName(sk, 'localEP.')
   if Rc < 0 then iterate
   res = 'Sock'right(sk,4)':' localEP.addr'('localEP.port')'
   Rc = SockGetPeerName(sk, 'remoteEP.')
   if Rc == 0 then res = res '-' remoteEP.addr'('remoteEP.port')'
   say res
end
exit

/* grep 98.9.2 */

'xcom e /n .grep'
call etksetfilefield 'autosave', 0
call etksetfilefield 'filename', '.grep'

parse arg Args
cnt = 0
do i = 1 to words(Args)
   if left(word(Args, i), 1) \= '-' then cnt = cnt +1
end
if cnt < 2 then do
   'sayerror 引数が足りない? ('cnt')'
   exit
end

'extract /last/line'
call etksetfilefield 'line', last.1
call etkinserttext ''
call etkinserttext '-----' Args

'xcom grep -n' Args '|RxQueue'
do while queued() > 0
   parse pull val =1 txt
   do until datatype(n, 'W')
      parse var txt ':'+1 txt +0 n':'
      if txt == '' then leave
   end
   txt = ':'n':'
   parse var val pre (txt) src
   call etkinserttext pre'('n')' src
end
call etksetfilefield 'modify', 0
call etksetfilefield 'line', line.1

/**  End of Script  **/

/* Xdump ... hexa dump program */
/* CR-DATE 95.12.23 by ori     */
/* modification log *//*
   97.11.4  Ver 2.0  ori
      offset を指定可能 (0〜)
      (-)を指定すると fileの最後の部分を表示する

   98.1.23  Ver 2.1  ori
      別moduleから呼び出されていた場合の処理を追加した
      この時 fileが存在しなければ、それを dataとみなす

   98.6.5   Ver 2.2 ori
      '.' で示す域を xrange(, '1f'x) から xrange('fd'x, '1f'x) に変更

   98.7.31
      逆Dump機能を追加。引数に "-O filename" を指定すると、このモードになる。
*/
options 'ETmode'
True = 1; False = 0;
ctl = xrange('fd'x, '1f'x)

BlkSize = 128

parse source . EV .
if EV \= 'COMMAND' then do
   parse arg val
   if stream(val, 'c', 'Query exists') == '' then
      exit Dump(val)
end

/* -- Start */
parse arg args
args = ' 'args; n = pos(' -O', translate(args));
if n > 0 then do; parse var args pre +(n)+2 outf args; args = pre args; end;

parse var args fname offset len .
if stream(fname, 'c', 'Query exists') == '' then do
   say 'File not found ('fname')'
   exit
end

if symbol('outf') == 'LIT' then do
   Rc = stream(fname, 'c', 'Open Read')
   fsize = stream(fname, 'c', 'Query Size')
   txt = fname 'Size='fsize
   say center(' 'txt' ', length(txt) +12, '=')

   if \datatype(offset, 'W') then offset = 0
   if offset < 0 then offset = fsize +offset
   if \datatype(len, 'W') then len = fsize

   do n = offset by BlkSize while chars(fname) > 0 & len > 0
      val = charin(fname, n +1, min(BlkSize +1, len))
      Dump(val, min(BlkSize, length(val)), n)
      len = len -BlkSize
   end
end
else do
   outf = strip(outf,, '=')
   Rc = stream(fname, 'c', 'Open Read')
   do while lines(fname) > 0
      parse value linein(fname) with txt ';'
      txt = translate(subword(txt, 2),, '-')
      if datatype(txt, 'X') then call charout outf, x2c(txt)
      else say '???:' txt
   end
   call charout outf
end
exit

/** Dump **/
Dump: procedure expose ctl
   parse arg val, ln, addr
   if ln = '' then ln = length(val)
   if addr = '' then addr = 0
   sz = 16   /* const */

   fmt = '01 23 45 67-89 ab cd ef-gh ij kl mn-op qr st uv'
   str = xrange(0, 9)xrange('a', 'v')
   do i = 1 to ln by sz
      if ln -i +1 < sz then sz = ln //sz
      ch = substr(val, i, sz)
      txt = d2x(addr, 8)'  'translate(fmt, c2x(ch), str)
      if \DBValidate(ch) then ch = ch ||substr(val, i +sz, 1)
      say txt ';' translate(ch,, ctl, '.')
      addr = addr +sz
   end
return ''

/* AddPageBreak   */
/* 98.5.11 by ori */
options 'ETmode'

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

fPause = 1

parse arg fname
fname = strip(fname)
if fname == '' then exit
if left(fname, 1) == '"' then parse var fname +1 fname'"'
if stream(fname, 'c', 'Query exists') == '' then do
   say 'ファイル' fname 'が存在しない'
   if fPause then pull .
   exit
end

src = ''
do i = 1 while lines(fname) > 0
   txt = linein(fname)
   if strip(txt) == '0c'x then src = src i
end
Rc = stream(fname, 'c', 'close')
if words(src) > 0 then do
   EPM_A = 'EPM.ATTRIBUTES'
   newEA = EA_PgBreak(src)
   Rc = SysGetEA(fname, EPM_A, 'oldEA')
   if Rc \= 0 then say 'GetEA='Rc
   else if length(oldEA) > 0 then do
      if newEA == oldEA then say '設定されています'
      else say EPM_A':' length(oldEA) 'Bytes'
      if fPause then pull .
      exit
   end
   Rc = SysPutEA(fname, EPM_A, newEA)
   if Rc \= 0 then say 'PutEA='Rc
   else say 'PageBreak を設定しました:' src '/'i -1
end
exit

EA_PgBreak: procedure
parse value 'fffd'x 'fffe'x 'fff9'x with EAT_Asc EAT_Bin EAT_ICON
parse value 'ffdf'x 'ffde'x         with EAT_MVMT EAT_MVST
parse arg ls
res = ''
cnt = words(ls)
do i = 1 to cnt
   n = word(ls, i)
   bega = '6 0 1 -2 2' n
   enda = '6 0 0 -1 2' n
   res = res''d2ii(length(bega))bega''d2ii(length(enda))enda
end
res = reverse(EAT_MVST)'00 00'x''d2ii(cnt *2)reverse(EAT_Asc)res
return res

d2ii: return reverse(right(d2c(arg(1)), word(arg(2) 2, 1), '0'x));
ii2d: return c2d(reverse(arg(1)), word(arg(2) 4, 1));

/* RxVList        */
/* 98.5.23 by ori */
/*
   EA を解析するため、OS/2 でしか動かない !
*/
options 'ETmode'

if RxFuncQuery('SysLoadFuncs') then do
   call RxFuncAdd 'SysLoadFuncs', 'rexxutil', 'SysLoadFuncs'
   call SysLoadFuncs
end

parse arg fname
fname = strip(fname)
if fname == '' then exit
if stream(fname, 'c', 'Query exists') == '' then do
   say 'ファイル' fname 'が存在しない'
   exit
end

'@call' fname '//t'
Rc = SysGetEA(fname, 'REXX.VARIABLEBUF', 'RxVar')
if Rc \= 0 then say 'GetEA='Rc
if RxVar == '' then do; say 'EA がないため分からない'; exit; end;
say center(' VarList ['fname'] ', 33, '=')
vn.0 = RexxEA(RxVar, 'vn.')
do i = 1 to vn.0
   if wordpos(translate(vn.i), 'RC RESULT SIGL') > 0 then
      vn.i = '特殊変数' vn.i
   say vn.i
end
exit

RexxEA: parse arg ,RexxEA; return RexxEAcore(arg(1));
RexxEAcore: procedure expose (RexxEA)
parse arg EA
cnt = ii2d(left(EA, 4))
lnsize = cnt *8 +1
easize = ii2d(substr(EA, 5, 4)) +1
parse var EA vlen =(lnsize) names =(easize)
do i = 1 for cnt -1
   ln = ii2d(substr(vlen, i *8 +1, 4))
   call value RexxEA''i, left(names, ln)
   names = substr(names, ln +1)
end
return cnt -1

ii2d: return c2d(reverse(arg(1)), word(arg(2) 4, 1));