سيو اچ تي ام ال

[asosh2003]

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

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

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

ممنون

 

[karagah]

سلام
دوست عزیز کاش سوالتون رو دقیقتر مطرح کرده بودید.مثلا این صفحات 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

 

[asosh2003]

ممنون
حالا همين روش رو امتحان مي‌كنم تا ببينم چي مي‌شه .
راستی ! می‌شه کاری کرد که ای اس پی ، بدون استایل شیتش بارگذاری بشه ؟

 

[asosh2003]

كارآگاه جان !
ببين ! من دقيقا مي گم مي خوام چي كار كنم ، تو همين دقيقا راهنمايي‌م کن . دستت درد نکنه
یک سری صفحه‌ی ای اس پی هست ، که من می‌خوام روی دستگاه خودم سیوشون کنم . البته اچ تی ام ال دیگه .
کاری که می‌خوام بکنم ، اینه که ای صفحه‌ها رو ، بدون استایل شیتشون لود کنم و بعد هم سیو .
این رو هم داشته باش که این صفحه‌ها ، یونیکد سیو می‌شن .
بعد از این که اون‌ها رو آوردم روی دستگاهم ، می‌خوام با اچ تی ام ال‌هاشون یه کارهایی بکنم . اما تا حالا هر کاری که کردم ، وی بی شیش نتونسته یونیکد رو بشناسه .
می‌گی چی کار کنم ؟
اگه سریع جواب بدی ، واقعا ممنون می‌شم .
چون کارم واقعا لنگ مونده .

 

[karagah]

دوست عزيز
رشته ها در 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

 

[asosh2003]

كارآگاه جان ممنون

 

[karagah]

:happy: .

 

[asosh2003]

كارآگاه كار نميكنه
ريچ تكست باكس هم ، "ي"ها رو "؟" نشون ميده .
چي كار كنم ؟ :blink:

 

[karagah]

شرمنده ! من تعريف API ها رو ننوشته بودم. آخر پست 5 مي نويسمش. بايد اونها رو در قسمت decleration پيست كنيد.
اگه بازم كار نكرد همينجا مطرح كنيد.

 

[asosh2003]

كارآگاه ! اون كار رو كه خودم كردم . با كمك api-text-viewer خود وي بي . ديگه انقدرها هم گاگول نيستم
منظورم از اين كه درست كار نميكنه ، اين بود كه جاي كاراكترهاي فارسي ، علامت سوال نشون ميده .
و الا ارورهاش رو كه خودم برطرف كردم .
حالا واسه ي اين مشكل ، راه حلي سراغ داري ؟
:blink:

 

[karagah]

من یک تابع جدید برای تبدیل 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