Dim GELEN_KELIME, AYR_KELIME
GELEN_KELIME ="MerhaBA ÇOKKKKKKMMMMMMLLMMMMMMMLÝLEMUKEÝAMLYUÝEKAYUMLÝEAK"
AYR_KELIME = 15
Function METINBOL(GELEN)
MARRAY = SPLIT(GELEN, " ") : TOPKELIME = UBound(MARRAY,1)
For I = 0 To TOPKELIME
KUZUN = Len(MARRAY(I))
If KUZUN > AYR_KELIME Then
BAS = 1 : BIT = AYR_KELIME
For J = 1 To (KUZUN/AYR_KELIME)+1
RESPONSE.Write MID(MARRAY(I),BAS,BIT) & " "
BAS = BAS + AYR_KELIME : If BIT + AYR_KELIME < AYR_KELIME Then BIT = BIT + AYR_KELIME Else BIT = AYR_KELIME
Next
Else
RESPONSE.Write MARRAY(I) & " "
End If
Next
End Function
Kullanımı:
Code:
<% METINBOL(GELEN_KELIME) %>
[FONT=Courier New]<%
[COLOR=blue]Function[/COLOR] Proper(X)
[COLOR=green]'Return a String With the first letter of the word capitalised[/COLOR]
[COLOR=blue]If[/COLOR] IsNull(X) [COLOR=blue]Then[/COLOR]
[COLOR=blue]Exit[/COLOR] [COLOR=blue]Function[/COLOR]
[COLOR=blue]Else[/COLOR]
lowercaseSTR = [COLOR=blue]CStr[/COLOR](LCase(X))
OldC = [COLOR=red]" "[/COLOR]
MyArray = Split(lowercaseSTR,[COLOR=red]" "[/COLOR])
[COLOR=blue]For[/COLOR] IntI = [COLOR=blue]LBound[/COLOR](MyArray) [COLOR=blue]To[/COLOR] [COLOR=blue]UBound[/COLOR](MyArray)
[COLOR=blue]For[/COLOR] I = 1 [COLOR=blue]To[/COLOR] [COLOR=blue]Len[/COLOR](MyArray(IntI))
[COLOR=blue]If[/COLOR] [COLOR=blue]Len[/COLOR](MyArray(IntI)) = 1 [COLOR=blue]Then[/COLOR]
newString = newString & UCase(MyArray(IntI)) & [COLOR=red]" "[/COLOR]
[COLOR=blue]ElseIf[/COLOR] I=1 [COLOR=blue]Then[/COLOR]
newString = newString & UCase(Mid(MyArray(IntI), I, 1))
[COLOR=blue]ElseIf[/COLOR] I = [COLOR=blue]Len[/COLOR](MyArray(IntI)) [COLOR=blue]Then[/COLOR]
newString = newString & Mid(MyArray(IntI), I, 1) & [COLOR=red]" "[/COLOR]
[COLOR=blue]Else[/COLOR]
newString = newString & Mid(MyArray(IntI), I, 1)
[COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=blue]Next[/COLOR]
[COLOR=blue]Next[/COLOR] [COLOR=green]'IntI[/COLOR]
Proper = Trim(newString)
[COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Function[/COLOR]
%>[/FONT]
.vbScript{color:black;background-color:white;font-size:10pt;font-family:Courier New;}.vbScript B{color:blue}[FONT=Courier New]Netscape sometimes has problems handling strings [COLOR=blue]With[/COLOR] a space [COLOR=blue]In[/COLOR] it when using the Response.Redirect method. [COLOR=blue]To[/COLOR] overcome this problem use the Server.URLEncode([COLOR=red]"variable name"[/COLOR]) [COLOR=blue]With[/COLOR] the [COLOR=blue]String[/COLOR].
strField = Server.URLEncode(strField)
Response.Redirect([COLOR=red]"yourpage.asp?Field=strField"[/COLOR])
<%
strAdres = "http://www.tcmb.gov.tr/kurlar/today.html"
Public Function VeriAl(strGelen)
Set objVeriAl = Server.CreateObject("Microsoft.XMLHTTP" )
With objVeriAl
.Open "GET" , strGelen, FALSE
.sEnd
VeriAl = .Responsetext
End With
SET objVeriAl = Nothing
End Function
strVeri = VeriAL(strAdres)
iDolar=InStr(strVeri,"USD" )
strDolarAlis=Mid(strVeri,iDolar+50,10)
strDolarSatis=Mid(strVeri,iDolar+51,10)
iEuro=InStr(strVeri,"EUR" )
strEuroAlis=Mid(strVeri,iEuro+38,11)
strEuroSatis=Mid(strVeri,iEuro+50,11)
%>
<html>
<title>TCMB Döviz Kurları</title>
<body>
<table width="20%" border="0" cellspacing="0" style="border: 1px solid #D7D7D7">
<tr>
<td nowrap width="99%" bgcolor="#E1E1E1" colspan="2"><strong>
<font face="Verdana"><b><font color="#FF0000" style="font-size: 7pt"> DOLAR</font></b></font></strong></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">ALIş</font></td>
<td width="92%">
<div align="left"><font face="verdana" size="1">
<p align="right"> <%=strdolaralis%> YTL
</font></div></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">SATIş</font></td>
<td width="92%">
<div align="left"><font face="verdana" size="1">
<p align="right"> <%=strdolarsatis%> YTL
</font></div></td>
</tr>
<tr>
<td colspan="2" style="border-top: 1px solid #C0C0C0"> </td>
</tr>
<tr>
<td colspan="2" bgcolor="#E1E1E1"><strong><font face="Verdana"><b>
<font color="#0099CC" style="font-size: 7pt"> </font><font color="#FF0000" style="font-size: 7pt">EURO</font></b></font></strong></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">ALIş</font></td>
<td width="92%">
<p align="right"><font face="verdana" size="1"> <%=streuroalis%> YTL </font></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">SATIş</font></td>
<td width="92%">
<p align="right"><font size="1" face="verdana"><%=streurosatis%> YTL</font><font size="1">
</font> </td>
</tr>
</table>
</body>
</html>
<%
const Request_GET = 2
Dim haberURL, haberim, basliklar
haberURL = "http://www.muneccim.com/gunluk_fal/bugun.asp?burc=7"
Set alma = CreateObject("SOFTWING.ASPtear" )
Session.CodePage = 1254
On Error Resume Next
haberim = alma.Retrieve(haberURL, Request_GET, "" , "" , "" )
Session.CodePage = 1254
If Err.Number <> 0 Then
Response.Write "HATA!!!!!!! Lütfen Sayfayi Yeniden Yükleyiniz... "
Response.End
End If
dim baslangic , bitis
baslangic = "><strong><big>"
bitis = "<br> </big></strong></font>"
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 "<p align='justify'><font size=1 face=verdana color=000000>"
Response.Write seklesok(lale)
Response.Write "</b></font></p>"
%>
<%
Response.Write "Ip Adresi = " & Request.ServerVariables("REMOTE_ADDR") & "<br>"
%>
<%
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") <> "" Then
Response.Write "Istek Yapan Ip : " & Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
%>
<%
deneme1=Request.QueryString("deneme1")
%>
<%=Request.QueryString("deneme1")%>
deneme1=Request.QueryString("deneme1")
Set AYDIN = server. CreateObject("ADODB.Recordset")
kayit = "Select * from arama where '%"& deneme1 &"%'"
AYDIN.Open kayit,Sur2,1,3
<%
deneme2=request.form("deneme2")
%>
<form method=post>
<input name="deneme2" type="text" size="40" />
<%=Request.form("deneme2")%>
deneme2=request.form("deneme2")
Set AYDIN = server. CreateObject("ADODB.Recordset")
kayit = "Select * from arama where '%"& deneme2 &"%'"
AYDIN.Open kayit,Sur2,1,3
<%
Set Sur = Server.CreateObject("ADODB.Connection")
Sur.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("klasor/db.mdb")
%>
<%deisken=cint(request.querystring("id"))
set id = Request.QueryString("id")
Set conn=server.createobject("adodb.connection")
dsnpath="DRIVER={MICROSOFT ACCESS DRIVER (*.MDB)}; "
dsnpath=dsnpath & "DBQ=" & Server.MapPath("klasor/db.mdb")
conn.open dsnpath
SQL = "select * from youtube where id="
SQL = SQL & id
Set AYDIN=conn.execute(sql)
Session.CodePage = 1254
%>
<%
set rs=server.createobject("adodb.recordset")
sql="select youtube.* from youtube where id="
sql=sql & deisken
rs.open sql,Sur,1,3
%>
<% Response.Redirect rs("url") %>
<%
vericekilecekadres = "http://www.domain.com/sayfa.asp"
Dim objXmlHttp
Set objXmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXmlHttp.Open "GET" , vericekilecekadres , false
objXmlHttp.sEnd
alinanveri = objXmlHttp.ResponseText
Set objXmlHttp = Nothing
response.write alinanveri
%>
left
right
mid
instr
trim
lcase
ucase
len
split
Bu nesneleri örnek ile açıklayalım.
<%
isim = "forum.iyinet.com"
yazdir = left(isim,6)
response.write yazdir
%>
<%
isim = "forum.iyinet.com"
yazdir = right(isim,6)
response.write yazdir
%>
<%
isim = "forum.iyinet.com"
yazdir = mid(isim,2,5)
response.write yazdir
%>
<%
isim = "forum.iyinet.com"
yazdir = Instr(isim,"com")
response.write yazdir
%>
<%
isim = " forum.iyinet.com "
yazdir = Trim(isim)
response.write yazdir
%>
<%
isim = "forum.iyinet.com"
yazdir = Ucase(isim)
response.write yazdir
%>
<%
isim = "FORUM.iyinet.com"
yazdir = Lcase(isim)
response.write yazdir
%>
<%
isim = "forum.iyinet.com"
yazdir = Len(isim)
response.write yazdir
%>
<%
obje = split(obje,"|")
obje(0)
obje(1)
%>
<%
obje = request.querystring
obje = split(obje,"-")
response.write obje(0) & "<br>"
response.write obje(1) & "<br>"
%>
<%
strAdres = "http://www.tcmb.gov.tr/kurlar/today.html"
Public Function VeriAl(strGelen)
Set objVeriAl = Server.CreateObject("Microsoft.XMLHTTP" )
With objVeriAl
.Open "GET" , strGelen, FALSE
.sEnd
VeriAl = .Responsetext
End With
SET objVeriAl = Nothing
End Function
strVeri = VeriAL(strAdres)
iDolar=InStr(strVeri,"USD" )
strDolarAlis=Mid(strVeri,iDolar+50,10)
strDolarSatis=Mid(strVeri,iDolar+51,10)
iEuro=InStr(strVeri,"EUR" )
strEuroAlis=Mid(strVeri,iEuro+38,11)
strEuroSatis=Mid(strVeri,iEuro+50,11)
%>
<html>
<title>TCMB Döviz Kurları - Kaynak : forum.iyinet.com</title>
<body>
<table width="20%" border="0" cellspacing="0" style="border: 1px solid #D7D7D7">
<tr>
<td nowrap width="99%" bgcolor="#E1E1E1" colspan="2"><strong>
<font face="Verdana"><b><font color="#FF0000" style="font-size: 7pt"> DOLAR</font></b></font></strong></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">ALIş</font></td>
<td width="92%">
<div align="left"><font face="verdana" size="1">
<p align="right"> <%=strdolaralis%> YTL
</font></div></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">SATIş</font></td>
<td width="92%">
<div align="left"><font face="verdana" size="1">
<p align="right"> <%=strdolarsatis%> YTL
</font></div></td>
</tr>
<tr>
<td colspan="2" style="border-top: 1px solid #C0C0C0"> </td>
</tr>
<tr>
<td colspan="2" bgcolor="#E1E1E1"><strong><font face="Verdana"><b>
<font color="#0099CC" style="font-size: 7pt"> </font><font color="#FF0000" style="font-size: 7pt">EURO</font></b></font></strong></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">ALIş</font></td>
<td width="92%">
<p align="right"><font face="verdana" size="1"> <%=streuroalis%> YTL </font></td>
</tr>
<tr>
<td nowrap width="7%"><font face="Verdana" style="font-size: 7pt; ">SATIş</font></td>
<td width="92%">
<p align="right"><font size="1" face="verdana"><%=streurosatis%> YTL</font><font size="1">
</font> </td>
</tr>
</table>
</body>
</html>
<%
strURL = "http://www.iyinet.com/"
Dim objXmlHttp
Set objXmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXmlHttp.Open "GET" , strURL , false
objXmlHttp.sEnd
strHTML = objXmlHttp.ResponseText
%>
<%
Private Function BinaryToString(Binary)
Dim cl1, cl2, cl3, pl1, pl2, pl3
Dim L
cl1 = 1
cl2 = 1
cl3 = 1
L = LenB(Binary)
Do While cl1<=L
pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
cl1 = cl1 + 1
cl3 = cl3 + 1
If cl3>300 Then
pl2 = pl2 & pl3
pl3 = ""
cl3 = 1
cl2 = cl2 + 1
If cl2>200 Then
pl1 = pl1 & pl2
pl2 = ""
cl2 = 1
End If
End If
Loop
BinaryToString = pl1 & pl2 & pl3
End Function
%>
<%
strURL = "http://www.iyinet.com/"
Dim objXmlHttp
Set objXmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXmlHttp.Open "GET" , strURL , false
objXmlHttp.sEnd
strHTML = objXmlHttp.ResponseBody
Private Function BinaryToString(Binary)
Dim cl1, cl2, cl3, pl1, pl2, pl3
Dim L
cl1 = 1
cl2 = 1
cl3 = 1
L = LenB(Binary)
Do While cl1<=L
pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
cl1 = cl1 + 1
cl3 = cl3 + 1
If cl3>300 Then
pl2 = pl2 & pl3
pl3 = ""
cl3 = 1
cl2 = cl2 + 1
If cl2>200 Then
pl1 = pl1 & pl2
pl2 = ""
cl2 = 1
End If
End If
Loop
BinaryToString = pl1 & pl2 & pl3
End Function
Response.Write BinaryToString(strHTML)
%>
bencede asptear.. xmlhttp ye geçmeden önce asptear kullandığım sayfayı aynı anda açan 4 kişi 1-2 dakka bekliyordu.. şimdi sorun yok gayette hızlı çekiyor.. ayrıca birçok kişi birçok yerde xmlhttp yi kullanıyor.. sabitlenirken gerekirse XMLHTTP ile veri çekmek olarak başlığı değişebilir..
<% function degistir(veri)
veri = Replace(veri ,"01","Oca",1,-1,0)
veri = Replace(veri ,"02","Şub",1,-1,0)
veri = Replace(veri ,"03","Mart",1,-1,0)
veri = Replace(veri ,"04","Nis",1,-1,0)
veri = Replace(veri ,"05","May",1,-1,0)
veri = Replace(veri ,"06","Haz",1,-1,0)
veri = Replace(veri ,"07","Tem",1,-1,0)
veri = Replace(veri ,"08","Ağus",1,-1,0)
veri = Replace(veri ,"09","Eyl",1,-1,0)
veri = Replace(veri ,"10","Ekim",1,-1,0)
veri = Replace(veri ,"11","Kas",1,-1,0)
veri = Replace(veri ,"12","Ara",1,-1,0)
degistir=veri
end function
%>
split yardımıyla . (nokta) dan bölüyoruz.<%tarihim=veritabanı-tarih-bilgileri-yolu
bol=split(tarihim,".")
gun=bol(0)
ay=bol(1)
yil=bol(2)
%>
Türkiye’nin ilk webmaster forum sitesi iyinet.com'da forum üyeleri tarafından yapılan tüm paylaşımlardan; Türk Ceza Kanunu’nun 20. Maddesinin, 5651 Sayılı Kanununun 4. maddesinin 2. fıkrasına göre, paylaşım yapan üyeler sorumludur.