سریعترین روش دریافت سورس سایت

[aleas2]

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

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

[aleas2]

ضمنا" دوستان از این روش استفاده میکنم ولی متاسفانه متن فارسی به شکل ناخوانا نمایش میده


Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal 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_LEN, iResult As Integer, sData As String
Dim hInternet As Long, hSession As Long, lReturn As Long
hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
If hInternet Then
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sBuffer
Do While lReturn <> 0
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sData + Mid(sBuffer, 1, lReturn)
Loop
End If
iResult = InternetCloseHandle(hInternet)
GetSource = sData
End Function

[SilverLearn]

درود

ببینید لینک زیر می تونه بهتون کمک کنه

http://vbnet.mvps.org/index.html?code/internet/urldownloadtofilenocache.htm

[aleas2]

چرا حروف فارسی در سورس به شکل ناخوانا برمیگردونه؟

[aleas2]

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


Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal 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_LEN, iResult As Integer, sData As String
Dim hInternet As Long, hSession As Long, lReturn As Long
hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
If hInternet Then
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sBuffer
Do While lReturn <> 0
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sData + Mid(sBuffer, 1, lReturn)
Loop
End If
iResult = InternetCloseHandle(hInternet)
GetSource = sData
End Function

[meys34]

سلام

این روش هنگی نداره؟

فکر کنم مشکل از این توابعتون باشه

InternetOpenA
InternetOpenUrlA

همونطور که میبیند آخرشون با حرف A تموم میشه یعنی Ansi
شما باید بگردید جایگزین این ها رو پیدا کنید که Unicode باشه یعنی آخرش W داشته باشه مثلا

InternetOpenW
InternetOpenUrlW

البته نحوه فراخوانی فرق میکنه لابد....

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

[aleas2]

یه روش خودم پیدا کردم

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

و اینم کد

Option Compare Text
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal 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_LEN, iResult As Integer, sData As String
Dim hInternet As Long, hSession As Long, lReturn As Long
hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
If hInternet Then
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sBuffer
Do While lReturn <> 0
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sData + Mid(sBuffer, 1, lReturn)
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 objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile (App.Path & "\web.txt")
text1.Text = objStream.ReadText()

End Sub