其他分享
首页 > 其他分享> > HTA 账号密码等资源记录管理工具

HTA 账号密码等资源记录管理工具

作者:互联网

HTA 账号密码等资源记录管理工具

以下代码保存为xxx.hta文件,代码中用到sql server数据库

<html> 
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" /> 
    <head> 
        <title>资源管理工具</title>
        <HTA:APPLICATION
  APPLICATIONNAME="ITMGT2"
  ID="ITMGT"
  VERSION="1.5"
  BORDER="thin"
  ICON="C:\Windows\system32\dfrgui.exe"
  SCROLL="no"
  SINGLEINSTANCE="yes"
  WINDOWSTATE="maximize"/>

        <style type="text/css">
            body {
                color:black;
                font-size:12px;
                
                border: white 5px solid;
                font-weight:bold;
                font-family: "trebuchet ms", calibri, helvetica, sans-serif, "Times New Roman";
                margin:0pt;
            }
            input {
                font-family: "trebuchet ms", calibri, helvetica, sans-serif, "Times New Roman";                
            }

            input.button {
                color: black;
                cursor: hand;
                background-color: #98D2F5;
                border: white 5px solid;
                font-weight: bold;
                
            }
            input.btnhov { 
                border-color: white;
                background-color: #cccccc;
    
            }
            input.mouseon {
                border-color: white;
                background-color: #98D2F5;
                cursor:hand;
            }
            .mouseon {
                border-color: white;
                background-color: #98D2F5;

            }
            input.text {
                color:blue;
                cursor:hand;
                font-size:12px;
                background-color:white;
                border:gray 2px solid;
                font-weight:bold;                
                
            }
            .vishidden {
                display: none;
                visibility: hidden;
            }

            .infoTD.disabled {                 
                color:gray;
                cursor:hand;
                background-color:white;
                border: #000033 2px solid;
                font-weight:bold;
                font-style:oblique
            }
            .redbold {
            color: red;
            font-weight: bold;
            }
            .tabdef {
            background-color:#eeeeee;
            }
            .tabcheck {
            background-color:#A593CE;
            }

            select#menu_select
            {
               border                   : 1px solid #94c1e7;
               font-size                : 14pt;
               background-color: #98D2F5;                
            }


            </style>
    </head> 
    <SCRIPT LANGUAGE="VBScript">        

        dim conn,rst,db_type,modeltxt(),modelcount,modelfield(),att_len(),model_search_text_arr()
        set rst = CreateObject("ADODB.Recordset")
        set conn = CreateObject("ADODB.Connection")
        
        Set oShell = CreateObject("Wscript.shell")'
        set fso = createobject("scripting.filesystemobject")
        '######################    
            
        User_Debug = False
        
        '################        
        If User_Debug = True Then
            ''''###############''''''''''测试用,关闭认证
            auth_status = True:auth_user = "admin"
            sql_host = "192.168.0.32,1433":sql_user="sa":sql_passwd="456789":SQL_DB_Name="ITOmd_test"'ITOmd_test  
            ''''######################
        Else
            ''''###############''''''''''测试用,关闭认证
            auth_status = False:auth_user = ""
            sql_host = "192.168.0.32,1433":sql_user="sa":sql_passwd="456789":SQL_DB_Name="ITOmd"
            ''''######################
        End If 
        
        Const strAbout  = "1.0 (2015年8月8日)"
        Const strCopyr  = "Copyright &copy; 2014 xxxxxx.com xxxxxx"
        Const strHelp  = "http:/www.xxxxxx.com。"
    
        db_path = oShell.ExpandEnvironmentStrings("%userprofile%") & "\itdb.csv"        
        model_tmp = oShell.ExpandEnvironmentStrings("%APPDATA%") & "\model_att.ini"
        page_row = 0:page_title_size=35:menu_size=210:row_size=35
        
        
        sub cancel 
            window.close 
        end sub 

        Sub Window_onLoad()
            If auth_status = True Then
                auth_user = "admin"
            End If 
            'Const Scr_width = 1200
            'Const src_height = 700
            'window.moveto (screen.width-Scr_width)/2,(screen.height-src_height)/2
            'window.resizeTo Scr_width,src_height
            
            'MsgBox (screen.width-100) & (screen.height-100)
            

            window.moveto 0,0
            panel.width=screen.width-40
            If screen.width <= 1440 Then 
                'window.moveto 0,10
                
                window.resizeTo screen.width,(screen.height-40)
                bodytab.height = (screen.height-menu_size)                
                page_row = Int((screen.height-menu_size-page_title_size)/row_size)
            Else
                'window.moveto 0,50
                window.resizeTo (screen.width),(screen.height-40)
                bodytab.height = (screen.height-menu_size)
                page_row = Int((screen.height-menu_size-page_title_size)/row_size)
            End If            

            If check_exsit_db_or_table("database",SQL_DB_Name) = False Then
                Create_db sql_host,sql_user,sql_passwd
            End If                    
            If check_exsit_db_or_table("table","o_model") = False Then
                run_db_sql "use ITOmd_test CREATE TABLE o_model ( id varchar(50), name varchar(255));"    
            End If                
            If check_exsit_db_or_table("table","o_user") = False Then
                run_db_sql "use ITOmd_test CREATE TABLE o_user ( name varchar(50), passwd varchar(50), auth_str varchar(50),db_addr varchar(50));"
                run_db_sql "INSERT INTO o_user VALUES ('admin','admin','ALL','127.0.0.1');"
                'run_db_sql "INSERT INTO o_user (name,passwd,auth_str) VALUES ('admin','admin','ALL');"
                run_db_sql "INSERT INTO o_model VALUES ('o_user','用户管理');"            
            End If                
            'If check_exsit_db_or_table("table","o_cache") = False Then
            '    run_db_sql "use ITOmd_test CREATE TABLE o_cache ( model_name varchar(50), model_att varchar(255));"    
            'End If            
    
            reloaddiv model_mgt_div        
                
        End Sub

        Function run_db_sql(sql_str)
            connection_db SQL_DB_Name
            
            rst.Open sql_str,conn,1,1
            'msgbox  rst.State
            If rst.State = adStateOpen Then
                'rst.Close
                run_db_sql = True
            Else
                run_db_sql = False
            End If                         
            conn.Close
        End function
        sub Create_db(server_str,user_str,passwd_str)
            On Error Resume Next
            'Set conn = CreateObject("ADODB.Connection")
            conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Initial Catalog=master;Data Source=" & server_str & ";",sql_user,passwd_str,adModeUnknown
            'set rst = CreateObject("ADODB.Recordset")
            rst.Open "create database ITOmd_test ;" ,conn
            If rst.State = adStateOpen Then
                rst.Close
            End If
            conn.Close
            'Set rst = Nothing
            'Set conn = Nothing
        End sub        
    
        
        
        Sub connection_db(db_name)
            On Error Resume Next        
            conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Initial Catalog=" & db_name & ";Data Source=" & sql_host & ";",sql_user,sql_passwd,adModeUnknown    
        End Sub        
        Function check_exsit_db_or_table(type_str,table_name)
            'set rst = CreateObject("ADODB.Recordset")
            
            If type_str = "database" Then
                connection_db "master"
                sql_str = "SELECT Name FROM Master..SysDatabases where name='" & table_name & "';"

            ElseIf type_str = "table" Then
                connection_db SQL_DB_Name
                sql_str = "SELECT Name FROM " & SQL_DB_Name & "..SysObjects where name='" & table_name & "';"

            End If
            
            'On Error Resume next
            rst.Open sql_str,conn,1,1
            If rst.RecordCount > 0 Then 
                check_exsit_db_or_table = True
            Else
                check_exsit_db_or_table = False
            End If 
            If rst.State = adStateOpen Then
                rst.Close
            End If
            conn.Close
            'Set rst = Nothing
            'Set conn = Nothing    
        End Function
        function get_user_auth(user_name,passwd_str)
            connection_db SQL_DB_Name
            sql_str = "SELECT * FROM o_user  where name='" & user_name & "' AND passwd='" & passwd_str & "' ;"            
            rst.Open sql_str,conn,1,1

            auth_str = ""
            do until rst.EOF
                if rst.Fields(0).value = user_name then
                    auth_str = rst.Fields(2).Value
                    'msgbox rst.Fields(2).value
                end if
                rst.MoveNext
            loop
            rst.Close
            conn.Close
            
            get_user_auth = auth_str
        end function
        Function user_auth(user_name,passwd_str,logon_type)            
            user_str=user_name
            If logon_type = "out" Then
                model_user_text.disabled=False
                model_pwd_text.disabled=False
                model_user_login.disabled=False
                auth_status = False
                auth_user = "" 

            Else             

                If Len(user_str) > 0 And Len(passwd_str) > 0 Then
                    auth_str =get_user_auth(user_name,passwd_str)
                    if len(auth_str) > 0 then
                        auth_status = auth_str
                        auth_user = user_str                       
                        model_user_text.disabled=true
                        model_pwd_text.disabled=true
                        model_user_login.disabled=True
                    Else
                        MsgBox "用户名和密码不对!"
                        auth_status = False
                        
                    End If 

                Else
                    MsgBox "用户名和密码不能为空!"
                    auth_status = False
                    auth_user = ""
                End If 
            End If 

        End Function
        Function check_user_auth(model_str) 
          
            If auth_status = False Then 
                check_user_auth = False
            ElseIf auth_status = True Then
                check_user_auth = True
            Else             
            
                If InStr(LCase(auth_status),LCase(model_str)) > 0 Or InStr(LCase(auth_status),lcase("ALL")) > 0 Then 
                    check_user_auth = True
                Else
                    check_user_auth = FALSE
                End If

            End If 

        End Function        
        Sub setx(t)
            Dim obj : Set obj = window.event.srcElement
            If t = "" Then
                    obj.style.color  = "gray"
                obj.style.cursor = "default"
            Else
                obj.style.color  = "darkblue"
                obj.style.cursor = "hand"
            End If
            footer.innerHTML = t
        End Sub
        Sub enterpass(f)

            If  Window.Event.keyCode = 13 Then                  
                 Select Case f
                       Case "selecte_menu"    selecte_menu
                       Case Else   user_auth model_user_text.value,model_pwd_text.value,"in"::reloaddiv model_mgt_div                       
                  End Select

            End If 
            
        End Sub 



        sub reloaddiv(pl)
            'If check_user_auth(auth_user,pl.id) Is False Then
                'MsgBox "用户权限不足!"
                'Exit sub
            'End If        
            'Dim n,myarray()
            
            On Error Resume Next
            model_add_div.classname="vishidden"
            model_mgt_div.classname="vishidden"
            menudiv.classname="vishidden"
            pl.className = pl.id
                
                
            '加载菜单
            If model_selecte_text.title = "model_selecte_text" Then model_selecte_text.title = "模板管理"
             
            
            If pl.name = "模板管理" Or pl.name = "model_add_div" Then                 
                model_str = ""        
            Else
                model_str = pl.name                    
            End If
            
            '#####加载菜单按钮
            load_model_menu_btn model_str    
    
            '###########模块的搜索文本缓存            
            On Error Resume Next

            For i = 0 To UBound(model_search_text_arr,1)
                '如果按钮的值和搜索框的标签相同,缓存搜索框文本 
                if model_search_text_arr(i,0) = model_selecte_text.title  Then
                    model_search_text_arr(i,1) = model_selecte_text.value
                    
                    Exit For 
                End If
            next
    
            On Error Resume Next    
            For i = 0 To UBound(model_search_text_arr,1)
                '加载模块搜索文本缓存
                If model_search_text_arr(i,0) = pl.name Then
                     If Len(model_search_text_arr(i,1)) > 0 Then
                         model_selecte_text.value = model_search_text_arr(i,1)
                     Else
                         model_selecte_text.value = "search text"
                     End If             
                    Exit For
                End If
            next

            '########加载模块管理页面
            If pl.name = "模板管理" Or pl.name = "model_add_div" Then                 
                reload_model_list    
            Else
                show_menu_table model_str                    
            End If
            
            model_selecte_text.title = pl.name    
        end Sub        
        
 
        '检查数据唯一性
        Function check_field_value_exist(model_str,field_name,field_value)
            On Error Resume Next
            If     model_str = "o_model" Then
                model_table_name = model_str
            else        
                model_table_name = get_table_name(model_str) 
            End if    

            connection_db SQL_DB_Name
            sql_str = "SELECT * FROM " & model_table_name & " where " & chr(34) & field_name & chr(34) & "='" & field_value & "' ;"

            'MsgBox sql_str
            rst.Open sql_str,conn,1,1

            If rst.RecordCount = 1 Then
                check_field_value_exist = True
            Else
                check_field_value_exist = False
            End If
            rst.Close
            conn.Close
        
        
        End function
        
        '更新模板数据表
        Function model_date_update(model_str,mp_num)
            table_name = get_table_name(model_str)
            table_field = get_table_Field(model_str)
            if document.getElementById("model_obj_add" & mp_num).name = "add" Then
                If     check_field_value_exist(model_str,table_field(0),document.getElementById("att_row_input_" & mp_num & "_1").value) = False Then
                    sql_command=""
                    for i = 1 to UBound(table_field)            
                        sql_command =sql_command & "'" & document.getElementById("att_row_input_" & mp_num & "_" & i).value & "',"
                    Next    
                    db_table_insert table_name,Mid(sql_command,1,Len(sql_command)-1)
                Else
                    MsgBox "数据 " & document.getElementById("att_row_input_" & mp_num & "_1").value & " 已经存在!"
                End if
            elseif document.getElementById("model_obj_add" & mp_num).name = "edit" Then            
                sql_command=""                
                for i = 1 to UBound(table_field)            
                    sql_command =sql_command & "'" & document.getElementById("att_row_input_" & mp_num & "_" & i).value & "',"
                Next

                db_table_value_del table_name,table_field(0),document.getElementById("att_row_input_" & mp_num & "_1").value
                db_table_insert table_name,Mid(sql_command,1,Len(sql_command)-1)
                
            elseif document.getElementById("model_obj_add" & mp_num).name = "del" Then
                db_table_value_del table_name,table_field(0),document.getElementById("att_row_input_" & mp_num & "_" & document.getElementById("att_row_input_" & mp_num & "_1").name & "_1").name
            end if        
        end Function
        

        
        '复制文本
        function SetClipBoard (Text)
            'oShell.Run "mshta vbscript:ClipboardData.SetData(" & Chr(34) & "text" & Chr(34) & ","& Chr(34) & Text & Chr(34) & ")(close)", 0, True
            window.clipboardData.setData "text",Text
        End function
        
        '删除文件
        function del_file(fpath)
            'On Error Resume Next
            If fso.FileExists(fpath) then
                set sfile = fso.getfile(fpath)
                sfile.attributes=0
                sfile.Delete
            End If
            
        end function
        
        '####加载板块菜单按钮
        sub load_model_menu_btn(model_str)

            On Error Resume Next
            If auth_status <> True And Len(auth_user) > 0 Then             
                auth_status = get_user_auth(auth_user,model_pwd_text.value)
            End If 
            
            strHTML = "":count = 0:onlick_str = ""

            connection_db SQL_DB_Name
            If auth_status = True Or LCase(auth_status) = LCASE("ALL") then
                sql_str = "SELECT * FROM o_model;"
            ElseIf auth_status = False  then
                sql_str = "SELECT * FROM o_model where name='用户管理';"
            Else
                fiter_str="":sql_str=""
                For each auth_s In Split(auth_status)
                    If LCase(auth_s) = LCASE("ALL") Then 
                        sql_str = "SELECT * FROM o_model;"
                        fiter_str=""
                        Exit for
                    else
                        fiter_str = fiter_str & " name='" & auth_s & "' or "
                    End if
                next
            
                If Len(fiter_str) > 0 Then     sql_str = "SELECT * FROM o_model where " & Mid(fiter_str,1,Len(fiter_str)-4) & ";"

            End If 
            rst.Open sql_str,conn,1,1
            do until rst.EOF
                count = count + 1
                onlick_str = onlick_str & "menu" & count & ".classname='button':"
                rst.MoveNext    
            Loop
            rst.MoveFirst
            count = 0
            select_html = "<option  value='' >----选择模块菜单----</option>"

            ReDim model_search_text_arr_tmp(rst.RecordCount,2)
            model_search_text_arr_tmp(0,0) = "模板管理"
            do until rst.EOF
                count = count + 1
                model_name = rst.Fields(1).Value
                model_search_text_arr_tmp(count,0) = rst.Fields(1).Value
                If rst.Fields(1).Value = "用户管理" Then
                    If model_str = model_name Then 
                        strHTML = strHTML & "<input id=""menu" & count & """  class=""button"" disabled onm ouseOver=""menu" & count & ".className='button btnhov'"" onm ouseOut=""menu" & count & ".className='button'"" type=""button"" value=""" & model_name & """ onclick=""if check_user_auth('" & model_name & "') = True then menu0.classname='button':menu0.disabled=false:menu1.classname='button':menudiv.name='" & model_name & "':reloaddiv menudiv:menu" & count & ".disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if "" >" 'chr(61) is =
                        
                    else
                        strHTML = strHTML & "<input id=""menu" & count & """  class=""button"" onm ouseOver=""menu" & count & ".className='button btnhov'"" onm ouseOut=""menu" & count & ".className='button'"" type=""button"" value=""" & model_name & """ onclick=""if check_user_auth('" & model_name & "') = True then menu0.classname='button':menu0.disabled=false:menu1.classname='button':menudiv.name='" & model_name & "':reloaddiv menudiv:menu" & count & ".disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if "" >" 'chr(61) is =
                    End if                
                else
                    If model_str = model_name Then 
                    'strHTML = strHTML & "<input id=""menu" & count & """ class=""button"" disabled onm ouseOver=""menu" & count & ".className='button btnhov'"" onm ouseOut=""menu" & count & ".className='button'"" type=""button"" value=""" & model_name & """ onclick=""if check_user_auth('" & model_name & "') = True then menu0.classname='button':menu0.disabled=false:" & onlick_str & "menudiv.name='" & model_name & "':reloaddiv menudiv:menu" & count & ".disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if "">" 'chr(61) is =
                        select_html = select_html & "<option selected='selected' value='" & model_name & "' >" & model_name & "</option>"
                    else
                        'strHTML = strHTML & "<input id=""menu" & count & """ class=""button"" onm ouseOver=""menu" & count & ".className='button btnhov'"" onm ouseOut=""menu" & count & ".className='button'"" type=""button"" value=""" & model_name & """ onclick=""if check_user_auth('" & model_name & "') = True then menu0.classname='button':menu0.disabled=false:" & onlick_str & "menudiv.name='" & model_name & "':reloaddiv menudiv:menu" & count & ".disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if "">" 'chr(61) is =
                        select_html = select_html & "<option value='" & model_name & "' >" & model_name & "</option>"
                    End if
                End If 
                
                rst.MoveNext    
            Loop        

            
            select_html = "&nbsp;&nbsp; <select name='menu_select'  id='menu_select' onchange=""if menu_select.value='' then if check_user_auth(menudiv.name) = True then menu0.classname='button':menu0.disabled=false:reloaddiv menudiv else msgbox '你可能还没有登陆或用户权限不足!' end if else if check_user_auth(menu_select.value) = True then menu0.classname='button':menu0.disabled=false:menudiv.name=menu_select.value:reloaddiv menudiv else msgbox '你可能还没有登陆或用户权限不足!' end if end if "">" & select_html & "</select>"
            rst.Close
            conn.Close
            modelcount=count    

            'strHTML = strHTML & "</table>"
            menu_btn_span.InnerHTML = strHTML & select_html
            

            For v = 0 To UBound(model_search_text_arr_tmp,1)
                For nu = 0 To UBound(model_search_text_arr,1)
                    If model_search_text_arr_tmp(v,0) = model_search_text_arr(nu,0) Then
                        model_search_text_arr_tmp(v,1) = model_search_text_arr(nu,1)
                    End If                     
                Next
            next

            ReDim model_search_text_arr(UBound(model_search_text_arr_tmp),2)
            For v = 0 To UBound(model_search_text_arr,1)
                model_search_text_arr(v,0) = model_search_text_arr_tmp(v,0)
                model_search_text_arr(v,1) = model_search_text_arr_tmp(v,1)
            next
            
        End  sub
        
        
        '####加载板块菜单按钮
        Sub load_model_menu_btn2(model_str)
            On Error Resume Next
            If auth_status <> True And Len(auth_user) > 0 Then             
                auth_status = get_user_auth(auth_user,model_pwd_text.value)
            End If 
            
            strHTML = "":count = 0:onlick_str = ""

            connection_db SQL_DB_Name
            If auth_status = True Or LCase(auth_status) = LCASE("ALL") then
                sql_str = "SELECT * FROM o_model;"
            ElseIf auth_status = False  then
                sql_str = "SELECT * FROM o_model where name='用户管理';"
            Else
                fiter_str="":sql_str=""
                For each auth_s In Split(auth_status)
                    If LCase(auth_s) = LCASE("ALL") Then 
                        sql_str = "SELECT * FROM o_model;"
                        fiter_str=""
                        Exit for
                    else
                        fiter_str = fiter_str & " name='" & auth_s & "' or "
                    End if
                next
            
                If Len(fiter_str) > 0 Then     sql_str = "SELECT * FROM o_model where " & Mid(fiter_str,1,Len(fiter_str)-4) & ";"

            End If 
            rst.Open sql_str,conn,1,1
            do until rst.EOF
                count = count + 1
                onlick_str = onlick_str & "menu" & count & ".classname='button':"
                rst.MoveNext    
            Loop
            rst.MoveFirst
            count = 0
            do until rst.EOF
                count = count + 1
                model_name = rst.Fields(1).Value

                If model_str = model_name Then 
                    strHTML = strHTML & "<input id=""menu" & count & """ class=""button"" disabled onm ouseOver=""menu" & count & ".className='button btnhov'"" onm ouseOut=""menu" & count & ".className='button'"" type=""button"" value=""" & model_name & """ onclick=""if check_user_auth('" & model_name & "') = True then menu0.classname='button':menu0.disabled=false:" & onlick_str & "menudiv.name='" & model_name & "':reloaddiv menudiv:menu" & count & ".disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if "">" 'chr(61) is =
            
                else
                    strHTML = strHTML & "<input id=""menu" & count & """ class=""button"" onm ouseOver=""menu" & count & ".className='button btnhov'"" onm ouseOut=""menu" & count & ".className='button'"" type=""button"" value=""" & model_name & """ onclick=""if check_user_auth('" & model_name & "') = True then menu0.classname='button':menu0.disabled=false:" & onlick_str & "menudiv.name='" & model_name & "':reloaddiv menudiv:menu" & count & ".disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if "">" 'chr(61) is =
                End if
                rst.MoveNext    
            Loop
            rst.Close
            conn.Close
            modelcount=count    

            'strHTML = strHTML & "</table>"
            menu_btn_span.InnerHTML = strHTML

        End Sub
        
        
        '###返回文件对象
        Function get_file_obj(fpath,open_mode)
            If fso.FileExists(fpath) then
                Set get_file_obj = FSO.opentextfile(fpath,open_mode)
            Else
                Set get_file_obj = fso.CreateTextFile(fpath,True)
            End If
        End Function
        
        
        '删除数据
        Function db_table_del(model_str)            
            table_name = get_table_name(model_str)
            run_db_sql "delete from o_model where id='" & table_name & "' ;"
            run_db_sql "drop table " & table_name & ";"
        End Function
        
        
        '####新建模块数据表
        Function db_table_add(model_str,model_field_arr)
            '获取一个数据库不存在的表名
            db_table_name = "o_" & DateDiff("s",0, Now())                
            Do Until check_exsit_db_or_table("table",db_table_name) = False                                        
                db_table_name = "o_" & DateDiff("s",0, Now())
            Loop
            
            '#####拼接建表语句
            
            create_tabel_sql = ""
            For i = 0 To  UBound(model_field_arr)-1
                create_tabel_sql = create_tabel_sql & CHR(34) & model_field_arr(i) & Chr(34) & " varchar(255) ," 
            Next
                        
            
            '########建表语句
            If run_db_sql("use " & SQL_DB_Name & " CREATE TABLE " & db_table_name & " ( " & Mid(create_tabel_sql,1,Len(create_tabel_sql)-2) & " );") = True Then             
                run_db_sql("INSERT INTO o_model VALUES ('" & db_table_name & "','" & model_str & "');")
            End If 
            db_table_add=db_table_name
            
        End function


        
        '####保存数据 
        Function model_field_save(model_str)
            If Len(model_str) = 0 And UBound(modelfield) = 0 then    
                MsgBox "模块名和字段名不能为空!"
            else
                If check_model_exist(model_str) = True Then            
                    old_table_value=get_table_value(model_str,"")
                    model_table_name = get_table_name(model_str)
                    old_table_field = get_table_Field(model_str)
                    
                    db_table_del model_str
                Else
                    ReDim old_table_field(0)
                    ReDim old_table_value(0)        
                End If         
                new_table_name = db_table_add(model_str,modelfield)
                ''''
                If UBound(old_table_field) > 0 And UBound(old_table_value,1) > 0 Then                                
                    Replace_table_value old_table_field,old_table_value,modelfield,new_table_name
                End If 
                
            End If     

        End Function
        
        
        '####转换数据 
        Function Replace_table_value(old_table_field,old_table_value,new_table_field,new_table_name)
            ReDim arr_index(UBound(new_table_field))
            
            For i = 0  To UBound(new_table_field)-1                
                For o = 0  To UBound(old_table_field)-1
                    If new_table_field(i) = old_table_field(o) Then
                        arr_index(i) = o
                        Exit for
                    else
                        arr_index(i) = "Null"
                    End If
                next
            Next
    
            'new_str=""
            For x=0 to UBound(old_table_value,1)-1
                sql_l=""
                For y=0 To UBound(arr_index)-1
                    If arr_index(y) = "Null" Then 
                        sql_l = sql_l & "'',"
                    else
                        sql_l = sql_l & "'" & old_table_value(x,arr_index(y)) & "',"
                    End if
                Next
                'new_str = new_str & "(" & Mid(sql_l,1,Len(sql_l)-1) & "),"                
                'run_db_sql "INSERT INTO " & new_table_name & " VALUES (" & Mid(sql_l,1,Len(sql_l)-1) & ");"
                db_table_insert new_table_name,Mid(sql_l,1,Len(sql_l)-1)
            Next            

        End Function
        
        '插入数据
        Function db_table_insert(table_name,table_data_str)
            'del_file \333.html"                
            'set aa = get_file_obj(oShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\333.log",8)
            'aa.WriteLine "INSERT INTO " & table_name & " VALUES (" & table_data_str & ");"
            'aa.Close
            run_db_sql "INSERT INTO " & table_name & " VALUES (" & table_data_str & ");"
        End Function 
        
        '删除数据
        Function db_table_value_del(table_name,field_name,field_value)
            run_db_sql "delete from " & table_name & " where " & chr(34) & field_name & chr(34) & "='" & field_value & "' ;"
            
        End Function 
        '####获取模块数据库对应的表名,返回string
        Function get_table_name(model_str)
            connection_db SQL_DB_Name
            sql_str = "SELECT * FROM o_model where name='" & model_str & "' ;"
            rst.Open sql_str,conn,1,1
            do until rst.EOF
                If rst.Fields(1).Value = model_str Then 
                    get_table_name = Split(rst.Fields(0).Value)(0)
                    rst.Close
                    conn.Close
                    Exit Function 
                    'rst.MoveLast
                End if
                rst.MoveNext
            Loop
            rst.Close
            conn.Close
        End Function
        
        
        '####获取模块数据记录,返回二维数组 
        Function get_table_value(model_str,selecte_str)
   
            On Error Resume next
            If     model_str = "o_model" Then
                model_table_name = model_str 
                field_str = get_table_Field(model_str)(0)
                If Len(selecte_str) > 0 Then
                    sql_str = "SELECT * FROM " & model_table_name & " where id like '%" & selecte_str & "%' or name like '%" & selecte_str & "%' order by '" & field_str & "' DESC ;"    
                Else
                    sql_str = "SELECT * FROM " & model_table_name & "  order by '" & field_str & "' DESC ;"                
                End if            
            else        
                model_table_name = get_table_name(model_str)

                field_arr = get_table_Field(model_str)                
                field_str = field_arr(0)
                
                If Len(selecte_str) > 0 Then
                    ser_sql = ""
                    For i=0 To UBound(field_arr)-1                        
                        ser_sql = ser_sql & Chr(34) & field_arr(i) & Chr(34) & " like '%" & selecte_str & "%' or "
                    next 
                    sql_str = "SELECT * FROM " & model_table_name & " where " & Mid(ser_sql,1,Len(ser_sql)-4) & " order by '" & field_str & "' DESC ;"
                Else
                    sql_str = "SELECT * FROM " & model_table_name & "  order by '" & field_str & "' DESC ;"                    
                End if
            End If


            connection_db SQL_DB_Name            
            'sql_str = "SELECT * FROM " & model_table_name & " ;"
            rst.Open sql_str,conn,1,1

            reDim menu_table_value(rst.RecordCount,rst.Fields.Count)
            line_count=0

            do until rst.EOF
                'If Len(selecte_str) > 0 Then                      
                    'If  InStr(LCase(split(rst.GetString(,,,vbcrlf),vbcrlf)(line_count)),LCase(selecte_str)) > 0 Then
                        'For i = 0 To (rst.Fields.Count-1)
                            'menu_table_value(line_count,i) = rst.Fields(i).value        
                        'Next
                    'end if 
                'Else
                    For i = 0 To (rst.Fields.Count-1)                        
                       menu_table_value(line_count,i) = rst.Fields(i).value    

                    Next
                'End If
                line_count=line_count+1                
                rst.MoveNext
            Loop
            rst.Close
            conn.Close
            get_table_value = menu_table_value
        End Function 
        '###检查模块是否在在
        Function check_model_exist(model_str)
            On Error Resume next
            connection_db SQL_DB_Name

            sql_str = "SELECT * FROM o_model where name='" & model_str & "' ;"
            rst.Open sql_str,conn,1,1
          
            if rst.RecordCount > 0 then
                check_model_exist = True
            else
                check_model_exist = False
            end if           
            rst.Close
            conn.Close    
        end function
        '####获取模块字段名,返回一维数组 
        Function get_table_Field(model_str)

            If     model_str = "o_model" Then
                model_table_name = model_str
            else        
                model_table_name = get_table_name(model_str) 
            End if    

            connection_db SQL_DB_Name
            sql_str = "SELECT * FROM " & model_table_name & " ;"
            'MsgBox sql_str
            rst.Open sql_str,conn,1,1
         
            redim menu_table_value(rst.Fields.Count)           
            For i = 0 To (rst.Fields.Count-1)                
                menu_table_value(i) = rst.Fields(i).Name                
            Next

            get_table_Field = menu_table_value
            
            rst.Close
            conn.Close            
        End Function
        
        
        ''#####模块内容页模板页面
        Function show_menu_table(menu_str)
            On Error Resume Next
            
            model_selecte_text.name = menu_str
            menu_table_value = ""
            menu_value = ""

            menu_value = get_table_value(menu_str,model_selecte_text.value)    
            menu_table_value = get_table_Field(menu_str)

            
            more_page = int(UBound(menu_value,1)/page_row)
            If (UBound(menu_value,1) mod page_row) > 0  Then more_page = more_page +1            


            If more_page < 1 Then more_page = 1
            
            Dim arr_formHTML()
            ReDim arr_formHTML(more_page)
            
            For arr_i = 1 To more_page

                formHTML = "":strHTML = "":count = 0
                '字段行
                strHTML = strHTML & "<tr  width=""50px"" style=""background-color:#cccccc;"" align=""center"" height='30'><th  id='th_num_" & arr_i & "' onm ouseOver=""th_num_" & arr_i & ".className='mouseon'"" onm ouseOut=""th_num_" & arr_i & ".className=''"">序号</th>"
                '表单行
                formHTML = formHTML & "<tr align=""center"" height='30' style=""background-color:#eeeeee;""><td id='td_row_0_" & arr_i & "' onm ouseOver=""td_row_0_" & arr_i & ".className='mouseon'"" onm ouseOut=""td_row_0_" & arr_i & ".className=''"">*</td>"

                For i = 0 To UBound(menu_table_value)-1                        
                    count = count + 1
                    '字段列
                    strHTML = strHTML & "<th id='th_title_" & arr_i & "_" & count & "' onm ouseOver=""th_title_" & arr_i & "_" & count & ".className='mouseon'"" onm ouseOut=""th_title_" & arr_i & "_" & count & ".className=''"">" & menu_table_value(i) & "</th>"
                    '表单列
                    formHTML = formHTML & "<td id='td_row_" & arr_i & "_" & count & "' onm ouseOver=""td_row_" & arr_i & "_" & count & ".className='mouseon'"" onm ouseOut=""td_row_" & arr_i & "_" & count & ".className=''"" ><input id='att_row_input_" & arr_i & "_" & count & "' onm ouseOver=""att_row_input_" & arr_i & "_" & count & ".className='mouseon'"" onm ouseOut=""att_row_input_" & arr_i & "_" & count & ".className='text'"" onclick=""att_row_input_" & arr_i & "_" & count & ".className='mouseon'"" name='att_row_input_" & arr_i & "_" & count & "' class='text' type='text' size='20'></td>"
                            
                Next
                strHTML = strHTML & "<th width='100px' id='th_btn_" & arr_i & "_" & count & "' onm ouseOver=""th_btn_" & arr_i & "_" & count & ".className='mouseon'"" onm ouseOut=""th_btn_" & arr_i & "_" & count & ".className=''"">控制按钮</th></tr>"
                
                onclick_str = "":insert_str = ""
                for i=1 to count
                    onclick_str = onclick_str & ":att_row_input_" & arr_i & "_" & i & ".name='att_row_input_" & arr_i & "_" & i & "'"
                    reset_onclick_str = reset_onclick_str & ":att_row_input_" & arr_i & "_" & i & ".name='att_row_input_" & arr_i & "_" & i & "':att_row_input_" & arr_i & "_" & i & ".value=''"
                    'insert_str = insert_str & "att_row_input_" & arr_i & "_" & i & ".value+'CHR(44)'+"
                Next

                formHTML = formHTML & "<td id='td_btn_" & arr_i & "' onm ouseOver=""td_btn_" & arr_i & ".className='mouseon'"" onm ouseOut=""td_btn_" & arr_i & ".className=''"" ><input  id='model_obj_add" & arr_i & "' onm ouseOver=""model_obj_add" & arr_i & ".className='mouseon'"" onm ouseOut=""model_obj_add" & arr_i & ".className=''"" name='add'  type=""button"" value=""添加"" onclick=""model_date_update '" & menu_str & "','" & arr_i & "':model_obj_add" & arr_i & ".name='add'" & onclick_str & ":att_row_input_" & arr_i & "_1.disabled=false:menudiv.name='" & menu_str & "':reloaddiv menudiv"">"
                formHTML = formHTML & "&nbsp;<input id='model_obj_reset" & arr_i & "' onm ouseOver=""model_obj_reset" & arr_i & ".className='mouseon'"" onm ouseOut=""model_obj_reset" & arr_i & ".className=''"" name='model_obj_reset'  type=""button"" value=""重置"" onclick=""model_obj_add" & arr_i & ".name='add'" & reset_onclick_str & ":att_row_input_" & arr_i & "_1.disabled=false""></td></tr>"
                reDim att_len(count)
                strHTML = strHTML & formHTML

                arr_formHTML(arr_i) = strHTML
            Next
            
            strHTML = ""
            '''''
            count = 0
            'more_page = 1
            page_num = 1

            For x = 0 To UBound(menu_value,1)-1

                If count = 0 Or (count mod page_row) = 0 Then 
                    strHTML = strHTML & "<table id=mp" & page_num & " style='table-layout:fixed;' class='vishidden' border=""0"" align=""center"" width=""100%"" >" & arr_formHTML(page_num) 
                End If                    
                count = count + 1
                If (count Mod 2) = 0 Then
                    trcolor_str = "#eeeeee;"
                Else
                    trcolor_str = "#E7D3B4;"
                End If 
                strHTML = strHTML & "    <tr style=""background-color:" & trcolor_str & """ align=""center"" height='30' ><td nowrap='nowrap' id='att_row_num_" & page_num & count & "' onm ouseOver=""att_row_num_" & page_num & count &  ".className='mouseon'"" onm ouseOut=""att_row_num_" & page_num & count &  ".className=''"">" & count & "</td>"
                field_count = 0

                For i = 0 To UBound(menu_value,2)-1
                    field_count = field_count + 1
                    str = menu_value(x,i)
                    sizt_num=Int((screen.width-40)/UBound(menu_value,2))
                    '#######http的内容显示成超链接########################
                    If InStr(str,"://") Then 'Or     InStr(str,"http:://") = 1
                        strHTML = strHTML & "<td nowrap='nowrap' align='left' id='att_row_input_" & page_num & "_" & count & "_" & field_count & "' onm ouseOver=""att_row_input_" & page_num & "_" & count & "_" & field_count & ".className='mouseon'"" onm ouseOut=""att_row_input_" & page_num & "_" & count & "_" & field_count & ".className=''"" name='" & str & "' ondblclick=""SetClipBoard('" & str & "')"" ><a target=""_blank"" title='" & str & "' href='" & str & "'><div style='overflow-x:hidden;overflow-y:hidden'>" & str & "</div></a></td>"
                        

                    Else                                    
                        '
                        If Len(str) > 0 Then 
                            '#######非空字符串########################
                            strHTML = strHTML & "<td nowrap='nowrap' id='att_row_input_" & page_num & "_" & count & "_" & field_count & "' onm ouseOver=""att_row_input_" & page_num & "_" & count & "_" & field_count & ".className='mouseon'"" onm ouseOut=""att_row_input_" & page_num & "_" & count & "_" & field_count & ".className=''"" title='" & str & "' name='" & str & "' ondblclick=""SetClipBoard('" & str & "')"" ><div style='overflow-x:hidden;overflow-y:hidden'>" & str & "</div></td>" 
                        Else
                            '#######空字符串取消复制按钮########################                                    
                            strHTML = strHTML & "<td nowrap='nowrap'  id='att_row_input_" & page_num & "_" & count & "_" & field_count & "' onm ouseOver=""att_row_input_" & page_num & "_" & count & "_" & field_count & ".className='mouseon'"" onm ouseOut=""att_row_input_" & page_num & "_" & count & "_" & field_count & ".className=''"" title='" & str & "' name='" & str & "' ondblclick=""SetClipBoard('" & str & "')"">" & str & "</td>" 
                        End If
                            
                    End If
                    '##############################
                    If count = 1 Then                                
                        'reDim att_len(field_count)
                        att_len(field_count) = Len(str)                            
                    Else                            
                        If att_len(field_count) < Len(str) Then
                            att_len(field_count) = Len(str)
                        End If                        
                    End If
            
                Next
                onclick_str = ""
                for i=1 to field_count
                    onclick_str = onclick_str & "att_row_input_" & page_num & "_" & i & ".value=att_row_input_" & page_num & "_" & count & "_" & i & ".name:"
                                        
                next
                strHTML = strHTML &     "<td nowrap='nowrap'  id='att_row_btn_" & page_num & "_" & count & "' onm ouseOver=""att_row_btn_" & page_num & "_" & count &  ".className='mouseon'"" onm ouseOut=""att_row_btn_" & page_num & "_" &  count &  ".className=''""><span style=""text-align:center;cursor:hand;"" onClick=""" & onclick_str & "model_obj_add" & page_num & ".name='edit':att_row_input_" & page_num & "_1.disabled=true"">Edit</span>" 

                strHTML = strHTML &     "&nbsp;&nbsp;<span style=""text-align:center;cursor:hand;"" onClick=""att_row_input_" & page_num & "_1.name='" & count & "':model_obj_add" & page_num & ".name='del':model_date_update '" & menu_str & "','" & page_num & "':att_row_input_" & page_num & "_1.name='':model_obj_add" & page_num & ".name='add':menudiv.name='" & menu_str & "':reloaddiv menudiv"">DEL</span>"
                strHTML = strHTML &     "&nbsp;&nbsp;<SPAN style=""text-align:center;cursor:hand;color:red;font-family: 'Arial Black',Gadget, sans-serif"" width='15' height='15' TITLE='复制' onclick='" & Mid(onclick_str,1,Len(onclick_str)-1) & "' >C</SPAN>&nbsp;"
                strHTML = strHTML & "</td></tr>"

                If ((count-1) mod page_row) = (page_row-1) Then 
                    'MsgBox page_num & "</table>" & count & "---"     & ((count-1) mod 25)
                    strHTML = strHTML & "</table>" & vbcrlf
                         
                    page_num = page_num +1

                End If
            Next 
            '分页显示

            If more_page > 1 And count > page_row Then
                
                td_height = bodytab.height - page_title_size
                
                strHTML = "<table border=""0"" align=""center"" width=""100%"" style='table-layout:fixed;' ><tr height='" & td_height & "' valign='top'><td >" & strHTML & "</table></td></tr><tr align=""center"" height='28' colspan=" & UBound(att_len) & "><td align=""center"">" & vbcrlf
                onclick_sub = ""
                For i = 1 To more_page
                    onclick_sub = onclick_sub & "mp" & i & ".classname='vishidden':" 
                    onclick_mpg = onclick_mpg & "show_more_page" & i & ".disabled=False:"
                Next
                
                For i = 1 To more_page
                    strHTML = strHTML & "<span align=""center"" id='show_more_page" & i & "' onm ouseOver=""show_more_page" & i & ".className='mouseon'"" onm ouseOut=""show_more_page" & i & ".className=''"" onClick=""reset_input_text_size '" & i & "'""><" & i & "></span>&nbsp;&nbsp;" & vbCrLf 
                Next
                strHTML = strHTML & "</td></tr>" & vbcrlf
                strHTML = strHTML & "</table>" & vbcrlf
            Else 

                If Len(strHTML) = 0 Then strHTML =  "<table id=mp" & more_page & " class='vishidden' border=""0"" align=""center"" width=""100%"" style='table-layout:fixed;'>" & arr_formHTML(more_page) 

                strHTML = strHTML & "</table>" & vbcrlf
            End If
            
            
            
            'del_file oShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\333.html"    
            
            'Set aa = get_file_obj(oShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\333.html",8)
            'aa.WriteLine strHTML_btn & strHTML
            
            'aa.Close
            'On Error Resume Next
            menu_div_span.InnerHTML =  Replace(strHTML_btn & strHTML,vbLf,"")
            
            document.getElementById("mp1").classname = document.getElementById("mp1").id

            reset_input_text_size 1
            
        End Function
        
        '#####重新设置输入框大小
        Function reset_input_text_size(mp_num)
            On error Resume Next
            'arr=att_len
            For arr_i = 1 To UBound(att_len)
                document.getElementById("mp" & arr_i).className = "vishidden"
                document.getElementById("show_more_page" & arr_i).disabled=False            
                
            Next
            document.getElementById("mp" & mp_num).className = document.getElementById("mp" & mp_num).id
            document.getElementById("show_more_page" & mp_num).disabled=True

        
            For i = 1 To UBound(att_len)
                sizt_num=Int((screen.width-40)/UBound(att_len)/10)

                'MsgBox "att_row_input_" & mp_num & "_" & i
                document.getElementById("att_row_input_" & mp_num & "_" & i).size = sizt_num
                If att_len(i) = 0 Then 
                    'document.getElementById("att_row_input_" & mp_num & "_" & i).size = 10
                Else                
                    'document.getElementById("att_row_input_" & mp_num & "_" & i).size = int(att_len(i)+5)
                End If 
                document.getElementById("th_title_" & mp_num & "_" & i).type="width:" & sizt_num & "px;"
            Next
            'For j=(page_row*mp_num-page_row+1) To (page_row*mp_num)
                'document.getElementById("att_row_input_" & mp_num & "_" & j & "_" & field_count).type="overflow-x:hidden;overflow-y:hidden"
            'next
            'type='overflow-x:hidden;overflow-y:hidden' id='att_row_input_" & page_num & "_" & count & "_" & field_count & "'
        End Function
        
        '#####首页模块列表页面
        Function reload_model_list()
            'On Error Resume Next
            
            sel_str = model_selecte_text.value
            
            strHTML = "<table border=""0"" align=""center"" width=""100%"" style='table-layout:fixed;'>"
            strHTML = strHTML & "    <tr style=""background-color:#cccccc;"" height='30'>"
            strHTML = strHTML & "        <th width='50px' align='center' id='mlst_th1' onm ouseOver=""mlst_th1.className='mouseon'"" onm ouseOut=""mlst_th1.className=''"" >序号</th>"
            strHTML = strHTML & "        <th id='mlst_th2' onm ouseOver=""mlst_th2.className='mouseon'"" onm ouseOut=""mlst_th2.className=''"" width=""300px"">模块名</th>"
            strHTML = strHTML & "        <th id='mlst_th3' onm ouseOver=""mlst_th3.className='mouseon'"" onm ouseOut=""mlst_th3.className=''"">字段</th>"
            strHTML = strHTML & "        <th id='mlst_th4' onm ouseOver=""mlst_th4.className='mouseon'"" onm ouseOut=""mlst_th4.className=''"" width=""160px"">控制</th>"        
            strHTML = strHTML & "    </tr>"
            count = 0
            model_list_str = ""
            If model_selecte_text.value = "search text" Then
                str=get_table_value("o_model","o")
            else
                str=get_table_value("o_model",model_selecte_text.value)
            End If 
            for i = 0 to UBound(str,1)-1   
                line = join(get_table_Field(str(i,1)),",")
                count = count + 1
                If (count Mod 2) = 0 Then
                    trcolor_str = "#eeeeee;"
                Else
                    trcolor_str = "#E7D3B4;"
                End If 
                strHTML = strHTML & "<tr style=""background-color:" & trcolor_str & """ align=""left"" height='30'><td nowrap='nowrap' id='mlst_td" & count & "1' onm ouseOver=""mlst_td" & count & "1.className='mouseon'"" onm ouseOut=""mlst_td" & count & "1.className=''"" align='center'>" & count & "</td>"
                value_len = Len(str(i,0)) + Len(str(i,0))
                'model_onlick_str = ""
                'For v=1 To UBound(str,1)
                    'model_onlick_str = model_onlick_str & "model_l_" & count & ".classname='button':"
                'next
                '模块名称列
                btn_str = "<input id=""model_l_" & count & """  type=""button"" value=""" & str(i,1) & """ onclick=""if check_user_auth('" & str(i,1) & "') = True then menu0.classname='button':menu0.disabled=false:menudiv.name='" & str(i,1) & "':reloaddiv menudiv:model_l_" & count & ".disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if "" style='width:220px'>"
                
                strHTML = strHTML & "<td nowrap='nowrap'  id='mlst_td" & count & "2' onm ouseOver=""mlst_td" & count & "2.className='mouseon'"" onm ouseOut=""mlst_td" & count & "2.className=''"" ondblclick=""SetClipBoard('" & str(i,1) & "')"" >&nbsp;" & btn_str & "</td>"
                
                '模块字段列
                strHTML = strHTML & "<td nowrap='nowrap' id='mlst_td" & count & "3' onm ouseOver=""mlst_td" & count & "3.className='mouseon'"" onm ouseOut=""mlst_td" & count & "3.className=''"" ondblclick=""SetClipBoard('" & mid(line,1,len(line)-1) & "')"">&nbsp;" & mid(line,1,len(line)-1) & "</td>"
                

                strHTML = strHTML & "<td nowrap='nowrap' id='mlst_td" & count & "4' onm ouseOver=""mlst_td" & count & "4.className='mouseon'"" onm ouseOut=""mlst_td" & count & "4.className=''"" >&nbsp;&nbsp;<BUTTON style=""text-align:center;cursor:hand;"" onClick=""if check_user_auth('模板管理') = True then model_att_save.name='model_att_save':redim modelfield(0):reloaddiv model_add_div:model_att_name.disabled=false:show_model_field_table '',True:model_att_name.value='':model_att.value='' else msgbox '你可能还没有登陆或用户权限不足!' end if"">添加</BUTTON>"
                
                strHTML = strHTML & "&nbsp;&nbsp;<BUTTON style=""text-align:center;cursor:hand;"" onClick=""if check_user_auth('模板管理') = True then model_att_save.name='edit':reloaddiv model_add_div:show_model_field_table '" & str(i,1) & "',True:model_att_name.disabled=true else msgbox '你可能还没有登陆或用户权限不足!' end if"">编辑</BUTTON>" 

                strHTML = strHTML & "&nbsp;&nbsp;<BUTTON style=""text-align:center;cursor:hand;"" onClick=""if check_user_auth('模板管理') = True then db_table_del '" & str(i,1) & "':reload_model_list:reloaddiv model_mgt_div else msgbox '你可能还没有登陆或用户权限不足!' end if"">删除</BUTTON> "
                strHTML = strHTML & "</td></tr>"
            next

            strHTML = strHTML & "</table>"
            model_list_span.InnerHTML =  strHTML
        End Function
        
        
        '#######模块属性页面
        Function show_model_field_table(model_name,load_db_field)
            If Len(model_name) > 0 then
                if check_model_exist(model_name) = True And load_db_field = True  Then
                    list_str = get_table_Field(model_name)
                    redim modelfield(UBound(list_str))
                    for i=0 to UBound(list_str)                     
                        modelfield(i) = list_str(i)
                    next
                end if 
            End If 

            strHTML = "<table border=""0"" align=""left"" width=""100%"" style='table-layout:fixed;'>"
            strHTML = strHTML & "    <tr style=""background-color:#cccccc;"" height='30'>"
            strHTML = strHTML & "        <th width=""50px"" align='center' id='att_tab_th1'  onm ouseOver=""att_tab_th1.className='mouseon'"" onm ouseOut=""att_tab_th1.className=''"">序号</th>"
            strHTML = strHTML & "        <th width=""30%"" id='att_tab_th2'  onm ouseOver=""att_tab_th2.className='mouseon'"" onm ouseOut=""att_tab_th2.className=''"">字段名</th>"
            strHTML = strHTML & "        <th width=""50%"" id='att_tab_th3'  onm ouseOver=""att_tab_th3.className='mouseon'"" onm ouseOut=""att_tab_th3.className=''""></th></tr>"
            count = 0

            model_att_name.value = model_name

            for i=0 to UBound(modelfield)
                'MsgBox modelfield(i)
                If Len(modelfield(i)) > 0  Then
                    str=modelfield(i)

                    count = count +1
                    strHTML = strHTML & "<tr   classname=""tabdef"" align=""left"" style=""background-color:#eeeeee;"" height='30'>"
                    strHTML = strHTML &     "<td align=""center"" id='att_tab_td" & count & "1'  onm ouseOver=""att_tab_td" & count & "1.className='mouseon'"" onm ouseOut=""att_tab_td" & count & "1.className=''"">" & count & "</td>"
                    strHTML = strHTML &     "<td align=""left"" id='att_tab_td" & count & "2'  onm ouseOver=""att_tab_td" & count & "2.className='mouseon'"" onm ouseOut=""att_tab_td" & count & "2.className=''"">" & str & "</td><td id='att_tab_td" & count & "3'  onm ouseOver=""att_tab_td" & count & "3.className='mouseon'"" onm ouseOut=""att_tab_td" & count & "3.className=''"">"
    

                    'If check_model_exist(model_name) = True Then
                        'strHTML = strHTML &     "<span  disabled>Edit</span>&nbsp;&nbsp;<span  disabled>DEL</span> "
                    'else
                        strHTML = strHTML &     "<span style=""text-align:center;cursor:hand;"" onClick=""model_att_add.name='edit':model_att.name='" & str & "':model_att.value='" & str & "'"">Edit</span>" 
                        strHTML = strHTML &     "&nbsp;&nbsp;<span style=""text-align:center;cursor:hand;"" onClick=""model_att_add.name='del':model_field_update model_att_name.value,'" & str & "':show_model_field_table model_att_name.value,False:model_att_add.name='add'"">DEL</span> "
                    'End If
                    

                    If count =< 2 Then
                        strHTML = strHTML &     "&nbsp;&nbsp;<span  disabled ><font color=green><strong>UP</strong></font></span> "
                    Else                    
                        strHTML = strHTML &     "&nbsp;&nbsp;<span style=""text-align:center;cursor:hand;""  onClick=""model_att_add.name='up':model_field_update model_att_name.value,'" & str & "':show_model_field_table model_att_name.value,False:model_att_add.name='add' ""><font color=green><strong>UP</strong></font></span> "
                    End If
                    If count = (UBound(modelfield)) Or count = 1 Then
                        strHTML = strHTML &     "&nbsp;&nbsp;<span  disabled><font color=green><strong>DOWN</strong></font></span> "
                    Else
                        strHTML = strHTML &     "&nbsp;&nbsp;<span style=""text-align:center;cursor:hand;"" onClick=""model_att_add.name='down':model_field_update model_att_name.value,'" & str & "':show_model_field_table model_att_name.value,False:model_att_add.name='add'""><font  color=green><strong>DOWN</strong></font></span> "
                    End If        

                    
                    strHTML = strHTML &    "</td>"
                    strHTML = strHTML &    "</tr>"                    

                end if                             
            next
            strHTML = strHTML & "</table>"
            model_att_span.InnerHTML = strHTML

        End Function
        
        '#######修改模块属性  'chr(9)=\t  chr(44)=, chr(58)=: chr(32)=' '         
        Function model_field_update(model_name,field_name)
            On Error Resume Next

            dim new_model_value()

            if UBound(modelfield) > 0 then tmp_arr = modelfield
            
            If  Len(model_name) = 0 Then  MsgBox "模块名不能为空!"
                
            If model_att_add.name = "add"  then
                if UBound(modelfield) = 0  then 
                    redim modelfield(1)
                    modelfield(0) = field_name
                else
                    field_exist = False
                    for i=0 to UBound(modelfield)                         
                        if LCase(modelfield(i)) = LCase(field_name) then                             
                            field_exist = True
                            exit for 
                        end if                         
                    next
                    if field_exist = False then
                        redim modelfield(UBound(tmp_arr)+1)
                        for i=0 to UBound(tmp_arr) 
                            modelfield(i) = tmp_arr(i)
                        next
                        modelfield(UBound(tmp_arr)) = field_name 
                    else
                        MsgBox model_att.value & "字段名已经存在!"
                    end if           
                end if                 
            elseif model_att_add.name = "edit"  Then
                for i=0 to UBound(tmp_arr)
                    if tmp_arr(i) = model_att.name then                                                 
                        modelfield(i) = field_name
                    Else
                        modelfield(i) = tmp_arr(i)   
                    end if 
                Next            
            elseif model_att_add.name = "up"  Then
                redim modelfield(UBound(tmp_arr))
                for i=0 to UBound(tmp_arr)
                    if tmp_arr(i) = field_name then
                        modelfield(i) = tmp_arr(i-1)
                        modelfield(i-1) = field_name
                    Else
                        modelfield(i) = tmp_arr(i)      
                    end if                     
                next 
        
            elseif model_att_add.name = "down"  Then
                redim modelfield(UBound(tmp_arr))
                for i=0 to UBound(tmp_arr)
                    if tmp_arr(i) = field_name Then
                        modelfield(i) = tmp_arr(i+1)
                        modelfield(i+1) = field_name
                        i=i+1
                    Else
                        modelfield(i) = tmp_arr(i)          
                    end if 
                Next
            elseif model_att_add.name = "del"  Then
                redim modelfield(UBound(tmp_arr)-1)
                for i=0 to UBound(modelfield)
                    if tmp_arr(i) <> field_name then
                        modelfield(i) = tmp_arr(i)          
                    end if 
                next
            end if 

        End Function
        
        Function selecte_menu()            
            if model_selecte_text.name="model_selecte_text" then 
                reload_model_list 
            Else
                show_menu_table model_selecte_text.name
            end if
        End Function
         Function File_export(model_str,export_type)
            'MsgBox Join(modeltxt)    
            'del_file \333.html"                
            'set aa = get_file_obj(oShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\333.html",8)
            'aa.WriteLine strHTML_btn & strHTML
            'aa.Close
            
            On Error Resume Next
            Set objExcel = CreateObject("Excel.Application")
            If export_type = "model" Then
                
                file_path = model_export_path.value
                
                If Len(file_path) = 0 Then 
                    MsgBox "请先选择Excel文件!"
                    Exit Function                    
                End If 
                Set objFile = FSO.GetFile(file_path)
                model_str=Left(objFile.Name,InStrRev(objFile.Name,".")-1)
                
                If check_model_exist(model_str) = True Then
                    MsgBox "数据模块已经存在!"
                End If 
                
                If InStr(LCase(objFile.Type),LCase(excel)) > 0 Then 
                                
                    Set objWorkbook = objExcel.Workbooks.Open(file_path) 
                    
                    'MsgBox objWorkbook.ActiveSheet.UsedRange.Rows.Count
                    'MsgBox objWorkbook.ActiveSheet.UsedRange.Columns.Count
                    
                    columns_num = objWorkbook.ActiveSheet.UsedRange.Columns.Count
                    rows_num = objWorkbook.ActiveSheet.UsedRange.Rows.Count

                    ReDim tmp_field(columns_num),tmp_value(rows_num,columns_num)
                    For r = 1 To rows_num                
                        For c = 1 To columns_num
                            If r = 1 Then
                                If Len(objExcel.Cells(1,c).Text) > 0  Then
                                    'If c = 1 Then MsgBox VarType(objExcel.Cells(1,c).Value)
                                    
                                    tmp=Replace(objExcel.Cells(1,c).Text,vbLf,"")
                                    tmp_field(c-1) = Replace(tmp,vbcrLf,"")
                                Else
                                    MsgBox "表格中数据格式不正确,可能有特殊符号存在!" 
                                    Exit Function                                    
                                End If 

                            Else
                                If c = 1 then
                                    For v = (r+1) To rows_num
                                        if objExcel.Cells(r,c).Text = objExcel.Cells(v,c).Text Then 
                                            MsgBox objFile.Name  & " 第" & r & "行第一列数据与第" & v & "行第一列数据重复!" & objExcel.Cells(r,c).Text & objExcel.Cells(v,c).Text
                                            objExcel.Quit
                                            Set objFile = Nothing                                            
                                            Exit Function
                                        End If 
                                    Next
                                End If 
                                

                                tmp=Replace(objExcel.Cells(r,c).Text,vbLf,"")                                
                                tmp_value(r-2,c-1)= Replace(tmp,vbcrLf,"")                    

                            End If 
                        next
                    Next
                    
                    db_table_name = db_table_add(model_str,tmp_field)                
                    For x=0 to UBound(tmp_value,1)-2
                        sql_l=""
                        For y=0 To UBound(tmp_field)-1
                            sql_l = sql_l & "'" & tmp_value(x,y) & "',"
                        Next            

                        db_table_insert db_table_name,Mid(sql_l,1,Len(sql_l)-1)
                    Next

                Else
                    MsgBox "文件" & objFile.Name & "的类型不是Excel!!!"
                End If 
                objExcel.Quit
                

                reloaddiv model_mgt_div:reload_model_list
                            
                MsgBox objFile.name & "模板导入成功!"
                Set objFile = Nothing
                
                '#######################################
            ElseIf export_type = "out" Then
            
                If model_str = "模板管理" Then
                    MsgBox "请先选择你要操作的模块哟!"
                    Exit Function 
                End If 
                '###############################
                file_path = oShell.ExpandEnvironmentStrings("%userprofile%") & "\desktop\" & model_str & ".xlsx"
                tmp_field = get_table_Field(model_str)
                tmp_value = get_table_value(model_str,"")
                objExcel.Visible = False
                objExcel.Workbooks.Add()            
                
                For f = 0 To UBound(tmp_field)-1
                    objExcel.Cells(1, f+1).Value = tmp_field(f)
                Next
                For x=2 To UBound(tmp_value,1)+1
                    For y=1 To UBound(tmp_value,2)
                        objExcel.Cells(x, y).Value = tmp_value(x-2,y-1)
                    next
                Next
                objExcel.ActiveWorkbook.SaveAs(file_path)    
                objExcel.Quit
                show_menu_table model_str    
                            
                MsgBox "文件" & file_path & "导出成功!"                
                '###############################
            ElseIf export_type = "in" Then
            
                If model_str = "模板管理" Then
                    MsgBox "请先选择你要操作的模块哟!"
                    Exit Function 
                End If 
                file_path = model_export_path.value
                If Len(file_path) = 0 Then 
                    MsgBox "请先选择Excel文件!"
                    Exit Function                    
                End If 
                Set objFile = FSO.GetFile(file_path)
                db_table_name = get_table_name(model_str)
                table_field = get_table_Field(model_str)
                If check_model_exist(model_str) = False Then
                    MsgBox model_str & "模块不存在!"
                    
                    Exit function
                End If 
                
                If InStr(LCase(objFile.Type),LCase(excel)) > 0 Then
                    Set objWorkbook = objExcel.Workbooks.Open(file_path)
                    columns_num = objWorkbook.ActiveSheet.UsedRange.Columns.Count
                    rows_num = objWorkbook.ActiveSheet.UsedRange.Rows.Count
                    'msgbox rows_num
                    For r = 1 To rows_num
                        'msgbox model_str & table_field(0) & objExcel.Cells(r,1).Text
                        '检查数据唯一性
                        If     check_field_value_exist(model_str,table_field(0),objExcel.Cells(r,1).Text) = FALSE Then
                            sql_l=""                
                            For c = 1 To columns_num+1
                                sql_l = sql_l & "'" & objExcel.Cells(r,c).Text & "',"
                            Next
                            'msgbox db_table_name & Mid(sql_l,1,Len(sql_l)-1)
                            
                            db_table_insert db_table_name,Mid(sql_l,1,Len(sql_l)-1)
                        Else
                            MsgBox objFile.Name  & " 第" & r & "行第一列数据与数据库中重复!"
                            Exit for
                        End If 
                    Next
                Else
                    MsgBox "文件" & objFile.Name & "的类型不是Excel!!!"
                End If                 
                objExcel.Quit
                
                show_menu_table model_str
                
                MsgBox "文件" & objFile.name & "中数据导入成功!"
                Set objFile = Nothing
                                    
            End If             
            Set objExcel = Nothing            
            model_export_span.InnerHTML = "<input id='model_export_path' name='model_export_path' type='file' />"
        End Function 


    </SCRIPT> 
    <body>
        <table id="panel" border="0" align="center" style="table-layout:fixed;" >
            <tr>
                <td colspan=3>
                    <input id="menu0" class="button" type="button" value="模板管理" disabled onm ouseOver="menu0.className='button btnhov'" onm ouseOut="menu0.className='button'" onclick="model_selecte_text.name='model_selecte_text':reloaddiv model_mgt_div:reload_model_list:menu0.disabled=true:menu0.className='button'">
                    <span id="menu_btn_span" class="hidden"></span>
                    <hr size=1 color=silver>
                    <!--<input id="indexbtn" class="button" type="button" value=" 首页 " onclick="reloaddiv indexdiv">
                    <input id="hostbtn" class="button" type="button" value="主机管理" onclick="reloaddiv hostdiv:showcontrolhosttable ''">
                    <input id="menu0" class="button" type="button" value="主机添加" onclick="reloaddiv confdiv:showhosttable">-->
                </td>
            </tr>
            <tr>
                <td>    
                    <input id='model_selecte_text' title="model_selecte_text" onm ouseOver="model_selecte_text.className='mouseon'" onm ouseOut="model_selecte_text.className=''" type='text' class='text' name='model_selecte_text'  size="40" value="search text" onkeyup="enterpass 'selecte_menu'">
                    <input id='model_selecte_btn'  onm ouseOver="model_selecte_btn.className='mouseon'" onm ouseOut="model_selecte_btn.className=''" name="model_selecte_btn"  type=button value="搜索" onclick="selecte_menu">
                    <input id='model_selecte_reset_btn'  onm ouseOver="model_selecte_reset_btn.className='mouseon'" onm ouseOut="model_selecte_reset_btn.className=''" name="model_selecte_reset_btn"  type=button value="清除" onclick="model_selecte_text.value='':selecte_menu">
    
                </td>
                <td>
                    <span id="model_export_span" class="hidden"><input id="model_export_path" name="model_export_path" type="file"   accept=".xls"></span>                    
                    <input id='model_export_in'  onm ouseOver="model_export_in.className='mouseon'" onm ouseOut="model_export_in.className=''" name="model_export_in" type=button value="导入数据" title="导出到Excle" onclick="File_export model_selecte_text.title,'in'">
                    <input id='model_export_model'  onm ouseOver="model_export_model.className='mouseon'" onm ouseOut="model_export_model.className=''" name="model_export_model" type=button value="导入模板" title="从Excel导入模板" onclick="File_export model_selecte_text.title,'model'">                    
                    <input id='model_export_out'  onm ouseOver="model_export_out.className='mouseon'" onm ouseOut="model_export_out.className=''" name="model_export_out"  type=button value="导出" title="导出到Excle" onclick="File_export model_selecte_text.title,'out'">
                </td>
                <td align="right">                
                    <input id='model_user_text'  onm ouseOver="model_user_text.className='mouseon'" onm ouseOut="model_user_text.className=''" type='text' class='text' name='model_user_text' size='' value='' onkeyup="enterpass 'user_auth':">
                    <input id='model_pwd_text'  onm ouseOver="model_pwd_text.className='mouseon'" onm ouseOut="model_pwd_text.className=''" type='password' class='text' name='model_pwd_text' ' value='' onkeyup="enterpass 'user_auth'">
                    <input id='model_user_login'  onm ouseOver="model_user_login.className='mouseon'" onm ouseOut="model_user_login.className=''" name="model_user_login"  type=button value="登陆" onclick="user_auth model_user_text.value,model_pwd_text.value,'in':reloaddiv model_mgt_div">
                    <input id='model_user_login_out'  onm ouseOver="model_user_login_out.className='mouseon'" onm ouseOut="model_user_login_out.className=''" name="model_user_login_out"  type=button value="注销" onclick="user_auth model_user_text.value,model_pwd_text.value,'out':model_user_text.value='':model_pwd_text.value='':model_selecte_text.name='model_selecte_text':reloaddiv model_mgt_div:reload_model_list:menu0.disabled=true:menu0.className='button'">
                </td>
            </tr>
            <tr id=bodytab height="" valign="top">
                <td colspan=3>                
                    <div id="model_add_div" name="model_add_div" class="vishidden" width="100%">
                        <table border="0" align="left" width="100%" style="table-layout:fixed;">    
                            <tr >
                                <td align="left">模板名:</td>
                                <td >
                                    <input id="model_att_name" onm ouseOver="model_att_name.className='mouseon'"  onm ouseOut="model_att_name.className='text'" name="model_att_name" class='text'  type="text"  size="26" value="" onclick="">
                                    <input id="model_att_save" onm ouseOver="model_att_save.className='mouseon'" onm ouseOut="model_att_save.className=''" name="model_att_save" type="button" value="保存模板" onclick="model_field_save model_att_name.value:model_att_save.name='model_att_save':reload_model_list:reloaddiv model_mgt_div:model_att_name.disabled=false">
                                    <input id="model_att_cancel" onm ouseOver="model_att_cancel.className='mouseon'" onm ouseOut="model_att_cancel.className=''" name="model_att_cancel" type="button" value="取消" onclick="reload_model_list:model_att_save.name='model_att_save':reloaddiv model_mgt_div:menu0.disabled=true:menu0.className='button'">
                                </td>
                            
                            </tr>                    
                            <tr>
                                <td align="left">字段名:</td>
                                <td >
                                    <input id="model_att" onm ouseOver="model_att.className='mouseon'" onm ouseOut="model_att.className='text'" name="model_att" class='text' type="text"  size="26" value="" onclick="">
                                    
                                    <input id="model_att_add" onm ouseOver="model_att_add.className='mouseon'" onm ouseOut="model_att_add.className=''" name="add" type="button" value="字段添加" onclick="model_att_name.disabled=true:model_field_update model_att_name.value,model_att.value:model_att.value='':show_model_field_table model_att_name.value,False:model_att.name='':model_att_name.name='add'">
                                    
                                    <input id="model_att_reset" onm ouseOver="model_att_reset.className='mouseon'" onm ouseOut="model_att_reset.className=''" name="model_att_reset"  type="button" value="重置表单" onclick="model_att_name.name='add':model_att.name='':model_att.value='':if model_att_name.disabled=false then model_att_name.value=''">
                                </td>
                            </tr>
                            <tr><td colspan=5  ><hr size=1 color=silver><span id="model_att_span" class="hidden"></span></td></tr>
                        </table>
                    </div>
                    
                    <div id="model_mgt_div" name="模板管理" class="vishidden" width="100%">
                        
                        <span id="model_list_span" class="hidden"></span>
    
                    </div>
                    <div id="menudiv" name="" class="vishidden" width="100%">
    
                        <span id="menu_div_span" class="hidden"></span>
    
                    </div>
                </td>
            </tr>
            <tr height="40">
                <td colspan=3>
                    <hr size=1 color=silver>
                    <span style="color:gray">
                        <span onm ouseover="setx(strAbout)" onm ouseout="setx('')">版本</span> |
                        <span onm ouseover="setx(strCopyr)" onm ouseout="setx('')">作者</span> |
                        <span onm ouseover="setx(strHelp)" onm ouseout="setx('')">帮助</span> |
                    </span>
                    <span style="color:darkblue" id="footer"></span>
                </td>
            </tr>
        </table>
</body>
</html> 

 

标签:End,name,HTA,管理工具,strHTML,str,table,model,账号密码
来源: https://www.cnblogs.com/blog-lhong/p/11670249.html