STRIGANOV SERGEY: Software development.

Разработка программного обеспечения на: C++, T-SQL, VBS, JavaScript, PHP

HTA, SQL_REPORT

Комплект файлов HTA_Report предназначен для запуска хранимой процедуры
(табличной функции / SQL запроса) на сервере  и отображения полученного
результата в виде HTML таблицы.  Двойной клик на таблице открывает ее в XLS.
 Как видим - ничего особенного, подобные этому скрипту уже были.
Отличие HTA_Report в том, что здесь собраны вместе
в единый комплект:

- форма вода параметров запроса
- заставка типа "подождите" на время выполнения запроса
- генерация HTML и XLS 


Чтобы воспользоваться всем этим - нужно только
вызвать функцию GetData с Вашим SQL запросом ( хранимкой/функцией) и все !

 HTA_Report.vbs

dim f, fso, HTA_Report_FileName ' файлы...
dim  item_counter,field_counter,qry_counter, application_connected ' системные переменные
dim s, dw' отображение на экране'
dim total_timing,timing,TimerID ' работа со временем
dim  CONNECTION_STRING, dbc,  rs' обьекты БД

dim  debug_mode 
debug_mode=false ' можно включить отладочный режим'

s = ""          'the output line
item_counter=0
qry_counter=0
application_connected=false
set rs           = CreateObject("ADODB.Recordset") ' временный (перезаписываемый) набор данных

Set fso = CreateObject ("Scripting.FileSystemObject")
if (fso.FolderExists("C:\HTA_Report")<>true)then
    fso.CreateFolder "C:\HTA_Report"
    end if
HTA_Report_FileName="C:\HTA_Report\HTA_Report.txt"

'------------------------------------------------------------------------------
Sub ShowHTA_ReportMsg
        total_timing=Time()          
        glass.style.width   = document.body.clientWidth
        glass.style.left    = document.body.scrollLeft
        glass.style.top     = document.body.scrollTop
        glass.style.display = "block"
        
        banner.style.left=document.body.scrollLeft+(document.body.clientWidth/4)
	    banner.style.width=document.body.clientWidth/2
	    banner.style.height=document.body.clientHeight/7
	    banner.style.top=document.body.scrollTop + (document.body.clientHeight/2) - (document.body.clientHeight/7)
	    banner.InnerHtml="<div class='WaitMsg'>Пожалуйста подождите.<br>Идет выполнение запроса к серверу...</div>"
	    banner.style.display="block"
 
End  sub
'------------------------------------------------------------------------------
Sub HideHTA_ReportMsg
window.ClearInterval(TimerID)
banner.style.display="none"
glass.style.display="none"
head.innerHTML="<b>"&GetLocalInfo()&", время выполнения: "&CDate(Time()-total_timing)&"</b><br>" 
End  sub
'-------------------------------------------------------------------------
Sub SaveToFile(sData, file_name)
    on error resume next
    Dim ts, ForWriting
    ForWriting = 2
    Set ts = fso.OpenTextFile(file_name, ForWriting, True)
    ts.Write sData
    ts.Close
End Sub
'------------------------------------------------------------------------------------
sub ShowItem(v)
    on error resume next
    Dim s1    
    s1 = "-" & trim(v)
    if len(s1) > 1 then 
        s1 = mid(s1, 2)
    else
        s1 = "&nbsp;"
    end if
    item_counter=item_counter+1
  
    s = s & "<TD >" & s1 & "</TD>"
   
end sub
'------------------------------------------------------------------------------------
sub ShowHeaderItem(v)
    on error resume next
    Dim s1
    s1 = "-" & trim(v)
    if len(s1) > 1 then 
        s1 = mid(s1, 2)
    else
        s1 = "&nbsp;"
    end if
    field_counter=field_counter+1      'style='writing-mode:tb-rl;' ' - вертикальное расположение текста в заголовках полей
    s = s & "<TD bgcolor='#DDDDDD'   id=""F_"& CStr(field_counter) &""" >&nbsp;" & s1 & "&nbsp;</TD>"
end sub
'------------------------------------------------------------------------------------
sub ShowLine
    on error resume next    
    dw=dw& "<TR  valign=top>" & s & "</TR>"
    s=""
end sub
'------------------------------------------------------------------------------------
Sub BodyOnLoad ()
 on error resume next 
 Dim CmdArry

CmdArry = Split(HTA_Report.commandLine,"$") 
if  UBound(CmdArry)>0 then
CONNECTION_STRING=Trim(CmdArry(1))
else
MsgBox "Неправильная командная строка:"&HTA_Report.commandLine
Window.close
exit sub
end if   
 
head.innerHTML="<b>"&GetLocalInfo()&"</b>" 

YearInput.value=DatePart ("yyyy",Date)
dim tmpM
tmpM=DatePart ("m",Date)-1

if (Len(tmpM)<2) then
MontchSelect.value= "0"&tmpM
else
MontchSelect.value= tmpM
end if 
MontchAutoSet

end sub
'------------------------------------------------------------------------------------
Sub BodyOnUnload()

fso = noting
dbc = noting
rs  = noting

end sub
'------------------------------------------------------------------------------------
function OpenDBConnect()
 on error resume next
 
 if ( application_connected = true) then 
 OpenDBConnect=application_connected
 exit Function
 end if
 
Dim RetVal
RetVal=true

Set dbc = CreateObject("ADODB.Connection")
        dbc.ConnectionString=CONNECTION_STRING
        dbc.Open     
    if  err.number then
        dw=dw& "<br><br>Ошибка при попытке подключения к базе данных (1):  <div class=""ErrMsg"">" & err.description & _
                                                                      " ("  &err.Source  &", "& err.number & ")</div>"       
		Disp.InnerHtml=dw
		dw ="" 
		RetVal=false
		 		  
    end if
    
dw ="" 
application_connected=RetVal
OpenDBConnect=RetVal
end function
'------------------------------------------------------------------------------------
Sub CloseDBConnect()

dbc.Close

dbc = noting
application_connected=false
end sub
'------------------------------------------------------------------------------------'
Sub RunBtnOnClick

Disp.InnerHtml=""
s=""
dw=""
ShowHTA_ReportMsg
TimerID =window.setInterval ("ShowForm",1)

end sub
'------------------------------------------------------------------------------------
function GetLocalInfo()
    on error resume next
    
dim  oWshNet,sUser, SCompName, info_str
Set oWshNet = CreateObject("Wscript.Network") 
sUser = oWshNet.Username 'Получаем имя входа текущего пользователя. '
SCompName = oWshNet.Computername 'Получаем имя компьютера.' 

   
   info_str= Date & " - "& Time() &", " &sUser & "@"&  SCompName
GetLocalInfo=info_str
end function
'------------------------------------------------------------------------------------
Sub ShowInXLS ( id_tbl)
' двойной клик на таблице - открывает эту таблицу в Excel
Dim XLSHeader
XLSHeader=""
XLSHeader=XLSHeader&"<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"&vbcrlf
XLSHeader=XLSHeader&"<html xmlns:v=""urn:schemas-microsoft-com:vml"""&vbcrlf
XLSHeader=XLSHeader&"xmlns:o=""urn:schemas-microsoft-com:office:office"""&vbcrlf
XLSHeader=XLSHeader&"xmlns:x=""urn:schemas-microsoft-com:office:excel"""&vbcrlf
XLSHeader=XLSHeader&"xmlns=""http://www.w3.org/TR/REC-html40"">"&vbcrlf
XLSHeader=XLSHeader&"<head>"&vbcrlf
XLSHeader=XLSHeader&"<META http-equiv=Content-Type content=""text/html;charset=windows-1251"">"&vbcrlf
XLSHeader=XLSHeader&"<style type='text/css'>"&vbcrlf
XLSHeader=XLSHeader&"v\:* {behavior:url(#default#VML);}"&vbcrlf
XLSHeader=XLSHeader&"o\:* {behavior:url(#default#VML);}"&vbcrlf
XLSHeader=XLSHeader&"x\:* {behavior:url(#default#VML);}"&vbcrlf
XLSHeader=XLSHeader&".shape {behavior:url(#default#VML);}"&vbcrlf
XLSHeader=XLSHeader&"</style></head><body>"&vbcrlf

 SaveToFile XLSHeader&document.GetElementById(id_tbl).OuterHTML&"</body></html>",HTA_Report_FileName&"_"&id_tbl&".xls"
 dim Sh	
 set Sh= CreateObject("WScript.Shell")
 Sh.Run HTA_Report_FileName&"_"&id_tbl&".xls", 0, false
 Sh=noting
 
end sub

 

Attachments:
FileDescriptionFile sizeLast modified
Download this file (HTA_Report.zip)HTA_Report.zip 49 kB2011-02-10 14:45

Comments   

 
+1 #1 serg 2011-02-11 12:35
Write your comments here.
Quote
 

Add comment