Mini Kabibi Habibi

Current Path : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/ffc/
Upload File :
Current File : C:/Users/ITO/Desktop/VF9/program files/microsoft visual foxpro 9/ffc/_internet.vct

xHVERSION =   3.00)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0
_openaddressdialogPixelsClass9_dialog_openaddressdialog.Top = 10
Left = 310
Name = "oShellExecute"
_openaddressdialog
oShellExecutecustom_environ.vcx
_shellexecutecmdOpenFile	_scx2htmlPixels1Classjcsource = 
coutfile = 
ngenoutput = 2
lautonameoutput = .T.
cscope = 
cstyle = 
Name = "_scx2html"
	_scx2html1n�� UU��%�	��Uk���!T��CC���
File Name:�@��%�C����>�B�-���T��������������U	LCURLTHISFORMCFILEEXTTHISPARENTCBOURLDISPLAYVALUECMDOKSETFOCUSClick,��1q�qAa2�)U_openaddressdialog
commandbutton
commandbutton=PROCEDURE Click
thisform.Hide
thisform.Release

ENDPROC
1_cookiePixelsClass1_custom_cookieFccookie = 
cookietable = cookies.dbf
dbfalias = 
Name = "_cookie"
custom�PROCEDURE Click
LOCAL lcURL

lcURL=LOWER(GETFILE(thisform.cFileExt,"File Name:"))
IF EMPTY(lcURL)
	RETURN .F.
ENDIF
this.parent.cboURL.DisplayValue=lcURL
this.parent.cmdOK.SetFocus

