Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
STRCONV() to Base64 in VFP 6.0
Message
De
02/03/2005 08:55:13
 
 
À
02/03/2005 08:09:20
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Versions des environnements
Visual FoxPro:
VFP 6 SP5
Divers
Thread ID:
00991916
Message ID:
00991933
Vues:
16
>Hi all,
>
>In VFP 7.0 or greater, I know you can use the STRCONV() to get a Base64 representation of a string. Does anyone have any tips on how I may be able to do this in VFP 6.0?
>
>Thanks in advance,
>
>Mike

Try this. It runs fast enough
&&	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
*--------------------------------------------------------------------------
Gregory
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform