In the HTML meta for robots items I will support for now are "index", "follow" and "archive". If the "Index the page?" checkbox is checked the "Allow" option will put "index" in the meta, or "Deny" will put "noindex". Unchecked, neither "index" nor "noindex is specified. "Follow links?" behaves similarly, checked has "Allow" for "follow" or "Deny" for "nofollow"; unchecked for neither. "Do not archive?" has "noarchive" or unused, so only the checkbox is needed, archiving is allowed by leaving the checkbox unchecked.
The Windows handle, hParent, for the Head_Edit window for the result to be put in the textbox there. And the color of tab for the file being worked on as a visual reminder.
'Filename: RobotsContentItems.bas
%TestRobots = 1 'REM this line to use this as include.
' https://developer.mozilla.org/en-US/docs/Web/HTML/Element/meta/name
#if %def(%TestRobots)
#include ".\Consolidated.inc"
#endif
declare function RobotsText (byval RTxtID as long) as wstring
callback function hRobotsCB () as long
local TmpTxt1, TmpTxt2 as wstring
local TmpLng as long
if cb.msg = %wm_command then
select case as const cb.ctl
case %ID_RobotsIndexCkBx
if cb.ctlmsg = %bn_clicked then
control get check cb.hndl, %ID_RobotsIndexCkBx to TmpLng
if TmpLng then
control enable cb.hndl, %ID_RobotsIndexYesOpt
control enable cb.hndl, %ID_RobotsIndexNoOpt
else
control disable cb.hndl, %ID_RobotsIndexYesOpt
control disable cb.hndl, %ID_RobotsIndexNoOpt
end if
control get check cb.hndl, %ID_RobotsIndexYesOpt to TmpLng
if TmpLng then
exit function
else
control set check cb.hndl, %ID_RobotsIndexNoOpt, 1
end if
end if
case %ID_RobotsFollowCkBx
if cb.ctlmsg = %bn_clicked then
control get check cb.hndl, %ID_RobotsFollowCkBx to TmpLng
if TmpLng then
control enable cb.hndl, %ID_RobotsFollowYesOpt
control enable cb.hndl, %ID_RobotsFollowNoOpt
else
control disable cb.hndl, %ID_RobotsFollowYesOpt
control disable cb.hndl, %ID_RobotsFollowNoOpt
end if
control get check cb.hndl, %ID_RobotsFollowYesOpt to TmpLng
if TmpLng then
exit function
else
control set check cb.hndl, %ID_RobotsFollowNoOpt, 1
end if
end if
case %ID_RobotsDoneBtn
if cb.ctlmsg = %bn_clicked then
control get check cb.hndl, %ID_RobotsIndexCkBx to TmpLng
if TmpLng then
control get check cb.hndl, %ID_RobotsIndexYesOpt to TmpLng
if TmpLng then
TmpTxt1 = "index"$$
else
TmpTxt1 = "noindex"$$
end if
end if
control get check cb.hndl, %ID_RobotsFollowCkBx to TmpLng
if TmpLng then
if len(TmpTxt1) then
TmpTxt1 = build$(TmpTxt1, ", "$$)
end if
control get check cb.hndl, %ID_RobotsFollowYesOpt to TmpLng
if TmpLng then
TmpTxt1 = build$(TmpTxt1, "follow"$$)
else
TmpTxt1 = build$(TmpTxt1, "nofollow"$$)
end if
end if
control get check cb.hndl, %ID_RobotsNoArchiveCkBx to TmpLng
if TmpLng then
if len(TmpTxt1) then
TmpTxt1 = build$(TmpTxt1, ", noarchive"$$)
else
TmpTxt1 = build$(TmpTxt1, "noarchive"$$)
end if
end if
if len(TmpTxt1) then
TmpTxt2 = build$(" "$$)
dialog get user cb.hndl, 1 to TmpLng
control set text TmpLng, %ID_HdEdRobotsTxtBx, TmpTxt2
dialog end cb.hndl
else
dialog get user cb.hndl, 2 to TmpLng
call dword TmpLng using RobotsText (%RobotsNoSelMBTxt) to TmpTxt1
call dword TmpLng using RobotsText (%RobotsNoSelMBCap) to TmpTxt2
TmpLng = msgbox(TmpTxt1, %mb_yesno or %mb_iconquestion or _
%mb_taskmodal, TmpTxt2)
if TmpLng = %idyes then
exit function
else
dialog end cb.hndl
end if
end if
end if
case %ID_RobotsAbandonBtn
if cb.ctlmsg = %bn_clicked then
dialog get user cb.hndl, 2 to TmpLng
call dword TmpLng using RobotsText (%RobotsAbandMBTxt) to TmpTxt1
call dword TmpLng using RobotsText (%RobotsAbandMBCap) to TmpTxt2
TmpLng = msgbox(TmpTxt1, %mb_yesno or %mb_iconquestion or _
%mb_defbutton2 or %mb_taskmodal, TmpTxt2)
if TmpLng = %idyes then
dialog end cb.hndl
end if
end if
end select
end if
end function
'-------------------------------------------------------------------------------
function RobotsMeta(byval hParent as dword, byval TabColor as long) as wstring
local hRobots as dword
local LineStyle as long
local TmpTxt as wstring
import addr "RobotsText"$$, gLangDLLName to gpRobotsText
if (TabColor = %Color_Orange) or (TabColor = %Color_Yellow) or _
(TabColor = %Color_White) then
LineStyle = %ss_blackrect
else
LineStyle = %ss_whiterect
end if
'-----------------------------------------------------------------------------
call dword gpRobotsText using RobotsText(%RobotsDlgCaption) to TmpTxt
dialog new hParent, TmpTxt, 20, 00, 140, 132, %ds_3dlook or %ds_modalframe or _
%ds_nofailcreate or %ds_setfont or %ws_caption or %ws_clipsiblings or _
%ws_dlgframe or %ws_popup, %ws_ex_left or %ws_ex_ltrreading to hRobots
dialog set user hRobots, 1, hParent
dialog set user hRobots, 2, gpRobotsText
dialog set color hRobots, -1, TabColor
'
'index/noindex · · · · · · · · · · · · · · · · · · · · · · · · · · · · · · ···
call dword gpRobotsText using RobotsText (%ID_RobotsIndexCkBx) to TmpTxt
control add checkbox, hRobots, %ID_RobotsIndexCkBx, TmpTxt, 5, 2, 130, 11, _
%bs_left or %bs_vcenter or %ws_tabstop, %ws_ex_left
'
call dword gpRobotsText using RobotsText (%ID_RobotsIndexYesOpt) to TmpTxt
control add option, hRobots, %ID_RobotsIndexYesOpt, TmpTxt, 12, 13, 123, 11, _
%bs_left or %bs_vcenter or %ws_disabled or %ws_group or %ws_tabstop, _
%ws_ex_left
'
call dword gpRobotsText using RobotsText (%ID_RobotsIndexNoOpt) to TmpTxt
control add option, hRobots, %ID_RobotsIndexNoOpt, TmpTxt, 12, 24, 123, 11, _
%bs_left or %bs_vcenter or %ws_disabled, %ws_ex_left
'
control add line, hRobots, %ID_RobotsIndexLine, "", 2, 37, 136, 2, _
LineStyle or %ws_group
'
'Follow links · · · · · · · · · · · · · · · · · · · · · · · · · · · · · · ···
call dword gpRobotsText using RobotsText (%ID_RobotsFollowCkBx) to TmpTxt
control add checkbox, hRobots, %ID_RobotsFollowCkBx, TmpTxt, 5, 41, 130, 11
'
call dword gpRobotsText using RobotsText (%ID_RobotsFollowYesOpt) to TmpTxt
control add option, hRobots, %ID_RobotsFollowYesOpt, TmpTxt, _
12, 52, 123, 11, %bs_left or %bs_vcenter or %ws_disabled or %ws_group or _
%ws_tabstop, %ws_ex_left
'
call dword gpRobotsText using RobotsText (%ID_RobotsFollowNoOpt) to TmpTxt
control add option, hRobots, %ID_RobotsFollowNoOpt, TmpTxt, 12, 63, 123, 11, _
%bs_left or %bs_vcenter or %ws_disabled, %ws_ex_left
control add line, hRobots, %ID_RobotsFollowLine, "", 2, 76, 136, 2, _
LineStyle or %ws_group
'
'Do not archive · · · · · · · · · · · · · · · · · · · · · · · · · · · · · ···
call dword gpRobotsText using RobotsText (%ID_RobotsNoArchiveCkBx) to TmpTxt
control add checkbox, hRobots, %ID_RobotsNoArchiveCkBx, TmpTxt, 5, 80, 130, 11
'
control add line, hRobots, %ID_RobotsNoArchiveLine, "", 2, 93, 136, 4, _
LineStyle
'
'Robots done · · · · · · · · · · · · · · · · · · · · · · · · · · · · · · · ···
call dword gpRobotsText using RobotsText(%ID_RobotsDoneBtn) to TmpTxt
control add button, hRobots, %ID_RobotsDoneBtn, TmpTxt, 10, 100, 120, 15
'
'Robots abandon · · · · · · · · · · · · · · · · · · · · · · · · · · · · · ···
call dword gpRobotsText using RobotsText (%ID_RobotsAbandonBtn) to TmpTxt
control add button, hRobots, %ID_RobotsAbandonBtn, TmpTxt, 10, 119, 120, 11
'-----------------------------------------------------------------------------
dialog show modal hRobots call hRobotsCB
'
end function
'#### For testing, not as an #INCLUDE file. ####################################
#if %def(%TestRobots)
%ID_TestRobotsBtn = 5000
%ID_ExitRobotsBtn = 5001
%ID_HdEdRobotsTxtBx = 5002
function pbmain () as long
local hTestRobotsDlg as dword
local DlgCnt as long
dialog default font "Microsoft Sans Serif"$$, 12, 0, 1
gLangDLLName = "DY_HTML_Edit_EN.dll"$$
dialog new 0, "Test Robots Meta Popup", , , 220, 55 to hTestRobotsDlg
'
control add button, hTestRobotsDlg, %ID_TestRobotsBtn, "Do Test", _
5, 5, 50, 12
control add textbox, hTestRobotsDlg, %ID_HdEdRobotsTxtBx, "", 5, 22, 210, 11
control add button, hTestRobotsDlg, %ID_ExitRobotsBtn, "Exit", 5, 38, 50, 12
dialog show modeless hTestRobotsDlg call TestRobotsDlgCB
do
dialog doevents to DlgCnt
loop while DlgCnt
'
end function
callback function TestRobotsDlgCB() as long
if cb.msg = %wm_command then
select case as long cb.ctl
case %ID_TestRobotsBtn
RobotsMeta cb.hndl, %Color_Orange
case %ID_ExitRobotsBtn
dialog end cb.hndl
end select
end if
end function
#endif
Full copyleft (ɔ), 2023 by Dale Yarker in source or compiled form. Complete license in new tab or window.
Created on 06 April 2024, updated 5 May 2024.
To Dale's Notebook
| To Programs
|