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