صفحه 1 از 2 12 آخرآخر
نمایش نتایج 1 تا 40 از 62

نام تاپیک: بانک کد ASP کلاسیک

  1. #1

    بانک کد ASP کلاسیک

    سلام
    برای جلوگیری از ساخت تاپیک‌های جدید که بعضاً تکراری هستند تصمیم گرفتم این تاپیک رو بسازم و نمونه کدهای کاربردی زبان ASP رو در آن قرار دهم تا با اینکار هم تاپیک جامعی برای این موضوع داشته باشیم و هم از ارسال تاپیکهای جدید کمی جلوگیری کرده باشیم. لذا در زیر نمونه کدهای انتخابی رو قرار دادم و امیدوارم به مرور کاملتر شود (البته به کمک شما دوستان).
    چند نکته و تقاضا‌:
    1. دوستانی که کد جالب و بدرد بخوری دارند ( هرچند ساده ) به همین شکلی که در زیر آمده است ( عنوان٬ مورد استفاده ٬ فایل‌های مورد نیاز ٬ توضیحات٬ نمونه کد + ترکیب رنگی استفاده شده و خطوط بین هر موضوع ) کد مربوطه را در همین تاپیک ارسال کنند .
    2. درصورتی که کد معرفی شده از سایتی برداشت شده لطفاً لینک سایت مربوطه را در ادامه پست‌تان قرار دهید .
    3. دوستان لطف کنند از ارسال پیام‌های خارج از بحث خودداری کنند که با عرض شرمندگی در اسرع وقت پست مربوطه حذف خواهد شد .
    4. نظرات خود را برای هرچه بهتر شدن این تاپیک برای من PM کنید .

    موفق و پیروز باشید


    تاریخ هجری شمسی

    فایل‌های مورد نیاز : Shamsi.asp
    توضیحات : تا اونجایی که یادمه مشکل سال کبیسش حل شده
    نمونه کد :
    <%
    FMonArray= array (0,31,31,31,31,31,31,30,30,30,30,30,30)
    EMonArray= Array(0,31, 28,31,30,31,30,31,31,30,31,30,31)

    W = Array ("یک‌شنبه", "دوشنبه", "سه‌شنبه", "چهار‌شنبه", "پنج‌شنبه", "جمعه", "شنبه")
    Mon = Array ("فروردین", "اردیبهشت", "خرداد", "تیر", "مرداد", "شهریور", "مهر", "آبان", "آذر", "دی", "بهمن", "اسفند")
    EYear= Year(Date)
    EMon= Month(Date)
    EDay = Day(Date)

    ELeap=0

    if ((EYear mod 4))= 0 Then
    ELeap =1
    End if

    Cnt=EMon-1
    Temp=0
    While Cnt<>0
    if ((Cnt=2)and(ELeap=1)) Then
    Temp= Temp+29
    else
    Temp= Temp + EMonArray(Cnt)
    end if
    Cnt=Cnt-1
    Wend

    EDayOfYear= Temp+EDay
    ' Convert to Farsi

    Temp= EDayOfYear-79
    if Temp>0 Then
    FYear= EYear-621
    else
    FYear= EYear-622

    if ((FYear mod 4)=3) then
    Temp= Temp+366
    else
    Temp= Temp+365
    End if
    End if

    if (FYear mod 4)=3 Then
    FLeap=1
    else
    Fleap=0
    End if

    Cnt= 1

    While( (Temp<>0) and (Temp>FMonArray(Cnt)) )
    if Cnt=12 Then
    if (FLeap=1) Then
    Temp=Temp-30
    else Temp= Temp-29
    end if
    else Temp= Temp-FMonArray(Cnt)
    end if

    Cnt= Cnt+1
    Wend

    if Temp<>0 Then
    FMon = Cnt
    FDay= Temp
    else
    FMon= 12
    FDay=30
    End if

    DateShamsi = W(WeekDay(Date) - 1) & " " & FDay& " " & Mon(FMon - 1) & " " &FYear
    %>
    <%
    response.write(DateShamsi)
    %>

    برداشت شده : فکر کنم یکی از پستهای آقای مهدوی



    نمایش تصادفی یک خط از فایل

    مورد استفاده : نمایش Tip های مختلف در صفحه
    فایل‌های مورد نیاز : text.txt, rndline.asp
    توضیحات :
    1. در این مثال فایل text.txt می‌بایست شامل 20 خط باشد .
    2. پوشه‌ی ذخیره‌ی این فایل باید اجازه ( permission ) لازم را برای اعمال تغییرات داشته باشد .
    کد نمونه :
    <%
    Randomize
    ' Number of 1-line entries in the text file. 21 here
    RandNo = Int(Rnd*20)

    ' Now open the file with the 20 entries
    userFile = "text.txt"
    userFile=Server.Mappath (userFile)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set thisfile = fs.OpenTextFile(userFile, 1, False)


    ' If you wish to skip lines, enter that number here
    For i = 1 to RandNo -1
    thisfile.SkipLine()
    Next

    ' Now assign the variable RandomLineItem to the line selected
    RandomLineItem = thisfile.ReadLine
    Set fs = Nothing

    ' Display the Random Line
    Response.write RandomLineItem
    %>
    محل برداشت : http://www.wondersky.com


    روز شمار

    فایل‌های مورد نیاز : countdown.asp
    کد نمونه :
    <%
    dim strDateTime
    strDateTime = CDate("2/9/2000")
    strFutureDay = #12/31#
    Response.write "There are" & INT(strFutureDay - strDateTime) & " more days till December 31st."
    %>
    محل برداشت : http://www.wondersky.com


    بدست آوردن IP Address کاربر

    مورد استفاده : ثبت آی پی و استفاده از آن برای جلوگیری از ثبت بیش از یک رأی در نظرخواهی
    فایل‌های مورد نیاز : ip.asp
    نمونه کد :
    My IP address is <%=Request.ServerVariables("REMOTE_ADDR")%>
    محل برداشت : http://www.wondersky.com


    بدست آوردن نام فایلها

    مورد استفاده : به هنگامی که نیاز داشته باشید نام فایل‌های موجود در یک پوشه را بدانید .
    فایل‌های مورد نیاز : filename.asp
    توضیحات :
    برای استفاده از نمونه کد زیر می‌بایست پوشه‌ای با نام MyFolder در پوشه‌ی جاری ایجاد نمایید .
    نمونه کد:
    <%
    Set MyDirectory=Server.CreateObject("Scripting.FileSys temObject")
    Set MyFiles=MyDirectory.GetFolder(Server.MapPath("MyFo lder"))
    For each filefound in MyFiles.files
    Response.write filefound.Name
    response.write "<br>"
    Next
    %>
    محل برداشت : http://www.wondersky.com


    ساخت پوشه

    فایل‌های مورد نیاز : CreateDir.asp
    توضیحات :
    پوشه‌ی ذخیره‌ی این فایل باید اجازه ( permission ) لازم را برای اعمال تغییرات داشته باشد .
    نمونه کد :
    <%
    set fs=createobject("scripting.filesystemobject")
    MyFolder=server.mappath("/personal/data/")

    If NOT fs.folderexists(MyFolder) then
    fs.createfolder(MyFolder)
    End If
    ' Check if the creation was a success or not
    If fs.folderexists(MyFolder) then
    Response.write "Success"
    Else
    Response.write "Failure."
    End If
    %>
    محل برداشت : http://www.wondersky.com


    حذف پوشه

    فایل‌های مورد نیاز : RemoveDir.asp
    توضیحات :
    پوشه‌ی ذخیره‌ی این فایل باید اجازه ( permission ) لازم را برای اعمال تغییرات داشته باشد .
    نمونه کد :
    <%
    set fs=createobject("scripting.filesystemobject")
    MyFolder=server.mappath("/download/incoming/")

    set delDir = fs.getfolder(myFolder)
    delDir.delete
    set delDir = Nothing

    'Check if the deletion was a success or Not
    If fs.folderexists(myFolder) then
    Response.write "Deleted"
    Else
    Response.write "Error"
    End If
    %>
    محل برداشت : http://www.wondersky.com


    استفاده از کامپوننت CDONT

    مورد استفاده : جهت ارسال ایمیل به دیگران
    فایل‌های مورد نیاز : CDONT1.asp , CDONT2.asp , CDONT3.asp , CDONT.dll
    توضیحات :
    1. در زیر سه نوع کد برای استفاده از این کامپوننت آمده است :
    کد اول : ارسال یک ایمیل ساده
    کد دوم : ارسال ایمیل به شکل HTML
    کد سوم : ارسال ایمیل به شکل HTML + ضمیمه
    2. برای استفاده از کدهای زیر می‌بایست کامپوننت یاد شده ( CDONT.dll ) در سیستم شما رجیستر شده باشد . درصورتی که این کامپوننت را در اختیار ندارید در گوگل جستجو کنید .
    نمونه کد :
    کد اول :
    <%
    Dim MyBody
    Dim MyCDONTSMail
    Set MyCDONTSMail = CreateObject("CDONTS.NewMail")
    MyCDONTSMail.From = "somebody@nowhere.com"
    MyCDONTSMail.To = "nobody@nowhere.com"
    MyCDONTSMail.Subject = "This is a Test"
    MyBody = "Thank you " & vbCrLf
    MyBody = MyBody & "Please do visit us again" & vbCrLf
    MyBody = MyBody & "Always at your service"
    MyCDONTSMail.Body = MyBody
    MyCDONTSMail.Send
    set MyCDONTSMail = nothing
    %>
    کد دوم :
    <%
    Dim MyCDONTSMail
    Dim HTML
    Set MyCDONTSMail = CreateObject("CDONTS.NewMail")
    HTML = "<!DOCTYPE HTML PUBLIC""-//IETF//DTD HTML//EN"">"
    HTML = HTML & "<html>"
    HTML = HTML & "<head>"
    HTML = HTML & "<title>Sending CDONTS Email Using HTML</title>"
    HTML = HTML & "</head>"
    HTML = HTML & "<body bgcolor=""FFFFFF"">"
    HTML = HTML & "<font size =""3"" face=""Arial"">"
    HTML = HTML & "Name Of Store<br>"
    HTML = HTML & "Incoming Customer Order<br>"
    HTML = HTML & "<p align = ""center"">Bla Bla Bla Bla Bla</p>"
    HTML = HTML & "<body>"
    HTML = HTML & "<html>"
    MyCDONTSMail.From= "myself@myplace.com"
    MyCDONTSMail.To="toyou@urplace.com"
    MyCDONTSMail.Subject="Saying Hello"
    MyCDONTSMail.BodyFormat=0
    MyCDONTSMail.MailFormat=0
    MyCDONTSMail.Body=HTML
    MyCDONTSMail.Send
    set MyCDONTSMail=nothing
    %>
    کد سوم :
    <%
    Dim MyBody
    Dim MyCDONTSMail

    Set MyCDONTSMail = CreateObject("CDONTS.NewMail")
    MyCDONTSMail.From= "somebody@nowhere.com"
    MyCDONTSMail.To= "nobody@nowhere.com"
    MyCDONTSMail.Cc="nobody2@nowhere.com"
    MyCDONTSMail.Subject="This is a Test"

    MyCDONTSMail.AttachFile Server.MapPath("/somedirectory/myfile.txt")
    ' or you could specify the path exactly if you knew it like below
    ' MyCDONTSMail.AttachFile "C:\inetpub\wwwroot\somedirectory\myfile.txt"
    MyBody = "Thank you" & vbCrLf
    MyBody = MyBody & "Please visit us again" & vbCrLf
    MyBody = MyBody & "Always at your service"
    MyCDONTSMail.Body= MyBody
    MyCDONTSMail.Send
    set MyCDONTSMail=nothing
    %>
    محل برداشت : http://www.wondersky.com


    هش با MD5

    مورد استفاده : هش ( Hash ) نمودن عبارات جهت بالا بردن امنیت . این کد کاربردهای مختلفی دارد .
    فایل‌های مورد نیاز : MD5.asp
    نمونه کد :
    <%
    ' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
    ' as set out in the memo RFC1321.
    '
    '
    ' ASP VBScript code for generating an MD5 'digest' or 'signature' of a string. The
    ' MD5 algorithm is one of the industry standard methods for generating digital
    ' signatures. It is generically known as a digest, digital signature, one-way
    ' encryption, hash or checksum algorithm. A common use for MD5 is for password
    ' encryption as it is one-way in nature, that does not mean that your passwords
    ' are not free from a dictionary attack.
    '
    ' This is 'free' software with the following restrictions:
    '
    ' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
    ' to use the source code in your own code, but you may not claim that you created
    ' the sample code. It is expressly forbidden to sell or profit from this source code
    ' other than by the knowledge gained or the enhanced value added by your own code.
    '
    ' Use of this software is also done so at your own risk. The code is supplied as
    ' is without warranty or guarantee of any kind.
    '
    ' Should you wish to commission some derivative work based on this code provided
    ' here, or any consultancy work, please do not hesitate to contact us.
    '
    ' Web Site: http://www.frez.co.uk
    ' E-mail: sales@frez.co.uk

    Private Const BITS_TO_A_BYTE = 8
    Private Const BYTES_TO_A_WORD = 4
    Private Const BITS_TO_A_WORD = 32

    Private m_lOnBits(30)
    Private m_l2Power(30)

    m_lOnBits(0) = CLng(1)
    m_lOnBits(1) = CLng(3)
    m_lOnBits(2) = CLng(7)
    m_lOnBits(3) = CLng(15)
    m_lOnBits(4) = CLng(31)
    m_lOnBits(5) = CLng(63)
    m_lOnBits(6) = CLng(127)
    m_lOnBits(7) = CLng(255)
    m_lOnBits(8) = CLng(511)
    m_lOnBits(9) = CLng(1023)
    m_lOnBits(10) = CLng(2047)
    m_lOnBits(11) = CLng(4095)
    m_lOnBits(12) = CLng(8191)
    m_lOnBits(13) = CLng(16383)
    m_lOnBits(14) = CLng(32767)
    m_lOnBits(15) = CLng(65535)
    m_lOnBits(16) = CLng(131071)
    m_lOnBits(17) = CLng(262143)
    m_lOnBits(18) = CLng(524287)
    m_lOnBits(19) = CLng(1048575)
    m_lOnBits(20) = CLng(2097151)
    m_lOnBits(21) = CLng(4194303)
    m_lOnBits(22) = CLng(8388607)
    m_lOnBits(23) = CLng(16777215)
    m_lOnBits(24) = CLng(33554431)
    m_lOnBits(25) = CLng(67108863)
    m_lOnBits(26) = CLng(134217727)
    m_lOnBits(27) = CLng(268435455)
    m_lOnBits(28) = CLng(536870911)
    m_lOnBits(29) = CLng(1073741823)
    m_lOnBits(30) = CLng(2147483647)

    m_l2Power(0) = CLng(1)
    m_l2Power(1) = CLng(2)
    m_l2Power(2) = CLng(4)
    m_l2Power(3) = CLng(8)
    m_l2Power(4) = CLng(16)
    m_l2Power(5) = CLng(32)
    m_l2Power(6) = CLng(64)
    m_l2Power(7) = CLng(128)
    m_l2Power(8) = CLng(256)
    m_l2Power(9) = CLng(512)
    m_l2Power(10) = CLng(1024)
    m_l2Power(11) = CLng(2048)
    m_l2Power(12) = CLng(4096)
    m_l2Power(13) = CLng(8192)
    m_l2Power(14) = CLng(16384)
    m_l2Power(15) = CLng(32768)
    m_l2Power(16) = CLng(65536)
    m_l2Power(17) = CLng(131072)
    m_l2Power(18) = CLng(262144)
    m_l2Power(19) = CLng(524288)
    m_l2Power(20) = CLng(1048576)
    m_l2Power(21) = CLng(2097152)
    m_l2Power(22) = CLng(4194304)
    m_l2Power(23) = CLng(8388608)
    m_l2Power(24) = CLng(16777216)
    m_l2Power(25) = CLng(33554432)
    m_l2Power(26) = CLng(67108864)
    m_l2Power(27) = CLng(134217728)
    m_l2Power(28) = CLng(268435456)
    m_l2Power(29) = CLng(536870912)
    m_l2Power(30) = CLng(1073741824)

    Private Function LShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
    LShift = lValue
    Exit Function
    ElseIf iShiftBits = 31 Then
    If lValue And 1 Then
    LShift = &H80000000
    Else
    LShift = 0
    End If
    Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    Err.Raise 6
    End If

    If (lValue And m_l2Power(31 - iShiftBits)) Then
    LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
    Else
    LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
    End If
    End Function

    Private Function RShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
    RShift = lValue
    Exit Function
    ElseIf iShiftBits = 31 Then
    If lValue And &H80000000 Then
    RShift = 1
    Else
    RShift = 0
    End If
    Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
    Err.Raise 6
    End If

    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    If (lValue And &H80000000) Then
    RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
    End Function

    Private Function RotateLeft(lValue, iShiftBits)
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
    End Function

    Private Function AddUnsigned(lX, lY)
    Dim lX4
    Dim lY4
    Dim lX8
    Dim lY8
    Dim lResult

    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

    If lX4 And lY4 Then
    lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
    If lResult And &H40000000 Then
    lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
    Else
    lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
    End If
    Else
    lResult = lResult Xor lX8 Xor lY8
    End If

    AddUnsigned = lResult
    End Function

    Private Function F(x, y, z)
    F = (x And y) Or ((Not x) And z)
    End Function

    Private Function G(x, y, z)
    G = (x And z) Or (y And (Not z))
    End Function

    Private Function H(x, y, z)
    H = (x Xor y Xor z)
    End Function

    Private Function I(x, y, z)
    I = (y Xor (x Or (Not z)))
    End Function

    Private Sub FF(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
    End Sub

    Private Sub GG(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
    End Sub

    Private Sub HH(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
    End Sub

    Private Sub II(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
    End Sub

    Private Function ConvertToWordArray(sMessage)
    Dim lMessageLength
    Dim lNumberOfWords
    Dim lWordArray()
    Dim lBytePosition
    Dim lByteCount
    Dim lWordCount

    Const MODULUS_BITS = 512
    Const CONGRUENT_BITS = 448

    lMessageLength = Len(sMessage)

    lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)

    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
    lWordCount = lByteCount \ BYTES_TO_A_WORD
    lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
    lByteCount = lByteCount + 1
    Loop

    lWordCount = lByteCount \ BYTES_TO_A_WORD
    lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

    lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)

    ConvertToWordArray = lWordArray
    End Function

    Private Function WordToHex(lValue)
    Dim lByte
    Dim lCount

    For lCount = 0 To 3
    lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
    WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
    Next
    End Function

    Public Function MD5(sMessage)
    Dim x
    Dim k
    Dim AA
    Dim BB
    Dim CC
    Dim DD
    Dim a
    Dim b
    Dim c
    Dim d

    Const S11 = 7
    Const S12 = 12
    Const S13 = 17
    Const S14 = 22
    Const S21 = 5
    Const S22 = 9
    Const S23 = 14
    Const S24 = 20
    Const S31 = 4
    Const S32 = 11
    Const S33 = 16
    Const S34 = 23
    Const S41 = 6
    Const S42 = 10
    Const S43 = 15
    Const S44 = 21

    x = ConvertToWordArray(sMessage)

    a = &H67452301
    b = &HEFCDAB89
    c = &H98BADCFE
    d = &H10325476

    For k = 0 To UBound(x) Step 16
    AA = a
    BB = b
    CC = c
    DD = d

    FF a, b, c, d, x(k + 0), S11, &HD76AA478
    FF d, a, b, c, x(k + 1), S12, &HE8C7B756
    FF c, d, a, b, x(k + 2), S13, &H242070DB
    FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
    FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
    FF d, a, b, c, x(k + 5), S12, &H4787C62A
    FF c, d, a, b, x(k + 6), S13, &HA8304613
    FF b, c, d, a, x(k + 7), S14, &HFD469501
    FF a, b, c, d, x(k + 8), S11, &H698098D8
    FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
    FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
    FF b, c, d, a, x(k + 11), S14, &H895CD7BE
    FF a, b, c, d, x(k + 12), S11, &H6B901122
    FF d, a, b, c, x(k + 13), S12, &HFD987193
    FF c, d, a, b, x(k + 14), S13, &HA679438E
    FF b, c, d, a, x(k + 15), S14, &H49B40821

    GG a, b, c, d, x(k + 1), S21, &HF61E2562
    GG d, a, b, c, x(k + 6), S22, &HC040B340
    GG c, d, a, b, x(k + 11), S23, &H265E5A51
    GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
    GG a, b, c, d, x(k + 5), S21, &HD62F105D
    GG d, a, b, c, x(k + 10), S22, &H2441453
    GG c, d, a, b, x(k + 15), S23, &HD8A1E681
    GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
    GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
    GG d, a, b, c, x(k + 14), S22, &HC33707D6
    GG c, d, a, b, x(k + 3), S23, &HF4D50D87
    GG b, c, d, a, x(k + 8), S24, &H455A14ED
    GG a, b, c, d, x(k + 13), S21, &HA9E3E905
    GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
    GG c, d, a, b, x(k + 7), S23, &H676F02D9
    GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A

    HH a, b, c, d, x(k + 5), S31, &HFFFA3942
    HH d, a, b, c, x(k + 8), S32, &H8771F681
    HH c, d, a, b, x(k + 11), S33, &H6D9D6122
    HH b, c, d, a, x(k + 14), S34, &HFDE5380C
    HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
    HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
    HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
    HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
    HH a, b, c, d, x(k + 13), S31, &H289B7EC6
    HH d, a, b, c, x(k + 0), S32, &HEAA127FA
    HH c, d, a, b, x(k + 3), S33, &HD4EF3085
    HH b, c, d, a, x(k + 6), S34, &H4881D05
    HH a, b, c, d, x(k + 9), S31, &HD9D4D039
    HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
    HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
    HH b, c, d, a, x(k + 2), S34, &HC4AC5665

    II a, b, c, d, x(k + 0), S41, &HF4292244
    II d, a, b, c, x(k + 7), S42, &H432AFF97
    II c, d, a, b, x(k + 14), S43, &HAB9423A7
    II b, c, d, a, x(k + 5), S44, &HFC93A039
    II a, b, c, d, x(k + 12), S41, &H655B59C3
    II d, a, b, c, x(k + 3), S42, &H8F0CCC92
    II c, d, a, b, x(k + 10), S43, &HFFEFF47D
    II b, c, d, a, x(k + 1), S44, &H85845DD1
    II a, b, c, d, x(k + 8), S41, &H6FA87E4F
    II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
    II c, d, a, b, x(k + 6), S43, &HA3014314
    II b, c, d, a, x(k + 13), S44, &H4E0811A1
    II a, b, c, d, x(k + 4), S41, &HF7537E82
    II d, a, b, c, x(k + 11), S42, &HBD3AF235
    II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
    II b, c, d, a, x(k + 9), S44, &HEB86D391

    a = AddUnsigned(a, AA)
    b = AddUnsigned(b, BB)
    c = AddUnsigned(c, CC)
    d = AddUnsigned(d, DD)
    Next

    MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
    End Function
    %>
    <%response.write md5(YourString)%>
    محل برداشت : http://www.frez.co.uk


    شمارنده‌ی دفعات مشاهده‌ی یک صفحه

    مورد استفاده : ذخیره‌ی آمار مشاهده‌ی یک صفحه
    فایل‌های مورد نیاز : counter.asp , asp_count.txt
    توضیحات :
    پوشه‌ی ذخیره‌ی این فایل باید اجازه ( permission ) لازم را برای اعمال تغییرات داشته باشد .

    نمونه کد :
    <%
    on error resume next

    ' Create a server object
    set fso = createobject("scripting.filesystemobject")

    ' Target the text file to be opened
    set act = fso.opentextfile(server.mappath("asp_count.txt"))

    ' Read the value of the text document
    ' If the text document does not exist then the on error resume next
    ' will drop down to the next line
    counter = clng(act.readline)

    ' Add one to the counter
    counter = counter + 1

    ' Close the object
    act.close

    ' Create a new text file on the server
    Set act = fso.CreateTextFile(server.mappath("asp_count.txt") , true)

    ' Write the current counter value to the text document
    act.WriteLine(counter)

    ' Close the object
    act.Close

    ' Write the counter to the browser as text
    Response.Write counter
    %>
    محل برداشت : http://www.CodeAve.com


    شمارنده‌ی تعداد جلسات استفاده از سایت

    مورد استفاده : ذخیره‌ی آمار مشاهده‌ی سایت
    فایل‌های مورد نیاز : session_counter.asp , session_count.txt
    توضیحات :
    پوشه‌ی ذخیره‌ی این فایل باید اجازه ( permission ) لازم را برای اعمال تغییرات داشته باشد .
    نمونه کد :
    <%
    set fso = createobject("scripting.filesystemobject")
    set act = fso.opentextfile(server.mappath("session_count.txt "))
    counter = clng(act.readline)
    if session("been_here_before") = "" then
    session("been_here_before") = "Yes"
    counter = counter + 1
    ' act.close
    Set act = fso.CreateTextFile(server.mappath("session_count.t xt"), true)
    act.WriteLine(counter)
    end if
    act.Close
    Response.Write counter
    %>
    محل برداشت : http://www.CodeAve.com


    شمارنده‌ی تعداد دفعات مراجعه به یک صفحه در روز

    مورد استفاده : ذخیره‌ی آمار مشاهده‌ی روزانه‌ی یک صفحه
    فایل‌های مورد نیاز : dailyhits.asp
    توضیحات :
    پوشه‌ی ذخیره‌ی این فایل باید اجازه ( permission ) لازم را برای اعمال تغییرات داشته باشد .
    نمونه کد :
    <%
    on error resume next

    ' Create a server object
    set fso = createobject("scripting.filesystemobject")

    ' Target the text file to be read.
    ' The text file is continually updated with the current date from the server
    set act = fso.opentextfile(server.mappath("daily_count-"& month(date()) & day(date()) & year(date())&".txt"))

    ' Read the value contained in the current day hit counter
    ' If there is no file for the current day the on error resume next command above
    ' will force the program to the next line
    counter = clng(act.readline)

    ' Add one to the counter. If there was no value the counter will be set to a value of one
    counter = counter + 1

    ' Close the text object.
    act.close

    ' Create a new text file on the server with the current date as part of the name
    Set act = fso.createtextfile(server.mappath("daily_count-"& month(date()) & day(date()) & year(date())&".txt"), true)

    ' Write the counter value to the text object
    act.writeline(counter)

    ' Close the text object
    act.Close

    %>
    <%= counter %> Total Hits for <%= date() %>
    محل برداشت : http://www.CodeAve.com
    آخرین ویرایش به وسیله M-Gheibi : یک شنبه 24 دی 1385 در 07:26 صبح دلیل: اصلاح

  2. #2
    آپلود فایل
    فایل‌های مورد نیاز : upload_page.asp , upload_class.asp
    توضیحات : تو سورس بگردید و آدرس محل ذخیره رو پیدا کنید و تغییر بدید .
    نمونه کد :
    فایل upload_page.asp

    <!-- #include file="upload_class.asp" -->
    <%
    Server.ScriptTimeout = 300 'now i can upload and save files upto ~8Mb
    Dim intLevel, intUpload, intSave, strError, strContenType, strFilename, lngFileSize
    Dim objUpload
    Dim lngTime, lngUploadTime, lngSaveTime
    intLevel = Request.QueryString("level")
    '--------------------------------------
    wrHead
    If intLevel = 1 Then
    Set objUpload = New FileUpload
    With objUpload
    .Path = "D:\Inetpub\wwwroot\test"
    lngTime = Timer()
    intUpload = .Upload
    lngUploadTime = Round((Timer() - lngTime) * 1000,3)
    lngTime = Timer()
    intSave = .Save(true)
    lngSaveTime = Round((Timer() - lngTime) * 1000,3)
    strError = .Error
    strFilename = .Filename
    lngFilesize = .Size
    strContentType= .ContentType
    End With
    Set objUpload = Nothing
    End If

    wrForm
    wr "<hr style=""height:1px;width:100%;"" />"
    wr "Upload = " & intUpload & "<br />"
    wr "Save = " & intSave & "<br />"
    wr "Error = " & strError & "<br />"
    wr "Filename = " & strFilename & "<br />"
    wr "Filesize = " & lngFilesize & "<br />"
    wr "Content-Type = " & strContentType & "<br />"
    wr "Upload time = " & lngUploadTime & " ms<br />"
    wr "Save time = " & lngSaveTime & " ms <br />"
    wr "<hr style=""height:1px;width:100%;"" />"
    wrFoot
    '--------------------------------------
    Sub wrForm
    wr "<form method=""post"" enctype=""multipart/form-data"" action=""?level=1"">"
    wr "<input type=""file"" name=""file""></input>"
    wr "<input type=""submit""></input>"
    wr "</form>"
    End Sub

    Sub wrHead
    wr "<html>"
    wr "<head>"
    wr "<title>upload</title>"
    wr "</head>"
    wr "<body>"
    End Sub

    Sub wrFoot
    wr "</body>"
    wr "</html>"
    Response.End
    End Sub

    Sub wr(byval sText)
    If sText <> "" Then Response.Write sText & vbNewLine
    End Sub
    %>
    فایل upload_class.asp

    <%
    '+--------------------------------+
    '|Class: FileUpload |
    '|Date: 11:01 PM 7/23/2002|
    '|By: M.Meijer |
    '|Version: 1.0 |
    '+--------------------------------+
    '
    'To upload and save a file submitted within a html form
    '
    '**Remarks:
    'Uploading files with this class is not recommended for huge files,
    'it takes alot of time saving the file to a textstream (as it the function 'save' does).
    'It takes 7.812ms to upload a file from 'localhost', with a size of 40,000 bytes.
    'Saving this file however costs 1078.125ms, and it takes 145828.1ms to save a file of 5.5Mb.
    'Conclusion don't save big files, use the maxfilesize property to limit the filesize.
    'The class can only handly one file on a submission.
    'The file will be saved in the specified 'Path', if there is no 'path' set, it can't save the file. (doh!)
    '
    'Properties:
    '-----------
    '
    ' ContentType string read Content-Type of the file
    ' Filename string read/write Name of the file
    ' Path string read/write A path to a directory with permissions to write the file
    ' Size long read The size of the file in bytes
    ' AllowedFiles string read/write Allowed file extension(s), multiple seperated with a comma
    ' Maxfilesize long read/write Maximum allowed size of the file
    ' Error string read The explenation of an error if occured
    '
    'Methods
    '-------
    '
    ' Upload() = Status
    ' Copies the result of Request.Binaryread to a file
    '
    ' Status integer 0 Upload success
    ' 1 A file has not been posted
    ' 2 File exceeds the maximum allowed filesize
    ' 3 Type is not allowed
    '
    ' Save(Overwrite) = Satus
    ' Slaat de bytearray op in een bestand met de in Filename gedefineerde bestandsnaam,
    ' in de in Path gedefineerde diretorie.
    '
    ' Overwrite boolean true If the file exists it will be overwritten
    ' false If the file exists it will not be overwritten
    '
    ' Status integer 0 The file has been saved
    ' 1 The binary value could not be written to a file
    ' 2 There is no binary value
    ' 3 The filename is empty
    ' 4 An error already occured, can't continue
    '
    '
    '
    'Code:
    '-----------------------------------------------------------------------------------
    Class FileUpload
    Private strContentType
    Private bytData
    Private strFilename
    Private strPath
    Private lngTotalbytes
    Private strAllowedFiles
    Private lngMaxFileSize
    Private strError

    Private Sub Class_initialize()
    strContentType = ""
    bytData = chrB(10)
    strFilename = ""
    strPath = ""
    lngTotalbytes = 0
    strAllowedFiles = ""
    lngMaxFileSize = 0
    strError = ""
    End Sub

    Private Sub CLass_Terminate()
    bytData = Null
    End Sub

    Public Property Get Size
    Size = lngTotalbytes
    End Property

    Public Property Let MaxFileSize(byval vData)
    If isNumeric(vData) > 0 Then
    lngMaxFileSize = vData
    End If
    End Property

    Public Property Get MaxFilesize
    MaxFilesize = lngMaxFileSize
    End Property

    Public Property Let AllowedFiles(byval vData)
    If Len(vData) > 0 Then
    strAllowedFiles = vData
    End If
    End Property

    Public Property Get AllowedFiles
    AllowedFiles = strAllowedFiles
    End Property

    Public Property Get Error
    Error = strError
    End Property

    Public Property Get ContentType
    ContentType = strContentType
    End Property

    Public Property Let Path(byval vData)
    If Len(vData) > 0 Then
    strPath = vData
    End If
    End Property

    Public Property Get Path
    Path = strPath
    End Property

    Public Property Let Filename(byval vData)
    If Len(vData) > 0 Then
    strFilename = vData
    End If
    End Property

    Public Property Get Filename
    Filename = strFilename
    End Property


    Public Function Upload()' as integer
    Dim bytAllData
    lngTotalbytes = Request.Totalbytes
    If lngTotalbytes > 0 Then
    If lngMaxFilesize <> 0 Then
    If lngTotalBytes > lngMaxFileSize Then
    strError = "The file exceeds the allowed capacity."
    Upload = 2
    Exit Function
    End If
    End If
    bytAllData = Request.BinaryRead(lngTotalbytes)
    strContentType = GetContentType(bytAllData)
    strFilename = GetFilename(bytAllData)
    If strAllowedFiles <> "" Then
    If Not AllowedFile(strFilename) Then
    strError = "Filetype is not allowed."
    Upload = 3
    Exit Function
    End If
    End If
    bytData = GetData(bytAllData)
    Upload = 0
    Else
    Upload = 1
    strError = "No data recieved."
    End If
    End Function

    Public Function Save(byval bOverwrite)
    If strError <> "" Then
    Save = 4
    Exit Function
    End If
    If strPath <> "" Then
    If Mid(strPath,Len(strPath)-1,1) <> "\" Then strPath = strPath & "\"
    If strFilename <> "" Then
    If LenB(bytData) > 1 Then
    If SaveBinaryData(bytData,strPath & strFilename,bOverwrite) Then
    Save = 0
    Else
    Save = 1
    End If
    Else
    Save = 2
    strError = "No data."
    End If
    Else
    Save = 3
    strError = "Not a valid filename specified."
    End If
    Else
    Save = 4
    strError = "No path specified."
    End If
    End Function

    Private Function AllowedFile(byval sFilename)'as boolean
    Dim arrAllowedFiles, intCount
    Dim strExtension
    If Len(sFilename) > 0 Then
    If inStr(sFilename,".") > 0 Then
    strExtension = Mid(sFilename,Len(sFilename) - inStr(strReverse(sFilename),".")+2)
    arrAllowedFiles = Split(strAllowedFiles,",")
    AllowedFile = False
    For intCount = 0 To Ubound(arrAllowedFiles)
    If arrAllowedFiles(intCount) <> "" Then
    If Lcase(strExtension) = Lcase(Trim(arrAllowedFiles(intCount))) Then
    AllowedFile = True
    Exit For
    End If
    End If
    Next
    Else
    AllowedFile = False
    End If
    Else
    AllowedFile = False
    End If
    End Function

    Private Function SaveBinaryData(byval bData, byval sFilename, byval bOverwrite) 'as boolean
    Dim objFs, objTextFile
    Dim intCount, strFile
    If LenB(bData) < 2 Then
    strError = "No data."
    SaveBinaryData = False
    Exit Function
    End If

    Set objFs = Server.CreateObject("scripting.filesystemobject")
    If Not objFs.FolderExists(strPath) Then
    strError = "Directory does not exists."
    SaveBinaryData = False
    Exit Function
    End If

    If Not bOverwrite And objFs.FileExists(sFilename) Then
    strError = "File already exists."
    SaveBinaryData = False
    Exit Function
    End If

    Set objTextFile = objFs.CreateTextFile(sFilename,True,False)

    For intCount = 1 To LenB(bData)
    objTextFile.Write Chr(AscB(MidB(bData,intCount,1)))
    Next

    objTextFile.Close
    Set objTextFile = Nothing
    Set objFs = Nothing
    Session("file") = Null
    SaveBinaryData = True
    End Function

    Private Function GetData(byval bFile)'as bytearray
    Dim intStart, intEnd

    If LenB(bFile) < 1 Then
    GetData = ChrB(10)
    Exit Function
    End If
    intStart = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(13) & ChrB(10)) + 4
    intEnd = inStrB(bFile,ChrB(13) & ChrB(10) & ChrB(45) & ChrB(45)& ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45) & ChrB(45))
    If intStart > 0 Then
    If intStart < intEnd Then
    GetData = MidB(bFile, intStart, intEnd - intStart)
    Else
    GetData = ChrB(10)
    End If
    Else
    GetData = ChrB(10)
    End If
    End Function

    Private Function GetFilename(byval bFile)' as string
    Dim bytFilename, bytChar, strFilename
    Dim intStart, intCount

    If LenB(bFile) < 1 Then
    GetFilename = ""
    Exit Function
    End If

    If LenB(bFile) > 0 Then
    If inStrB(bFile,ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) Then
    intStart = inStrB(bFile, ChrB(102) & ChrB(105) & ChrB(108) & ChrB(101) & ChrB(110) & ChrB(97) & ChrB(109) & ChrB(101) & ChrB(61)) + 10
    For intCount = intStart To LenB(bFile)
    bytChar = MidB(bFile, intCount,1)
    If bytChar = ChrB(34) Then
    Exit For
    End If
    bytFilename = bytFilename & bytChar
    Next
    End If
    End If
    For intCount = 1 To LenB(bytFilename)
    strFilename = strFilename & Chr(AscB(MidB(bytFilename,intCount,1)))
    Next
    strFilename = Mid(strFilename,Len(strFilename) - inStr(strReverse(strFilename),"\")+2)
    GetFilename = strFilename
    End Function

    Private Function GetContentType(byval bFile)
    Dim bytContentType, strContentType, bytChar
    Dim intStart, intCount

    If LenB(bFile) < 1 Then
    GetContentType = ""
    Exit Function
    End If

    If inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) > 0 Then
    intStart = inStrB(bFile,ChrB(67) & ChrB(111) & ChrB(110) & ChrB(116) & ChrB(101) & ChrB(110) & ChrB(116) & ChrB(45) & ChrB(84) & ChrB(121) & ChrB(112) & ChrB(101) & ChrB(58)) + 14
    For intCount = intStart To LenB(bFile)
    bytChar = MidB(bFile, intCount,1)
    If bytChar = ChrB(13) Then
    Exit For
    End If
    bytContentType = bytContentType & bytChar
    Next
    End If
    For intCount = 1 To LenB(bytContentType)
    strContentType = strContentType & Chr(AscB(MidB(bytContentType,intCount,1)))
    Next
    GetContentType = strContentType
    End Function
    End Class
    '-----------------------------------------------------------------------------------

    %>
    محل برداشت : http://www.planetsourcecode.com
    آخرین ویرایش به وسیله M-Gheibi : جمعه 22 دی 1385 در 14:50 عصر دلیل: اصلاح شکل ظاهری

  3. #3
    اتصال به بانک اطلاعاتی اکسس

    نمونه کد :
    <%
    set conn = server.CreateObject("ADODB.Connection")
    conn.Open= "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & server.MapPath("DB.mdb")
    Set rs = conn.Execute("Select * from table")
    %>
    آخرین ویرایش به وسیله M-Gheibi : جمعه 22 دی 1385 در 15:09 عصر دلیل: اصلاح

  4. #4
    کد ساعت تقریبی

    نمونه کد :
    <%
    Function Far(xTime)
    Select Case xtime
    Case "1"
    Far = "یک"
    Case "2"
    Far = "دو"
    Case "3"
    Far = "سه"
    Case "4"
    Far = "چهار"
    Case "5"
    Far = "پنج"
    Case "6"
    Far = "شش"
    Case "7"
    Far = "هفت"
    Case "8"
    Far = "هشت"
    Case "9"
    Far = "نه"
    Case "10"
    Far = "ده"
    Case "11"
    Far = "یازده"
    Case "12"
    Far = "دوازده"
    End select
    End Function

    if hour(time)>12 then
    h = hour(time)-12
    elseif hour(time) = 12 then
    h=12
    elseif hour(time) =24 then
    h=12
    ElseIf hour(time)<12 Then
    h=hour(time)
    End If

    if hour(time) > 12 then
    th = hour(time)-11
    elseif hour(time) < 12 then
    th = h+1
    elseif hour(time) = 12 then
    th = 1
    end if
    min = minute(time)

    if min>-1 and min<4 then
    response.Write(Far(h))
    elseif min>3 and min<8 then
    Response.Write(far(h))
    Response.Write(" و پنج دقیقه")
    elseif min>7 and min<13 then
    Response.Write(far(h))
    Response.Write(" و ده دقیقه")
    elseif min>12 and min<18 then
    Response.Write(far(h))
    Response.Write(" و ربع")
    elseif min>17 and min<23 then
    Response.Write(far(h))
    Response.Write(" و بیست دقیقه")
    elseif min>22 and min<27 then
    Response.Write(far(h))
    Response.Write(" و بیست و پنج دقیقه")
    elseif min>26 and min<33 then
    Response.Write(far(h))
    Response.Write(" و نیم")
    elseif min>32 and min<37 then
    Response.Write("بیست و پنج دقیقه مانده به ")
    Response.Write(far(th))
    elseif min>32 and min<37 then
    Response.Write("بیست و پنج دقیقه مانده به ")
    Response.Write(far(th))
    elseif min>36 and min<43 then
    Response.Write("بیست دقیقه مانده به ")
    Response.Write(far(th))
    elseif min>42 and min<48 then
    Response.Write("یک ربع مانده به ")
    Response.Write(far(th))
    elseif min>47 and min<53 then
    Response.Write("ده دقیقه مانده به ")
    Response.Write(far(th))
    elseif min>54 and min<58 then
    Response.Write("ده دقیقه مانده به ")
    Response.Write(far(th))
    elseif min>57 then
    Response.Write(far(th))
    End If
    %>
    آخرین ویرایش به وسیله M-Gheibi : جمعه 22 دی 1385 در 14:56 عصر دلیل: اصلاح شکل ظاهری

  5. #5
    به‌روز رسانی دیتابیس توسط فیلد

    توضیحات : بعد از به وجود آوردن connection دیتابیس باید اطلاعات فرم را بفرستید به صفحه‌ی بعد و در آنجا کد زیر را وارد کنید .
    نمونه کد :

    <%
    objRS.AddNew
    objRS("Email") = Request.Form("Email")
    objRS("Name") = Request.Form("Name")
    objRS("Scr") = Request.Form("fulltext")
    objRS.Update

    DIM bookmark
    bookmark = objRS.absolutePosition
    objRS.Requery

    DIM strCustomerID
    strCustomerID = objRS("ID")
    %>
    آخرین ویرایش به وسیله M-Gheibi : جمعه 22 دی 1385 در 14:55 عصر دلیل: اصلاح شکل ظاهری

  6. #6
    اتصال به بانک اطلاعاتی MS SQL Server


    توضیحات : برای اتصال به بانک اطلاعاتی از نوع MS SQL Server از یکی از روش‌های زیر استفاده کنید .
    نمونه کد :
    1. استفاده از OLE DB
    Set objConn = Server.CreateObject("ADODB.Connection")
    objConn.Open "Provider=SQLOLEDB; Data Source=YOUR_SERVER_NAME; Initial
    Catalog=your_database_name; User ID=your_username; Password=your_password"
    objConn.Close
    Set objConn = Nothing
    2. استفاده از SQL Driver
     Set objConn = Server.CreateObject("ADODB.Connection")
    objConn.Open "Driver={SQL Server};" & _
    "Server=YOUR_SERVER_NAME;" & _
    "Database=your_database_name;" & _
    "Uid=your_username;" & _
    "Pwd=your_password;"
    objConn.Close
    Set objConn = Nothing
    آخرین ویرایش به وسیله M-Gheibi : جمعه 22 دی 1385 در 15:08 عصر دلیل: اصلاح شکل ظاهری

  7. #7
    کاربر دائمی آواتار musiox
    تاریخ عضویت
    اردیبهشت 1386
    محل زندگی
    پشت کامپیوتر
    پست
    269
    اینم سورس یه فروم forum.zip.

  8. #8
    آقا واقعا دستت درد نکنه..خیلی به درد بخور بودن!

  9. #9
    میشه لطفا کد مربوط به فرم ایمیل با تکنولوژی cdosys رو هم بگذارید؟؟؟؟ ضمنا اگه تنظیماتی از قبیل استفاده از فیل دی ال ال یا هر چیز دیگه روی هاست داره هم بفرمایید... من دیگه خسته شدم از بس گشتم و هیچی نفهمیدم....

  10. #10
    سلام... کد ساعت تقریبی مقدار ساعت سرور رو برمیگردونه... من نتونستم کاری کنم که زمان سیستم کاربر رو نشون بده... لطفا میشه بفرمایید چی کار باید کرد؟؟

  11. #11
    کاربر تازه وارد آواتار hamid_kz
    تاریخ عضویت
    خرداد 1386
    محل زندگی
    تهران
    پست
    31
    سلام.. از کد Upload استفاده کردم ... نمیدونم چرا کار نمی کنه.. همش میگه :

    Server object error 'ASP 0177 : 800401f3'
    Server.CreateObject Failed
    /up/upload_class.asp, line 227
    Invalid ProgID. For additional information specific to this message please visit the Microsoft Online Support site located at: http://www.microsoft.com/contentredirect.asp.


    اشکال از کجاست؟؟ شاید مسیر رو بد ست می کنم برای سرور... لطفا راهنماییم کنید

  12. #12
    کاربر جدید
    تاریخ عضویت
    مهر 1386
    محل زندگی
    بروجرد - ايران
    پست
    1
    من یه سری کد برای راه اندازی یهASP میخوام کسی می تونه کمک کنه؟

  13. #13
    منظورت و لطفا واضح بگو... یعنی چی میخوای؟؟؟

  14. #14
    من یه سری کد برای راه اندازی یهASP میخوام کسی می تونه کمک کنه؟
    این سوالتون اصلا معنی خاصی نداره ! دوست عزیز !
    واضح بپرسید !
    اگر که منظورتون اجرای صفحاتتون هست که دو حالت یا لوکال یا تحت وب !
    1-local : با IIS در ویندوز xp
    2-Web :این هم که معلومه یه هاستی که asp Suport باشه می خرین (البته مجانیش هم هستا )
    ;)
    اگر منظور دیگهی دارین بفرمایین !

  15. #15
    سلام.. از کد Upload استفاده کردم ... نمیدونم چرا کار نمی کنه.. همش میگه :

    Server object error 'ASP 0177 : 800401f3'
    Server.CreateObject Failed
    /up/upload_class.asp, line 227
    Invalid ProgID. For additional information specific to this message please visit the Microsoft Online Support site located at: http://www.microsoft.com/contentredirect.asp.


    اشکال از کجاست؟؟ شاید مسیر رو بد ست می کنم برای سرور... لطفا راهنماییم کنید
    دو حالت داره یا این ها مشکل دارن :
    upload_page.asp , upload_class.asp
    یا اینکه اجازه upload کردن را بدون login نداره
    یا مسیر مشکل دارند !

  16. #16
    دوست عزیز hamid_kz

    این را حتما به خوان ! :
    http://support.microsoft.com/kb/q188289/

    این راه حل مشکلت را هم داره ;)

  17. #17

    فرستادن ایمیل


    <%@ LANGUAGE="VBSCRIPT" %>
    <!-- remove this comment and end comment below before using
    <html>
    <head>
    <title>Simple Form E-mail Component for ASP</title>
    </head>
    <body bgcolor="#FFFFFF">
    <h1>Form E-mail with ASP<br></h1>
    <form method="POST" action="SENDFORM.asp">
    <p>From: <input type="text" name="From" size="40"><br>
    Email To: <input type="text" name="EmailTo" size="38"><br>
    Subject: <input type="text" name="Subject" size="55"></p>
    <p>Message<br>
    <textarea rows="6" name="Message" cols="55"></TEXTAREA><P>
    <p>Other: <input type="text" name="AnyFieldNameYouWant" size="49"></p>
    <p><input type="submit" value="Send Form" name="Submit"><input type="reset"
    value="Reset" name="Reset"></p>
    </form>
    <%
    '************************************************* ***********
    ' SENDFORM.ASP -- Simple Form E-mail Component for ASP
    ' Created 7/31/98
    ' by Valentin Frixione
    ' e-mail: vfrixion@ix.netcom.com
    ' -- Must have Microsoft Windows NT 4 Server
    ' -- running Option Pack 4, with IIS4 & simple SMTP server
    '************************************************* ***********
    If Request.Form("Submit")= "Send Form" then
    Set objSend = Server.CreateObject("CDONTS.Newmail")
    objSend.From = Request ("From")
    objSend.To = Request ("EmailTo")
    objSend.Subject = Request ("Subject")
    '--------------------------------------------------
    ' Putting the Body of the e-mail together...
    '--------------------------------------------------
    strBodyHeader= "This form was sent via e-mail on " _
    & Now & ". " & "<P>"
    '---------------------------------------------------------------'Collecting the fields from the HTML Form
    '--------------------------------------------------------------
    strBody =""
    For each item in Request.Form
    if item <> "Submit" then
    strLineItem = item &" : " & _
    Request.Form(item) & "<BR>"
    strBody = strBody & strLineItem
    end if
    Next

    strBody = strBodyHeader & strBody

    objSend.Body = strBody
    '--------------------------------------------------
    'Sending the Form
    '--------------------------------------------------

    objSend.Send

    If err.number = 0 then
    'OK?
    Response.Write "<p><strong>"
    Response.Write "Your message was sent. "
    response.write "It was:</strong><br><P>" & strBody
    else
    'Not OK!
    Response.Write "<p><strong>A problem was detected, please "
    Response.Write "contact the Webmaster with the following "
    Response.Write "error description.</strong><br>"
    Response.Write "Error: " & objSend.Response
    End if
    set objSend = Nothing
    End If
    %>
    remove end comment and comment on top before using
    -->
    </BODY>
    </HTML>

  18. #18

    محیط چت

    یک محیط چت جالب
    فایل های ضمیمه فایل های ضمیمه

  19. #19

    Guestbv3_1

    Guestbv3_1
    فایل های ضمیمه فایل های ضمیمه

  20. #20

    Forum نحوه تهیه

    در این فایل چگونگی ساخت و کد برنامه جمع آوری شده است
    فایل های ضمیمه فایل های ضمیمه

  21. #21
    سلام دوستان
    من در حین کار با Access با پیغام زیر مواجه می شم و خیلی کارم لنگ کرده ازتون خواهش می کنم که کمکم کنید پروژه ام مانده رو دستم 10 نمره داره دیگه کار از عوض کردن CD و برنامه دوباره ریختن و Full نصب کردن و ویندوز عوض کردن گذشته
    بازم خواهش می کنم کمکم کنید

    ActiveX component can`t create object

  22. #22
    سلام... اول اینکه شما یه پست جدید باید میزدی برای این مشکلت...دوم اینکه این مشکل فکر نکنم از بانکت باشه... احتمالا داری از یه dll استفاده میکنی و اون dll رو تو ویندوزت یوز نکردی... در زبان asp classic برای استفاده از dll باید cmd رو باز کنی و این دستور رو بنویسی:

    Regsvr32 C:\Inetpub\wwwroot\masire file DLL

    بعد از نوشتن آدرس کامل فایل اینتر کن و بعد از چند لحطه پیغام میده که با موفقیت انجام شد. بعد از اون از برنامت یه اجرا بگیر ببین مشکل حل شده یا نه....
    البته من فکر مبکنم از این باشه چون شما توضیح ندادی!

  23. #23
    نقل قول نوشته شده توسط Hadi-karimi مشاهده تاپیک
    خیلی کارم لنگ کرده ازتون خواهش می کنم که کمکم کنید
    خبری نیست از شما

  24. #24

    نقل قول: بانک کد ASP کلاسیک

    سلام دوست عزیز ممکنه ارسال ایمیل و ارتباط با دیتابیس را با کدهاش برایم توضیح بدی؟

  25. #25

    نقل قول: بانک کد ASP کلاسیک

    نقل قول نوشته شده توسط buyredblack مشاهده تاپیک
    سلام دوست عزیز ممکنه ارسال ایمیل و ارتباط با دیتابیس را با کدهاش برایم توضیح بدی؟
    سلام... اول اینکه یه کم بگردی بد نیست...
    دوم اینکه شما تو تالار باید یه تاپیک بدی برای مشکلت...
    در ضمن بعد از گشتن و نهایتا پیدا نکردن جوابت تاپیکت رو پست کنی...


    با تشکر از نهایت توجه مدیران این بخش در مورد رسیدگی به این تاپیک

  26. #26
    کاربر دائمی آواتار kashaneh
    تاریخ عضویت
    آبان 1383
    محل زندگی
    در همین نزدیکی
    پست
    537

    نقل قول: بانک کد ASP کلاسیک

    با سلام خدمت دوستان

    مي خواستم بگم اين كد مربوط به تاريخ شمسي داراي مشكل هست. اگه مي شه لطف كنيد و كد تصحيح شده رو براي استفاده دوستان در اينجا قرار بديد.... هر چه سريعتر بهتر ... ممنون

  27. #27

    نقل قول: فرستادن ایمیل

    نقل قول نوشته شده توسط Reza Safa مشاهده تاپیک

    <%@ LANGUAGE="VBSCRIPT" %>
    <!-- remove this comment and end comment below before using
    <html>
    <head>
    <title>Simple Form E-mail Component for ASP</title>
    </head>
    <body bgcolor="#FFFFFF">
    <h1>Form E-mail with ASP<br></h1>
    <form method="POST" action="SENDFORM.asp">
    <p>From: <input type="text" name="From" size="40"><br>
    Email To: <input type="text" name="EmailTo" size="38"><br>
    Subject: <input type="text" name="Subject" size="55"></p>
    <p>Message<br>
    <textarea rows="6" name="Message" cols="55"></TEXTAREA><P>
    <p>Other: <input type="text" name="AnyFieldNameYouWant" size="49"></p>
    <p><input type="submit" value="Send Form" name="Submit"><input type="reset"
    value="Reset" name="Reset"></p>
    </form>
    <%
    '************************************************* ***********
    ' SENDFORM.ASP -- Simple Form E-mail Component for ASP
    ' Created 7/31/98
    ' by Valentin Frixione
    ' e-mail: vfrixion@ix.netcom.com
    ' -- Must have Microsoft Windows NT 4 Server
    ' -- running Option Pack 4, with IIS4 & simple SMTP server
    '************************************************* ***********
    If Request.Form("Submit")= "Send Form" then
    Set objSend = Server.CreateObject("CDONTS.Newmail")
    objSend.From = Request ("From")
    objSend.To = Request ("EmailTo")
    objSend.Subject = Request ("Subject")
    '--------------------------------------------------
    ' Putting the Body of the e-mail together...
    '--------------------------------------------------
    strBodyHeader= "This form was sent via e-mail on " _
    & Now & ". " & "<P>"
    '---------------------------------------------------------------'Collecting the fields from the HTML Form
    '--------------------------------------------------------------
    strBody =""
    For each item in Request.Form
    if item <> "Submit" then
    strLineItem = item &" : " & _
    Request.Form(item) & "<BR>"
    strBody = strBody & strLineItem
    end if
    Next

    strBody = strBodyHeader & strBody

    objSend.Body = strBody
    '--------------------------------------------------
    'Sending the Form
    '--------------------------------------------------

    objSend.Send

    If err.number = 0 then
    'OK?
    Response.Write "<p><strong>"
    Response.Write "Your message was sent. "
    response.write "It was:</strong><br><P>" & strBody
    else
    'Not OK!
    Response.Write "<p><strong>A problem was detected, please "
    Response.Write "contact the Webmaster with the following "
    Response.Write "error description.</strong><br>"
    Response.Write "Error: " & objSend.Response
    End if
    set objSend = Nothing
    End If
    %>
    remove end comment and comment on top before using
    -->
    </BODY>
    </HTML>
    باسلام وقتی از این کد استفاده میکنم و دکمه سند رو میزنم
    ارور

    The page cannot be found

    lمیگیرم چه کار کنم

  28. #28
    کاربر دائمی آواتار kashaneh
    تاریخ عضویت
    آبان 1383
    محل زندگی
    در همین نزدیکی
    پست
    537

    نقل قول: بانک کد ASP کلاسیک

    با سلام. نسخه اصلاح شده و حرفه ای از تاریخ هجری شمسی با قابلیت های اضافه شده. این نسخه از تاریخ هجری شمسی با استفاده از تقویم جلالی و محاسبه ی کامل سال های کبیسه طراحی شده. تا حدود بسیار زیادی عقب و جلو افتادن های تاریخ در نسخه های قبلی رو از بین برده. باز هم دوستان تست کنید و چنانچه نیازی به اصلاح در اون دیدین، برای استفاده دیگران در اینجا قرار دهید.
    فایل های ضمیمه فایل های ضمیمه

  29. #29
    مدیر بخش آواتار aryaei2000
    تاریخ عضویت
    مرداد 1387
    محل زندگی
    جزیره بی آفتاب
    پست
    633

    نقل قول: بانک کد ASP کلاسیک

    عالی بود

  30. #30

    نقل قول: بانک کد ASP کلاسیک

    kheylimamnonam doste aziz enshaallah movaffag bashin va bazam az in code ha to hamin bakhsh bezarin

  31. #31

    نقل قول: بانک کد ASP کلاسیک

    كد چت روم رو نداريد؟

  32. #32

    نقل قول: بانک کد ASP کلاسیک

    بنام خدا
    سلام
    به سایت زیر مراجعه کنید هر نوع کد آماده تست شده و ساده تا پیشرفته بخواهید آنجا وجود داره
    من که خیلی استفاده کردم
    قابلیت های سایت:
    اراءه کد های آماده و تست شده به زبان های asp vb c delphi php sql , غیره

    این هم دایرکتوری قسمت asp


    Algorithims
    (4,775 lines)

    ASP Server Object Model
    (18,968 lines)

    Coding Standards
    (6,941 lines)

    Complete Applications
    (67,741 lines)

    Controls/ Forms/ Dialogs/ Menus
    (13,696 lines)

    Data Structures
    (1,172 lines)

    Databases
    (32,408 lines)

    Debugging and Error Handling
    (1,794 lines)

    Documents/ Frames
    (1,377 lines)

    Files
    (12,090 lines)

    Games
    (6,550 lines)

    Graphics/ Sound
    (8,859 lines)


    GUIs
    (2,721 lines)

    Internet/ Browsers/ HTML
    (25,884 lines)

    Libraries
    (3,287 lines)

    Macros
    (378 lines)

    Math
    (2,792 lines)

    Miscellaneous
    (30,829 lines)

    Object Oriented Programming (OOP)
    (3,526 lines)

    Security
    (7,492 lines)

    Server Side
    (9,629 lines)

    Sorting
    (1,284 lines)

    Strings
    (5,514 lines)

    System Services/ Functions
    (6,628 lines)

    Validation/ Processing
    (6,528 lines)


  33. #33

    نقل قول: بانک کد ASP کلاسیک

    البته من دارم سعی می کنم cd یا dvd اون رو دانلود کنم با emule اگه گرفتم خبر می دم تا برای هر کس خواست ارسال کنیم البته اگه کسی قبلا کامل و 2008 اون رو گرفته بگه تا ما از اون بگیریم


    این هم یه سایت دیگه http://www.apache-asp.org/eg/index.html

    البته به قدرت قبلی نیست قبلی واقعا جالب و خوبه
    آخرین ویرایش به وسیله هواشناس : پنج شنبه 20 فروردین 1388 در 08:14 صبح

  34. #34

    کتاب اموزشی

    آدرس دانلود یه کتاب رو اینجا گذاشتم البته می تونید از جای دیگه دانلود کنید
    مجموعه مقالات ASP ( سایت IranASP.net) (جهت دریافت کلیک کنید)



    محتوا:
    مقالات در IranASP.NET
    ADO.NET و پايگاه داده (۹ مقاله)
    مقالاتی راجع به کلاسهای ADO.NET و دستيابی به بانکهای اطلاعاتی تحت وب. ASP کلاسيک (۳۸ مقاله)
    ASP مخفف Active Server Pages است که در مقابل ASP.NET که نسل بعدی آن است، اصطلاحا ASP کلاسيک ناميده می شود. ASP روشی کارا و آسان جهت توليد سايتهای پويای وب و برنامه های تحت وب می باشد. آشنايی با #C (۲ مقاله)
    شامل مقالاتی در مورد آموزش و قابليتهای زبان برنامه نويسی #C. آشنايی با VB.NET (۵ مقاله)
    مقالاتی جهت آشنايی و فراگيری زبان ويژوال بيسيک دات نت شامل نحوه تعريف متغير،عملگرها، ساختارهای شرطی، توابع و ساير مواردی که برای يادگيری يک زبان مورد نياز است. سرويس های XML وب (۸ مقاله)
    شامل مقالاتی جهت آشنائی با XML و سرويس های XML وب. اين سرويس ها نقشی اساسی در توليد برنامه های توزيع يافته در سطح وب دارند. فارسی در وب (۱۲ مقاله)
    اين گروه از مقالات به موضوع خط فارسی در وب و سهم ايران يا زبان فارسی در دات نت می پردازد و سعی دارد تا کارهائی که در اين زمينه انجام می شود را حمايت و معرفی نمايد. فرم های وب (۳۰ مقاله)
    فرم های وب يکی از اجزای مهم فناوری ASP.NET است که با استفاده از آنها می توان صفحات پيشرفته وب را به آسانی ايجاد نمود. گفتگو (۳ مقاله)
    گفتگو با متخصصان ASP.NET و IT. کليات ASP.NET (۶۲ مقاله)
    مقالاتی جهت آشنائی با ASP.NET و مجموعه دات نت و شناخت ويژگيها و توانمنديهای آن و ساير موارد مربوطه.

  35. #35

    نقل قول: بانک کد ASP کلاسیک

    سلام به همگی
    من یه سایت با زبان asp دارم درست میکنم
    میخوام دو زبانه باشه فارسی و انگلیسی
    فکر کنید سایت من یه منو داره و چند تا متن
    میخوام وقتی این سایت انگلیسی شد هم منو و هم متن هاش انگلیسی بشه
    اگه لطف کنید یه نمونه از این سایت رو رو فایل زیپ بزارین که من بتونم ازش کمک بگیرم ممنون میشم
    راستی داشت یادم میرفت این سایت به Access وصل هستش
    که متن سایت و منو هم از بانک اطلاعاتی خونده میشه
    دم همتون گرم

  36. #36

    نقل قول: بانک کد ASP کلاسیک

    بنام خدا
    سلام
    مدتی بود دنبال کدی با asp می گشتم که با بارگذاری اون در هاست بصورت انلاین (بدون اینکه نیاز باشه دیتابیس رو برای تغییر در ساختار اون یکبار دانلود و دوباره پس از انجام تغییرات آپلود کنم ) هر بلایی که خاسته باشم سر دیتابیس اکسس بیارم
    خب بلاخره يکي پيدا کردم که کامل کار مي کنه و امکانات خوبي هم داره براي ديتابيس اکسس
    مثل ويرايش کل ديتابيس از جمله جداول، ستونها، نوع فيلدها، حذف و اضافه کردن تمام موارد يک جدول ، فشرده سازي ديتابيس، پسورد گذاري روي ديتابيس،اکسپورت و ايمپورت در ديتابيس، بکآپ گيري و غيره که همگي بصورت انلاين انجام مي شه و کافي سورس برنامه رو روي هاست بذاريد بعد با ورود به برنامه با پسورد از قبل تعريف شده (حالت ديفلت: admin) همه کاري با ديتابيس تون انجام بدهيد
    يا علي موفق باشيد
    لینک تاپیک اصلی بروید تا توضیحات کامل رو ببینید و دانلودش کنید:

  37. #37

    نقل قول: بانک کد ASP کلاسیک

    خیلی تاپیک مفید و پر محتوایی بود
    دست همه درد نکنه

  38. #38

    نقل قول: بانک کد ASP کلاسیک

    بنام خدا
    این تاپیک ها رو قبلا گذاشتم حالا گفتم داخل اینجا بذارم که بانک کد تکمیلتر بشه:

    تاپیک سلام اکسپورت asp به اکسل:

    تاپیک سلام اکسپورت asp به pdf:

    یا علی

  39. #39

    نقل قول: بانک کد ASP کلاسیک

    بنام خدا
    یه کسی برنام اوقات شرعی خواسته بود:
    در مورد برنامه اوقات شرعی هم من چند مدلش رو دارم ولی این مدلی که اینجا گذاشتم خیلی کامله، می تونی هر روز از سال رو که می خواهی انخاب کنی و همچنین هر شهری که بخواهی ، و درضمن برای اضافه کردن شهرهای دیگه هم فقط طول و عرض جغرافیایی اون رو بهش معرفی کنید من سورس اون رو از سایت nahad.ir گیر آوردم (این بخاطر رعایت کپی رایت!)

    این لینک دریافتش در همین فروم
    http://www.barnamenevis.org/sh...72&postcount=4

  40. #40

    نقل قول: بانک کد ASP کلاسیک

    سلام
    در اولین پست این قسمت در بالای بعضی از نمونه کدها، جمله زیر نوشته شده.


    پوشه‌ی ذخیره‌ی این فایل باید اجازه ( permission ) لازم را برای اعمال تغییرات داشته باشد .
    میشه لطف کنید و توضیح کاملی در این مورد بدید. چون در اجرای کدها اروری در رابطه با همین permission دریافت میکنم.

صفحه 1 از 2 12 آخرآخر

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •