home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / kkmail01.zip / kkmail2.cmd < prev    next >
OS/2 REXX Batch file  |  1996-10-23  |  33KB  |  1,244 lines
  1. /* Åëè·É▌ÆΦâfü[â^ */
  2. '@echo off'
  3. 'chcp 932'
  4.    pcmVersion=" < special thanks : PCM/2 OS/2 REXX ver0.60 by Pururun >"
  5.    KKMailVer ="KKMail Ver0.1(NKF)"
  6.    PCM_HOME="pcm"
  7.    PCMAIL_PROFILE="kkmail.cfg"
  8.    PCMAIL_CUR_BOX="current.pms"
  9.    LAST_NUMBER_FILE="number.pms"
  10.    CUR_NUMBER_FILE="current.pcm"
  11.    smtpPort=25
  12.    popPort=110
  13.    interFace=" RexxSock "
  14.    myHostName=""
  15.    DEBUG=(0)
  16.    ASCERASE=(0)
  17.    JSTDATE=(1)
  18.    INC_LIST_FLAG = 1
  19.    INC_LIST      = "kkmail.inc"
  20.  
  21. /* Åëè·ë╗ */
  22. main:
  23.    options etmode
  24.    arg cfgDir .
  25.  
  26.    if RxFuncQuery("SysLoadFuncs") then
  27.       do
  28.          call RxFuncAdd "SysLoadFuncs", "RexxUtil", "SysLoadFuncs"
  29.          call SysLoadFuncs
  30.       end
  31.  
  32.    if RxFuncQuery("SockLoadFuncs") then
  33.       do
  34.          call RxFuncAdd "SockLoadFuncs","RxSock","SockLoadFuncs"
  35.          call SockLoadFuncs
  36.       end
  37.  
  38.    if RxFuncQuery("RxJisLoadFuncs") then
  39.       do
  40.          call RxFuncAdd 'RxJisLoadFuncs', 'RXJIS', 'RxJisLoadFuncs'
  41.          call RxJisLoadFuncs
  42.       end
  43.  
  44.    say KKMailVer || pcmVersion
  45.  
  46.    if \ReadProfile() then exit 1
  47.  
  48.    curFolder = "inbox"
  49.    addr      = SockGetHostId()
  50.    call SockGetHostByAddr addr, "host.!"
  51.  
  52.    signal on halt name shutdown
  53.  
  54.    rc = SendMqueues() 
  55.    rc = RecvMail(profile.password,"","","FALSE")
  56.  
  57.    say "Complete"
  58.    
  59.    exit 0
  60.  
  61. /* profile.pcm âtâ@âCâïé≡ô╟é±é┼Åëè·ò╧Éöé≡É▌ÆΦé╖éΘ */
  62. ReadProfile:
  63.    profile.path=""
  64.    profile.smtphost=""
  65.    profile.pophost=""
  66.    profile.user=""
  67.    profile.password=""
  68.    profile.incmbox=""
  69.    profile.mqueue=""
  70.    profile.domain=""
  71.    profile.tzstring=""
  72.    ret = 1
  73.  
  74.    if cfgDir\="" then do 
  75.       fName = cfgDir
  76.       rc = CheckCFG(fName)
  77.    end
  78.    else
  79.       rc = 0
  80.    if rc = 0 then do
  81.       fName = "."
  82.       if CheckCFG(fName) = 0 then do
  83.          fName = value(PCM_HOME,,"OS2ENVIRONMENT")
  84.          if fName="" then do
  85.             say "è┬ï½ò╧Éö("||PCM_HOME||")é≡É▌ÆΦé╡é─é¡é╛é│éóüB"
  86.             return 0
  87.          end
  88.          if CheckCFG(fName) = 0 then do
  89.             say "è┬ï½É▌ÆΦâtâ@âCâïé¬î⌐é┬é⌐éΦé▄é╣é±üB"
  90.             return 0
  91.          end
  92.       end
  93.    end
  94.  
  95.    if right(fName,1)="\" then fName=left(fName,(length(fName)-1))
  96.  
  97.    if INC_LIST_FLAG = 1 then
  98.       inc_list_file = fName || "\" || INC_LIST
  99.    else
  100.       inc_list_file = ""
  101.  
  102.    fName = fName||"\"||PCMAIL_PROFILE
  103.    rc = SysFileTree( fName, "stem", "F" )
  104.    if stem.0=0 then
  105.       do
  106.          say "è┬ï½É▌ÆΦâtâ@âCâï("||fName||")é¬î⌐é┬é⌐éΦé▄é╣é±üB"
  107.          return 0
  108.       end
  109.  
  110.    rb = stream( fName,"c","OPEN READ")
  111.    do forever
  112.       buf=linein( fName )
  113.       if buf="" then leave
  114.       if left(buf,1)="#" then iterate
  115.       buf=translate( buf, " ", "    " )
  116.       if left(buf,5)="PATH:" then
  117.          do
  118.             parse var buf keywd profile.path
  119.             profile.path=strip(profile.path)
  120.             if right(profile.path,1)="\" then profile.path=left(profile.path,(length(profile.path)-1))
  121.          end
  122.       if left(buf,9)="SMTPHOST:" then
  123.          do
  124.             parse var buf keywd profile.smtphost
  125.             profile.smtphost=strip(profile.smtphost)
  126.          end /* do */
  127.       if left(buf,8)="POPHOST:" then
  128.          do
  129.             parse var buf keywd profile.pophost
  130.             profile.pophost=strip(profile.pophost)
  131.          end /* do */
  132.       if left(buf,5)="USER:" then
  133.          do
  134.             parse var buf keywd profile.user
  135.             profile.user=strip(profile.user)
  136.          end
  137.       if left(buf,9)="PASSWORD:" then
  138.          do
  139.             parse var buf keywd profile.password
  140.             profile.password=strip(profile.password)
  141.          end
  142.       if left(buf,9)="INC-MBOX:" then
  143.          do 
  144.             parse var buf keywd profile.incmbox
  145.             profile.incmbox=strip(profile.incmbox)
  146.          end
  147.       if left(buf,7)="MQUEUE:" then
  148.          do
  149.             parse var buf keywd profile.mqueue
  150.             profile.mqueue=strip(profile.mqueue)
  151.          end
  152.       if left(buf,7)="DOMAIN:" then
  153.          do
  154.             parse var buf keywd profile.domain
  155.             profile.domain=strip(profile.domain)
  156.          end
  157.       if left(buf,9)="TZSTRING:" then
  158.          do
  159.             parse var buf keywd profile.tzstring
  160.             profile.tzstring=strip(profile.tzstring)
  161.          end /* do */
  162.    end /* do */
  163.    rb = stream( fName,"c","CLOSE")
  164.  
  165.    if profile.path="" then
  166.       do
  167.          say "è┬ï½É▌ÆΦâtâ@âCâï("||fName||")é╔("||"PATH: "||"é≡É▌ÆΦé╡é─ë║é│éóüB"
  168.          ret = 0
  169.       end
  170.    if profile.pophost="" then
  171.       do
  172.          say "è┬ï½É▌ÆΦâtâ@âCâï("||fName||")é╔("||"POPHOST: "||"é≡É▌ÆΦé╡é─ë║é│éóüB"
  173.          ret = 0
  174.       end
  175.    if profile.smtphost="" then
  176.       do
  177.          say "è┬ï½É▌ÆΦâtâ@âCâï("||fName||")é╔("||"SMTPHOST: "||"é≡É▌ÆΦé╡é─ë║é│éóüB"
  178.          ret = 0
  179.       end
  180.    if profile.user="" then
  181.       do
  182.          say "è┬ï½É▌ÆΦâtâ@âCâï("||fName||")é╔("||"USER: "||"é≡É▌ÆΦé╡é─ë║é│éóüB"
  183.          ret = 0
  184.       end
  185.    if profile.incmbox="" then profile.incmbox="inbox"
  186.    if profile.mqueue="" then profile.mqueue="mqueue"
  187.    if profile.tzstring="" then profile.tzstring="+0900"
  188.    return ret
  189.  
  190. CheckCFG: procedure expose PCMAIL_PROFILE
  191.    arg f
  192.    if right(f,1)="\" then f=left(f,(length(f)-1))
  193.    f = f||"\"||PCMAIL_PROFILE
  194.    rc = SysFileTree( f, "stem", "F" )
  195.    if stem.0=0 then
  196.       return 0
  197.    return 1
  198.  
  199.  
  200.  
  201. /* âüü[âïé≡Ä≤ÉMé╖éΘ */
  202. RecvMail:
  203.    parse arg passwd, folder, nfolder, checkOnly
  204.    if nfolder="" then
  205.       f=profile.incmbox
  206.    else
  207.       f=nfolder
  208.    rc = CheckFolder(f)
  209.    if rc=0 then
  210.       do
  211.          say "ÆåÆfé╡é▄é╡é╜!!"
  212.          exit 1
  213.       end
  214.    rc = NetOpen(profile.pophost,popPort)
  215.    if rc=0 then
  216.       do
  217.          say "POPâTü[âoü[("||profile.pophost||")é╞É┌æ▒é┼é½é▄é╣é±!"
  218.          password=""
  219.          return 1
  220.       end
  221.    rc = NetRec1("recbuf1")
  222.    if rc=0 then
  223.       do
  224.          say "POPâTü[âoü[é⌐éτïæö█é│éΩé▄é╡é╜üB"
  225.          call NetClose
  226.          exit 1
  227.       end
  228.    if left(recbuf1,1)\="+" then
  229.       do
  230.          say "POPâTü[âoü[é⌐éτïæö█é│éΩé▄é╡é╜üB"
  231.          call NetClose
  232.          exit 1
  233.       end
  234.    rc = CheckUser(profile.user,profile.passwd)
  235.    if rc=0 then
  236.       do
  237.          rc=NetSend("QUIT");
  238.          rc=NetRec1("recbuf1");
  239.          rc=NetClose()
  240.          return 0
  241.       end
  242.    num=GetStatus()
  243.    if num=0 then
  244.       say "éáé╚é╜ê╢é╠âüü[âïé═éáéΦé▄é╣é±üB"
  245.    else
  246.       say "éáé╚é╜ê╢é╠ "||num||" Æ╩é╠âüü[âïé¬ô═éóé─éóé▄é╖üB"
  247.  
  248.    if checkOnly\="TRUE" & num\=0 then
  249.       rc = GetNewMails( f, num )
  250.  
  251.    rc = NetSend("QUIT")
  252.    rc = NetRec1("recbuf1")
  253.    rc = NetClose()
  254.  
  255.    /* set new folder to current folder */
  256.    if f=nfolder then
  257.       curFolder=nfolder
  258.    else
  259.       do
  260.          if f=profile.incmbox & folder \="" then curFolder=profile.incmbox
  261.       end
  262.    return 1
  263.  
  264. /* âtâHâïâ_ü[é╠ùLû│é≡Æ▓é╫éΘ */
  265. CheckFolder:
  266.    procedure expose profile.path profile.mqueue
  267.    parse arg folder
  268.    fname=profile.path||"\folder"
  269.    rc = SysFileTree( fname, "stem", "D" )
  270.    if stem.0=0 then
  271.       do
  272.         rc = SysMkDir(fname)
  273.         if rc\=0 then return 0
  274.       end
  275.  
  276.    fname=profile.path||"\folder\"||folder
  277.    rc = SysFileTree( fname, "stem", "D" )
  278.    if stem.0=0 then
  279.       do
  280.         rc = SysMkDir(fname)
  281.         if rc\=0 then  return 0
  282.       end
  283.    return 1
  284.  
  285. /* ùLî°é╚âåü[âUü[é⌐Æ▓é╫éΘü@[recmail.c] */
  286. CheckUser:
  287.    parse arg userName,passwd
  288.    passwd = profile.password
  289.    rc=NetSend("USER "||userName)
  290.    rc=NetRec1("recbuf1")
  291.    if rc=0 | left(recbuf1,1)\="+" then
  292.       do
  293.          say "éáé╚é╜("||userName||")é═é╗é╠âzâXâgé╔âüü[âïâ{âbâNâXé≡Ä¥é┴é─éóé▄é╣é±üB"
  294.          return 0
  295.       end
  296.    rc=NetSend("PASS "||passwd)
  297.    rc=NetRec1("recbuf1")
  298.    if rc=0 | left(recbuf1,1)\="+" then
  299.       do
  300.          say "âpâXâÅü[âhé¬êßéóé▄é╖üB["||recbuf1||"]"
  301.          password=""
  302.          return 0
  303.       end
  304.    return 1
  305.  
  306. /* ùXò╓Ä≤é»é╠Å≤ï╡é≡Æ▓é╫éΘ */
  307. GetStatus:
  308.    rc=NetSend("STAT")
  309.    rc=NetRec1("recbuf1")
  310.    if rc=0 | left(recbuf1,1)\="+" then
  311.       do
  312.          say "POPâvâìâgâRâïâGâëü[(STAT)["||recbuf1||"]"
  313.          return 0
  314.       end
  315.    parse var recbuf1 crap num .
  316.    return num
  317.  
  318. /* ÉVé╡éóòíÉöé╠âüü[âïé≡Ä≤ÉMé╖éΘ */
  319. GetNewMails:
  320.    parse arg folder,num
  321.    nmn = ReadNewMailNumber(folder)
  322.    onmn = nmn
  323.    if nmn=-1 then
  324.       do
  325.          nmn=1
  326.          onmn=1
  327.       end /* do */
  328.    do i=1 to num
  329. /*
  330.       rc = NetSend("RETR "||i)
  331.       rc = NetRec1("recbuf1")
  332.       if rc=0 | left(recbuf1,1)\="+" then
  333.          do
  334.             say "POPâvâìâgâRâïâGâëü[(RETR)["||recbuf1||"]"
  335.             return 0
  336.          end
  337.  */
  338.       fname=profile.path||"\folder\"||folder||"\"||nmn
  339.       rc = SaveTillDot(i,fname)
  340.       if rc=0 then
  341.          do
  342.             ret = 0
  343.             leave
  344.          end /* do */
  345.       rc = DispSmallHeader(nmn,fname,"FALSE",(nmn=omnm))
  346.       nmn=nmn+1
  347.    end /* do */
  348.    if inc_list_file \= "" then
  349.      call stream inc_list_file, "c", "close"
  350.    rc = WriteNewMailNumber(folder,nmn)
  351.    if rc=0 then
  352.       do
  353.          say "ÉVé╡éóâüü[âïö╘ìåé╠âZü[âué╔Ä╕ösé╡é▄é╡é╜üB"
  354.          return 0
  355.       end /* do */
  356.    recbuf1=""
  357.  
  358. if ASCERASE then
  359.    do
  360.    call charout , "âüü[âïâXâvü[âïé≡Å┴ïÄé╡é▄é╖é⌐? (Y/N):"
  361.    parse upper pull ans
  362.    if left(ans,1)\="Y" then return ret
  363.    end
  364.  
  365.    do i=1 to num
  366.       rc = NetSend("DELE "||i)
  367.       rc = NetRec1("recbuf1")
  368.       if rc=0 | left(recbuf1,1)\="+" then
  369.          do
  370.             say "POPâvâìâgâRâïâGâëü[(DELE)["||recbuf1||"]"
  371.             return 0
  372.          end /* do */
  373.    end /* do */
  374.    return ret
  375.  
  376. /* âüü[âïé╠ò╢Å═é≡Ä≤ÉMé╖éΘ */
  377. SaveTillDot:
  378.    procedure expose DEBUG sock recbuf1 mrecbuf. inc_list_file MailDate MailFromAddr MailSubjAndBody
  379.    parse arg number,fName
  380.    rc = NetRec(number)
  381.    if rc=0 then return 0
  382.    rb=stream( fName,"c","OPEN WRITE")
  383.    if rb\="READY:" then
  384.       do
  385.          say "âüü[âïâZü[âuâtâ@âCâï("||fName||")é╠âIü[âvâôé╔Ä╕ösé╡é▄é╡é╜üB"
  386.          return 0
  387.       end
  388.    j=1
  389.    subjFlag = 0
  390.    MailDate = ""
  391.    MailFromAddr = ""
  392.    MailSubjAndBody = ""
  393.    do i=1 to mrecbuf.0
  394.       if left(mrecbuf.i,8)="Subject:" | left(mrecbuf.i,5)="From:" | left(mrecbuf.i,3)="Cc:" then
  395.          do
  396.             sjisbuf.j=RxJisMimeJisTo(mrecbuf.i) 
  397.             if left(mrecbuf.i,8)="Subject:" then
  398.                subjFlag = 1
  399.             else
  400.                subjFlag = 0
  401.          end /* do */
  402.       else do
  403.          if subjFlag = 1 then do
  404.             sjisbuf.j=RxJisMimeJisTo(mrecbuf.i) 
  405.          end
  406.          else do
  407.             /*sjisbuf.j=RxJisMimeJisTo(mrecbuf.i) */
  408.             sjisbuf.j = mrecbuf.i
  409.          end
  410.          subjFlag = 0
  411.       end
  412.       buf = sjisbuf.j
  413.       if left(buf,5)="Date:" then MailDate    = ParseDate( substr(buf,6) )
  414.       if left(buf,5)="From:" then MailFromAddr= strip( substr(buf,6) )
  415.       if left(buf,8)="Subject:" then MailSubjAndBody=strip( substr(buf,9) )
  416.    j=j+1
  417.    end /* do */
  418.    sjisbuf.0=j-1;
  419.    rc = lineout( fName,,1)
  420.    if rc\=0 then
  421.       do
  422.          say "âüü[âïâtâ@âCâï("||fName||")é╠Åoù═é╔Ä╕ösé╡é▄é╡é╜üB"
  423.          rb=stream(fName,"c","CLOSE")
  424.          return 0
  425.       end /* do */
  426.    do i=1 to sjisbuf.0
  427.       rc = lineout( fName,sjisbuf.i)
  428.       if rc\=0 then
  429.          do
  430.             say "âüü[âïâtâ@âCâï("||fName||")é╠Åoù═é╔Ä╕ösé╡é▄é╡é╜üB"
  431.             rb=stream(fName,"c","CLOSE")
  432.             return 0
  433.          end
  434.    end /* do */
  435.    rc = lineout(fName)
  436.    rb=stream(fName,"c","CLOSE")
  437.    return 1
  438.  
  439. ParseDate:
  440.    procedure
  441.    parse arg buf
  442.    buf = translate(buf," ",",")
  443.    parse value buf with wk dd mmm .
  444.    return dd||" "||mmm
  445.  
  446. DispSmallHeader:
  447.    procedure expose inc_list_file MailDate MailFromAddr MailSubjAndBody
  448.    parse arg n, fName, quiet, curf
  449.    call charout , right(n,4," ")
  450.    if curf then call charout ,"+"; else call charout ," "
  451.    buf = MailDate ||" " || left(MailFromAddr,15," ") || " " ||  left(MailSubjAndBody,48 )
  452.    call charout , buf||d2c(13)||d2c(10)
  453.    if inc_list_file \= "" then
  454.       call lineout inc_list_file, right(n, 4, " ") || buf
  455.    return 1
  456.  
  457. /* Äƒé╠âüü[âïö╘ìåé≡ô╟é▌é╛é╖ */
  458. ReadNewMailNumber:
  459.    procedure expose profile.path profile.mqueue LAST_NUMBER_FILE
  460.    parse arg folder
  461.    fname=profile.path||"\folder\"||folder||"\"||LAST_NUMBER_FILE
  462.    rb=stream(fname,"c","OPEN READ")
  463.    if rb="READY:" then
  464.       do
  465.          n = linein( fname,1 )
  466.          call stream fname,"c","CLOSE"
  467.       end
  468.    else
  469.       do
  470.          n = -1
  471.       end
  472.    return n
  473.  
  474. /* Äƒé╠âüü[âïö╘ìåé≡ïLÿ^é╖éΘ */
  475. WriteNewMailNumber:
  476.    procedure expose profile.path profile.mqueue LAST_NUMBER_FILE 
  477.    parse arg folder, n
  478.    fname=profile.path||"\folder\"||folder||"\"||LAST_NUMBER_FILE
  479.    rb=stream(fname,"c","OPEN WRITE")
  480.    if rb="READY:" then
  481.       do
  482.          call lineout fname,n,1
  483.          call lineout fname
  484.          call stream fname,"c","CLOSE"
  485.          return 1
  486.       end
  487.    else
  488.       do
  489.          say "âëâXâgâüü[âïNoâtâ@âCâï("||fname||")é¬ì∞ɼé┼é½é▄é╣é±"
  490.          return 0
  491.       end
  492.  
  493.  
  494. /*  */
  495. SendMqueues:
  496.    n = GetMqueuesVol()
  497.    if n=0 then return 1
  498.    fname=profile.path||"\folder\"||profile.mqueue
  499.    rc = SysFileTree(fname||"\*","stemF","F")
  500.    if stemF.0=0 then return 0
  501.    say "âLâàü[é╠âüü[âïé≡æùÉMé╡é▄é╖üB"
  502.    do j=1 to stemF.0
  503.       fn = substr(word(stemF.j,5), lastpos("\",word(stemF.j,5))+1)
  504.       if \datatype(fn,"N") then iterate
  505.       rc = DeliverMail(word(stemF.j,5), profile.domain, "Queue");
  506.       if rc = 0 then return 0
  507.    end /* do */
  508.    return 1
  509.  
  510. GetMqueuesVol:
  511.    procedure expose profile.path profile.mqueue CUR_NUMBER_FILE
  512.    fname=profile.path||"\folder\"||profile.mqueue
  513.    rc = SysFileTree(fname||"\*","stemF","F")
  514.    if stemF.0=0 then return 0
  515.    cnt = 0; fst = 0; end = 0;
  516.    do j=1 to stemF.0
  517.       fn = substr(word(stemF.j,5), lastpos("\",word(stemF.j,5))+1)
  518.       if \datatype(fn,"N") then iterate
  519.       cnt=cnt+1
  520.       if fn+0>end then end = fn+0
  521.       if fn+0<fst | fst=0 then fst=fn+0
  522.    end /* do */
  523.    return cnt
  524.  
  525. /*  */
  526. DeliverMail:
  527.    parse arg fName, myHost, mode
  528.    /* âüü[âïé≡özù±é╔ô╟é▌ì₧é▐ */
  529.    rb = stream(fName,"c","OPEN READ")
  530.    if rb\="READY:" then
  531.       do
  532.          say "âüü[âïâtâ@âCâï("||fName||")é╠ô╟é▌ì₧é▌é╔Ä╕ösé╡é▄é╡é╜üB"
  533.          rb=stream(fName,"c","CLOSE")
  534.          return 0
  535.       end
  536.    _i_ = 1
  537.    bodyFlag = 0
  538.    do while lines(fName)\=0
  539.       buf=linein(fName)
  540.       MailBody._i_ = buf
  541.       _i_ = _i_ + 1
  542.       if strip(buf)=""  & bodyFlag = 0 then
  543.          bodyFlag = 1
  544.    end /* do */
  545.    rb = stream(fName,"c","CLOSE")
  546.    if bodyFlag = 0 then do
  547.       say "âüü[âïâwâbâ_ü[é╞ôαùeé╠ï½é≡ö╗Æfé╖éΘé╜é▀é╠ìsé¬éáéΦé▄é╣é±üI"
  548.       return 0
  549.    end
  550.    MailBody.0 = _i_
  551.  
  552.    sendNum = CheckSendMailUsers(fName)
  553.    if sendNum=0 then return 0
  554.    /* send mail */
  555.    rc = NetOpen(profile.smtphost, smtpPort)
  556.    if rc=0 then
  557.       do
  558.          say "âüü[âïâzâXâg("||profile.smtphost||")é╞é╠É┌æ▒é¬é┼é½é▄é╣é±üB"
  559.          rc=0
  560.          if mode = "Normal" then rc = MqueueCopy(fName)
  561.          if rc\=0 then rc=SysFileDelete(fName)
  562.          return 0
  563.       end
  564.    rc = NetRec2("recbuf1")
  565.    if rc=0 | left(recbuf1,3)\="220" then
  566.       do
  567.          say "âüü[âïâzâXâgé⌐éτé╠âîâXâ|âôâXé┼ïæö█é│éΩé▄é╡é╜üB"
  568.          call NetClose
  569.          return 0
  570.       end
  571.    /* greeting sequence */
  572.    call NetSend "HELO "||myHost
  573.    rc = NetRec2("recbuf1")
  574.    if rc=0 | left(recbuf1,3)\="250" then
  575.       do
  576.          say "SMTPâvâìâgâRâïâGâëü[(HELO)"
  577.          call NetSend "QUIT"
  578.          call NetRec2 "recbuf1"
  579.          call NetClose
  580.          return 0
  581.       end
  582.    rc = SendMails(fName,sendNum)
  583.    if rc\=0 then
  584.       do
  585.          rc = FolderCarbonCopy(fName)
  586. /*         if  rc\=0 then call unlink(fName) */
  587.          rc = SysFileDelete(fName)
  588.       end
  589.    call NetSend "QUIT"
  590.    rc = NetRec2("recbuf1")
  591.    if rc=0 then say "SMTPâvâìâgâRâïâGâëü[(QUIT)"
  592.    call NetClose
  593.    return 1
  594.  
  595. /*  */
  596. CheckSendMailUsers:
  597.    parse arg fName
  598.    c=0
  599.    _i_=1
  600.    do while _i_ < MailBody.0
  601.       buf=MailBody._i_
  602.       _i_ = _i_ + 1
  603.       if strip(buf)="" then leave
  604.       if left(buf,3)="To:" then
  605.          do
  606.             buf=substr(buf,4)
  607.             c = GetMailUserNames( buf, c )
  608.             iterate
  609.          end
  610.       if left(buf,3)="Cc:" then
  611.          do
  612.             buf=substr(buf,4)
  613.             c = GetMailUserNames( buf, c )
  614.             iterate
  615.          end
  616.       if left(buf,4)="Bcc:" then
  617.          do
  618.             buf=substr(buf,5)
  619.             c = GetMailUserNames( buf, c )
  620.             iterate
  621.          end
  622.    end /* do */
  623.    return c
  624.  
  625. /*  */
  626. GetMailUserNames:
  627.    procedure expose sendUserName.
  628.    parse arg str, c
  629.    buf = translate( str, " ","    \<>," )
  630.    sendUserName.0=c+words( buf )
  631.    if sendUserName.0=c then return c
  632.    j=1
  633.    do _i=c+1 to sendUserName.0
  634.       sendUserName._i=strip(word(buf,j))
  635.       j=j+1
  636.    end /* do */
  637.    return sendUserName.0
  638.  
  639. /*  */
  640. SendMails:
  641.    parse arg fName, pNum
  642.    rc = NetSend("MAIL FROM:<"||profile.user||">")
  643.    rc = NetRec2("recbuf1")
  644.    if left(recbuf1,3)\="250" then
  645.       do
  646.          say "éréléséoâvâìâgâRâïâGâëü[(MAIL FROM:)"
  647.          return 0
  648.       end
  649.    if DEBUG then say "MAIL FROM: ok!!"
  650.    do _i=1 to pNum
  651.       if left(sendUserName._i,1)="<" then rc = NetSend("RCPT TO:"||sendUserName._i)
  652.       else rc = NetSend("RCPT TO:<"||sendUserName._i||">")
  653.       rc = NetRec2("recbuf1")
  654.       if left(recbuf1,3)\="250" then
  655.          do
  656.             say "éréléséoâvâìâgâRâïâGâëü[(RCPT TO:<"||sendUserName._i||">)"
  657.             return 0
  658.          end
  659.       else
  660.          say "æùÉMɵ ["||_i||"] : <"||sendUserName._i||">"
  661.    end /* do */
  662.  
  663.    rc = NetSend("DATA")
  664.    rc = NetRec2("recbuf1")
  665.    if  left(recbuf1,3)\="354" then
  666.       do
  667.          say "éréléséoâvâìâgâRâïâGâëü[(DATA)"
  668.          return 0
  669.       end
  670.  
  671.    if DEBUG then say "DATA start ok !!"
  672.    say "û{ò╢é≡æùÉMÆåé┼é╖...."
  673.    rc = SendMailBody(fName)
  674.    if rc=0 then
  675.       do
  676.          say "éréléséoâvâìâgâRâïâGâëü[(DATA[MailBody])"
  677.          return 0
  678.       end
  679.    say "âüü[âïé╠æùÉMé¬É│Åφé╔è«ù╣é╡é▄é╡é╜üB"
  680.    return 1
  681.  
  682. /*  */
  683. SendMailBody:
  684.    procedure expose DEBUG JSTDATE pcmVersion sock recbuf1 profile.tzstring MailBody.
  685.    parse arg fName
  686.    _i_=1
  687.    mimeFlag=0
  688.    bodyFlag=0
  689.    do while _i_ < MailBody.0
  690.       buf=MailBody._i_
  691.       _i_ = _i_ + 1
  692.       if left(buf,3)="Cc:" & strip(buf)="Cc:" then iterate
  693.       if left(buf,4)="Bcc:" then iterate
  694.       if left(buf,4)="Fcc:" then iterate
  695.  
  696.       if strip(buf)="" & bodyFlag = 0 then
  697.          do
  698.             bodyFlag = 1
  699.             if JSTDATE then
  700.                do
  701.                   buf = "Date: "||GetMailFormatDate()
  702.                   rc = NetSend(buf)
  703.                end /* do */
  704.             if mimeFlag=0 then
  705.                do
  706.                   buf = "X-Mailer: PC/M ["||pcmVersion||"]"
  707.                   iterate
  708.                end
  709.             else
  710.                do
  711.                   mimeFlag=0
  712.                   buf = "MIME-Version: 1.0"
  713.                   rc = NetSend(buf)
  714.                   buf = "Content-Type: text/plain; charset=ISO-2022-JP"
  715.                   rc = NetSend(buf)
  716.                   buf = "X-Mailer: PC/M ["||pcmVersion||"]"
  717.                   iterate
  718.                end /* do */
  719.          end /* do */
  720.       sndbuf=RxJisToJis(buf)
  721.       if left(sndbuf,8)="Subject:" | left(sndbuf,5)="From:" then
  722.          do
  723. /*
  724.             parse var sndbuf h b
  725.             b = '=?ISO-2022-JP?B?' || RxJisToBase64(strip(b)) || '?='
  726.             sndbuf= h || ' ' || b
  727. */
  728.             sndbuf=Base64ex(sndbuf)
  729.             if pos("=?ISO-2022-JP?B?",sndbuf)\=0 then mimeFlag=1
  730.             do while pos(d2c(13),sndbuf)\=0
  731.                po = pos( d2c(13),sndbuf)
  732.                rc = NetSend(left(sndbuf,(po-1)))
  733.                sndbuf=substr(sndbuf,po+1)
  734.             end /* do */
  735.          end /* do */
  736.       rc = NetSend(sndbuf)
  737.    end /* do */
  738.    rb = stream(fName,"c","CLOSE")
  739.  
  740.    rc = NetSend("")
  741.    rc = NetSend(".")
  742.    rc = NetRec2("recbuf1")
  743.    if left(recbuf1,3)\="250" then return 0
  744.    return 1
  745.  
  746. /*  */
  747. FolderCarbonCopy:
  748.    parse arg fName
  749.    fccfolder=""
  750.    _i_ = 1
  751.    do while _i_ < MailBody.0
  752.       buf=MailBody._i_
  753.       _i_ = _i_ + 1
  754.       if left(buf,4)="Fcc:" then
  755.          do
  756.             buf = strip(substr(buf,5))
  757.             if buf="" then  return 0
  758.             fccfolder=buf
  759.             leave
  760.          end
  761.       if strip(buf)="" then  return 1
  762.    end /* do */
  763.    if fccfolder\="" then
  764.       do
  765.          rc = CheckFolder(fccfolder)
  766.          if rc=0 then  return 0
  767.          nmn=ReadNewMailNumber(fccfolder)
  768.          if nmn<0 then nmn=1
  769.          dfname=profile.path||"\folder\"||fccfolder||"\"||nmn
  770.          rb=stream(dfname,"c","OPEN WRITE")
  771.          if rb\="READY:" then
  772.             do
  773.                say "âüü[âïâZü[âuâtâ@âCâï("||dfname||")é╠ì∞ɼé╔Ä╕ösé╡é▄é╡é╜"
  774.                rb = stream(fName,"c","CLOSE")
  775.                return 0
  776.             end
  777.          call lineout dfname,,1
  778.          i = 1
  779.          bodyFlag = 0
  780.          do while i < MailBody.0
  781.             buf=MailBody.i
  782.             i = i + 1
  783.             if strip(buf)="" & bodyFlag = 0 then
  784.               do
  785.                  bodyFlag = 1
  786.                  rb = lineout( dfname, "Date: "||GetMailFormatDate())
  787.                  rb = lineout( dfname, "" )
  788.                  iterate
  789.                end
  790.             else
  791.                rb = lineout( dfname, buf )
  792.          end
  793.          call stream dfname
  794.          rb = stream(dfname,"c","CLOSE")
  795.          rc = WriteNewMailNumber(fccfolder, nmn+1 )
  796.          if rc=0 then
  797.             do
  798.                say "ÉVé╡éóâüü[âïö╘ìåé╠âZü[âué╔Ä╕ösé╡é▄é╡é╜üB"
  799.                return 0
  800.             end
  801.       end
  802.    return 1
  803.  
  804. /*  */
  805. GetMailFormatDate:
  806.    procedure expose profile.tzstring
  807.    datestr=date("N")
  808.    parse var datestr dd mmm yy
  809.    return left( date("W"), 3)||", "||dd||" "||mmm||" "||right(yy,2)||" "||time()||" "||profile.tzstring
  810.  
  811. /*  */
  812. NetOpen:
  813.    procedure expose DEBUG host.! address.! sock
  814.    parse arg hostName, portNum
  815.    rc = SockGetHostByName( hostName, "host.!" )
  816.    if rc=0 then
  817.       do
  818.          say "âzâXâgé╠Ä»ò╩é¬Åoùêé▄é╣é±üB("||hostName||")"
  819.          return 0
  820.       end
  821.    sock = SockSocket("AF_INET","SOCK_STREAM",0 )
  822.    if sock = -1 then
  823.       do
  824.          say "â\âPâbâgé¬ì∞ɼé┼é½é▄é╣é±üB"
  825.          return 0
  826.       end
  827.    address.!family = "AF_INET"
  828.    address.!port = portNum
  829.    address.!addr = host.!addr
  830.    rc = SockConnect( sock,"address.!" )
  831.    if rc=-1 then
  832.       do
  833.          say "PC-MAILâzâXâgé╓é╠âRâlâNâgé¬é┼é½é▄é╣é±üB"
  834.          call socksoclose sock
  835.          return 0
  836.       end
  837.    return 1
  838.  
  839. NetClose:
  840.    procedure expose DEBUG sock
  841.    call socksoclose sock
  842.    return 1
  843.  
  844. /*  */
  845. NetSend:
  846.    procedure expose DEBUG sock
  847.    parse arg buf
  848.    if DEBUG then
  849.       do
  850.          if left(buf,4)="PASS" then
  851.             say "[ PC ] PASS ****"
  852.          else
  853.             say "[ PC ] "||buf
  854.       end /* do */
  855.  
  856.    buf = buf || d2c(13) || d2c(10)
  857.    rc = SockSend( sock, buf )
  858. /*   if errno\=0 | rc<=0 then */
  859.    if rc<=0 then
  860.       do
  861.          say "âfü[â^æùÉMâGâëü["
  862.          return 0
  863.       end
  864.    return 1
  865.  
  866. /*  */
  867. NetRec1:
  868.    procedure expose DEBUG sock mrecbuf. recbuf1
  869.    parse arg i
  870.    crlf = d2c(13)||d2c(10)
  871.    o=0
  872.    mrecbuf.0=0
  873.    buf =""
  874.  
  875.    do forever
  876.       o = mrecbuf.0
  877.       rc = SockRecv( sock, "getstring", 4096 )
  878.  
  879.       buf = buf || getstring
  880.       s = 1 
  881.       e = 1 
  882.       do while( pos(crlf, buf, s)\=0 )
  883.          o = o + 1
  884.          e = pos(crlf, buf, s)
  885.          mrecbuf.o=substr(buf,s,(e-s))
  886.          s = e+2
  887.          if DEBUG then say "[HOST] "||mrecbuf.o
  888.       end /* while */
  889.       buf=substr(buf,s) /* rest of LINEs */
  890.  
  891.       mrecbuf.0 = o
  892.       if o=1 then
  893.          do
  894.             recbuf1=mrecbuf.1
  895.             leave
  896.          end
  897.    end
  898.    return 1
  899.  
  900.  
  901. /*  */
  902. NetRec2:
  903.    procedure expose DEBUG sock mrecbuf. recbuf1
  904.    parse arg i
  905.    crlf = d2c(13)||d2c(10)
  906.    o=0
  907.    mrecbuf.0=0
  908.    buf =""
  909.  
  910.    do forever
  911.       o = mrecbuf.0
  912.       rc = SockRecv( sock, "getstring", 4096 )
  913.  
  914.       buf = buf || getstring
  915.       s = 1 
  916.       e = 1 
  917.       do while( pos(crlf, buf, s)\=0 )
  918.          o = o + 1
  919.          e = pos(crlf, buf, s)
  920.          mrecbuf.o=substr(buf,s,(e-s))
  921.          s = e+2
  922.          if DEBUG then say "[HOST] "||mrecbuf.o
  923.       end /* while */
  924.       buf=substr(buf,s) /* rest of LINEs */
  925.  
  926.       mrecbuf.0 = o
  927.       if substr(mrecbuf.o,4,1) = " " then
  928.          do
  929.             recbuf1=mrecbuf.o
  930.             leave
  931.          end
  932.    end
  933.    return 1
  934.  
  935. /*  */
  936. NetRec:
  937.    procedure expose DEBUG sock mrecbuf. recbuf1
  938.    parse arg i
  939.    crlf = d2c(13)||d2c(10)
  940.    progress=" .oO"
  941.    o=0
  942.    mrecbuf.0=0
  943.    buf =""
  944.  
  945.    rc = NetSend("RETR "||i)
  946.    do forever
  947.       call charout , substr(progress,1+o//length(progress),1)||d2c(13)
  948.       o = mrecbuf.0
  949.       rc = SockRecv( sock, "getstring", 4096 )
  950.  
  951.       buf = buf || getstring
  952.       s = 1 
  953.       e = 1 
  954.       do while( pos(crlf, buf, s)\=0 )
  955.          o = o + 1
  956.          e = pos(crlf, buf, s)
  957.          mrecbuf.o=substr(buf,s,(e-s))
  958.          s = e+2
  959.       end /* while */
  960.       buf=substr(buf,s) /* rest of LINEs */
  961.  
  962.       if mrecbuf.o = "." then
  963.          do
  964.             mrecbuf.0 = o-1
  965.             leave
  966.          end
  967.       mrecbuf.0 = o
  968.    end
  969.    call charout ," "||d2c(13)
  970.  
  971.    if mrecbuf.0\=0 & left(mrecbuf.1,1)\="+" then
  972.       do
  973.          say "POPâvâìâgâRâïâGâëü[(RETR)["||mrecbuf.1||"]"
  974.          return 0
  975.       end /* do */
  976.    if mrecbuf.0\=0 then mrecbuf.1=""
  977.  
  978.    return 1
  979.  
  980. StringToJIS:
  981.    procedure
  982.    parse arg str
  983.    dstr=""
  984.    kanjiFlag=0
  985.    kanaFlag=0
  986.    len=length(str)
  987.    if len=0 then return str
  988.    do i=1 to len
  989.       c=substr(str,i,1)
  990.       if c2d(c) > 127 then
  991.         /* kanji */
  992.          do
  993.             if \kanjiFlag then
  994.                do
  995.                   dstr=dstr||d2c(27)||"$@"
  996.                   kanjiFlag=1
  997.                end /* do */
  998.             c1=c2d(c)
  999.             i=i+1
  1000.             c2=c2d(substr(str,i,1))
  1001.             if c1<c2d('a0'x) then c1=(256 + c1-c2d('71'x))//256
  1002.             else c1=(256+c1-c2d('b1'x))//256
  1003.             c1 = c1 * 2 + 1
  1004.             if c2>c2d('7f'x) then c2=c2-1
  1005.             if c2>c2d('9d'x) then
  1006.                do
  1007.                   c2 = ( 256 + c2 - c2d('7d'x))//256
  1008.                   c1 = c1 + 1
  1009.                end /* do */
  1010.             else
  1011.                do
  1012.                   c2 = (256 + c2 - c2d('1f'x))//256
  1013.                end /* do */
  1014.             dstr=dstr||d2c(c1)||d2c(c2)
  1015.          end /* do */
  1016.       else  /* ank */
  1017.          do
  1018.             if kanjiFlag then
  1019.                do
  1020.                   dstr=dstr||d2c(27)||"(J"
  1021.                   kanjiFlag=0
  1022.                end /* do */
  1023.             dstr=dstr||c
  1024.          end
  1025.    end /* do */
  1026.    if kanjiFlag then
  1027.       do
  1028.          dstr=dstr||d2c(27)||"(J"
  1029.          kanjiFlag=0
  1030.       end /* do */
  1031.    return dstr
  1032.  
  1033. StringToSJIS:
  1034.    parse arg str1
  1035.    if pos( '1B'x||'$' , str1 ) = 0 then return str1
  1036.    sp = 1
  1037.    str2 = ""
  1038.    spend = length( str1 )
  1039.  
  1040.  
  1041.    do while ( sp <= spend )
  1042.       if (substr( str1, sp , 1) == '1B'x ) & ( substr( str1, sp+1, 1 ) == '$' ) then
  1043.          do
  1044.             sp = sp + 3
  1045.             if sp <= spend then
  1046.                do while ( substr(str1,sp,1) \= '1B'x | substr(str1,sp+1,1) \= '(' )
  1047.                   c1 = c2d( substr( str1,sp,1 ));
  1048.                   sp = sp +1;
  1049.                   c2 = c2d(substr( str1, sp,1))
  1050.                   sp = sp + 1;
  1051.                   c3 = ( c1 - 1 ) % 2;
  1052.                   if  c1 <= c2d('5E'x) then
  1053.                      c3 = c3 + c2d('71'x)
  1054.                   else
  1055.                      c3 = c3 + c2d('B1'x)
  1056.                   str2 = str2 || d2c(c3 // 256)
  1057.                   c4 = c2
  1058.                   if ((c1 // 2)= 1) then
  1059.                      do
  1060.                         if( c2 < c2d('60'x) ) then
  1061.                            c4 = c4 + c2d('1F'x)
  1062.                         else
  1063.                            c4 = c4 + c2d('20'x)
  1064.                      end
  1065.                   else
  1066.                      c4 = c4 + c2d('7E'x)
  1067.                   str2 = str2 || d2c(c4)
  1068.                end /* do */
  1069.             sp = sp + 3
  1070.          end /* do */
  1071.       else
  1072.          do
  1073.             str2 = str2 || substr(str1,sp,1)
  1074.             sp = sp + 1
  1075.          end
  1076.    end /* do */
  1077.    return str2
  1078.  
  1079. /* MIME */
  1080. /* base 64 encode */
  1081. Base64ex:
  1082.    procedure
  1083.    parse arg str1
  1084.    isoJP="=?ISO-2022-JP?B?"
  1085.  
  1086.    po=pos(d2c(27),str1)
  1087.    if po=0 then return str1
  1088.  
  1089.    str2=""
  1090.    do forever
  1091.       if str1="" then leave
  1092.       po=pos(d2c(27)||"$",str1)
  1093.       poe=pos(d2c(27)||"(",str1,(po+1))
  1094.       if po=0 then leave
  1095.       if po>=poe then leave
  1096.       str2=str2||left(str1,(po-1) )
  1097.       k=3+poe-po
  1098.       if k<43 then
  1099.          do
  1100.             str2=str2||encode(substr(str1,po,k))
  1101.             str1=substr(str1,(poe+3))
  1102.          end /* do */
  1103.       else
  1104.          do
  1105.             str2=str2||encode(substr(str1,po,39)||d2c(27)||"(J")||d2c(13)||d2c(9)
  1106.             str1=d2c(27)||"$@"||substr(str1,(po+39))
  1107.          end /* do */
  1108.    end /* do */
  1109.  
  1110.    str2=str2||str1
  1111.    return str2
  1112.  
  1113. encode:
  1114.    procedure
  1115.    parse arg str1
  1116.    base64alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
  1117.    len=length(str1)
  1118.  
  1119.    str2="=?ISO-2022-JP?B?"
  1120.    do i=1 to len by 3
  1121.       c81=substr(str1,i+0,1)
  1122.       c82=substr(str1,i+1,1)
  1123.       c83=substr(str1,i+2,1)
  1124.       if c82="" & c83="" then
  1125.          do
  1126.             d61= 1+(c2d(c81)%4)
  1127.             d62= 1+((c2d(c81)//4)*16)
  1128.             str2=str2||substr(base64alpha,d61,1)||substr(base64alpha,d62,1)||"=="
  1129.             iterate
  1130.          end /* do */
  1131.       if c83="" then
  1132.          do
  1133.             d61= 1+(c2d(c81)%4)
  1134.             d62= 1+((c2d(c81)//4)*16)+(c2d(c82)%16)
  1135.             d63= 1+((c2d(c82)//16)*4)
  1136.             str2=str2||substr(base64alpha,d61,1)||substr(base64alpha,d62,1)||substr(base64alpha,d63,1)||"="
  1137.             iterate
  1138.          end /* do */
  1139.       d61= 1+(c2d(c81)%4)
  1140.       d62= 1+((c2d(c81)//4)*16)+(c2d(c82)%16)
  1141.       d63= 1+((c2d(c82)//16)*4)+((c2d(c83)%64)//64)
  1142.       d64= 1+(c2d(c83)//64)
  1143.       str2=str2||substr(base64alpha,d61,1)||substr(base64alpha,d62,1)||substr(base64alpha,d63,1)||substr(base64alpha,d64,1)
  1144.    end /* do */
  1145.    str3=""
  1146.    do while length(str2)>73
  1147.       str3=str3||left(str2,72)||"?="||d2c(13)||d2c(9)||"=?ISO-2022-JP?Q?"
  1148.       str2=substr(str2,73)
  1149.    end /* do */
  1150.    str3=str3||str2||"?="
  1151.    return str3
  1152.  
  1153.  
  1154. /* base64-decode */
  1155. /*            sjisbuf.i=StringToSJIS( Base64dx( mrecbuf.i ) ) */
  1156. Base64dx:
  1157.    procedure expose i mrecbuf.
  1158.    parse arg str1
  1159.    isoJp="=?ISO-2022-JP?B?"
  1160.    isoJpEnd="?="
  1161.  
  1162. /*   po=pos(isoJp,str1)
  1163.    if po=0 then return str1 */
  1164.  
  1165.    do k=1 to 5
  1166.       m=i+1
  1167.       next = left( mrecbuf.m, 1 )
  1168. /*      if (next \= d2c(9)) & (next \= d2c(32)) then leave */
  1169.       if (next \= d2c(9)) then leave
  1170.       i=i+1;
  1171. /*      len=length(str1)
  1172.       if len=0 then len=1
  1173.       str1=left(str1, len-1)||substr(mrecbuf.i , 2) */
  1174.       str1=str1||substr(mrecbuf.i, 2)
  1175.    end /* do */
  1176.  
  1177.    str1u=translate(str1);
  1178.    po=pos(isoJp,str1u)
  1179.    if po=0 then return str1
  1180.  
  1181.    str2=""
  1182.    do forever
  1183.       if str1="" then leave
  1184.       po=pos(isoJp,str1u)
  1185.       if po=0 then leave
  1186.       str2=str2||left(str1,(po-1) )
  1187.       str1=substr(str1,po+16)
  1188.       str1u=translate(str1)
  1189.       po=pos(isoJpEnd,str1u)
  1190.       if po=0 then leave
  1191.       str2=str2||decode(left(str1,(po-1)))
  1192.       str1=substr(str1,(po+2))
  1193.       str1u=translate(str1)
  1194.    end /* do */
  1195.    str2=str2||str1
  1196.    return str2
  1197.  
  1198. decode:
  1199.    procedure
  1200.    parse arg str1
  1201.    base64alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
  1202.    len=length(str1)
  1203.    str2=""
  1204.    do i=1 to len by 4
  1205.       c61=substr(str1,i+0,1)
  1206.       c62=substr(str1,i+1,1)
  1207.       c63=substr(str1,i+2,1)
  1208.       c64=substr(str1,i+3,1)
  1209.       if c63="=" & c64="=" then
  1210.          do
  1211.             d81= (pos(c61,base64alpha)-1)*4 + (pos(c62,base64alpha)-1)%16
  1212.             str2=str2||d2c(d81)
  1213.             iterate
  1214.          end /* do */
  1215.       if c64="=" then
  1216.          do
  1217.             d81= (pos(c61,base64alpha)-1)*4 + (pos(c62,base64alpha)-1)%16
  1218.             d82= ((pos(c62,base64alpha)-1)//16)*16 + (pos(c63,base64alpha)-1)%4
  1219.             str2=str2||d2c(d81)||d2c(d82)
  1220.             iterate
  1221.          end /* do */
  1222.       d81= (pos(c61,base64alpha)-1)*4 + (pos(c62,base64alpha)-1)%16  
  1223.       d82= ((pos(c62,base64alpha)-1)//16)*16 + (pos(c63,base64alpha)-1)%4
  1224.       d83= ((pos(c63,base64alpha)-1)//4)*64 + (pos(c64,base64alpha)-1) 
  1225.       str2=str2||d2c(d81)||d2c(d82)||d2c(d83)
  1226.    end /* do */
  1227.    return str2
  1228.  
  1229.  
  1230. inc_nkf:
  1231.    do forever
  1232.       if lines(inc_list_file) = 0 then leave
  1233.       buf = linein(inc_list_file)
  1234.       parse var buf num x
  1235.       if num \= '' then
  1236.           fname=profile.path||"\folder\"||profile.incmbox||"\"||nmn
  1237.          '@nkf -s < ' || fname || ' > xxx'
  1238.          '@copy xxx ' || fname
  1239.       end
  1240.    end
  1241.    call stream inc_list_file, 'c', 'close'
  1242.    return
  1243.  
  1244.