ورود

View Full Version : مشکل Inet


aleas2
چهارشنبه 11 خرداد 1390, 17:08 عصر
سلام خسته نباشید چرا من از کد زیر استفاده میکنم


Text1 = Inet1.OpenURL("http://www.google.com")

سورس کامل نمیده مثلا برای گوگل فقط این کد پایینی رو میده تعداد کاراکترهای سورس صفحه هم زیاد نیسته که بگیم تو textbox جا نمیشه مشکل چی؟


<!doctype html><html><head><meta http-equiv="content-type" content="text/html; charset=ISO-8859-1"><title>Google</title><script>window.google={kEI:"IjfmTZngOZCq8QOkntTCCQ",kEXPI:"28505,29134,29229,29695,29795,29810,29892,30111,30 275,30525,30547",kCSI:{e:"28505,29134,29229,29695,29795,29810,29892,30111,30 275,30525,30547",ei:"IjfmTZngOZCq8QOkntTCCQ",expi:"28505,29134,29229,29695,29795,29810,29892,30111,30 275,30525,30547"},authuser:0,ml:function(){},kHL:"en",time:function(){return(new Date).getTime()},
log:function(c,d,b){var a=new Image,e=google,g=e.lc,f=e.li;a.onerror=(a.onload=( a.onabort=function(){delete g[f]}));g[f]=a;b=b||"/gen_204?atyp=i&ct="+c+"&cad="+d+"&zx="+google.time();a.src=b;e.li=f+1},lc:[],li:0,
Toolbelt:{}};

window.google.sn="webhp";var i=window.google.timers={};window.google.startTick= functio
محسن واژدی
چهارشنبه 11 خرداد 1390, 19:18 عصر
سلام علیکم
کد زیر محتویات یک سایت را کاملا" برمیگرداند،

موفق باشید


Option Explicit

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0

Private Const INTERNET_OPEN_TYPE_DIRECT = 1

Private Const INTERNET_OPEN_TYPE_PROXY = 3

Private Const scUserAgent = "VB Project"

Private Const INTERNET_FLAG_RELOAD = &H80000000

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 hOpen As Long, _
ByVal sUrl As String, _
ByVal sHeaders As String, _
ByVal lLength 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

Public Function GetWebContents(ByVal sUrl As String) As String
Dim hOpen As Long

Dim hOpenUrl As Long

Dim bDoLoop As Boolean

Dim bRet As Boolean

Dim sReadBuffer As String * 2048

Dim lNumberOfBytesRead As Long

Dim sBuffer As String

hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)

hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)

bDoLoop = True

While bDoLoop

sReadBuffer = vbNullString
bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)

If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
DoEvents
Wend

If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
GetWebContents = sBuffer

End Function
aleas2
چهارشنبه 11 خرداد 1390, 20:03 عصر
ببخشید میشه طرز استفاده از کد هم بگین بنده که متوجه نشدم
Mr'Jamshidy
چهارشنبه 11 خرداد 1390, 20:16 عصر
خیلی سادس اول کد هایی که براتون گزاشتن رو کپی کنید تو یک ماژول بعد هر جا خواستید اطلاعات یک سایت رو بدست بیارید از این کد استفاده کنید
WebData = GetWebContents("http://barnamenevis.org")
aleas2
پنج شنبه 12 خرداد 1390, 08:59 صبح
این کد کارشو درست انجام میده ولی وقتی چند تا سایت میگی یکی یکی باز کنه سورسشو بده هنگ میکنه صفحه سفید میشه چکار کنم هنگ نکنه؟
Mr'Jamshidy
پنج شنبه 12 خرداد 1390, 09:59 صبح
بهتره از کد های زیر استفاده کنی

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

http://barnamenevis.org/attachment.php?attachmentid=69642&d=1304774554
http://barnamenevis.org/attachment.php?attachmentid=69648&d=1304781523
aleas2
پنج شنبه 12 خرداد 1390, 14:07 عصر
سلام
متاسفانه هیچکدوم سالم نبودن
محسن واژدی
پنج شنبه 12 خرداد 1390, 15:58 عصر
این کد کارشو درست انجام میده ولی وقتی چند تا سایت میگی یکی یکی باز کنه سورسشو بده هنگ میکنه صفحه سفید میشه چکار کنم هنگ نکنه؟

سلام علیکم
برای اینکه سورس با موفقیت انجام عمل کند حتما" باید عملیات قبل پایان یافته و هندلش بسته باشد وگرنه برنامه crash میکند؛ اگر به انتهای کدها نگاه کنین دو دستور مشاهده میکنید بصورت زیر:

If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)

که هندل عملیات شروع شده را میبندند، شما میتوانید با حذف دستور شرط و قرار دادن اینها قبل از حلقه While هندلی که احیانا" از قبل باز است را ببندید که در این صورت برنامه متوقف نمیشود

موفق باشید
aleas2
یک شنبه 15 خرداد 1390, 15:25 عصر
بازم هنگ میکنه
یعنی هیچ روشی نیسته سورس سایت در سریع ترین زمان ممکنه بهم بده بدون اینکه فرم هنگ کنه؟
aleas2
یک شنبه 15 خرداد 1390, 20:18 عصر
طرز گرفتن سورس با Inet همینجوری؟

Text1 = Inet1.OpenURL("www.google.com")
Text2 = Inet1.OpenURL("www.gmail.com")
Text3 = Inet1.OpenURL("www.yahoo.com")