[x]
Posted via EE Mobile

Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.
Question
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
7.8

ASP FileMan and Recent Windows Security Update

Asked by bleckron in Active Server Pages (ASP), Microsoft Windows Operating Systems, File Servers

Tags: Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=" & Session("Str")(174) & """>"

I am using ASP Fileman to access files on our server remotely.  A recent windows security update on our web server keeps causing the error below:

Microsoft VBScript runtime error '800a000d'

Type mismatch: '[undefined]'

/cs/tcm/FileMan/fmlib.asp, line 28

The code for the file "fmlib.asp is below.

I know it is the update as when it is uninstalled the error goes away.  However the update keeps installing so I keep uninstalling it.  I have shut off the updates but would rather not do that.  Any ideas on how to correct this?

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:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:

<%
'### Check if IIS app has application/session
On error resume next
If NOT Application("AppIsInitialized") OR NOT Session("SessionIsInitialized") Then Response.redirect("diags.asp")
On Error Goto 0
 
Server.ScriptTimeout=Application("ScriptTimeout")
 
'### Prevent caching
'Response.ExpiresAbsolute = #2000-01-01# 
'Response.AddHeader "pragma", "no-cache" 
'Response.AddHeader "cache-control", "private, no-cache, must-revalidate"
Response.AddHeader "P3P","CP=CAO PSA OUR'"
 
%>
<!--
#############################################################
Powerful ASP applications for IIS
© 2006 - http://www.iisworks.com
#############################################################
-->
<%
Const Delim1="@¶@" 'Separates items
Const Delim2="#¶#" 'Separates item name from value
 
'### Page title
Response.Write "<title>Wright County Community Services</title>"
Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=" & Session("Str")(174) & """>"
 
'### Setup general objects
If Application("Debugging")=False Then On Error resume next
Set fso=Server.CreateObject("Scripting.FileSystemObject")
 
Set oFind = New RegExp
oFind.IgnoreCase = True
 
Set oForbiddenList = New RegExp
oForbiddenList.IgnoreCase = True
 
'### Check if Bandwidth limit was reached
If Session("MaxBandwidth")>0 Then 
	If Session("Bandwidth")>Session("MaxBandwidth") Then 
		Info=" (" & SizeString((Session("Bandwidth"))) & "/" & SizeString(Session("MaxBandwidth")) & ")."
		Session.Abandon
		If Application("LogLevel")>1 Then WriteLogLine "Bandwidth limit reached:" & Info
		ShowError Session("Str")(245) & Info
	End If
End If
 
'########################
Function GetCustomInfo(f, InfoName)
'########################
On error resume next
If Right(f,1)="\" Then f=Left(f,len(f)-1) 
StreamFile=f & ":FM" & InfoName
GetCustomInfo=""
If fso.FileExists(StreamFile) Then
	Set ts=fso.OpenTextFile(StreamFile,1,True)
	GetCustomInfo=ts.ReadAll
	ts.Close
	Set ts=nothing
End If	
End Function
 
'########################
Function SetCustomInfo(f,InfoName,StreamText)
'########################
'Note that Streams cannot be enumerated or deleted with vbscript!
On Error resume next
StreamText=stripHTML(StreamText)
If Right(f,1)="\" Then StreamFile=Left(f,len(f)-1) &  ":FM" & InfoName Else StreamFile=f &  ":FM" & InfoName
If Session("IsNTFS") Then
	Set ts=fso.CreateTextFile(StreamFile,True)
	ts.Write Left(StreamText,Application("CustomFileInfoMaxSize"))
	ts.Close
	Set ts=Nothing
End If
SetCustomInfo=(Err=0)
End Function
 
'########################
Sub SendAdminUploadNotification(FileList)
'########################
If Instr(Application("UploadNotificationEmail"),"@")>0 AND NOT (Application("NoUploadNotificationForAdminUploads") AND Session("IsAdmin")) Then
	If Application("LogLevel")>2 Then writelogline "Upload notification sent to " & Application("UploadNotificationEmail")
	Body="The following files were uploaded to folder " & Session("Dir") & ":" & VbCrLf
	Body = Body & FileList
	'Body = Body & "(" & Session("BaseURL") & "?dir=" & Server.URLEncode(GetRelPath(BasePath)) & ")" & VbCrLf & FileList
	Body = Body & VbCrLf & "__________" & VbCrLf
	Body = Body & "Sent with FileMan " & Application("Version") & VbCrLf & Session("BaseURL") & VbCrLf
	SendMail Application("UploadNotificationEmail"), Application("UploadNotificationEmail"), "Upload notification", Body, ""
End If
End Sub
 
