konum bulma

Kodları bir metin editörü ile uzantısı .ASP olacak şekilde kaydedin. Kodun çalışması için sunucunuzda XMLHTTP desteği olması gerekmektedir.

<%
// Coded by Semih TURNA
// ****.A PsyChaos - psychaos[@]gmail[.]com
// ASP & Webservices (Konum Bulma Aparatı)

Set RS = Request.ServerVariables

Private Function IP
If RS("HTTP_VIA") <> "" Then
IP = RS("HTTP_X_FORWARDED_FOR")
Else
IP = RS("REMOTE_ADDR")
End If
End Function

strIP = "203.167.109.146" 'IP

Function XMLWebservices(byVal IP)
Dim SOAP
SOAP = "<?xml version=""1.0"" encoding=""utf-8""?>"&_
"<soap:Envelope xmlnssi=""http://www.w3.org/2001/XMLSchema-instance"" xmlnssd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"&_
"<soap:Body>"&_
"<GetGeoIP xmlns=""http://www.webservicex.net"">"&_
"<IPAddress>"& IP &"</IPAddress>"&_
"</GetGeoIP>"&_
"</soap:Body>"&_
"</soap:Envelope>"

Set objWebServices = Server.CreateObject("Msxml2.ServerXMLHTTP")
objWebServices.Open "POST", "http://www.webservicex.net/geoipservice.asmx", false
objWebServices.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
objWebServices.setRequestHeader "soapAction", "http://www.webservicex.net/GetGeoIP"
objWebServices.Send(SOAP)

Dim Text
If objWebServices.readyState = 4 Then
If objWebServices.Status = 200 Then
Text = objWebServices.responseText
End If
End If

Set objWebServices = Nothing

XMLWebservices = Text
End Function

Dim Sonuc
Sonuc = Trim(XMLWebservices(strIP))

If (Len(Sonuc) <> 0) Then

Set objXML = Server.CreateObject("Microsoft.XMLDOM")
objXML.async = False
objXML.loadxml(Sonuc)
Set objNODE = objXML.selectSingleNode("soap:Envelope/soap:Body/GetGeoIPResponse/GetGeoIPResult")
Response.Write "<b>Ülke Kodu :</b> "& objNode.childNodes.item(1).Text &"<br />"& vbCrlf
Response.Write "<b>Ülke :</b> "& objNode.childNodes.item(2).Text &"<br />"& vbCrlf

Set objNODE = Nothing
Set objXML = Nothing

Else
Response.Write "Girdiğiniz Bilgi Doğrulanamadı!"
End If
%>

a - z listeleme

Kodu bu haliyle normal çıktı alacak şekilde kullanabilirsiniz. Eğer isterseniz kendi veritabanınıza göre ayarlayıp çıkan sonuçların sizin verilerinizle ilişkili olmasını sağlayabilirsiniz.

Şu an size vereceği çıktı şu şekildedir:

A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
a b c d e f g h i j k l m n o p q r s t u v w x y z


<%
'Bu sistemi PHP olarak turkphp.com sitesinden Serkan arkadaşımız yazmıştır.
'Bende ASP olarak yazayım dedim. Bu konuda forumlarda çok soruldu.
'Php To ASP Psychaos
'****.A Semih Turna

For b = 65 To 90 Step 1
Response.Write "<a href='?Harf=" & Chr(b) &"'>" & Chr(b) &"</a> "
Next
Response.Write "<br>"

For s = 97 To 122 Step 1
Response.Write "<a href='?Harf=" & Chr(s) &"'>" & Chr(s) &"</a> "
Next
%>

kod renklendırıcı

Bir medit editörü ile fonksiyon kodlarını istediğiniz bir ASP dosyanızın içerisine ekleyin.Ya da sıfırdan bir dosya oluşturarak içerisine koyduktan sonra aşağıda vermiş olduğumuz örnek ile kodu çalıştırmaya başlayabilirsiniz:

<%=ColorCode(Metin)%>


<%
Public Function ColorCode(Code)
'|
'| Color Code
'| Coded By PsyChaos
'| ****.A Semih Turna
'|

Code = Replace(Code,"<" +"%" ,"<" &"%" )
Code = Replace(Code,"%" +">" ,"%" &">" )

Set CodeTag = Server.CreateObject("Scripting.Dictionary" )
With CodeTag
.CompareMode = 3
.Add "<" &"%" , "%" &">" 'ASP
.Add "<" +"?" , "?" +">" 'PHP
End With

strColor = Array("#FFFF99" ,"#E4EEFD" ) 'Color Code

strBeginTag = CodeTag.Keys
strEndTag = CodeTag.Items

intCodeCount = CodeTag.Count - 1

For CT = 0 To intCodeCount
Code = Replace(Code,strBeginTag(CT), "<span style='background-color: " & strColor(CT) &"'>" & strBeginTag(CT),1,-1,1)
Code = Replace(Code,strEndTag(CT), strEndTag(CT) &"</span>" ,1,-1,1)
Next

Set CodeTag = Nothing

ColorCode = Code 'Replace(Code,vbCrlf,"<br>" )

End Function
%>

doviz bilgilerini alma

Kodları bir metin editörü ile .ASP uzantılı olacak şekilde kaydettikten sonra çalıştırabilirsiniz.


<%
dim kaynak,bilgi_al,bilgi,yersaat,saat,yertarih,gun,ay d,yil,ay,tarihs,yerdolar,dlral,dlrst,yereuro,eroal ,erost
kaynak = "http://www.tcmb.gov.tr/kurlar/today.html"
set bilgi_al = server.createobject("microsoft.XMLHTTP")
bilgi_al.open "get", kaynak, false
bilgi_al.send
bilgi = bilgi_al.responsetext
set bilgi_al = nothing
yersaat = instr(bilgi,"ced at ")
saat = trim(mid(bilgi,yersaat+7,5))
yertarih = trim(mid(bilgi,yersaat+16,10))
gun = trim(mid(yertarih,4,2))
ayd = trim(mid(yertarih,1,2))
yil = trim(mid(yertarih,7,4))
select case (ayd)
case "01":
ay = "Ocak"
case "02":
ay = "Şubat"
case "03":
ay = "Mart"
case "04":
ay = "Nisan"
case "05":
ay = "Mayıs"
case "06":
ay = "Haziran"
case "07":
ay = "Temmuz"
case "08":
ay = "Ağustos"
case "09":
ay = "Eylül"
case "10":
ay = "Ekim"
case "10":
ay = "Kasım"
case "12":
ay = "Aralık"
end select
tarihs = gun & " " & ay & " " & yil & " günü saat " & saat
yerdolar = instr(bilgi,"USD")
dlral = trim(mid(bilgi,yerdolar+37,11))
dlrst = trim(mid(bilgi,yerdolar+50,11))
yereuro = instr(bilgi,"EUR")
eroal = trim(mid(bilgi,yereuro+37,11))
erost = trim(mid(bilgi,yereuro+50,11))
%>

SAol arkadaşım kodlar cok kullanışlı ellerine sağlık.

Punk İs Not Dead