Wilson WindowWare Tech Support

WinBatch WinBatch+Compiler WebBatch
Home | Tech Database | Tech BBS | White Papers | Purchase


Stronger Encryption Example.wbt

Keywords: 	 encryption

IntControl (4, 1, 0, 0, 0);						file list box must return a directory name

;set the stage
blocksize=128
blocklen=1000
testfile=""
outfile=""
offset=0
encrypt="CryptEncrypt"
decrypt="CryptDecrypt"
final=@True
loop=0
fileoffset=0

CryptoFormat=`WWWDLGED,5.0`;						create dialog box
CryptoCaption=`File Encryption`
CryptoX=66
CryptoY=58
CryptoWidth=149
CryptoHeight=43
CryptoNumControls=2
Crypto01=`4,16,64,DEFAULT,PUSHBUTTON,DEFAULT,"Encrypt a file",1`
Crypto02=`78,16,64,DEFAULT,PUSHBUTTON,DEFAULT,"Decrypt a File",2`

ButtonPushed=Dialog("Crypto")
if isdefined(param1)==@yes
	if param1=="/d" then debug(@on)
end if
;get user input
:files
testfile=AskFileName("Crypto", "", "All Files|*.*|Text Files|*.txt", "", 1)
outfile=Askline("Crypto","Enter an output file name?","output.txt")
outfile=filefullname(outfile)
if strupper(testfile)==strupper(filefullname(outfile))
	Message("Can't Do That!!","Output file name must be different than Input file name")
	goto files
end if

if fileexist(outfile)==@true
	if askyesno("Warning!","%outfile% already exists!%@crlf%Overwrite it?")==@yes
		if filedelete(outfile)==@false
			Message("Error","File: %outfile% could not be overwritten.%@crlf%Please choose another!")
			goto files
		end if
	else
		goto files
	end if
end if

:getpassword
hpass=askpassword("Encryption","Please enter a password to use with encryption key")
if hpass==""
	if askyesno("Wow","Did you mean to leave the password blank")==@no
		goto getpassword
	end if
end if



:dllstuff
bbcrypt=binaryalloc(5000)
binaryeodset(bbcrypt,5000)
binarypoke4(bbcrypt,0,0)

dll=strcat(dirwindows(1),"advapi32.dll")
func="CryptAcquireContextA"

if dllcall(dll,long:func,lpbinary:bbcrypt,long:0,long:0,long:1,long:0)==0
	rc=dllcall(dll,long:func,lpbinary:bbcrypt,long:0,long:0,long:1,long:8)
else
	rc=1
end if

if rc <>0 
	hcrypt=binarypeek4(bbcrypt,0)
	binaryfree(bbcrypt)
else
	Message("Error","Could not acquire a cryptgraphic context or system parameter is invalid")
	exit
end if

bbhashobj=binaryalloc(32)
binaryeodset(bbhashobj,32)

hashfunc="CryptCreateHash"
MD5=32771
rc=dllcall(dll,long:hashfunc,long:hcrypt,long:md5,long:0,long:0,lpbinary:bbhashobj)


hobj=binarypeek4(bbhashobj,0)
binaryfree(bbhashobj)

len=strlen(hpass)
bbpass=binaryalloc(len)
binaryeodset(bbpass,len)
binarypokestr(bbpass,0,hpass)

passfunc="CryptHashData"
rc=dllcall(dll,long:passfunc,long:hobj,lpbinary:bbpass,long:len,long:0)
if rc==0
	Message("Error","Could not create hash object..Exiting")
	exit
end if
binaryfree(bbpass)

keyfunc="CryptDeriveKey"
en_alg=26114
bbkey=binaryalloc(100)
binaryeodset(bbkey,100)

rc=dllcall(dll,long:keyfunc,long:hcrypt,long:en_alg,long:hobj,long:0,lpbinary:bbkey)

if rc<>0 
	hkey=binarypeek4(bbkey,0)
	binaryfree(bbkey)
	killhash=dllcall(dll,long:"CryptDestroyHash",long:hobj)
else
	Message("Error","Encryption Key Failed!.. Exiting")
	exit
end if

eof=filesize(testfile)

bbdatalen=binaryalloc(32)
binaryeodset(bbdatalen,32)
binarypoke4(bbdatalen,0,0)

if eof > blocklen 
	while @true
		if blocklen > eof then break
		blocklen=blocklen + 1000
	end while
end if

bbdata=binaryalloc(blocklen)

if buttonpushed==2 then goto decryptloop

:encryptloop
BoxOpen("Encrypting","")
BoxColor(1, "0,255,0", 2);						Green with yellow Wash Color
BoxTextColor(1, "255,255,255")
BoxDataTag(1,"HERCULES")
While @True
	target=eof - offset
	if target < blocksize
		blocksize=target
		final=@true
	else
		final=@false
	end if
	dwRead=BinaryReadEx(bbdata, 0, testfile, offset, blocksize)
	binarypoke4(bbdatalen,0,blocksize)
	rc=dllcall(dll,long:encrypt,long:hkey,long:0,long:final,long:0,lpbinary:bbdata,lpbinary:bbdatalen,long:blocklen)
	if rc==1
		advance=binarypeek4(bbdatalen,0)
		if advance==0 then message("",binarypeekstr(bbdata,0,blocksize))
		a=filesize(outfile)
		written=binarywriteex(bbdata,0,outfile,a,advance)
		BoxDataClear(1,"HERCULES")
		Boxtext(strcat(@crlf,@crlf,@tab,@tab,"Processing: %a% of %eof%Bytes.."))
	end if
	offset=offset + blocksize
	if offset >= eof then break
	loop=loop + 1
end while
exit

:decryptloop
BoxOpen("Decrypting","")
BoxColor(1, "0,0,255",1 );						Blue with Red Wash Color
BoxTextColor(1, "255,255,255")
BoxDataTag(1,"HERCULES")
While @True
	if eof - offset < blocksize
		blocksize=eof-offset
		final=@true
	else
		final=@false
	end if
	if offset >= eof then break
	dwRead=BinaryReadEx(bbdata, 0, testfile, offset, blocksize)
	binarypoke4(bbdatalen,0,blocksize)
	rc=dllcall(dll,long:decrypt,long:hkey,long:0,long:final,long:0,lpbinary:bbdata,lpbinary:bbdatalen)
	if rc==1
		advance=binarypeek4(bbdatalen,0)
		written=BinaryWriteEx(bbdata, 0, OutFile, offset, advance)
		BOXDATACLEAR(1,"HERCULES")
		Boxtext(strcat(@crlf,@crlf,@tab,@tab,"Processing: %offset% of %eof%Bytes.."))
	end if
	offset=offset + advance
	loop=loop + 1
end while
exit

Article ID:   W14965