'########################
Function stripHTML(strHTML)
'########################
If strHTML<>"" Then
	tStr=strHTML
	Set regEx = New RegExp 
	regEx.IgnoreCase = True 
	regEx.Global = True
	regEx.Pattern = " " 
	tStr = regEx.Replace(tStr, " #@!")
	
	'Add special character to certain tags to detect groups of html-elements
	regEx.Pattern = "(</pre[^<]*>|</script[^<]*>|</a[^<]*>)" 
	tStr = regEx.Replace(tStr, "$1" & " ")
	
	'Remove <head>, hyperlinks and script
	regEx.Pattern = "<head[\w\W]+</head>|<a href[^ ]*</a> |<script[^ ]*</script> "
	tStr = regEx.Replace(tStr, "")
	
	'Remove lf and cr (except between <pre>-tags)
	'regEx.Pattern = "(<pre>[^ ]*</pre>) |[\r\n]" 
	'tStr = regEx.Replace(tStr, "$1")
	
	'Add crlf at certain html-tags (only one lf at </pre></p>)
	regEx.Pattern = "(<p>|</p>|<pre>|</pre></p>|</pre>|<BR>)" 
	tStr = regEx.Replace(tStr, "$1" & vbcrlf)
	
	'Remove html-tags (don't remove numeric comparisation's using < >)
	regEx.Pattern = "(<\s*\d+[^<]*>)|<[^<]+>" 
	tStr = regEx.Replace(tStr, "$1")
	
	'Replace code by 
	regEx.Pattern = " #@!" 
	tStr = regEx.Replace(tStr, " ")
	
	'Remove multiple linefeeds
	regEx.Pattern = "[\n\r]{3,}" 
	regEx.IgnoreCase = True 
	regEx.Global = True
	tStr = regEx.Replace(tStr, vbcrlf & vbcrlf)
	
	'Remove leading and trailing cr's and lf's
	regEx.Pattern = "^[\r\n]*([^\r\n].*)" 
	tStr = regEx.Replace(tStr, "$1")
	regEx.Pattern = "(.*[^\r\n])[\r\n]*$" 
	tStr = regEx.Replace(tStr, "$1")
 
	'General tags
	regEx.Pattern = "<(.|\n)+?>"
	tStr = regEx.Replace(tStr, "")
	tStr = Replace(tStr, "&nbsp;", " ",1,-1,1)
 
	stripHTML=tStr
End If
End Function
 
'########################
Function IsWritable(Dir)
'########################
	On Error resume next
	If Right(dir,1)<>"\" Then dir=dir & "\"
	fn=Dir & fso.GetTempName
	Set tf=fso.OpenTextFile(fn,2,True)
	tf.close
	Set tf=Nothing
	fso.deletefile fn
	IsWritable=(err=0)
End Function
 
'########################
Function IsAccessible(fldr)
'########################
If Session("Settings")(62) Then
	On Error resume next
	Set ofolder=fso.getfolder(fldr)
	Set oFolders=oFolder.SubFolders
	For each tf in oFolders
		Exit For 'Subfolders need to be touched for a perms error to occur...
	Next
	Set oFolders=Nothing
	Set ofolder=Nothing
	IsAccessible=err<>70
	Err.Clear
Else
	IsAccessible=True
End If
End Function
 
'########################
Function GenerateDateString
'########################
sDate=Now
y = Right(Year(sDate),2)
m = Month(sDate)
If len(m)<2 then m="0" & m
d = Day(sDate)
If len(d)<2 then d="0" & d
h=Hour(sDate)
If len(h)<2 then h="0" & h
Min=Minute(sDate)
If len(min)<2 then min="0" & min
s=second(sDate)
If len(s)<2 then s="0" & s
'GenerateDateString = "FM" & y & m & d & h & min & s
GenerateDateString = "FM" & h & min & s
End Function
 
'########################
Function CountOccurrences(s,sFind)
'########################
sFind=Replace(sFind,"|","\|")
Set objRegExp = New Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = sFind
Set Matches = objRegExp.Execute(s)
CountOccurrences=Matches.Count
Set objRegExp = Nothing
End Function
 
'########################
Function IsForbidden(sPath)
'########################
	If Instr(sPath,"..")>0 Then ' No relative paths allowed!
		IsForbidden=True
	ElseIf NOT IsAllowedExtension(sPath) Then
		IsForbidden=True
	ElseIf Len(sPath)>255 Then
		IsForbidden=True
	ElseIf Instr(sPath,"<")>0 OR InStr(sPath,">")>0 Then ' Do not allow escape chars for , and &
		IsForbidden=True
	ElseIf Application("TempZipFolder")<>"" Then 'Zip folder?
		If Instr(1,sPath,Application("TempZipFolder"),1)=1 Then IsForbidden=False
	ElseIf (Session("UseRootfolders") AND NOT Session("AllowMapDrives")) Then ' Check for Rootfolder if defined (if not allowed to map drives)
		 If Application("LogLevel")>2 Then WriteLogLine "############## Check IsForbidden: " & sPath
		IsForbidden=True
		For i = 0 To Ubound(Session("RFPath"))
			If Instr(1,sPath,Session("RFPath")(i),1)=1 Then IsForbidden=False
			If Application("LogLevel")>2 Then WriteLogLine "Check IsForbidden RF " & i & ") "& Session("RFPath")(i) & VbTab & IsForbidden
		Next
	End If
	If NOT IsForbidden Then
		If IsArray(Session("ForbiddenList")) Then ' Check all entries in ForbiddenList (if not empty)
			For i=0 to Ubound(Session("ForbiddenList"))
				If Session("ForbiddenList")(i)<>"" AND MatchName(sPath,Session("ForbiddenList")(i),oFind) Then
					If Application("LogLevel")>2 Then WriteLogLine "Forbidden " & sPath & ". Matched with: " & Session("ForbiddenList")(i)
					IsForbidden=True
					Exit Function
				End If
			Next
		End If
		If IsArray(Session("LockInFolderList")) AND Right(sPath,1)="\" Then ' Check all entries in LockInFolderList (if not empty)
			IsForbidden=True
			For i=0 to Ubound(Session("LockInFolderList"))
				If Session("LockInFolderList")(i)<>"" AND Instr(1,sPath, Session("LockInFolderList")(i),1)=1 Then IsForbidden=False
			Next
		End If
	End If
End Function
 
'########################
Function IsAllowedExtension(sPath)
'########################
IsAllowedExtension=True
If Application("AllowedFileTypes")<>"" AND NOT Session("IsAdmin") Then 
	Ext=fso.GetExtensionName(sPath)
	If NOT Right(sPath,1)="\" AND Ext<>"" Then If NOT IsInList(Ext, Application("AllowedFileTypes")) Then IsAllowedExtension=False
