FiveTech Support Forums

*-- PROGRAM FILE -------------------------------------------------------------
*  Application: Mime Based Encoding/Decoding
*  Description:   optimized for MIME
*    File Name: mimeclip.prg
*       Author: Jim Gale              Tester:
* Date created: 5/2/98                Date updated: þ5/2/98
* Time created: 1:52:22AM             Time updated: þ1:52:22AM
*    Copyright: (c) 1998 by Gale-Force. All Rights Reserved.
*        Email: jg5@gale-force.com
*-----------------------------------------------------------------------------

#define  HKEY_CLASSES_ROOT       2147483648
#define  HKEY_CURRENT_USER       2147483649
#define  HKEY_LOCAL_MACHINE      2147483650
#define  HKEY_USERS              2147483651
#define  HKEY_PERFORMANCE_DATA   2147483652
#define  HKEY_CURRENT_CONFIG     2147483653
#define  HKEY_DYN_DATA           2147483654

#DEFINE MIMESIZE    2964  //multiple of 3, 4, 76, and 78 -> perfect mimeblock for IN and OUT
#define SYSCOUNT    12

#DEFINE TEST
#INCLUDE "fivewin.CH"

#ifdef TEST

Function MakeWind()
local oApp

   DEFINE WINDOW oApp TITLE "MimeTest"

   @ 1,1 BUTTON "TEST" of oApp ACTION TestThis()

   ACTIVATE WINDOW oApp

return nil


Function TESTTHIS()
local nIN, nOUT, a, x, a1, a2, cIN, cOUT, z, cF, n1, n2

   a := directory("*.obj")

   n1 := seconds()
   for x := 1 to len(a)
      cF := a[x,1]
      //?cF
      COPY FILE (cF) TO ("aaaa.in")

      fMimeEnc("aaaa.in", "aaaa.mim")
      fMimeDec("aaaa.mim","aaaa.out")

      a1 := directory("aaaa.in")
      a2 := directory("aaaa.out")

      if a1[1,2]#a2[1,2]
         msgstop("SIZE MISMATCH!!! "+cF)
         quit
      endif
   next
   n2 := seconds()
   msginfo("elapsed "+alltrim(str(n2-n1,7,2))+" seconds")

RETURN NIL

//function sysrefresh() ; return nil
#endif

//----------------------------------------------------------------------------

Function fMimeDec(cIn,cOut)
Local nIn, nOut, c

   nOut := FCreate(cOut,0)
   nIn  := FOpen(cIn,0)

   ffMimeDec(nIn,nOut)

   FClose(nOut)
   FClose(nIn)

Return nil

//----------------------------------------------------------------------------

Function fMimeEnc(cIn,cOut)
Local nIn, nOut

   nOut := FCreate(cOut,0)
   nIn  := FOpen(cIn,0)

   ffMimeEnc(nIn,nOut)

   FClose(nOut)
   FClose(nIn)

Return NIL

//----------------------------------------------------------------------------

Function ffMimeDec(nIn,nOut)
local cOut, n, cIn, nS:=0, cPre:="", nMod, lEOF:= .f.

   While !lEOF
      cIn     := Space(MIMESIZE)
      if (n   := FRead(nIn,@cIn,MIMESIZE)) < MIMESIZE
         cIn  := substr(cIn,1,n)
         lEOF := .t.
      endif

      cIn     :=      strtran(cIn,Chr(13)+Chr(10),"")

      if at(chr(13),cIn)>0
         cIn     :=      strtran(cIn,Chr(13),"")
      endif
      if at(chr(10),cIn)>0
         cIn     :=      strtran(cIn,Chr(10),"")
      endif
      cIn     := cPre+cIn
      if !lEOF
         if (nMod := len(cIn)%4) > 0
            cPre  := substr(cIn,len(cIn)-nMod+1)
            cIn   := substr(cIn,1,len(cIn)-nMod)
         else
            cPre  := ""
         endif
      endif

      if !empty(cIn)
         cOut := cMimeDec(cIn)
         FWrite(nOut, cOut, Len(cOut))
      endif

      If ++nS%SYSCOUNT=0
         sysrefresh()
      Endif
   Enddo

Return nil

//----------------------------------------------------------------------------

Function ffMimeEnc(nIn,nOut)
Local cIn, cOut, n, nn:=0, cOut2, nS:=0, lEOF:=.f.

   cIn  := Space(MIMESIZE)
   cOut := ""

   While !lEOF
      if (n     := FRead(nIn,@cIn,MIMESIZE)) < MIMESIZE
         lEOF   := .t.
      endif

      cOut2 := cMimeEnc(substr(cIn,1,n))
      nn    += len(cOut2)
      cOut  += cOut2

      while nn >= 76
         FWrite(nOut,Substr(cOut,1,76)+Chr(13)+Chr(10),78)
         nn-=76
         cOut := Substr(cOut,77)

         If ++nS%SYSCOUNT=0
            sysrefresh()
         Endif
      enddo

   Enddo

   if nn>0
      FWrite(nOut,cOut+Chr(13)+Chr(10),nn+2)
      nn:=0
   Endif

Return NIL

#ifndef __XPP__

function MimeExt( cExt )

   local nHandle, cValue:= space( 50 )
   local nLen:= 50

   if RegOpenKey( HKEY_LOCAL_MACHINE,;
         "SOFTWARE\Classes\." + cExt, @nHandle ) == 0

      RegQryValueEx( nHandle, "Content Type", 0, 1, cValue, nLen )
      RegCloseKey( nHandle )
   endif

return if( empty( alltrim( cValue )), "application/octet-stream", cValue )

DLL32 FUNCTION RegQryValueEx( HKEY AS LONG, VALUE AS LPSTR, RES1 AS LONG,;
   @TYPE AS PTR, BUFFER AS LPSTR, @SIZE AS PTR ) AS LONG ;
   PASCAL FROM "RegQueryValueExA" LIB "ADVAPI32"

#endif

//----------------------------------------------------------------------------