Don't know how well it will work, but it does hide all reference to email address links as 2 seperated parts hidden using Base64 encoding & might be useful to some of you.

Code: Select all
#Title="Base64 HideMail Script Generator"
#EncryptGood=0
#EncryptFail=1
#EncryptNoText=2
Enumeration
#Window_0
EndEnumeration
Enumeration
#Menu_0
#M_Exit
#M_About
EndEnumeration
Enumeration
#Label_Addy
#String_EmailAddy
#Editor_Script
#Label_Script
#Text_Encrypted_php
#Label_Encrypted_php
#Button_Encrypt
#File
EndEnumeration
Procedure SelectAll(Gadget_Id.l)
SendMessage_(GadgetID(Gadget_Id),#EM_SETSEL,0,-1)
SetActiveGadget(Gadget_Id)
EndProcedure
Procedure Encrypt_Addy()
Addy$=GetGadgetText(#String_EmailAddy)
Anchor_Start$="<a href='<?php echo addy_decrypt('"
Anchor_Finish$="');?>?subject=Feedback'>My Contact Info</a>"
If Addy$<>""
If FindString(Addy$,"@",1) And FindString(Addy$,".",1)
AddyLen.l=Len(Addy$)
lngth.l=AddyLen*1.5
Encrypted$=Space(lngth)
If Base64Encoder(@Addy$,AddyLen,@Encrypted$,lngth)
SetGadgetText(#Text_Encrypted_php,Anchor_Start$+Encrypted$+Anchor_Finish$)
ProcedureReturn #EncryptGood
Else
ProcedureReturn #EncryptFail
EndIf
EndIf
EndIf
ProcedureReturn #EncryptNoText
EndProcedure
Procedure Open_Window_0()
Script$="<!-- Start of decrypt funtcion -->"+#CRLF$+"<?php"+#CRLF$
Script$+"// Script by Baldrick"+#CRLF$
Script$+"// Copy and paste this php function complete into your page"+#CRLF$
Script$+"function addy_decrypt($addy)"+#CRLF$+"{"+#CRLF$
Script$+"$mial2=base64_decode('bWFpbHRvOg==');"+#CRLF$
Script$+"$decoded=base64_decode($addy); "+#CRLF$
Script$+"$result="+Chr(34)+"$mial2$decoded"+Chr(34)+" ;"+#CRLF$
Script$+"return trim($result);"+#CRLF$+"}"+#CRLF$+"?>"+#CRLF$
Script$+"<!-- end of decrypt function -->"+#CRLF$
If OpenWindow(#Window_0, 216, 0, 600, 370, #Title, #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
If CreateMenu(#Menu_0,WindowID(#Window_0))
MenuTitle("&File")
MenuItem(#M_Exit,"&Exit")
AddKeyboardShortcut(#Window_0,#PB_Shortcut_Escape,#M_Exit)
MenuTitle("&About")
MenuItem(#M_About,"Abou&t")
If CreateGadgetList(WindowID(#Window_0))
TextGadget(#Label_Addy, 10, 10, 255, 20, "Email address: e.g. myname@mydomain.com.au")
StringGadget(#String_EmailAddy, 10, 30, 270, 20, "")
ButtonGadget(#Button_Encrypt, 400, 20, 100, 30, "Encrypt Address")
GadgetToolTip(#String_EmailAddy, "Type your real email address here")
TextGadget(#Label_Encrypted_php,10,70,400,20,"Anchor tagged address: - copy and paste to replace anchors")
StringGadget(#Text_Encrypted_php,10,90,580,20,"",#PB_String_ReadOnly)
TextGadget(#Label_Script,10,120,400,20,"Decryption php function, copy and paste into body of webpage")
EditorGadget(#Editor_Script,10,140,580,190,#PB_Editor_ReadOnly)
GadgetToolTip(#Text_Encrypted_php, "Copy and paste as new link anchor")
GadgetToolTip(#Editor_Script, "Copy and paste complete funtion to php page")
SetGadgetText(#Editor_Script,Script$)
GadgetToolTip(#Button_Encrypt, "Encrypt Address")
SetActiveGadget(#String_EmailAddy)
ProcedureReturn 1
EndIf
EndIf
EndIf
EndProcedure
If Not Open_Window_0()
MessageRequester(#Title+" error",#Title+" window initialisation fault "+#Title+" will now close",#MB_ICONERROR)
End
EndIf
Repeat
Ev.l=WaitWindowEvent(100)
If Ev=#PB_Event_Menu
Select EventMenu()
Case #M_Exit
Quit=1
Case #M_About
Amsg$="This program coded by Baldrick to try and help make the "
Amsg$+"idiot email spammers harvesting a bit more difficult"
MessageRequester(#Title,Amsg$,#MB_ICONINFORMATION)
EndSelect
EndIf
If Ev=#PB_Event_Gadget
Select EventGadget()
Case #Button_Encrypt
Result.l=Encrypt_Addy()
If Result
Select Result
Case #EncryptFail
errormsg$="Encryption fail"
Case #EncryptNoText
errormsg$="Invalid or no email address"
EndSelect
MessageRequester(#Title+" error",errormsg$,#MB_ICONINFORMATION)
Else
SelectAll(#Text_Encrypted_php)
EndIf
EndSelect
Select EventType()
Case #PB_EventType_Focus
Select EventGadget()
Case #String_EmailAddy
SelectAll(#String_EmailAddy)
Case #Text_Encrypted_php
SelectAll(#Text_Encrypted_php)
EndSelect
EndSelect
EndIf
If Ev=#PB_Event_CloseWindow
Quit=1
EndIf
Until Quit