End If
End Function
 
'########################
Function IsInList(Str,List)
'########################
'Checks is an exact string is in a comma separated list of words
List=Replace(List," ,",",")
List=Replace(List,", ",",")
If Instr(1,"," & List & ",","," & Str & ",",1)>0 AND List<>"" AND Str<>"" Then IsInList=True Else IsInList=False
End Function
 
'########################
Function FormatSQL(str)
'########################
FormatSQL=Replace(Str,"'","''")
End Function
 
'########################
SUB CheckRootfolder(RFNum)
'########################
On Error resume next
QuotaExceeded=False
Session("IsReadOnly")=False
Session("IsQuotaExceeded")=False
If Session("UseRootfolders") Then
	'### Only check if a RF is the folder has a quotum, and is not Read-only
	If Session("RFQuota")(RFNum)>0 AND NOT Session("RFreadOnly")(Session("CurRFNum")) Then
		RFSize=0
		Set oFolder=fso.getfolder(Session("RFPath")(RFNum))
		RFSize=oFolder.Size
		Set oFolder=Nothing
		If RFSize>Session("RFQuota")(RFNum) Then QuotaExceeded=True 
		''### Set Size
		aTmp=Session("RFSize")
		aTmp(RFNum)=RFSize
		Session("RFSize")=aTmp
		'### Set FreeSize
		aTmp=Session("RFSizeFree")
		aTmp(RFNum)=Session("RFQuota")(RFNum)-RFSize
		Session("RFSizeFree")=aTmp
		''### Set Exceeded status
		aTmp=Session("RFQuotaExceeded")
		aTmp(RFNum)=QuotaExceeded
		Session("RFQuotaExceeded")=aTmp
	End If
	Session("IsQuotaExceeded")=Session("RFQuotaExceeded")(Session("CurRFNum")) 
	Session("IsReadOnly")=Session("RFreadOnly")(Session("CurRFNum")) OR Session("IsQuotaExceeded")
	If Application("LogLevel")>1 Then WriteLogLine "Checking Rootfolder " & Session("RFPath")(RFNum)
End If
End SUB
 
'########################
SUB SendUploadNotification(FileList)
'########################
	'### Get list of mail addresses of other group members that have a valid email address and UploadNotification enabled
	If Application("Debugging")=False Then On Error resume next
	SQL="SELECT Email FROM Login Where GroupID=" & Session("GroupID") & " AND User<>'" & Session("User") & "' AND UploadNotification=1;"
	Set Conn=Server.CreateObject("ADODB.Connection")
	Set RS=Server.CreateObject("ADODB.RecordSet")
	Conn.Mode = 3
	Conn.Open Application("DBConnection")
	RS.Open SQL,Conn,3,3
	SendTo="" 
	While Not RS.EOF
		If Instr(RS("Email") & "" ,"@")>0 Then SendTo=SendTo & RS("Email") & ";"
		RS.Movenext
	Wend
	RS.close
	Set RS=Nothing
	Conn.close
	Set Conn=Nothing
	If Application("LogLevel")>1 Then WriteLogLine "Send upload notification to: " & SendTo
	If SendTo<>"" Then	
		'### Get To/From
		If Session("Email")<>"" Then 
			User=UCase(Session("User")) & " (" & Session("Email") & ")"
			From=Session("Email")
		Else
			User=UCase(Session("User"))
			From=Application("ReplyToAddress")
		End If
		'### Construct body
		Body= Body & Session("Str")(255) & VbCrLf
		Body= Body & Session("Str")(256) & VbCrLf
		Body= Body & VbCrLf
		Body= Body & Session("Str")(102) & ": " & User & VbCrLf
		Body= Body & Session("Str")(163) & ": " & Now & VbCrLf
		Body= Body & Session("Str")(258) & ": " & Session("BaseURL") & VbCrLf 
		t=FriendlyPath(RelativePath(Session("Dir")))
		If Session("UseRootfolders") Then If UBound(Session("RFPath"))>0 Then t= "[" & Session("RFName")(Session("CurRFNum")) & "]" & t
		Body= Body & Session("Str")(257) & ": " & t & VbCrLf
		Body= Body & VbCrLf
		Body= Body & Session("Str")(259) & ": " & VbCrLf
		Body= Body & FileList
		Body= Body & VbCrLf
		Body= Body & "___________" & VbCrLf
		Body= Body & "ASP FileMan " & Application("FMVersion") & " - " & VbCrLf & "http://www.iisworks.com"
		Subject=Session("Str")(260)
		'If SendTo<>"" Then SendMail "",SendTo,From,Subject,Body,Attachments
		SendMail SendTo,From,Subject,Body,""
	End If
	'response.write "<pre>" & sendto & body
	'response.end
End Sub
 
'########################
Function IsSharedFolder(Dir)
'########################
'Checks if current folder is a shared folder (for upload notification)
If Session("RootFolderString")<>"" Then
	IsSharedFolder=False
	aTmp=Split(Session("RootFolderString"),VbCrLf)
	For i = 0 To Ubound(aTmp)
		If Instr(aTmp(i),"|")>0 Then aTmp(i)=Left(aTmp(i),Instr(aTmp(i),"|")-1)
		aTmp(i)=Trim(aTmp(i))
		If aTmp(i)<>"" Then If Instr(1,Dir,aTmp(i),1)=1 Then IsSharedFolder=True
	Next
Else
	IsSharedFolder=True
End If
End Function
 