ENDPROC
�Top = 86
Left = 256
Height = 23
Width = 75
FontName = "MS Sans Serif"
FontSize = 8
Caption = "\<Browse..."
TabIndex = 8
Name = "cmdOpenFile"
�� ���%`wo�U
����
����UTHISFORMHIDERELEASEClick,��1��22)��Top = 86
Left = 175
Height = 23
Width = 75
FontName = "MS Sans Serif"
FontSize = 8
Caption = "Cancel"
TabIndex = 7
Name = "cmdCancel"
_openaddressdialog	cmdCancel
commandbutton
commandbutton��� ���Y%i�x�U����
����T��C�������%�C��
������C���������T��C�������T������%���	������C���
�����
����U
LCURLTHISFORMHIDETHISPARENTCBOURLDISPLAYVALUEADDITEMCTARGET
LSHELLEXECUTE
OSHELLEXECUTESHELLEXECUTERELEASEClick,��1q����AAA�2Q)�_openaddressdialog1	_base.vcxcustom	_base.vcxcmdOKcboURL_custom	_frx2htmlPixelsClass	_frx2htmlcustomPixels�Top = 86
Left = 94
Height = 23
Width = 75
FontName = "MS Sans Serif"
FontSize = 8
Caption = "OK"
Default = .T.
Enabled = .F.
TabIndex = 6
Name = "cmdOK"

commandbuttonlabel�coutfile = 
csource = 
ngenoutput = 2
lautonameoutput = .T.
cscope = 
cstyle = 
lcreatetempreport = .T.
Name = "_frx2html"
	_base.vcx_custom	_dbf2htmlClass�csource = 
ngenoutput = 2
coutfile = 
lusecurrentalias = .T.
lautonameoutput = .T.
cscope = 
cstyle = 
Name = "_dbf2html"
custom\PROCEDURE Click
LOCAL lcURL

thisform.Hide
lcURL=ALLTRIM(this.parent.cboURL.DisplayValue)
IF NOT EMPTY(lcURL)
	this.parent.cboURL.AddItem(lcURL,1,1)
	lcURL=ALLTRIM(this.parent.cboURL.DisplayValue)
	thisform.cTarget=lcURL
	IF thisform.lShellExecute
		thisform.oShellExecute.ShellExecute(lcURL)
	ENDIF
ENDIF
thisform.Release

ENDPROC

commandbuttonY�� @@7�%����U T�����C���
��UTHISPARENTCMDOKENABLEDDISPLAYVALUE

����UTHISINTERACTIVECHANGEInteractiveChange,��ProgrammaticChange|��1�3�2W��)@cHeight = 23
Left = 63
TabIndex = 4
Top = 57
Width = 267
lformnavigate = .T.
Name = "cboURL"
_openaddressdialog	_dbf2html	_base.vcx_custom_urlcomboboxClass�PROCEDURE InteractiveChange
this.parent.cmdOK.Enabled=(NOT EMPTY(this.DisplayValue))

ENDPROC
PROCEDURE ProgrammaticChange
this.InteractiveChange

ENDPROC
combobox
_internet.vcx_urlcombobox_openaddressdialoglblOpenlabel_openaddressdialog
lblHeader1labellabel)MS Sans Serif, 0, 8, 5, 13, 11, 11, 2, 0
linitialized
ldropdown
PixelsSelect URL address combo box.	_combobox_urlcomboboxcombobox	_base.vcx_dialogs.vcxformMctarget Name of target URL.
lshellexecute Executes selected URL.
cfileext
�FontName = "MS Sans Serif"
FontSize = 8
BackStyle = 0
Caption = "\<Open:"
Height = 18
Left = 13
Top = 57
Width = 51
Name = "lblOpen"
�FontName = "MS Sans Serif"
FontSize = 8
BackStyle = 0
Caption = "Type the Internet address of a document or folder."
Height = 16
Left = 64
Top = 22
Width = 264
TabIndex = 1
Name = "lblHeader1"
oPicture = graphics\openadlg.bmp
Height = 36
Left = 8
Top = 12
Width = 42
Name = "imgOpenInternetAddress"
_openaddressdialogimgOpenInternetAddressimageimageHeight = 121
Width = 339
ShowWindow = 1
DoCreate = .T.
Caption = "Open"
Icon = graphics\hyperlink.ico
WindowType = 1
ctarget = 
lshellexecute = .T.
cfileext = htm;html;asp;txt;doc;xls;ppt;gif;jpg;jpeg;au;aiff;xbm;app
Name = "_openaddressdialog"
eccookie Name of current cookie.
cookietable Name of cookie table.
dbfalias Alias of cookie table.
*makecookie Generates unique cookie based on system datetime.
*getcookie Gets cookie from HTML.
*writecookieinfo Writes cookie information to cookie table.
*fixurl Reads and cleans up URL for reading cookie.
*getval Retrieves value from given string.
�� ���%=�m�U�����%�C�
�� �B�-���%�C����L��K�T����
���%�C��
�C����C	����T���C�����UTLNOSHELLEXECUTE	TCFILEEXTTHIS
LSHELLEXECUTECFILEEXTB�����UTHISCTARGET$%�C�
���B�-���F��UInit,��Unload���Activate��1��qAQ!A�!A3�3�qA�24Ih�)��PROCEDURE Init
LPARAMETERS tlNoShellExecute,tcFileExt

IF NOT DODEFAULT()
	RETURN .F.
ENDIF
IF VARTYPE(tlNoShellExecute)=="L"
	this.lShellExecute=(NOT tlNoShellExecute)
ENDIF
IF NOT EMPTY(tcFileExt) AND VARTYPE(tcFileExt)=="C"
	this.cFileExt=ALLTRIM(tcFileExt)
ENDIF

ENDPROC
PROCEDURE Unload
RETURN this.cTarget

ENDPROC
PROCEDURE Activate
IF NOT DODEFAULT()
	RETURN .F.
ENDIF
SELECT 0

ENDPROC
�csource This is source file from which to generate HTML.
coutfile This is name of HTM file to output.
ngenoutput _GENHTML output options. See _GENHTML file header.
lautonameoutput Causes _GENHTML to automatically name the output file based on source.
cscope The scope of records to process (e.g., NEXT 1, REST).
cstyle The registered style to use for visual display (tables only).
*genhtml Generates HTML calling _GENHTML engine.
5�� q%%����U���T������%�C����C�C�0
��c�T��C�SCX���%�C�0
��_�B�-����T������%�CC���f�SCX����B�-���"%�C�����L���	����T���C��HTM����A��G�������������������������ULCSOURCETHISCSOURCELAUTONAMEOUTPUTCOUTFILE
NGENOUTPUTCSTYLECSCOPEgenhtml,��1q�!qAA�qA#�A2�)�PROCEDURE genhtml
LOCAL lcSource

lcSource = THIS.cSource
IF VARTYPE(lcSource)#"C" OR !FILE(lcSource)
	lcSource = GETFILE("SCX")
	IF !FILE(lcSource)
		RETURN .F.
	ENDIF
ENDIF

THIS.cSource = lcSource

IF UPPER(JUSTEXT(lcSource))#"SCX"
	RETURN .F.
ENDIF

IF VARTYPE(THIS.lAutoNameOutput)="L" AND; 
	THIS.lAutoNameOutput
	THIS.cOutFile = FORCEEXT(lcSource,"HTM")
ENDIF

DO (_GENHTML) WITH (this.cOutFile),(this.cSource),(this.nGenOutput),"",(this.cStyle),(this.cScope)

ENDPROC
	coutfile This is name of HTM file to output.
csource This is source file from which to generate HTML.
ngenoutput _GENHTML output options. See _GENHTML file header.
lautonameoutput Causes _GENHTML to automatically name the output file based on source.
cscope The scope of records to process (e.g., NEXT 1, REST).
cstyle The registered style to use for visual display (tables only).
lcreatetempreport Whether to automatically create a new temp report if DBF passed.
*genhtml Generates HTML calling _GENHTML engine.
�� ����%2\z�U)&B�CCC^CC��
�0��:���.����Ub�����C�
�����%��Cookie=�
�����#T���C�
��Cookie����'m.cStr = STRTRAN(m.cStr,"&Cookie=")
T�
��C�
��Cookie=������T���C�
�CC��>=���T��C�
�������%�C���cookies�
���r��cookies��������P�%�C���
��L�#�������	����B��
���U
CSTRTHISFIXURLCCOOKIEGETVAL
MAKECOOKIECOOKIEDBFALIASCOOKIESRNUM�%�C���
���F��E�����
%�C4
��R�r��cookies��������%�C���
��{�>��C��O����UTHISCCOOKIECOOKIESCOOKIEDBFALIASRNUM�	��
����
��
��T�
��C�
��+� ���T�
�����+�a����%��%�
�����T�
��C�%�
���%��
�C�
�>�����T�
���
��
���!��6%�CC�
��
���\�0123456789ABCDEF����'�T�
���
�C�
��
�=��T�
��C�
��
��\��.��@T�
���
�C�
��
��=CC�0xC�
��
���\� ��%�C�
�>�
������T�
��C�
��
��\�����!�����T�
���
��
���!���T�
���
���B��
���UCSTRN1RV���������T��C�
��
���%�����F�	B�����T��CC�
��C�
�>\���%�C�
��=�=����T��C�
��\���%��&�����B�CC�
�C�&�
��=������
B�C�
�����UCSTRCVALN1C2����%�C����� �B�-���%T��CCC��_������6��%�C�
�0
����5h1��
�����C�����I��C��
��& ������Q��
����1�T����
���T���C��U	
CCOOKIEDBFTHISCOOKIETABLEC_DEFCOOKIEDBFCOOKIERNUMEXTRACOOKIESDBFALIAS
makecookie,��	getcookieY��writecookieinfo��fixurl���getval���Init���1a3q1�1q���A����1qAA�31q���A1!AA3�����Aq�qAAa��AA���AA�qAAA�3��a�A��AA!���A3s!qAQ!R�AQ!�2]}���!�;)?XpJO��	\)��� ��cn%c�t�U������T������%�C����C�C�0
��k�T��C�FRX���%�C�0
��g�B�-����T������%�CC���f�DBF��5�%�����"�T��C�SAFETYv��G.�%T��C��]�\CC��FRX������3�������SET SAFETY &lcSafety
T�������1�B�-����"%�C�����L���	��t�T���C��HTM����A��G�������������������	����
��ULCSOURCELCREPORTLCSAFETYTHISCSOURCELCREATETEMPREPORTLAUTONAMEOUTPUTCOUTFILE
NGENOUTPUTCSTYLECSCOPEgenhtml,��1��!qAA�QaQ!��qAA#�A2�)��csource This is source file from which to generate HTML.
ngenoutput _GENHTML output options. See _GENHTML file header.
coutfile This is name of HTM file to output.
lusecurrentalias Use current alias as source.
lautonameoutput Causes _GENHTML to automatically name the output file based on source.
cscope The scope of records to process (e.g., NEXT 1, REST).
cstyle The registered style to use for visual display.
*genhtml Generates HTML calling _GENHTML engine.
o�� VV�;%�
��UB���+%�C�����L���	�CC�
	��>�T��C���%�C������T������%�C�0
����T��C�DBF���%�C���C�0
����B�-�����T������"%�C�����L���	����T���C��HTM����A��G�������������������������U	LCSOURCETHISLUSECURRENTALIASCSOURCELAUTONAMEOUTPUTCOUTFILE
NGENOUTPUTCSTYLECSCOPEgenhtml,��1q��A�!�qAAA"�A2<)VGPROCEDURE genhtml
LOCAL lcSource

IF VARTYPE(THIS.lUseCurrentAlias)="L" AND; 
	THIS.lUseCurrentAlias AND !EMPTY(ALIAS())
	lcSource=ALIAS()
ENDIF

IF EMPTY(lcSource)
	lcSource=this.cSource
	IF !FILE(lcSource)
		lcSource = GETFILE("DBF")
		IF EMPTY(lcSource) OR !FILE(lcSource)
			RETURN .F.
		ENDIF
	ENDIF
ENDIF

this.cSource=lcSource
IF VARTYPE(THIS.lAutoNameOutput)="L" AND; 
	THIS.lAutoNameOutput
	THIS.cOutFile = FORCEEXT(lcSource,"HTM")
ENDIF

DO (_GENHTML) WITH (this.cOutFile),(this.cSource),(this.nGenOutput),"",(this.cStyle),(this.cScope)

ENDPROC
PROCEDURE genhtml
LOCAL lcSource,lcReport,lcSafety

lcSource = THIS.cSource
IF VARTYPE(lcSource)#"C" OR !FILE(lcSource)
	lcSource = GETFILE("FRX")
	IF !FILE(lcSource)
		RETURN .F.
	ENDIF
ENDIF

THIS.cSource = lcSource

IF UPPER(JUSTEXT(lcSource))="DBF" 
	IF THIS.lCreateTempReport
		lcSafety = SET("SAFETY")
		SET SAFETY OFF
		lcReport = SYS(2023)+"\"+ JUSTFNAME(FORCEEXT(lcSource,"FRX"))
		CREATE REPORT (lcReport) FROM (lcSource)
		SET SAFETY &lcSafety
		THIS.cSource = lcReport
	ELSE
		RETURN .F.
	ENDIF
ENDIF

IF VARTYPE(THIS.lAutoNameOutput)="L" AND; 
	THIS.lAutoNameOutput
	THIS.cOutFile = FORCEEXT(lcSource,"HTM")
ENDIF

DO (_GENHTML) WITH (this.cOutFile),(this.cSource),(this.nGenOutput),"",(this.cStyle),(this.cScope)

ENDPROC
�linitialized Control initialized flag.
ldropdown
lrequestonenter
lmovefocus
lgotfocus
curl Current URL.
curlhistorytable Name of URL history table.
lurlhistory Saves URL history.
ctempfileprefix
lformnavigate
ohyperlink
chyperlinkclass
chyperlinkclasslibrary
*openurlhistory 
*navigate Request document based on URL address.
*initialize 
*validurl 
*ohyperlink_access 
	�PROCEDURE makecookie
RETURN STRTRAN(STRTRAN(TIME()+ PADL(SECONDS(),10,'0'),":",""),".","")

ENDPROC
PROCEDURE getcookie
LPARAMETERS cStr
THIS.FixURL(@m.cStr)
*Get the cookie value from either a parameter or a 
*hidden input field
IF "Cookie="$ m.cStr
	THIS.cCookie=THIS.getval(m.cStr,"Cookie")
	m.cStr = STRTRAN(m.cStr,"&Cookie=")
	m.cStr = STRTRAN(m.cStr,"Cookie=")
ELSE
	THIS.cCookie= LEFT(m.cStr,LEN(THIS.MakeCookie()))
ENDIF
cStr = STRTRAN(m.cStr,THIS.cCookie,"")
IF !SEEK(THIS.cCookie,"cookies")
	INSERT INTO cookies (cookie) VALUES (THIS.cCookie)
ELSE
	IF !EMPTY(THIS.dbfAlias)
		GOTO (cookies.rnum) IN (THIS.dbfAlias)
	ENDIF
ENDIF
RETURN m.cstr

ENDPROC
PROCEDURE writecookieinfo
IF !EMPTY(THIS.cCookie)
	SELECT cookies
	SEEK THIS.cCookie
	IF !FOUND()
		INSERT INTO cookies (cookie) VALUES (THIS.cCookie)
	ENDIF
	IF !EMPTY(THIS.dbfAlias)
		REPLACE rnum WITH RECNO(THIS.dbfAlias)
	ENDIF
ENDIF

ENDPROC
PROCEDURE fixurl
LPARAMETERS  m.cStr
LOCAL m.n1,m.rv
m.cstr=STRTRAN(m.cstr,"+"," ")
m.rv = ""
DO WHILE .T.
	IF "%" $ m.cStr
		m.n1 = AT('%',m.cStr)
		IF m.n1 > LEN(m.cStr) - 2
			m.rv = m.rv + m.cStr
			EXIT
		ENDIF
		IF atc(SUBSTR(m.cStr,m.n1+1,1),"0123456789ABCDEF")=0 && not hex digit
			m.rv = m.rv + LEFT(m.cStr,m.n1)
			m.cStr = SUBSTR(m.cStr,m.n1+1)
			LOOP
		ENDIF
		m.rv = m.rv + LEFT(m.cStr,m.n1-1) + ;
			CHR(EVAL("0x"+SUBSTR(m.cStr,m.n1+1,2)))
		IF LEN(m.cStr) > m.n1 + 2
			m.cStr = SUBSTR(m.cStr,m.n1+3)
		ELSE
			EXIT
		ENDIF
	ELSE
		m.rv = m.rv + m.cStr
		EXIT
	ENDIF
ENDDO
m.cStr = m.rv
RETURN m.rv

ENDPROC
PROCEDURE getval
LPARAMETERS cstr,cVal
LOCAL n1,c2
n1 = AT(m.cVal,m.cStr)
IF n1 = 0
	return ""
ENDIF
c2 = ALLTRIM(SUBSTR(m.cStr,n1 + LEN(m.cVal)))
IF LEFT(m.c2,1) = '='
	c2 = SUBSTR(m.c2,2)
ENDIF
IF "&"$c2
	RETURN ALLTRIM(LEFT(m.c2,AT('&',m.c2)-1))
ELSE
	RETURN ALLTRIM(m.c2)
ENDIF

ENDPROC
PROCEDURE Init
* We could present the user with a Login screen, 
* and use the username as a key for the cookie.
LOCAL cCookieDBF
IF EMPTY(THIS.CookieTable)
	RETURN .F.
ENDIF
cCookieDBF = IIF(EMPTY(TRAN(THIS.CookieTable)),C_DEFCOOKIEDBF,THIS.CookieTable)
IF !FILE(m.cCookieDBF)
	* a table to store user state based on a cookie (timestamp)
	CREATE TABLE (m.cCookieDBF) free (cookie c(20), rnum i, extra c(10))	
	INDEX ON cookie TAG cookie
ENDIF
USE (m.cCookieDBF) ALIAS cookies ORDER 1  && Reopen shared
THIS.CookieTable = m.cCookieDBF
THIS.dbfAlias=ALIAS()

ENDPROC
�FontName = "MS Sans Serif"
FontSize = 8
ColumnCount = 1
Height = 23
TabIndex = 2
Width = 200
Format = "K"
InputMask = (REPLICATE("X",254))
DisplayCount = 16
curl = 
curlhistorytable = (IIF(VERSION(2)=0,"",HOME())+"URLHstry.dbf")
lurlhistory = .T.
ctempfileprefix = _temp
ohyperlink = .NULL.
chyperlinkclass = _HyperLinkBase
chyperlinkclasslibrary = _HyperLink.vcx
Name = "_urlcombobox"
�� ��[%�����U ����%���
�	C�����T�%�C�
urlhistory���I�Q���B�-���T��CW��%�C�
urlhistory�����F����T��CC���@��F��%�CC���]�
���Q������
%�C�
����
F����B�-���%�C�URLNameb�M���Q�
 ������%�CC���]���y�3h1�����M��T��T�	�N����Q�������M%�C�
CreateDateb�T�C�
LastAccessb�T�C�	ExecCountb�N����Q������
%�C�
����
F����B�-���%�C�
CreateDateb�T��2�S�i1������T��%�C�
LastAccessb�T��i�i1������T��%�C�	ExecCountb�N����i1�����	�N�����Q�������%�C�m�
LASTACCESS����G((�
LastAccess���& �������G(�C'
��-��U

LCFILENAMELNLASTSELECTTHISLURLHISTORYCURLHISTORYTABLE
URLHISTORYURLNAME
CREATEDATE
LASTACCESS	EXECCOUNT�����%�����-�T��C������G�T��C������T���-��%�C����o�B�-���T��CC���@��)%��.��CCC���C�>=@�	����T������B�-���%�C�@C��@����B��Z%�CC�����\�:�8C�@C�file://��@�C�@C�http://��@	��I�B����C�������%���	
������C���
���B��L%���	
�C�thisformb�O�"CC��Navigate��h@�method
����B����C���
��ULCURLLCTEMPFILEPREFIXTHIS	LDROPDOWNVALUEDISPLAYVALUECTEMPFILEPREFIXCURLADDITEM
LFORMNAVIGATE
OHYPERLINK
NAVIGATETOTHISFORMNAVIGATE�%������B��T���a��%�C��
��G�F��B�-���%�C�
urlhistory�����F��	~�����C����������?������F��UTHISLINITIALIZEDOPENURLHISTORY
URLHISTORYADDITEMURLNAME�������%�C����&�	B�����T��C�����%��:�
�CC��=@�http:
	�CC��=@�file:
	�CC��=@�ftp.
	�bCC��=@�www.�"CCC��R@�.com�.gov�.net��&C���\�:
�C��=�\\
		���T���http://����%�CC�����\�:��W�$T��CC��\�/��///�//������<%��:�
�C�:���CC��=@�ftp.
	����:T���file://CCC��\�/��///�//��//�/�����	B����UTCURLLCURLQ%�C�����O��>�&��C�
oHyperLink���������B�����UTHIS
OHYPERLINKSETOBJECTREFCHYPERLINKCLASSCHYPERLINKCLASSLIBRARY

����UTHIS
INITIALIZET�������UTHISCURLDISPLAYVALUE(%�C�
urlhistory���!�Q���U
URLHISTORY����T������%������
	��<�
�����
%������T���a��%�����z�\��{TAB}�;����\��{Ctrl+A}�;���U
LLDROPDOWNTHIS	LDROPDOWNLREQUESTONENTER
LMOVEFOCUSNAVIGATE��������������%�C����D���B�-���'%�C�tnColumnb�N���	��s�B��
T��C��T��C��	�
��T��CW��
��	��T��C�#����3%�����C�\��	��C�/��	��
���
F����B�-���T��CC�	��@��)%��.��CCC���C�>=@�	��p�T�	�
������
F����B�-��������(��	�����%�CCC��	��@C�@������C��	���!������C�������T�	�
����%�C�
urlhistory�
���
F����B��F��%�C+��6�-��-�CCC���@�C�@��%�C4��z�>�������������=r��
urlhistory�������������������
F����UTCITEMTNINDEXTNCOLUMNLCITEMLNLASTSELECT
LTDATETIMELNCOUNTLNATPOSLCTEMPFILEPREFIXTHISVALIDURLOPENURLHISTORYCTEMPFILEPREFIXDISPLAYVALUE	LISTCOUNTLIST
REMOVEITEM
URLHISTORYURLNAME
LASTACCESS	EXECCOUNT
CREATEDATE�T���-��T���-��%�����0�B��%�C�����f�T������T���������T������T���C��>���UTHIS	LDROPDOWN
LMOVEFOCUS	LGOTFOCUSDISPLAYVALUESELSTART	SELLENGTHT���-��T���-��UTHIS	LGOTFOCUS	LDROPDOWNv����T���a��%������
	��o�%�����a�T���-��\��{TAB}�;��
�����UNKEYCODE
NSHIFTALTCTRLTHIS	LGOTFOCUSLREQUESTONENTER	LDROPDOWNVALIDT���a��UTHIS	LDROPDOWN,%�����%�T���-��B�-���UTHIS
LMOVEFOCUS�������%�����'�B��T���a��%������Q�B��%�C�������T������T���������T������T���C��>���U	NBUTTONNSHIFTNXCOORDNYCOORDTHIS	LGOTFOCUS	SELLENGTHDISPLAYVALUESELSTARTopenurlhistory,��navigate���
initialize^��validurlJ��ohyperlink_accessE	��Refresh�	��ProgrammaticChange
��Destroy:
��Validr
��AddItemY��GotFocus"��	LostFocus��KeyPressJ��DropDown��When7��MouseUpy��1����AqA��q�A�a��qA�A�AAQ2A����qA�AQA�QA��AA�1�A�AA3�!�!A��qAA�qA�AA�AAqAAA�AA3AA�!�qA�q��AA�3qq��A���A�A���AA�3�aA�3�313��A3q��A����!AA3���AqAqAA�Q��11A�qAA�A�qA��AAAQA��AAq�AA�����A�3��AA!�QA3��3�����A�A3�3�qA31AA�AAA!�QA2�8�	<W,	
`g5
�ry
�
�~�
�
��"��@r�����������������*���
!	�<z
���)��PROCEDURE openurlhistory
LOCAL lcFileName,lnLastSelect

