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 © 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 = " <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 & " <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 & " <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 & " <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> "
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> " & 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) & "')"" > " & 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) & "')""> " & 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=''"" > <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 & " <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 & " <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> <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 & " <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 & " <span disabled ><font color=green><strong>UP</strong></font></span> "
Else
strHTML = strHTML & " <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 & " <span disabled><font color=green><strong>DOWN</strong></font></span> "
Else
strHTML = strHTML & " <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