سيو اچ تي ام ال

شروع موضوع توسط asosh2003 ‏13 ژوئن 2004 در انجمن برنامه نویسی

  1. asosh2003

    asosh2003 کاربر تازه وارد

    تاریخ عضویت:
    ‏4 آپریل 2004
    نوشته ها:
    37
    تشکر شده:
    1
    سلام به همه دوستان :)

    من چند تا صفحه‌ی ای اس پی دارم که می‌خوام با وي بي شيش (!) ، اچ تی ام ال سیوشون کنم .

    کسی راهی واسه این کار سراغ داره ؟ :blush:

    ممنون :)
     
  2. خرید بک لینکبازدیدیار - افزایش بازدید سایت و سیگنال های برند
  3. karagah

    karagah کاربر تازه وارد

    تاریخ عضویت:
    ‏22 می 2004
    نوشته ها:
    63
    تشکر شده:
    0
    سلام
    دوست عزیز کاش سوالتون رو دقیقتر مطرح کرده بودید.مثلا این صفحات ASP کجا ذخیره شده اند؟ چه امکاناتی دارید؟ مثلا به سروری که از ASP پشتیبانی کنه دسترسی دارید؟ امیدوارم این روش مشکلتون رو حل کنه. برای استفاده از روش زیر باید این صفحات روی یک سرور که از ASP پشتیبانی میکنه قرار داشته باشند. اگر این صفحه ها روی کامپیوتر خودتون هستند و نمی تونید به یک وب سرور منتقلشون کنید باید IIS یا Personal Web Server رو نصب کنید و این صفحه ها رو در فولدر wwwroot کپی کنید.

    برای دریافت هر نوع فایلی از یک وب سرور ، می تونید از کنترل ITC استفاده کنید. کافیه فایل ASP رو با پروتکل HTTP از سرور درخواست کنید ، سرور اون رو به HTML تبدیل میکنه و میفرسته. بعد باید اطلاعات دریافت شده رو در یک فایل ذخیره کنید.

    ITC=Internet Transfer Control

    1- یک کنترل ITC به فرم اضافه کنید اسمش رو مثلا myITC بزارید.
    2- یک آرایه از نوع Byte با اندازه نامحدود بسازید.
    4- پروتکل رو برابر HTTP قرار بدید.
    3- آدرس صفحه ASP رو به myITC بدید. مثال:
    - اگر فایلtest.asp روی کامپیوتر خودتون و در شاخه wwwroot قرار داشته باشه باید این آدرس رو بدید:
    http://127.0.0.1/test.asp
    - یا برای تبدیل فایل index.asp روی سرور www.myserver.com قرار داره این آدرس:
    http://www.myserver.com/index.asp

    5- متد OpenURL رو صدا بزنید تا صفحه رو دریافت کنه و در آرایه قرار بده.
    6- یک فایل باینری باز کنید و آرایه رو در اون ذخیره کنید.
    برای اطلاعات بیشتر اینجا رو ببینید:
    http://msdn.microsoft.com/library/en-us/dnexpvb/html/usinginternettransfercontrol.asp

    کد نمونه:
    آدرس صفحه ASP و نام فایلی که می خواهید کدهای HTML در اون ذخیره بشه رو به این روتین بفرستید. توجه کنید که اول باید
    یک کنترل Internet Transfer Control به فرم اضافه کنید و Name اش رو هم برابر myITC قرار بدید. مثلا برای ذخیره
    http://www.microsoft.com/default.asp در فایل c:\mshome.htm ، روتین رو اینطور فراخوانی کنید:
    کد:
     Dim myURL as String
    Dim myFileName as String
    
    myURL ="http://www.microsoft.com/default.asp"
    myFileName="c:\mshome.htm"
    
    Call ASP2HTML ( myURL, myFileName)
    
    کد:
    Private Sub ASP2HTML(PageAddress As String , HTMLFile As String)
             'Written by: Karagah (pt_karagah at yahoo dot com)
             Dim Buffer() as Byte
    
    
             myITC.Protocol = icHTTP	         ' Set the protocol
             myITC.URL = PageAddress	         ' Set the URL
    	
             ' Save HTML data in Buffer 
             Buffer() = myITC.OpenURL(myITC.URL,icByteArray)
    
             ' Write the buffer to the local file
             Open HTMLFile For Binary Access Write As #1
             Put #1, , Buffer()
             Close #1
    
            
          End Sub
    
     
     
  4. asosh2003

    asosh2003 کاربر تازه وارد

    تاریخ عضویت:
    ‏4 آپریل 2004
    نوشته ها:
    37
    تشکر شده:
    1
    ممنون :)
    حالا همين روش رو امتحان مي‌كنم تا ببينم چي مي‌شه .
    راستی ! می‌شه کاری کرد که ای اس پی ، بدون استایل شیتش بارگذاری بشه ؟
     
  5. asosh2003

    asosh2003 کاربر تازه وارد

    تاریخ عضویت:
    ‏4 آپریل 2004
    نوشته ها:
    37
    تشکر شده:
    1
    كارآگاه جان !
    ببين ! من دقيقا مي گم مي خوام چي كار كنم ، تو همين دقيقا راهنمايي‌م کن . دستت درد نکنه :)
    یک سری صفحه‌ی ای اس پی هست ، که من می‌خوام روی دستگاه خودم سیوشون کنم . البته اچ تی ام ال دیگه .
    کاری که می‌خوام بکنم ، اینه که ای صفحه‌ها رو ، بدون استایل شیتشون لود کنم و بعد هم سیو .
    این رو هم داشته باش که این صفحه‌ها ، یونیکد سیو می‌شن .
    بعد از این که اون‌ها رو آوردم روی دستگاهم ، می‌خوام با اچ تی ام ال‌هاشون یه کارهایی بکنم . اما تا حالا هر کاری که کردم ، وی بی شیش نتونسته یونیکد رو بشناسه .
    می‌گی چی کار کنم ؟
    اگه سریع جواب بدی ، واقعا ممنون می‌شم .
    چون کارم واقعا لنگ مونده .
    :)
     
  6. karagah

    karagah کاربر تازه وارد

    تاریخ عضویت:
    ‏22 می 2004
    نوشته ها:
    63
    تشکر شده:
    0
    دوست عزيز
    رشته ها در VB6 يوني كد هستند و به صورت UTF-16 ذخيره ميشوند. در حالي كه فايل HTML شما UTF-8 هست. اول با كمك تابع UTF8_Decode بايد UTF-8 رو به UTF-16 تبديل كنيد. بعد مي تونيد رشته UTF-16 بدست اومده رو با تابع STRCONV به فرمتي تبديل كنيد كه در كنترل ها (مثلا TextBox ها ) قابل نمايش باشد. من كد تابع UTF8_Decode رو از اينجا برداشتم كه اطلاعات و كد هاي خوبي درباره Unicode داره:
    http://www.cyberactivex.com/UnicodeTutorialVb.htm
    ولي الان VB6 ندارم كه امتحانش كنم. اميدوارم درست كار كنه.

    كد نمونه:
    اين كد كلمه "ايران" رو كه بصورت UTF-8 در متغيير رشته اي myStr ذخيره شده در TextBox1 نمايش ميده:
    کد:
        Dim myStr As String
        Dim temp As String
        
        myStr = Chr(216) & Chr(167) & _
                Chr(217) & Chr(138) & _
                Chr(216) & Chr(177) & _
                Chr(216) & Chr(167) & _
                Chr(217) & Chr(134)
    
        temp = UTF8_Decode(myStr)
    
        TextBox1.Text = StrConv(temp, vbFromUnicode)
    
     
    كد تابع UTF8_Decode:
    کد:
    'Purpose:Convert Utf8 to Unicode
    Public Function UTF8_Decode(ByVal sUTF8 As String) As String
    
       Dim lngUtf8Size      As Long
       Dim strBuffer        As String
       Dim lngBufferSize    As Long
       Dim lngResult        As Long
       Dim bytUtf8()        As Byte
       Dim n                As Long
    
       If LenB(sUTF8) = 0 Then Exit Function
    
       If m_bIsNt Then
          On Error GoTo EndFunction
          bytUtf8 = StrConv(sUTF8, vbFromUnicode)
          lngUtf8Size = UBound(bytUtf8) + 1
          On Error GoTo 0
          'Set buffer for longest possible string i.e. each byte is
          'ANSI, thus 1 unicode(2 bytes)for every utf-8 character.
          lngBufferSize = lngUtf8Size * 2
          strBuffer = String$(lngBufferSize, vbNullChar)
          'Translate using code page 65001(UTF-8)
          lngResult = MultiByteToWideChar(CP_UTF8, 0, bytUtf8(0), _
             lngUtf8Size, StrPtr(strBuffer), lngBufferSize)
          'Trim result to actual length
          If lngResult Then
             UTF8_Decode = Left$(strBuffer, lngResult)
          End If
       Else
          Dim i                As Long
          Dim TopIndex         As Long
          Dim TwoBytes(1)      As Byte
          Dim ThreeBytes(2)    As Byte
          Dim AByte            As Byte
          Dim TStr             As String
          Dim BArray()         As Byte
    
          'Resume on error in case someone inputs text with accents
          'that should have been encoded as UTF-8
          On Error Resume Next
    
          TopIndex = Len(sUTF8)  ' Number of bytes equal TopIndex+1
          If TopIndex = 0 Then Exit Function ' get out if there's nothing to convert
          BArray = StrConv(sUTF8, vbFromUnicode)
          i = 0 ' Initialise pointer
          TopIndex = TopIndex - 1
          ' Iterate through the Byte Array
          Do While i <= TopIndex
             AByte = BArray(i)
             If AByte < &H80 Then
                ' Normal ANSI character - use it as is
                TStr = TStr & Chr$(AByte): i = i + 1 ' Increment byte array index
             ElseIf AByte >= &HE0 Then         'was = &HE1 Then
                ' Start of 3 byte UTF-8 group for a character
                ' Copy 3 byte to ThreeBytes
                ThreeBytes(0) = BArray(i): i = i + 1
                ThreeBytes(1) = BArray(i): i = i + 1
                ThreeBytes(2) = BArray(i): i = i + 1
                ' Convert Byte array to UTF-16 then Unicode
                TStr = TStr & ChrW$((ThreeBytes(0) And &HF) * &H1000 + (ThreeBytes(1) And &H3F) * &H40 + (ThreeBytes(2) And &H3F))
             ElseIf (AByte >= &HC2) And (AByte <= &HDB) Then
                ' Start of 2 byte UTF-8 group for a character
                TwoBytes(0) = BArray(i): i = i + 1
                TwoBytes(1) = BArray(i): i = i + 1
                ' Convert Byte array to UTF-16 then Unicode
                TStr = TStr & ChrW$((TwoBytes(0) And &H1F) * &H40 + (TwoBytes(1) And &H3F))
             Else
                ' Normal ANSI character - use it as is
                TStr = TStr & Chr$(AByte): i = i + 1 ' Increment byte array index
             End If
          Loop
          UTF8_Decode = TStr    ' Return the resultant string
          Erase BArray
       End If
    
    EndFunction:
    
    End Function
    
     
    تعريف API ها و ثابت كد پيج:
    کد:
    Option Explicit
    
    Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
    Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    
    Public Const CP_UTF8 = 65001
    
     
     
  7. asosh2003

    asosh2003 کاربر تازه وارد

    تاریخ عضویت:
    ‏4 آپریل 2004
    نوشته ها:
    37
    تشکر شده:
    1
    كارآگاه جان ممنون :)
     
  8. karagah

    karagah کاربر تازه وارد

    تاریخ عضویت:
    ‏22 می 2004
    نوشته ها:
    63
    تشکر شده:
    0
    :happy: .
     
  9. asosh2003

    asosh2003 کاربر تازه وارد

    تاریخ عضویت:
    ‏4 آپریل 2004
    نوشته ها:
    37
    تشکر شده:
    1
    كارآگاه كار نميكنه :(
    ريچ تكست باكس هم ، "ي"ها رو "؟" نشون ميده .
    چي كار كنم ؟ :blink:
     
  10. karagah

    karagah کاربر تازه وارد

    تاریخ عضویت:
    ‏22 می 2004
    نوشته ها:
    63
    تشکر شده:
    0
    شرمنده ! من تعريف API ها رو ننوشته بودم. آخر پست 5 مي نويسمش. بايد اونها رو در قسمت decleration پيست كنيد.
    اگه بازم كار نكرد همينجا مطرح كنيد.
     
  11. asosh2003

    asosh2003 کاربر تازه وارد

    تاریخ عضویت:
    ‏4 آپریل 2004
    نوشته ها:
    37
    تشکر شده:
    1
    كارآگاه ! اون كار رو كه خودم كردم . با كمك api-text-viewer خود وي بي . ديگه انقدرها هم گاگول نيستم ;)
    منظورم از اين كه درست كار نميكنه ، اين بود كه جاي كاراكترهاي فارسي ، علامت سوال نشون ميده .
    و الا ارورهاش رو كه خودم برطرف كردم .
    حالا واسه ي اين مشكل ، راه حلي سراغ داري ؟
    :blink:
     
  12. karagah

    karagah کاربر تازه وارد

    تاریخ عضویت:
    ‏22 می 2004
    نوشته ها:
    63
    تشکر شده:
    0
    :cool:
    من یک تابع جدید برای تبدیل UTF8 به UTF16 نوشتم که درست کار می کنه. باید کنترل هایی رو استفاده کنید که از
    unicode پشتیبانی کنند. اگر هم UTF16 مناسب نیست ، می تونید با تابع StrConv به کد پیج سیستم تبدیلش کنید.

    فقط این تابع دو تا مشکل داره :
    1-فعلا از کارکترهای با کد بزرگتر از 65535 پشتیبانی نمی کنه.(ویندوز هم بصورت پیش فرض اون کارکتر ها رو نشون نمیده ;) )
    2- درستی رشته UTF8 رو چک نمی کنه . برای برنامه های با امنیت بالا باید این مشکل برطرف بشه. چون امکان
    هک شدن هست.
    کد:
    Function UTF8Decode(UTF8_Str As String) As String
        '-------------------------------------------------------
        ' UTF8Decode Beta version
        ' USE AT YOUR OWN RISK
        ' This Function Converts a UTF8 string to
        ' it's UTF16 equivalent.
        ' Limitations:
        '  -Does not support surrogated pairs
        '  -Does not check UTF8 validity so it may
        '   cause scurity problems.
        ' Coded by : Karagah (pt_karagah at yahoo dot com)
        ' You may use this code freely as long as this notice
        ' remains intact and appears on top of the code.
        '------------------------------------------------------
        Dim i, UTF8_Str_Length As Long
        Dim B1, B2, B3 As Byte
        Dim UTF16h, UTF16L As Long
        Dim Temp_Str As String
        Dim CodeLength As Integer
        'Dim Surrogated As Boolean
        
        
        UTF8_Str_Length = Len(UTF8_Str)
        i = 1
        Do While i <= UTF8_Str_Length
            
            B1 = Asc(Mid(UTF8_Str, i, 1))
            'Surrogated = False
             
             If B1 <= 127 Then
                CodeLength = 1
             ElseIf (B1 >= 192) And (B1 <= 223) Then
                CodeLength = 2
             ElseIf (B1 >= 224) And (B1 <= 239) Then
                CodeLength = 3
             ElseIf (B1 >= 240) And (B1 <= 247) Then
                CodeLength = 4
             End If
    
            Select Case CodeLength
                Case 1:
                    UTF16h = 0
                    UTF16L = B1
                Case 2:
                    i = i + 1
                    B2 = Asc(Mid(UTF8_Str, i, 1))
                    UTF16h = (B1 And 31) \ 4
                    UTF16L = (B1 And 3) * 64 + (B2 And 63)
                Case 3:
                    i = i + 1
                    B2 = Asc(Mid(UTF8_Str, i, 1))
                    i = i + 1
                    B3 = Asc(Mid(UTF8_Str, i, 1))
                    UTF16h = (B1 And 15) * 16 + (B2 And 63) \ 4
                    UTF16L = (B2 And 3) * 64 + (B3 And 63)
                Case 4:
                    'Surrogated pairs not supported in this version!
                    'Just return "?"
                    UTF16h = 0
                    UTF16L = 63
                
                Case Else
            End Select
            Temp_Str = Temp_Str + ChrW(UTF16h * 256 + UTF16L)
            i = i + 1
            
        Loop
        
        UTF8Decode = Temp_Str
    End Function
    
     
    کد نمونه برای نمایش الفبای فارسی:
    کد:
     
    Private Sub Command1_Click()
        
        Dim test As String
        'The Entire persian alphabet encoded in UTF8:
        test = Chr(216) & Chr(167) & Chr(32) & Chr(216) & Chr(168) & Chr(32) & Chr(217) & Chr(190) & Chr(32) & Chr(216) & Chr(170) & _
        Chr(32) & Chr(216) & Chr(171) & Chr(32) & Chr(216) & Chr(172) & Chr(32) & Chr(218) & Chr(134) & Chr(32) & Chr(216) & _
        Chr(173) & Chr(32) & Chr(216) & Chr(174) & Chr(32) & Chr(216) & Chr(175) & Chr(32) & Chr(216) & Chr(176) & Chr(32) & _
        Chr(216) & Chr(177) & Chr(32) & Chr(216) & Chr(178) & Chr(32) & Chr(218) & Chr(152) & Chr(216) & Chr(179) & Chr(32) & _
        Chr(216) & Chr(180) & Chr(32) & Chr(216) & Chr(181) & Chr(32) & Chr(216) & Chr(182) & Chr(32) & Chr(32) & Chr(216) & _
        Chr(183) & Chr(32) & Chr(216) & Chr(184) & Chr(32) & Chr(216) & Chr(185) & Chr(32) & Chr(216) & Chr(186) & Chr(32) & _
        Chr(217) & Chr(129) & Chr(32) & Chr(217) & Chr(130) & Chr(32) & Chr(218) & Chr(169) & Chr(32) & Chr(218) & Chr(175) & _
        Chr(32) & Chr(217) & Chr(132) & Chr(32) & Chr(217) & Chr(133) & Chr(32) & Chr(217) & Chr(134) & Chr(32) & Chr(217) & _
        Chr(136) & Chr(32) & Chr(217) & Chr(135) & Chr(32) & Chr(219) & Chr(140)
        
        textbox1.Font = "Airal"
        textbox2.Font = "Arial"
        
        textbox1.Text = test
        textbox2.Text = UTF8Decode(test)
        
        
    End Sub
    
    [​IMG]
     
عسل طبیعی و گرده گل ایرانیخدمات پی پال، وسترن یونیون