IF NOT this.lURLHistory OR EMPTY(this.cURLHistoryTable)
	IF USED("urlhistory")
		USE IN urlhistory
	ENDIF
	RETURN .F.
ENDIF
lnLastSelect=SELECT()
IF USED("urlhistory")
	SELECT urlhistory
ELSE
	lcFileName=LOWER(FULLPATH(this.cURLHistoryTable))
	SELECT 0
	IF NOT EMPTY(SYS(2000,lcFileName))
		USE (lcFileName) SHARED ALIAS urlhistory AGAIN
		IF NOT USED()
			SELECT (lnLastSelect)
			RETURN .F.
		ENDIF
		IF TYPE("URLName")#"M"
			USE
			ERASE (lcFileName)
		ENDIF
	ENDIF
	IF EMPTY(SYS(2000,lcFileName))
		CREATE TABLE (lcFileName) ;
				(URLName M, CreateDate T, LastAccess T, ExecCount N(8))
		USE (lcFileName) SHARED ALIAS urlhistory AGAIN
	ENDIF
	IF TYPE("CreateDate")#"T" OR TYPE("LastAccess")#"T" OR TYPE("ExecCount")#"N"
		USE (lcFileName) EXCLUSIVE ALIAS urlhistory
		IF NOT USED()
			SELECT (lnLastSelect)
			RETURN .F.
		ENDIF
		IF TYPE("CreateDate")#"T"
			ZAP
			ALTER TABLE (lcFileName) ADD COLUMN CreateDate T NULL
		ENDIF
		IF TYPE("LastAccess")#"T"
			ALTER TABLE (lcFileName) ADD COLUMN LastAccess T NULL
		ENDIF
		IF TYPE("ExecCount")#"N"
			ALTER TABLE (lcFileName) ADD COLUMN ExecCount N(8) NULL
		ENDIF
		USE (lcFileName) SHARED ALIAS urlhistory AGAIN
	ENDIF
	IF KEY(1)=="LASTACCESS"
		SET ORDER TO LastAccess
	ELSE
		INDEX ON LastAccess TAG LastAccess ASCENDING ADDITIVE
	ENDIF
	SET FILTER TO NOT DELETED()
	LOCATE
