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