جزء من الكود لالتقاط عنوان البريد الإلكتروني لمنتدى Dongwang
/**
المؤلف: Ci Qinqiang
البريد الإلكتروني: [email protected]
**/
لقد فكرت مؤخرًا في كيفية الترويج لموقعنا الجديد http://www.up114.com .
يعد تحسين محرك البحث هو الخيار الأول بطبيعة الحال، ولكن لا يمكنك التخلي عن البريد الجماعي، على الرغم من احتقار البريد الجماعي،
طالما حددت هدف البريد الجماعي وأرسلت أقل، فلا بأس، :=——. .
لذلك وجدت بعض المنتديات حول مواضيع ذات صلة، والعديد منها عبارة عن منتديات Dongwang. والآن أحتاج إلى
جمع عناوين البريد الإلكتروني لمستخدمي المنتدى. وهناك أيضًا أدوات خاصة تُباع عبر الإنترنت، ولكن اليوم سنكتب أداة صغيرة بأنفسنا، والتي يمكن تحقيقها أيضًا نفس الهدف.
الكود كما يلي. استخدم أدوات تحرير النص مثل Notepad لحفظه بتنسيق dv.vbs.
قبل استخدامه، عليك الذهاب إلى المنتدى والتسجيل كمستخدم وتسجيل الدخول.
الاستخدام: c:cscript dv.vbs جيد.
'موقع تخزين عناوين البريد الإلكتروني المجمعة
strFile = "d:email.txt"
srtUrl = " http://bbs.aaa.com "
iStart = 1 'الحد الأدنى لقيمة معرف المستخدم
iEnd = 1000 'الحد الأقصى لقيمة معرف المستخدم
i= iStart إلى iEnd
strUrl1 = strUrl & "/dispuser.asp?id=" & cstr(i)
strRet = OpenUrl(strurl1)
strRet = getMid(strRet"،mailto:"،>") 'قد يحتاج هذا المكان إلى التغيير بمرونة
إذا قمت بتعديل 100=0
استدعاء WriteToFile(strFile,strA)
سترا = ""
آخر
إذا strRet<>"" ثم strA = strA & strRet & vbCrLf
نهاية إذا
Wscript.Echo i & vbTab & strRet
التالي
Sub WriteToFile(strFile,str)
خافت fso، f
تعيين fso = CreateObject("Scripting.FileSystemObject")
تعيين f = fso.OpenTextFile(strfile, 8, True)
f.اكتب شارع
تعيين و = لا شيء
تعيين fso=لا شيء
نهاية الفرعية
البايتات الدالة 2BSTR(vIn)
خافت ط
strReturn = ""
لأني = 1 إلى LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
إذا كان ThisCharCode < &H80 إذن
strReturn = strReturn & Chr(ThisCharCode)
آخر
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
ط = ط + 1
نهاية إذا
التالي
bytes2BSTR = strReturn
وظيفة النهاية
الدالة OpenUrl(strUrl)
عند حدوث خطأ في استئناف
المجموعة التالية xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "GET"،(strUrl)،خطأ
xmlhttp.send
OpenUrl=bytes2BSTR(xmlhttp.ResponseBody)
اضبط xmlhttp = لا شيء
النهاية
getMid(str, str1, str2)
خافت ط
ي
str11 = ""
أنا = InStr(شارع، str1)
إذا كنت> 0 ثم
ي = InStr(i، str، str2)
إذا ي > 0 ثم
str11 = منتصف (شارع، ط + لين (str1)، ي - ط - لين (str1))
نهاية إذا
نهاية إذا
getMid = str11
وظيفة النهاية