ENDIF

ENDPROC
PROCEDURE navigate
LOCAL lcURL,lcTempFilePrefix

IF this.lDropDown
	lcURL=ALLTRIM(this.Value)
ELSE
	lcURL=ALLTRIM(this.DisplayValue)
ENDIF
this.lDropDown=.F.
IF EMPTY(lcURL)
	RETURN .F.
ENDIF
lcTempFilePrefix=LOWER(ALLTRIM(this.cTempFilePrefix))
IF "."$lcURL AND LOWER(LEFT(JUSTFNAME(lcURL),LEN(lcTempFilePrefix)))==lcTempFilePrefix
	this.DisplayValue=lcURL
	RETURN .F.
ENDIF
IF LOWER(lcURL)==LOWER(this.cURL)
	RETURN
ENDIF
IF SUBSTR(PADR(lcURL,5),5,1)==":" AND (LOWER(lcURL)==LOWER("file://"+this.cURL) OR ;
		LOWER(lcURL)==LOWER("http://"+this.cURL))
	RETURN
ENDIF
this.AddItem(lcURL,1,1)
IF NOT this.lFormNavigate
	this.oHyperLink.NavigateTo(lcURL)
	RETURN
ENDIF
IF NOT this.lFormNavigate OR TYPE("thisform")#"O" OR ;
		NOT LOWER(PEMSTATUS(thisform,"Navigate",3))=="method"
	RETURN
