'Optimize eden varlık=Toygar Dundaralp 'e-Mail=tdundaralp@msn.com
%> <% option explicit %> <body bgcolor=336699> <style type=text/css> a{color:white;font-family:tahoma;font-size:12;font-weight:bold} a:hover{color:#990000} </style> <font color=orange face=tahoma size=2><b> <% dim sol,sag,sayi,connobj,rsobj,sql,ara,sayiand,soland,sagand set connobj=server.createobject("adodb.connection") connobj.open("Driver={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("denek.mdb")) set rsobj=server.createobject("adodb.recordset")
ara=request.form("ara") if instr(ara,"'") then ara=replace(ara,"'","") end if if instr(ara," and ") then ara=replace(ara," and ","|") sayiand=instr(ara,"|") soland=left(ara,sayiand-1) sagand=mid(ara,sayiand+1) sql="select site,bilgi from denek where kelime1 like '"&soland&"' or kelime2 like '"&soland&"' or " &_ "kelime3 like '"&soland&"' or kelime4 like '"&soland&"' or kelime1 like '"&sagand&"' or " &_ "kelime2 like '"&sagand&"' or kelime3 like '"&sagand&"' or kelime4 like '"&sagand&"'" elseif instr(ara,"*") then sol=left(ara,1) sag=right(ara,1) sayi=len(ara)-1 if left(ara,1)="*" then ara=mid(ara,2) sql="select site,bilgi from denek where kelime1 like '%"&ara&"' or kelime2 like '%"&ara&"' or " &_ "kelime3 like '%"&ara&"' or kelime4 like '%"&ara&"'" elseif right(ara,1)="*" then ara=left(ara,sayi) sql="select site,bilgi from denek where kelime1 like '"&ara&"%' or kelime2 like '"&ara&"%'or " &_ "kelime3 like '"&ara&"%' or kelime4 like '"&ara&"%'" end if else sql="select site,bilgi from denek where kelime1 like '"&ara&"' or kelime2 like '"&ara&"' or " &_ "kelime3 like '"&ara &"' or kelime4 like '"& ara &"'" end if rsobj.open sql,connobj,2,3 do while not rsobj.eof response.write "<a href=http://"& rsobj(0)&">" & rsobj(0) &"</a>" &"<br>" & rsobj(1) &"<br><br>" rsobj.movenext loop
%>
<% rsobj.close set rsobj = nothing connobj.close set connobj = nothing %>
Sifreleme Sifrelerinizi korumak için yazilmis bir uygulama. orjinal sifreye sadik kalarak bir yöntemle bu sifrenin karistirilip baskalari tarafindan okunmasini engeller.
PHP- Kodu:
<% function Encrypt(Text,Password) Dim TextCharCode, PasswordCharCode, NewCharCode
For Char = 1 To LEN(Text) TextCharCode = ASC(MID(Text,Char,1)) PasswordCharCode = ASC(MID(Password,(Char MOD LEN(Password) + 1),1)) NewCharCode = TextCharCode + PasswordCharCode if NewCharCode > 255 Then NewCharCode = NewCharCode -255
Encrypt = Encrypt & CHR(NewCharCode) NEXT End function
function Decrypt(Code,Password) Dim CodeCharCode, PasswordCharCode, OriginalCharCode
For Char = 1 To LEN(Code) CodeCharCode = ASC(MID(Code,Char,1))
<html> <head> <title>Resim Yükle</title> <meta http-equiv="Content-Type" content="text/html; charset=windows-1254"> <LINK href="../images/links.css" rel="stylesheet"> <script language="_JavaScript"> function S_im() { var tm=new Image(); var o=document.all; if (o.statu.value=="ok") { tm.src=o.upi.src; window.location="Limage.asp?fn="+o.fn.value+"&w="+tm.width+"&h="+tm.height+"&qstr=<%=Request.ServerVariables("QUERY_STRING")%>"; } } </script> </head>
<body onfiltered='S_im()'> <% dim ImageType,Ft_Filename ImageType=false ' This code is needed to "initialize" the retrieved data Dim q q = Chr(34) ' All data Dim aAllDataB, aAllData, x, aHdr aAllDataB = Request.BinaryRead(Request.TotalBytes) ' It comes in as unicode, so convert it to ascii For x = 1 To LenB(aAllDataB) aAllData = aAllData & Chr(AscB(MidB(aAllDataB, x, 1))) Next ' The "header" is a unique string generated by the system to indicate ' the beginning and end of file data aHdr = Left(aAllData, Instr(aAllData,vbCrLf)+1)
'response.write(len(aHdr))
'response.end %>
<% ' Here's where your code goes. ' In this example, "file1" and "file2" are the field names ' specified within the form of the upload submission page. ' Response.Write "file1: Filename = " & GetFilename("file1") & "<br>" Response.Write GetFileData("file1") & "<br><br>"
' Writing out the file data like this only looks okay when ' the uploaded file is some kind of text - images and things ' like that probably just need to be saved or otherwise ' acted upon. ' Response.Write Replace(aAllData,vbCrLf,"<br>")
Dim aFilename ' aFilename equates to the original filename, except saved ' in the root path of the server. The root path must have ' Change rights for the default internet user. Ft_FileName=GetFileName("file1") aFilename = Server.MapPath("images/Users") & "/" & Ft_FileName
'response.write("///"&GetFileName("file1")&"///") Set FSO1 = server.CreateObject("Scripting.FileSystemObject") if FSO1.FileExists(aFilename) then Dim tfl tfl=Ft_Filename x=instr(tfl,".") if x>0 then if userId="" then userId=1 tfl=Mid(tfl,1,x-1)&"_"&Second(time)&"."&Right(tfl,3) aFilename = Server.MapPath("images/Users") & "/" & tfl 'response.write("000-"&tfl&"-000") Ft_FileName=tfl end if end if Set FSO1=nothing
<% ' These are functions used to retrieve the data Function GetFileName(aField) Dim x2, i x = Instr(aAllData, aHdr & "Content-Disposition: form-data; name=" &q&aField & q) x = Instr(x, aAllData, "filename=" & q) x2 = Instr(x, aAllData, vbCrLf) For i = x2 To x Step -1 If Mid(aAllData,i,1) = "\" Then x = i - 9 Exit For End If Next GetFileName = Mid(aAllData, x+10, x2-(x+11)) End Function Function GetFileData(aField) Dim x2 'aHdr="-----------------------------7d21db231008c2 " x = Instr(aAllData, aHdr & "Content-Disposition: form-data; name=" & q &aField & q) x = Instr(x, aAllData, vbCrLf) x = Instr(x+1, aAllData, vbCrLf) x = Instr(x+1, aAllData, vbCrLf) + 2 x2 = Instr(x, aAllData, Left(aHdr,Len(aHdr)-2)) GetFileData = Mid(aAllData, x+2, x2-x-4) End Function Function SaveFile(aField1, aFilename) bh=lcase(aFileName) if instr(bh,".gif")>0 then ImageType=true if instr(bh,".jpg")>0 then ImageType=true if instr(bh,".png")>0 then ImageType=true if instr(bh,".bmp")>0 then ImageType=true
Dim FSO, TS Set FSO = server.CreateObject("Scripting.FileSystemObject") if ImageType then Set TS = FSO.CreateTextFile(aFilename, True, False) ' response.write(afield) 'response.end on error resume next if ImageType then TS.Write GetFileData(aField1) TS.Close if ImageType then Set TS = Nothing Set FSO = Nothing
End Function %><% If not ImageType then %> <input type="Hidden" name="statu" value="badfile"> <div align="center"> Hatalı Dosya formatı.<br> <a href="_javascript:window.history.go(-1)">Geri Dön</a> </div> <% Else %> <input type="Hidden" name="statu" value="ok"> <input type="Hidden" name="fn" value="<%=trim(Ft_FileName)%>"> <strong>Lütfen Bekleyiniz...</strong><br> <IMG name="upi" SRC="images/users/<%=trim(Ft_FileName)%>"> <% End If %>
Else satir=Mid(alinacakbolum,baslangic,son-baslangic) If InStr(satir,"/news/./" )=0 or Len(satir)<20 Then Else ekle=ekle & satir & "<br>" End If End If
<% const Request_GET = 2 Dim haberURL, haberim, basliklar haberURL = "http://www.tr.net" Set alma = CreateObject("SOFTWING.ASPtear" ) On Error Resume Next haberim = alma.Retrieve(haberURL, Request_GET, "" , "" , "" ) If Err.Number <> 0 Then Response.Write "HATA!!!!!!! Lütfen Sayfayi Yeniden Yükleyiniz... " Response.End End If dim baslangic , bitis baslangic = "<table border=0 cellpadding=0 cellcpacing=0>" bitis = "</table>" dim x , abc x = 0 abc = 0 dim lale lale = "" Do Until abc = 2 x = x + 1 If Mid(haberim,x,Len(bitis)) = bitis and abc = 1 Then abc = abc + 1 End If If Mid(haberim,x,Len(baslangic)) = baslangic Then abc = abc + 1 Else If abc = 1 Then lale = lale + Mid(haberim,x,1) End If End If Loop Function seklesok(hammadde) Dim gecicigeyik gecicigeyik = hammadde gecicigeyik = Replace(gecicigeyik, "" , "" , 1, -1, 1) gecicigeyik = Replace(gecicigeyik, "" , "" & vbCrLf, 1, -1, 1) seklesok = gecicigeyik End Function Response.Write "<" Response.Write seklesok(lale) Response.Write "</table>" %>
Forumdaki online üyeler
PHP- Kodu:
<% dk_g = 4 db = Server.MapPath("forums.mdb" ) Set objCon = Server.CreateObject("ADODB.Connection" ) objCon.Open ("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & db)
Session.LCID = 1033 tarih = DateAdd("n" , -1 * dk_g, Now()) Set objList = Server.CreateObject("ADODB.RecordSet" ) objList.Open "SELECT * FROM member WHERE son_giris >= #" &tarih&"# ORDER BY son_giris DESC" , objCon, 3, 3 Session.LCID = 2048
If objList.Eof Then ' kayit yoksa 0 degerini veriyos uNumber = "0" Else ' kayit varsa kaç tane oldugunu aliyoruz uNumber = objList.RecordCount End If
'Döngüye giriyoruz For I = 0 to Toplam If Ip_array(I) = ipno Then
'Eğer giren kullanicinin ip`si ban listesinde mevcut ise banlanmissiniz diye bir sayfa gosteriyoruz Response.Redirect "ban.asp"
End If Next
Allah'ın yakınından dostlar edinenlerin durumu, kendine ev edinen örümceğin durumu gibidir. halbuki evlerin de en çürüğü şüphesiz örümcek yuvasıdır. Ah keşke bilselerdi!
18-08-2008, 22:17
Benzer Konular
Normal