'########################
Function EncryptText(strText,strKey)
'########################
If strText<>"" Then
	KeyLen=Len(strKey)
	ReDim aKey(KeyLen)
	For i=1 To KeyLen
		aKey(i)=Asc(Mid(strKey,i, 1))
	Next
	For i=1 To Len(strText)
		If j=KeyLen Then j=1 Else j=j+1
	strEnc = strEnc & Chr(Asc(Mid(strText, i, 1)) XOR aKey(j))
	Next
	EncryptText = strEnc
End If
End Function
 
'########################
Function GetOwner(filepath)
'########################
Set oSec = Server.CreateObject("ADsSecurity")
Set oSD = oSec.GetSecurityDescriptor("FILE://" & filepath)
GetOwner = oSD.Owner
Set oSec = Nothing
End Function
 
'########################
Function ConvDate(TheDate) 'Convert Date to US format.
'########################
	OldLCID=Session.LCID
	Session.LCID=Application("DefaultLCID")
	ConvDate=FormatDateTime(TheDate,0)
	Session.LCID=OldLCID
End Function
 
'########################
Function MakeShortstring(Str,Length)
'########################
	t=Replace(Str,"\"," ")
	t=Replace(t,"_"," ")
	p=Instr(t," ")
	If Len(Str)>Length AND p>0 AND p<>Len(t) Then
		t1=InStr(Length\4,t," ")
		t2=InStr(Len(t)-Length+t1,t," ")
		MakeShortstring=Left(Str,t1) & "..." & Mid(Str,t2)
	Else
		MakeShortstring=Str
	End If
End Function
 
'########################
Sub SendMail(SendTo,ReplyTo,Subject,Body,Attachments)
'########################
On Error resume next
Attachments=Split(Attachments,";")
If LCase(Application("MailComponent")="jmail") Then 
	' ### Send mail with jmail
	Set Msg = Server.CreateObject( "JMail.Message" )
	Msg.Charset = Session("Str")(174)
	Msg.ISOEncodeHeaders = false
	Msg.AddRecipient SendTo
	Msg.From = ReplyTo
	Msg.Subject = Subject
	Msg.Body = Body
	If IsArray(Attachments) Then
		For i = 0 To Ubound(Attachments)
			Msg.AddAttachment Attachments(i)
		Next
	End If
	Msg.AddHeader "Originating-IP", Session("IP")
	Msg.send(Application("SMTPMailServer"))
	Msg.close
	Set Msg=Nothing
	If err<>0 Then ShowError "Error sending email!"
ElseIf LCase(Application("MailComponent")="aspmail") Then
	' ### Send mail with AspMail
	Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
	Mailer.Charset = Session("Str")(174)
	Mailer.FromAddress = ReplyTo
	Mailer.AddRecipient SendTo,SendTo
	Mailer.Subject = Subject
	Mailer.BodyText = Body
	If IsArray(Attachments) Then
		For i = 0 To Ubound(Attachments)
			Mailer.AddAttachment Attachments(i)
		Next
	End If
	Mailer.AddExtraHeader "Originating-IP: " & Session("IP")
	Mailer.RemoteHost = Application("SMTPMailServer")
	SentOK=Mailer.SendMail 
	Set Mailer=Nothing
	If NOT SentOK Then ShowError "Error sending email!"
ElseIf LCase(Application("MailComponent")="cdonts") Then
	Set objNewMail = Server.CreateObject("CDONTS.NewMail")
	objNewMail.From = ReplyTo
	objNewMail.Value("Originating-IP") = Session("IP")
	objNewMail.Value("Content-Type") = "text/html; charset=" & Session("Str")(174) & ""
	objNewMail.To = SendTo
	objNewMail.Subject =Subject
	objNewMail.Body = Body
	objNewMail.BodyFormat=1
	objNewMail.MailFormat=0
	If IsArray(Attachments) Then
		For i = 0 To Ubound(Attachments)
			objNewMail.AttachFile Attachments(i)
		Next
	End If
	objNewMail.Send
	Set objNewMail = Nothing
	If err<>0 Then ShowError "Error sending email!"
ElseIf LCase(Application("MailComponent")="cdo") Then
	Set cdoConfig = Server.CreateObject("CDO.Configuration")
	sch = "http://schemas.microsoft.com/cdo/configuration/" 
	cdoConfig.Fields.Item(sch & "sendusing") = 2
	cdoConfig.Fields.Item(sch & "smtpserver") = Application("SMTPMailServer")
	cdoConfig.fields.update
 	Set objNewMail = Server.CreateObject("CDO.Message")
	Set objNewMail.Configuration = cdoConfig
	objNewMail.BodyPart.Charset = Session("Str")(174)
	objNewMail.From=ReplyTo
	objNewMail.To= SendTo
	objNewMail.Subject=Subject
	objNewMail.TextBody=Body
	If IsArray(Attachments) Then
		For i = 0 To Ubound(Attachments)
			objNewMail.AddAttachment Attachments(i)
		Next
	End If
	objNewMail.Send
	Set objNewMail = Nothing 
	If err<>0 Then ShowError "Error sending email!"
Else
	ShowError "Invalid email component defined!"
End If
End Sub
 
'########################
Function CheckEmail(Email)
'########################
' Email=Replace(email,";",",")
aEmail=Split(email,";")
For n=0 To Ubound(aEmail)
	aEmail(n)=Trim(aEmail(n))
	If aEmail(n)<>"" Then
		CheckEmail=False
		If Application("AllowedMailDomains")="" Then
			If Instr(aEmail(n),"@")>0 AND Instr(aEmail(n),".")>0 AND Len(aEmail(n))>5 AND NOT Isnumeric(mid(aEmail(n), instrrev(aEmail(n),".")+1)) Then CheckEmail=True '### Webmail does not check for email but for host name, no @ present!
		Else
			aTmp=Split(Trim(LCase(Application("AllowedMailDomains"))),",")
			For i=0 to Ubound(aTmp)
				s=Trim(aTmp(i))
				If InstrRev(aEmail(n),s,-1,1)=Len(aEmail(n))-Len(s)+1 Then
					CheckEmail=True
					Exit For
				End If
			Next
		End If
		If Application("DeniedMailDomains")<>"" Then
			aTmp=Split(Trim(LCase(Application("DeniedMailDomains"))),",")
			For i=0 to Ubound(aTmp)
				s=Trim(aTmp(i))
				If InstrRev(aEmail(n),s,-1,1)=Len(aEmail(n))-Len(s)+1 Then
					CheckEmail=False
					Exit For
				End If
			Next
		End If
		If CheckEmail=False Then Exit For
	End If
Next
End Function
 
'########################
Function DownloadCount(f,Increment)
'########################
'Note that Streams cannot be enumerated or deleted with vbscript!
'If Application("Debugging")=False Then On Error resume next
On Error resume next ' Ignore Read only file probs
 
DownloadCount=0
If Session("Settings")(55) AND UCase(fso.getExtensionName(f))<>"ASA" Then 
	StreamFile=f & ":FMDLCnt"
 
	'### Get existing counter 
	If fso.FileExists(StreamFile) then 
		Set ts=fso.OpenTextFile(StreamFile,1,False)
		If NOT ts.AtEndOfStream Then DownloadCount=CLng(ts.readline)
		ts.Close
		Set ts=Nothing
	End If
 
	'### Increment counter
	If fso.FileExists(f) AND Session("IsNTFS") Then
		'### Get modified date (Works on W2k+ only!)
 		If Application("ShellAppInstalled") Then
			Set tf=fso.getFile(f)
			ModDate=tf.datelastmodified
			Set tf=Nothing
		End If
	
		'### Create new stream file
		Set ts=fso.OpenTextFile(StreamFile,2,True)
		ts.Writeline DownloadCount + Increment
		ts.Close
 
		'### Reset Modified date to original (gets changed when a streams file is added) Works on W2k+ only!
 		If Application("ShellAppInstalled") Then
			Set oShell = Server.CreateObject("Shell.Application")
			Set oFolder = oShell.NameSpace(Session("Dir")) 
			Set oFile = oFolder.ParseName(fso.getfilename(f))
			oFile.ModifyDate=ModDate
			Set oShell = Nothing
			Set oFolder = Nothing
		End If
	End If
End If
End Function
'########################
Function Truncate(str,length)
'########################
	If len(str)>length Then Truncate=Left(str ,length) & "..." Else Truncate=str
End Function
 
'########################
Function IsNTFS(f)
'########################
On Error resume next
Set drv = fso.GetDrive(fso.GetDriveName(f)) 
If drv.FileSystem = "NTFS" then IsNTFS=True Else IsNTFS=False
Set Drv=Nothing
End Function
 
'########################
SUB Download(f, IsAttachment)
'########################
If Application("Debugging")=False Then On Error resume next
Server.ScriptTimeout=Application("LongScriptTimeout")
f=decPath(f)
fn= fso.getfilename(f)
strFileType = LCase(fso.getExtensionName(f))
Select Case strFileType
	Case "htm", "html"
		ContentType = "text/html"
	Case "xml"
		ContentType = "text/xml"
	Case "asp"
		ContentType = "text/asp"
	Case "txt"
		ContentType = "text/plain"
	Case "doc", "dot"
		ContentType = "application/msword"
	Case "xls", "xlt"
		ContentType = "application/vnd.ms-excel"
	Case "rtf"
		ContentType = "application/rtf"
	Case "ppt"
		ContentType = "application/x-mspowerpoint"
	Case "gif"
		ContentType = "image/gif"
	Case "bmp"
		ContentType = "image/bmp"
	Case "jpg", "jpeg"
		ContentType = "image/jpeg"
	Case "pdf"
		ContentType = "application/pdf"
	Case "zip"
		ContentType = "application/zip"
	Case "wav"
		ContentType = "audio/wav"
	Case "mid"
		ContentType = "audio/midi"
	Case "mp3"
		ContentType = "audio/mpeg"
	Case "asf"
		ContentType = "video/x-ms-asf"
	Case "avi"
		ContentType = "video/avi"
	Case "mpg", "mpeg"
		ContentType = "video/mpeg"
	Case Else
		ContentType = "application/octet-stream"
End Select
Response.Clear
Response.Charset = "UTF-8"
If IsAttachment Then
	Response.AddHeader "Content-Disposition", "attachment; filename=" & fn & ";"  
Else
	Response.AddHeader "Content-Disposition", "inline; filename=" & fn & ";" 
End If
If Application("UseFathDownload") Then' ### Use efficient FasthUpload method
	Set oUpload = Server.CreateObject("Fath.Upload")
	oUpload.SendBinary f, ContentType
	Set oUpload=Nothing
Else' ### Use ODBC streams method
	Response.ContentType = ContentType
	Set ObjStream=Server.CreateObject("Adodb.stream")
	ObjStream.Open
	ObjStream.Type=1
	ObjStream.LoadFromFile(f)
	TotalSize=ObjStream.Size
	Response.AddHeader "Content-Length", TotalSize
	BlockSize=131072 
	For lBlocks = 1 To TotalSize \ BlockSize
		If NOT Response.IsClientConnected Then Exit For
		Response.BinaryWrite objStream.Read(BlockSize)
		Response.Flush
	Next
	If TotalSize>0 Then Response.BinaryWrite objStream.Read(TotalSize Mod BlockSize)
	ObjStream.Close
	Set ObjStream=Nothing
End If
FileSize=fso.getfile(f).size
If Err=0 AND Application("LogLevel")>1 Then WriteLogLine("Download " & f & " (" & SizeString(FileSize) & ")")
Session("Bandwidth")=Session("Bandwidth") + Round(FileSize/1024)
If err<>0 Then Call ShowError(Session("Str")(142) & " " & RelativePath(f)) Else DownloadCount f,1
'Response.End
End SUB
 
'########################
Function CreatePath(sPath)
'########################
If Application("Debugging")=False Then On Error resume next
pos=Instr(3,sPath,"\",1)
aTmp=Split(Mid(sPath,pos+1),"\")
sNewPath=Left(sPath,pos-1)
For n = 0 to Ubound(aTmp)
	On Error resume next 'Ignore permission problems on higher levels
	sNewPath = sNewPath & "\" & aTmp(n)
	If aTmp(n)<>"" AND NOT fso.FolderExists(sNewPath) Then
		fso.CreateFolder sNewPath
	End if
Next
If fso.FolderExists(sPath) Then 
	If Application("LogLevel")>0 Then WriteLogLine "Created folder: " & sNewPath
	CreatePath=True 
Else
	If Application("LogLevel")>0 Then WriteLogLine "ERROR creating folder: " & sNewPath
	CreatePath=False
End If
End Function
 
'##################
Function RandomString(length)
'##################
Randomize
For n= 1 to length
	s=s+ Chr(Asc("a") + rnd()*(Asc("z")-Asc("a")))
next
RandomString=s
End Function
 
'########################
SUB GetLanguage(languagefile)
'########################
If Application("Debugging")=False Then On Error resume next
ReDim aTmp(0)
f=Server.Mappath("lang/"& languagefile)
If fso.fileexists(f) Then
	Session("LanguageFile")=languagefile
	Set fr=fso.OpenTextFile(f,1,False)
	aLines=Split(fr.readall,VbCrLf)
	fr.close
	For n = 0 To UBound(aLines)
		s=Trim(aLines(n))
		Pos=Instr(s,"=")
		If s<>"" AND Pos>1 AND Pos<10 AND left(s,1)<>"'" AND left(s,1)<>";" Then 
			If Instr(s,";")>0 Then s=Left(s,Instr(pos,s,";",1)-1)
			If IsNumeric(Left(s,Pos-1)) Then
				i=Int(Left(s,Pos-1))
					If i>Hi Then
					Hi=i
					Redim Preserve aTmp(i)
				End If
				aTmp(i)=EscapeQuote(Trim(Mid(s,Pos+1)))
			End If
		End If
	Next
	If UBound(aTmp)>=Application("NumLangEntries") Then Session("Str")=aTmp Else ShowError("Invalid language file """ & languagefile & """: too few entries found (probably an old file)!")
End If
If Application("LogLevel")>1 Then WriteLogLine "Read language file: " & languagefile
On Error resume next
Session.LCID = Session("Str")(164)
Err.Clear
End SUB
 
'########################
Function GetSettings(SettingsMask)
'########################
ReDim aTmp(0)
For i=0 to Len(SettingsMask)
	Redim Preserve aTmp(i)
	If Mid(SettingsMask,i+1, 1)="1" Then aTmp(i)=True Else aTmp(i)=False
Next
GetSettings=aTmp
End Function
 
'########################
Function ObjectExists(oClass)
'########################
	On Error resume next
	Set obj=Server.CreateObject(oClass)
	If Err Then ObjectExists=False Else ObjectExists=True
	Set Obj=Nothing
End Function
 
'########################
Function GetAttr(Attr)
'########################
	S=""
	If Attr And 32 Then S=S & "A"
	If Attr And 1 Then S=S & "R"
	If Attr And 2 Then S=S & "H"
	If Attr And 4 Then S=S & "S"
	If Attr And 2048 Then S=S & " C"
	GetAttr=S
End Function
 
'########################
Function SizeString(size)
'########################
If NOT Isnumeric(Size) OR Size="" Then
	SizeString=""
ElseIf Size<=0 Then
	SizeString="0B"
ElseIf Size>1024*1024*1024 Then
	SizeString=Round(Size/1024/1024/1024,1) & "GB"
ElseIf Size>10*1024*1024 Then
	SizeString=Round(Size/1024/1024) & "MB"
ElseIf Size>1024*1024 Then
	SizeString=Round(Size/1024/1024,1) & "MB"
'ElseIf Size<1024 Then
'	SizeString=Round(Size/1024,1) & "kB"
ElseIf Size<1024 Then
	SizeString="1kB"
ElseIf Size>100*1024 AND Size<=1024*1024 Then
	SizeString=Round(Size/1024/1024,1) & "MB"
Else
	SizeString=Round(Size/1024) & "kB"
End If
End Function
 
'########################
SUB ShowError(Info)
'########################
	Response.Clear
	Response.Write "<link rel=stylesheet href=fm.css>"
	Response.Write "<br><table width=400 align=center border='1' cellpadding=6 cellspacing='0' bordercolor='#444444'>"
	Response.Write "<tr><td align='center' bgcolor=" & Application("BgColorHeader") & "><font color=FFFFFF size=2>"
	Response.Write "<b>" & Session("Str")(1) & "</b></td></tr><tr><td bgcolor=EEEEEE>"
	Response.Write "<table>"
	Response.Write "<tr><td valign=top><img src=img/stop.gif border=0></td><td>" & Info & "</td></tr>"
	If err.description <>"" Then Response.Write "<tr><td></td><td><i>" & Session("Str")(208) & ": " & err.description & "</i></td></tr>"
	Response.Write "</table>"
	Response.Write "<br><center>"
	Response.Write "<input type='button' class=Formitem value='" & Session("Str")(41) & "' onclick='history.go(-1)';> "
	Response.Write "</center>"
	Response.Write "</td></tr></table>"
	Response.Write "<table width=400 align=center><tr><td>"
	If Session("User")<>"" Then 
		If Session("UseRootfolders") then t="\" else t=Server.Mappath("/")
		Response.Write "<center><a href=fileman.asp?dir="& Server.URLEncode(t) & ">" & Session("Str")(119) & "</a></center><br>"
	End If
	If Application("ExtraErrorMsg")<>"" Then Response.Write Application("ExtraErrorMsg")
	Response.Write "<br><br>"
	Response.Write "</td></tr></table><br>"
	If IsObject(Conn) Then Set Conn=Nothing
	If IsObject(RS) Then Set RS=Nothing
	Response.end
End SUB
 
'########################
SUB ShowInfo(Info)
'########################
	Response.Clear
	Response.Write "<link rel=stylesheet href=fm.css>"
	Response.Write "<br><table width=400 align=center border='1' cellpadding=6 cellspacing='0' bordercolor='#444444'>"
	Response.Write "<tr><td align='center' bgcolor=" & Application("BgColorHeader") & "><font color=FFFFFF size=2>"
	Response.Write "<b>" & Session("Str")(207) & "</b></td></tr><tr><td bgcolor=EEEEEE>"
	Response.Write "<table>"
	Response.Write "<tr><td valign=top><img src=img/info.gif border=0></td><td>" & Info & "</td></tr>"
	Response.Write "</table>"
	Response.Write "<br><center>"
	Response.Write "<input type='button' class=Formitem value='" & Session("Str")(41) & "' onclick='location.href=""fileman.asp""'> "
	Response.Write "</center>"
	Response.Write "</td></tr></table>"
	Response.Write "<table width=400 align=center><tr><td>"
	If Session("User")<>"" Then 
		If Session("UseRootfolders") then t="\" else t=Server.Mappath("/")
		Response.Write "<center><a href=fileman.asp?dir="& Server.URLEncode(t) & ">" & Session("Str")(119) & "</a></center><br>"
	End If
	Response.end
End SUB
 
'########################
Function StartCapital(str)
'########################
If Session("Settings")(3) Then
	s=LCase(str)
	chLast=" "
	For Pos=1 To Len(s)
	 	ch=Mid(s,Pos,1)
	 	If Instr(" _\[(",chLast)>0 then t=t & Ucase(ch) Else t=t & ch
	 	chLast=ch
	Next
	StartCapital=Replace(t," of "," of ",1,-1,1)
	StartCapital=Replace(t," a "," a ",1,-1,1)
Else
	StartCapital=Str
End If
End Function
 
'########################
Function DisplayDate(sDate)
'########################
	If Session("Settings")(27) Then DisplayDate=sDate Else DisplayDate=FormatdateTime(sDate,2)
End Function
 
'########################
Function Make2Digits(s)
'########################
	If len(s)<2 then s="0" & s
	Make2Digits=s
End Function
 
'########################
Function TimePassed(t1,t2)
'########################
t=DateDiff("s",t1,t2)
t1=t
hr=t\3600
If len(hr)=1 Then hr="0" & hr
t=t mod 3600
min=t\60
If len(min)=1 Then min="0" & min
sec=t mod 60
If len(sec)=1 Then sec="0" & sec
TimePassed=hr & ":" & min & ":" & sec
End Function
 
'########################
SUB CountRecyclerItems
'########################
If Session("FMRecyclerName")<>"" AND fso.FolderExists(Session("FMRecyclerName")) Then
	If Application("Debugging")=False Then On Error resume next
	Set oFolder=fso.getfolder(Session("FMRecyclerName"))
	Session("RecyclerSize")=oFolder.Size
	Set oFolders=oFolder.SubFolders
	Set oFiles=oFolder.files
	Session("NumRecyclerItems")=oFiles.Count + oFolders.Count
	Set oFiles=Nothing
	Set oFolders=Nothing
	Set ofolder=Nothing
End If
End SUB
 
'########################
Function RelativePath(sPath)
'########################
	RelativePath=sPath
	If Session("UseRootfolders") AND NOT Session("AllowMapDrives") Then 
		If RelativePath="" Then
			RelativePath="\" 
		Else 
			rp=Replace(sPath,Session("RFPath")(Session("CurRFNum")),"",1,-1,1)
			If rp="" Then rp="\"
			RelativePath=Session("CurRFNum") & "|" & rp
		End If
	End If
End Function
 
'########################
Function IsEditable(ext)
'########################
	If Instr(1,Application("UnEditableExtensions"),"," & ext & ",",1)>0 AND Ext<>"" Then IsEditable=False Else IsEditable=True
End Function
 
'########################
Function IsWysiwygExtension(ext)
'########################
	If Instr(1,Application("WysiwygExtensions"),"," & ext & ",",1)=0 Then IsWysiwygExtension=False Else IsWysiwygExtension=True
End Function
 
'########################
Function FriendlyPath(p)
'########################
	If Instr(p,"|")>0 Then
		aTmp=Split(p,"|")
		p=aTmp(1)
		'p=Session("RFName")(aTmp(0)) & "\" & aTmp(1)
	End If
	If Left(p,1)<>"\" AND Session("UseRootfolders") AND NOT Session("AllowMapDrives") then p="\" & p
	FriendlyPath=p
End Function
 
'########################
Function encPath(p)
'########################
	s=Replace(p,",","<") 'Escape comma
	s=Replace(s,"&",">") 'Escape ampersand
	encPath=s
End Function
 
'########################
Function decPath(p)
'########################
	s=Replace(p,"<",",") 'comma
	s=Replace(s,">","&") 'ampersand
	decPath=s
End Function
 
'########################
Function GetRFNum(p)
'########################
GetRFNum=0
For n = 0 to UBound(Session("RFPath"))
	If Instr(1,p,Session("RFPath")(n),1)=1 Then GetRFNum=n
Next
End Function
 
'########################
Function BuildPath(sPath)
'########################
If sPath<>"" Then
	BuildPath=sPath
	aTmp=Split(sPath,", ")
	For i=0 to Ubound(aTmp)
		If aTmp(i)="\" AND Session("UseRootfolders") Then '### Empty RootFolder
			aTmp(i)= Session("RFPath")(Session("CurRFNum"))
		ElseIf (Instr(aTmp(i),"|")=0 AND Instr(aTmp(i),"\\")<>1 AND Instr(aTmp(i),":")<>2) AND Left(aTmp(i),1)<>"\" Then ''### Relative path: add current folder
			aTmp(i)=Session("Dir") & aTmp(i)
		ElseIf Session("UseRootfolders") Then ''### Replace rootFolders
			If Instr(aTmp(i),"|")>0 Then
				aTmp1=Split(aTmp(i),"|")
				aTmp(i)= Session("RFPath")(aTmp1(0)) & aTmp1(1)
			Else '## Resort to quick-n-dirty folder checking
				For n = 0 to UBound(Session("RFPath"))
					If Left(aTmp(i),1)="\" AND Instr(aTmp(i),"\\")<>1 Then aTmp(i)=Mid(aTmp(i),2)
					t=Session("RFPath")(n) & aTmp(i)
					dp=decPath(t)
					If Right(dp,1)="\" Then If fso.folderexists(dp) Then aTmp(i)=t Else If fso.fileexists(dp) Then aTmp(i)=t
				Next
			End If
		End If
		If IsForbidden(decPath(aTmp(i))) Then ShowError(Session("Str")(140) & ": " & FriendlyPath(RelativePath(sPath)))
		'response.write aTmp(i) & "<br>"
	Next
 	BuildPath=Join(aTmp,", ")
End If
If Application("LogLevel")>2 Then WriteLogLine "Buildpath " & sPath & " = " & BuildPath
End Function
 
'########################
Function LastPart(p)
'########################
If Right(p,1)<>"\" Then p=p & "\"
aTmp=Split(p,"\")
LastPart=aTmp(UBound(aTmp)-1)
End Function
 
'########################
Function MatchName(f,Match,oRegEx)
'########################
MatchName=True
If Match<>"" Then
	oRegEx.Pattern = Match
	MatchName=oRegEx.Test(f)
	'If Application("LogLevel")>2 Then WriteLogLine "Matching " & f & " with " & Match & ". Result: " & MatchName
End If
End Function
 
'########################
SUB WriteLogLine(msg)
'########################
On Error resume next
If Application("LogToDatabase")=True Then
	Set LogConn=Server.CreateObject("ADODB.Connection")
	LogConn.Mode = 2
	LogConn.Open Application("DBConnection")
	If err<>0 Then sErr=err & ": " & Replace(err.description,"'","''") Else sErr=""
	SQL= "INSERT INTO FMLog ([Date], IP, [User], Description, LastError) VALUES ('" & Now & "','" & Session("IP") & "','" & Session("User") & "','" & Replace(Msg,"'","''") & "','" & sErr & "')"
	LogConn.execute(SQL)
	LogConn.close
	Set LogConn = Nothing
ElseIf Application("LogFile")<>"" Then
	If err<>0 then sErr=VbTab & "Error: " & err.description Else sErr=""
	Set fLog=fso.OpenTextFile(Application("LogFile"),8,True)
	fLog.WriteLine Now & Vbtab & Session("User") & Vbtab & Session("IP") & VbTab & msg & sErr
	fLog.close
End If
End SUB
 
'########################
Function EscapeQuote(str)
'########################
If str<>"" Then 
	EscapeQuote=Replace(str,"'","&#39;")
Else
	EscapeQuote=str
End If
End Function
%>
[+][-]07/31/09 06:38 AM, ID: 24988642Accepted Solution

View this solution now by starting your 30-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

About this solution

Zones: Active Server Pages (ASP), Microsoft Windows Operating Systems, File Servers
Tags: Response.Write &quot;&lt;meta http-equiv=&quot;&quot;Content-Type&quot;&quot; content=&quot;&quot;text/html; charset=&quot; &amp; Session(&quot;Str&quot;)(174) &amp; &quot;&quot;&quot;&gt;&quot;
Sign Up Now!
Solution Provided By: bleckron
Participating Experts: 2
Solution Grade: A
 
[+][-]01/21/09 08:34 PM, ID: 23436521Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]02/13/09 01:29 AM, ID: 23631084Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]08/13/09 01:22 PM, ID: 25092481Administrative Comment

Experts Exchange has a courteous staff of administrators who help members get the most out of the website by means of administrative comments like this one.

Start your 30-day free trial to view this Administrative Comment or ask the Experts your question.

 
 
Loading Advertisement...
20091111-EE-VQP-92 - Hierarchy / EE_QW_3_20080625