ENDIF
thisform.Navigate(lcURL)

ENDPROC
PROCEDURE initialize
IF this.lInitialized
	RETURN
ENDIF
this.lInitialized=.T.
IF NOT this.OpenURLHistory()
	SELECT 0
	RETURN .F.
ENDIF
IF USED("urlhistory")
	SELECT urlhistory
	SCAN ALL
		this.AddItem(URLName,1,1.1)
	ENDSCAN
ENDIF
SELECT 0

ENDPROC
PROCEDURE validurl
LPARAMETERS tcURL
LOCAL lcURL

IF EMPTY(tcURL)
	RETURN ""
ENDIF
lcURL=ALLTRIM(tcURL)
IF NOT ":"$lcURL AND NOT LOWER(LEFT(lcURL,5))=="http:" AND ;
		NOT LOWER(LEFT(lcURL,5))=="file:" AND ;
		NOT LOWER(LEFT(lcURL,4))=="ftp." AND (LOWER(LEFT(lcURL,4))=="www." OR ;
		INLIST(LOWER(RIGHT(lcURL,4)),".com",".gov",".net") OR ;
		(NOT SUBSTR(lcURL,2,1)==":" AND NOT LEFT(lcURL,2)=="\\"))
	lcURL="http://"+lcURL
ENDIF
IF SUBSTR(PADR(lcURL,5),5,1)==":"
	lcURL=STRTRAN(STRTRAN(lcURl,"\","/"),"///","//")
ELSE
	IF (NOT ":"$lcURL OR AT(":",lcURL)=2) AND NOT LOWER(LEFT(lcURL,4))=="ftp."
		lcURL="file://"+STRTRAN(STRTRAN(STRTRAN(lcURL,"\","/"),"///","//"),"//","/")
	ENDIF
ENDIF
RETURN lcURL

ENDPROC
PROCEDURE ohyperlink_access
IF VARTYPE(this.oHyperlink)#"O"
	this.SetObjectRef("oHyperLink",this.cHyperLinkClass,this.cHyperLinkClassLibrary)
ENDIF
RETURN this.oHyperlink

ENDPROC
PROCEDURE Refresh
this.Initialize

ENDPROC
PROCEDURE ProgrammaticChange
this.cURL=this.DisplayValue

ENDPROC
PROCEDURE Destroy
IF USED("urlhistory")
	USE IN urlhistory
ENDIF

ENDPROC
PROCEDURE Valid
LOCAL llDropDown

llDropDown=this.lDropDown
IF this.lRequestOnEnter AND NOT this.lMoveFocus
	this.Navigate
ENDIF
IF llDropDown
	this.lMoveFocus=.T.
	IF this.lRequestOnEnter
		KEYBOARD "{TAB}" PLAIN
	ELSE
		KEYBOARD "{Ctrl+A}" PLAIN
	ENDIF
ENDIF

ENDPROC
PROCEDURE AddItem
LPARAMETERS tcItem,tnIndex,tnColumn
LOCAL lcItem,lnLastSelect,ltDateTime,lnCount,lnAtPos,lcTempFilePrefix

IF EMPTY(tcItem)
	NODEFAULT
	RETURN .F.
ENDIF
IF TYPE("tnColumn")=="N" AND tnColumn#1
	RETURN
ENDIF
ltDateTime=DATETIME()
lcItem=this.ValidURL(tcItem)
lnLastSelect=SELECT()
this.OpenURLHistory
lnAtPos=RAT("#",lcItem)
IF lnAtPos>0 AND lnAtPos>RAT("\",lcItem) AND lnAtPos>RAT("/",lcItem)
	NODEFAULT
	SELECT (lnLastSelect)
	RETURN .F.
ENDIF
lcTempFilePrefix=LOWER(ALLTRIM(this.cTempFilePrefix))
IF "."$lcItem AND LOWER(LEFT(JUSTFNAME(lcItem),LEN(lcTempFilePrefix)))==lcTempFilePrefix
	this.DisplayValue=lcItem
	NODEFAULT
	SELECT (lnLastSelect)
	RETURN .F.
ENDIF
FOR lnCount = 1 TO this.ListCount
	IF LOWER(ALLTRIM(this.List[lnCount]))==LOWER(lcItem)
		this.RemoveItem(lnCount)
		EXIT
	ENDIF
ENDFOR
DODEFAULT(lcItem,tnIndex,tnColumn)
NODEFAULT
this.DisplayValue=lcItem
IF NOT USED("urlhistory")
	SELECT (lnLastSelect)
	RETURN
ENDIF
SELECT urlhistory
IF EOF()
	LOCATE
ENDIF
LOCATE FOR ALLTRIM(LOWER(MLINE(URLName,1)))==LOWER(lcItem)
IF FOUND()
	REPLACE LastAccess WITH ltDateTime, ExecCount WITH ExecCount+1
ELSE
	INSERT INTO urlhistory (URLName, CreateDate, LastAccess, ExecCount) ;
			VALUES (lcItem, ltDateTime, ltDateTime, 1)
ENDIF
SELECT (lnLastSelect)

ENDPROC
PROCEDURE GotFocus
this.lDropDown=.F.
this.lMoveFocus=.F.
IF this.lGotFocus
	RETURN
ENDIF
IF EMPTY(this.DisplayValue)
	this.SelStart=0
	this.SelLength=0
ELSE
	this.SelStart=0
	this.SelLength=LEN(this.DisplayValue)
ENDIF

ENDPROC
PROCEDURE LostFocus
this.lGotFocus=.F.
this.lDropDown=.F.

ENDPROC
PROCEDURE KeyPress
LPARAMETERS nKeyCode, nShiftAltCtrl

this.lGotFocus=.T.
IF this.lRequestOnEnter AND nKeyCode=13
	IF this.lDropDown
		this.lDropDown=.F.
		KEYBOARD "{TAB}" PLAIN
	ENDIF
	this.Valid
ENDIF

ENDPROC
PROCEDURE DropDown
this.lDropDown=.T.

ENDPROC
PROCEDURE When
IF this.lMoveFocus
	this.lMoveFocus=.F.
	RETURN .F.
ENDIF

ENDPROC
PROCEDURE MouseUp
LPARAMETERS nButton, nShift, nXCoord, nYCoord

IF this.lGotFocus
	RETURN
ENDIF
this.lGotFocus=.T.
IF this.SelLength>0
	RETURN
ENDIF
IF EMPTY(this.DisplayValue)
	this.SelStart=0
	this.SelLength=0
ELSE
	this.SelStart=0
	this.SelLength=LEN(this.DisplayValue)
ENDIF

ENDPROC