&& base64 for vfp6 *================================================================================ * usage * base64_encode(s) returns base64 encoded string * base64_decode(s) returns base64 decoded string *================================================================================ #include "FoxPro.h" #define TRUE .T. #define FALSE .F. *================================================================================ *--------------------------------------------------------------------------- function base64_encode(s) local FileName_in, FileName_Out, fd, out FileName_in = GetTmpFileName('txt') =strToFile(m.s, m.FileName_in) FileName_Out= GetTmpFileName('txt') fd = fcreate(m.FileName_Out) do case case m.fd < 0 out = '' case !base64_encode_append(m.FileName_in, m.fd) =fclose(m.fd) out = '' otherwise =fclose(m.fd) out = FileTostr(m.FileName_Out) endcase declare Integer DeleteFile in win32api string @ =DeleteFile(m.FileName_in) =DeleteFile(m.FileName_out) return m.Out endfunc *--------------------------------------------------------------------------- function base64_encode_append(FileName, fd_out) local Success Success = TRUE local fd_in, nbytes, i, x, nBytesLine nBytesLine = 0 do case case !m.Success case !Base64_Tables() assert FALSE Success = FALSE otherwise fd_in = fopen(m.FileName, F_READONLY) endcase do case case !m.Success case m.fd_in < 0 assert FALSE Success = FALSE otherwise nbytes = fseek(m.fd_in, 0, 2) =fseek(m.fd_in, 0, 0) endcase do case case !m.Success && bof() ? && go to beginning of new line case !empty(fseek(m.fd_out, 0, 1)) and (2 <> fputs(m.fd_out, '')) assert FALSE Success = FALSE otherwise for i = 1 to m.nBytes - mod(m.nBytes,3) step 3 x = ctobin(chr(0x80) + fread(m.fd_in, 3) ) do case case 4 <> fwrite(m.fd_out, _screen.Base64_Encode[bitrshift(m.x, 12)+1] + _screen.Base64_Encode[bitand(m.x, 0x0fff)+1]) assert FALSE Success = FALSE exit otherwise nBytesLine = m.nBytesLine + 4 if( m.nBytesLine = 76 ) nBytesLine = 0 = fputs(m.fd_out, '') endif endcase endfor endcase do case case !m.Success case empty(mod(m.nBytes, 3)) case mod(m.nBytes,3) = 1 x = ctobin(chr(0x80) + fread(m.fd_in, 1) + chr(0) + chr(0) ) do case case 4 <> fwrite(m.fd_out, _screen.Base64_Encode[bitrshift(m.x, 12)+1] + '==') assert FALSE Success = FALSE otherwise nBytesLine = m.nBytesLine + 4 endcase otherwise x = ctobin(chr(0x80) + fread(m.fd_in, 2) + chr(0) ) do case case 4 <> fwrite(m.fd_out, _screen.Base64_Encode[bitrshift(m.x, 12)+1] + left(_screen.Base64_Encode[bitand(m.x, 0x0fff)+1],1) + '=') assert FALSE Success = FALSE otherwise nBytesLine = m.nBytesLine + 4 endcase endcase do case case !m.Success case (m.nBytesLine = 76) and (2 <> fputs(m.fd_out, '')) assert FALSE Success = FALSE endcase =fclose(m.fd_in) return m.Success endfunc *--------------------------------------------------------------------------- function base64_decode(s) local FileName_in, FileName_Out, fd, out FileName_in = GetTmpFileName('txt') =strToFile(m.s, m.FileName_in) fd = fopen(m.FileName_in) FileName_Out= GetTmpFileName('txt') do case case m.fd < 0 out = '' case !base64_Decode_fd(m.fd, m.FileName_Out) =fclose(m.fd) out = '' otherwise =fclose(m.fd) out = FileTostr(m.FileName_Out) endcase declare Integer DeleteFile in win32api string @ =DeleteFile(m.FileName_in) =DeleteFile(m.FileName_out) return m.Out endfunc *--------------------------------------------------------------------------- && read fd_in && skip all chars not in A-Z, a-z, 0-9, +, /, = && stop when char = '-', or eof function base64_Decode_fd(fd_in, FileNameOut) local Success Success = TRUE local fd_out, out, n, nbytes, BytesIn do case case !m.Success case !Base64_Tables() assert FALSE Success = FALSE otherwise fd_out = fcreate(m.FileNameOut) endcase do case case !m.Success case m.fd_out < 0 assert FALSE Success = FALSE otherwise nbytes = fseek(fd_in, 0, 1) nBytes = fseek(fd_in, 0, 2) - fseek(fd_in, m.nBytes, 0) out = 0x80 BytesIn = 0 for i = 1 to m.nBytes && can never have feof() n = _screen.Base64_Decode[ asc(fread(m.fd_in, 1)) + 1 ] do case && Normal char case m.n >= 0 && most likely out = bitlshift(m.out, 6) + m.n BytesIn = m.BytesIn + 1 do case case m.BytesIn = 4 do case case 3 <> fwrite(m.fd_out, right(bintoc(m.out),3)) assert FALSE Success = FALSE exit endcase out = 0x80 BytesIn = 0 endcase && skip char case m.n = -1 && ignore && pad char '=' case m.n = -2 do case case m.BytesIn = 2 out = bitlshift(m.out, 6) n = _screen.Base64_Decode[ asc(fread(m.fd_in, 1)) + 1] do case case m.n = -2 out = bitlshift(m.out, 6) do case case 1 <> fwrite(m.fd_out, substr(bintoc(m.out),2, 1)) assert FALSE Success = FALSE exit otherwise BytesIn = 0 exit endcase otherwise assert FALSE Success = FALSE exit endcase case m.BytesIn = 3 out = bitlshift(m.out, 6) do case case 2 <> fwrite(m.fd_out, substr(bintoc(m.out),2, 2)) assert FALSE Success = FALSE exit otherwise BytesIn = 0 exit endcase otherwise assert FALSE Success = FALSE exit endcase && eof marker '-' case m.BytesIn <> 0 assert FALSE Success = FALSE exit endcase endfor do case case !m.Success case m.BytesIn <> 0 assert FALSE Success = FALSE exit endcase endcase =fclose(m.fd_out) return m.Success endfunc *--------------------------------------------------------------------------- function Base64_Tables() local Success Success = TRUE do case case type('_screen.Base64_Encode[1]') == T_CHARACTER case !_screen.AddProperty('Base64_Encode[4096]') assert FALSE Success = FALSE case !_screen.AddProperty('Base64_Decode[256]') assert FALSE Success = FALSE otherwise local i, j, Base64_Table[64] for i = 1 to 26 Base64_Table[m.i] = chr(0x40+m.i) endfor for i = 27 to 52 Base64_Table[m.i] = chr(0x46+m.i) endfor for i = 53 to 62 Base64_Table[m.i] = chr(-5+m.i) endfor Base64_Table[63] = '+' Base64_Table[64] = '/' && encode table for i = 0 to 63 for j = 0 to 63 _screen.Base64_Encode[ m.i * 64 + m.j + 1 ] = Base64_Table[m.i+1] + Base64_Table[m.j+1] endfor endfor && decode table _screen.Base64_Decode = -1 && skip char for i = 1 to 64 _screen.Base64_Decode[ asc(Base64_Table[m.i]) + 1 ] = m.i-1 endfor _screen.Base64_Decode[ asc('=') + 1] = -2 && pad char _screen.Base64_Decode[ asc('-') + 1] = -3 && eof marker endcase return m.Success endfunc *--------------------------------------------------------------------------- *--------------------------------------------------------------------------- *--------------------------------------------------------------------------- function GetTmpFileName(Extension) local FileName do case case empty(m.Extension) FileName = addbs(GetTmpDir()) + substr(sys(2015), 3, 10) do while FileExists(m.FileName) FileName = addbs(GetTmpDir()) + substr(sys(2015), 3, 10) enddo otherwise FileName = ForceExt(addbs(GetTmpDir()) + substr(sys(2015), 3, 10), m.Extension) do while FileExists(m.FileName) FileName = ForceExt(addbs(GetTmpDir()) + substr(sys(2015), 3, 10), m.Extension) enddo endcase return m.FileName endfunc *-------------------------------------------------------------------------- Function FileExists(FileName) declare Integer GetFileAttributes in win32api string @ return (GetFileAttributes(@m.FileName) <> -1) endfunc *-------------------------------------------------------------------------- function GetTmpDir(ToTmpVfp) local tmpdir do case case !IsRunTime() or m.ToTmpVfp or (ExpandEnvStrings('%userprofile%') = '%userprofile%') tmpdir = lower(Fullpath('\tmp\vfp')) otherwise tmpdir = addbs(ExpandEnvStrings('%userprofile%')) + 'tmp\vfp' endcase if( !Directory(tmpdir) ) md (tmpdir) endif return tmpdir endfunc *-------------------------------------------------------------------------- function IsRunTime() return empty(Version(2)) endfunc *--------------------------------------------------------------------------- function ExpandEnvStrings(s) declare Long ExpandEnvironmentStrings in Kernel32.dll ; String @lpSrc, String @ lpDst, Long nSize && maximum characters in expanded string local i, s1 s1 = space(1024) i = ExpandEnvironmentStrings(@m.s, @m.s1, 1024) return left(m.s1, m.i-1) endfunc *--------------------------------------------------------------------------