Parsi Coders
دریافت سورس سایت بصورت یونیکد - نسخه قابل چاپ

+- Parsi Coders (http://parsicoders.com)
+-- انجمن: Software Development Programming (http://parsicoders.com/forumdisplay.php?fid=37)
+--- انجمن: Visual Basic Programming (http://parsicoders.com/forumdisplay.php?fid=39)
+---- انجمن: Visual Basic 6 (http://parsicoders.com/forumdisplay.php?fid=44)
+---- موضوع: دریافت سورس سایت بصورت یونیکد (/showthread.php?tid=3560)



دریافت سورس سایت بصورت یونیکد - aleas - 06-02-2014

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

چطور میتونم سورس سایت دریافت کنم بصورت یونیکد باشه؟

کد پی‌اچ‌پی:
Private  Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA"  (ByVal sAgent As StringByVal lAccessType As LongByVal sProxyName As  StringByVal sProxyBypass As StringByVal lFlags As Long) As Long
Private  Declare Function InternetOpenUrl Lib "wininet.dll" Alias  "InternetOpenUrlA" (ByVal hInternetSession As LongByVal sURL As  StringByVal sHeaders As StringByVal lHeadersLength As LongByVal  lFlags As LongByVal lContext As Long) As Long
Private  Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As  LongByVal sBuffer As StringByVal lNumBytesToRead As Long,  lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Const IF_FROM_CACHE = &H1000000
Private Const IF_MAKE_PERSISTENT = &H2000000
Private Const IF_NO_CACHE_WRITE = &H4000000
Private Const BUFFER_LEN 256
   
Public Function GetSource(sURL As String) As String
    Dim sBuffer 
As String BUFFER_LENiResult As IntegersData As String
    Dim hInternet 
As LonghSession As LonglReturn As Long
    hSession 
InternetOpen("vb wininet"1vbNullStringvbNullString0)
    If 
hSession Then hInternet InternetOpenUrl(hSessionsURLvbNullString0IF_NO_CACHE_WRITE0)
    If 
hInternet Then
        iResult 
InternetReadFile(hInternetsBufferBUFFER_LENlReturn)
        
sData sBuffer
        
Do While lReturn <> 0
            iResult 
InternetReadFile(hInternetsBufferBUFFER_LENlReturn)
            
sData sData Mid(sBuffer1lReturn)
        
Loop
    End 
If
    
iResult InternetCloseHandle(hInternet)
    
GetSource sData
End 
Function 
 


RE: دریافت سورس سایت بصورت یونیکد - aleas - 06-07-2014

کسی در این مورد نمیتونه  راهنمایی کنه؟


RE: دریافت سورس سایت بصورت یونیکد - Amin_Mansouri - 06-07-2014

با این دستور ذخیره کن :


کد:
Option Explicit
Private Sub Command1_Click()
WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub
Form_Load()
WebBrowser1.Navigate2 "www.google.com"
End Sub

 


RE: دریافت سورس سایت بصورت یونیکد - aleas - 06-07-2014

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

اول microsoft activex data objects 2.5 library اضافه کنین

و اینم کد
کد پی‌اچ‌پی:
Option Compare Text
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As StringByVal lAccessType As LongByVal sProxyName As StringByVal sProxyBypass As StringByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As LongByVal sURL As StringByVal sHeaders As StringByVal lHeadersLength As LongByVal lFlags As LongByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As LongByVal sBuffer As StringByVal lNumBytesToRead As LonglNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Const IF_FROM_CACHE = &H1000000
Private Const IF_MAKE_PERSISTENT = &H2000000
Private Const IF_NO_CACHE_WRITE = &H4000000
Private Const BUFFER_LEN 256
Public Function GetSource(sURL As String) As String
    Dim sBuffer 
As String BUFFER_LENiResult As IntegersData As String
    Dim hInternet 
As LonghSession As LonglReturn As Long
    hSession 
InternetOpen("vb wininet"1vbNullStringvbNullString0)
    If 
hSession Then hInternet InternetOpenUrl(hSessionsURLvbNullString0IF_NO_CACHE_WRITE0)
    If 
hInternet Then
        iResult 
InternetReadFile(hInternetsBufferBUFFER_LENlReturn)
        
sData sBuffer
        
Do While lReturn <> 0
            iResult 
InternetReadFile(hInternetsBufferBUFFER_LENlReturn)
            
sData sData Mid(sBuffer1lReturn)
        
Loop
    End 
If
    
iResult InternetCloseHandle(hInternet)
    
GetSource sData
End 
Function
 
 
 
Private 
Sub Command1_Click()
 
   
out2 GetSource("http://www.google.com")
 
    
Open App.Path "\web.txt" For Output As #1
    
Print #1, out2
    
Close #1
     
    
Dim objStreamstrData
Set objStream 
CreateObject("ADODB.Stream")
objStream.Charset "utf-8"
objStream.Open
objStream
.LoadFromFile (App.Path "\web.txt")
text1.Text objStream.ReadText()
     
End Sub