laylaClass

  laylaGetVersion



  
Dim laylaFunctionTargetUrl
Dim ErrorMessage
Dim objSrvHTTP
Dim objRegistry

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002

REM ***********************************************************
REM laylaClass : インターネット用汎用関数セット
REM ***********************************************************
Function laylaGetVersion()

	laylaGetVersion = "2007.04.01"

End Function 
  



  LoadMsxmlHTTP

  
Function LoadMsxmlHTTP( )

	if not IsObject( objSrvHTTP ) then
		Set objSrvHTTP = CreateObject("Msxml2.ServerXMLHTTP.3.0")
	end if 

End Function
  



  HTTPGet

  
Function HTTPGet( strUrl )

	LoadMsxmlHTTP

	on error resume next
	Call objSrvHTTP.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		HTTPGet = Empty
		Exit Function
	end if
	on error goto 0

	objSrvHTTP.Send

	HTTPGet = objSrvHTTP.responseText

End Function
  



  laylaFunctionTarget

  
Function laylaFunctionTarget( strUrl )

	laylaFunctionTargetUrl = strUrl

End Function
  



  laylaLoadFunction

  
Function laylaLoadFunction( strUrl )

	Dim str

	if Left( strUrl, 7 )  <> "http://" then
		strUrl = laylaFunctionTargetUrl & strUrl
	end if

	str = HTTPGet( strUrl )
	if not IsEmpty( str ) then
		ExecuteGlobal str
	end if

End Function
  



  laylaLoadFunctionPrefix

  
Function laylaLoadFunctionPrefix( strUrl, strPrefix, aData )

	Dim str,I

	if Left( strUrl, 7 )  <> "http://" then
		strUrl = laylaFunctionTargetUrl & strUrl
	end if

	str = HTTPGet( strUrl )
	if not IsEmpty( str ) then
		For I = 0 to Ubound( aData )
			str = Replace( str, aData( I ), strPrefix & aData( I ) )
		Next
		ExecuteGlobal str
	end if

End Function
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