浙江移動(dòng)發(fā)送手機(jī)短信實(shí)例!!!!!!!!!!!!!!!!!!!!!!!
'****************************************************************************
'form1 窗體
dim userid as string
dim mobileno as string
dim checkrnd as string
dim longin as boolean
dim checkrndbox as string
public fileno as variant
dim ys as integer
dim su as long
dim sum as long
dim pas as string
private sub check2_click()
on error goto err1
if check2.value then
open app.path & "/" & text9.text for input as #fileno
else
close #fileno
end if
exit sub
err1:
stop
msgbox "打開文件出錯(cuò)"
end sub
private sub command1_click()
on error resume next
dim allcol
dim tagname as string
dim allcount, i
label2.caption = "準(zhǔn)備讀取數(shù)據(jù)"
set allcol = webbrowser1.document.all
allcount = allcol.length
for i = 0 to allcount - 1
tagname = allcol.item(i).tagname
if "input" = tagname then
tagname = allcol.item(i).name
select case tagname
case "userid"
userid = allcol.item(i).value
case "mobileno"
mobileno = allcol.item(i).value
end select
end if
next
timer5.enabled = true
exit sub
end sub
private sub command2_click()
timer5.enabled = true
end sub
private sub command3_click()
dim deskhdc&, ret&
dim pxy as pointapi
deskhdc = getdc(0)
pxy.x = me.left / screen.twipsperpixelx + picture1.left
pxy.y = me.top / screen.twipsperpixely + picture1.top + 17 + val(text1.text)
deskhdc = bitblt(picture2.hdc, 0, 0, picture1.width + val(text3.text), picture1.height + 6, deskhdc, pxy.x, pxy.y, vbsrccopy)
' stop
ret = releasedc(0&, deskhdc)
picture2.refresh
end sub
private sub command4_click()
dim i as double
dim y as integer
dim deskhdc&, ret&
dim pxy as pointapi
dim pxy1 as pointapi
dim pxy2 as pointapi
deskhdc = getdc(0)
pxy.x = me.left / screen.twipsperpixelx + picture1.left
pxy.y = me.top / screen.twipsperpixely + picture1.top + 17
pxy1.x = me.left / screen.twipsperpixelx + picture1.width + 5 + picture1.left
i = (pxy1.x - pxy.x) / 4
select case val(text1.text)
case 0
deskhdc = bitblt(picture2.hdc, 0, 0, i, picture1.height + 6, deskhdc, pxy.x + 2, pxy.y, vbsrccopy)
case 1
deskhdc = bitblt(picture2.hdc, 0, 0, i, picture1.height + 6, deskhdc, pxy.x + i + 1, pxy.y, vbsrccopy)
case 2
deskhdc = bitblt(picture2.hdc, 0, 0, i, picture1.height + 6, deskhdc, pxy.x + i * 2 + 1, pxy.y, vbsrccopy)
case 3
pxy1.x = me.left / screen.twipsperpixelx + picture1.width + picture1.left
i = (pxy1.x - pxy.x) / 4
deskhdc = bitblt(picture2.hdc, 0, 0, i + 2, picture1.height + 6, deskhdc, pxy.x + i * 3 + 3.5, pxy.y, vbsrccopy)
end select
ret = releasedc(0&, deskhdc)
picture2.refresh
end sub
private sub command5_click()
dim x1, y1 as integer
dim i as integer
dim h as integer
dim s as long
dim mu as long
y1 = picture2.scaleheight
'y2 = y1 * 7
x1 = picture2.scalewidth
'x2 = x1 * 8
'================
for i = 1 to x1
for h = 1 to y1
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
select case s
'1 30
'2 36
'3 36
'4 36
'5 31
'6 43
'7 23 24
'8 47
'9 42
'0 42
case 20
mu = 2
case 30
s = 0
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
if s = 25 then
mu = 5
else
mu = 1
end if
case 33, 14
mu = 3
case 35
s = 0
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
if s = 22 then
mu = 2
elseif s = 35 then
mu = 6
elseif s = 26 then
mu = 5
else
mu = 4
end if
case 36
s = 0
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
if s = 22 then
mu = 2
elseif s = 32 then
mu = 4
else
mu = 3
end if
case 31, 26
s = 0
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
if s = 23 then mu = 1 else mu = 5
case 37, 29
mu = 3
case 43
mu = 6
case 34
s = 0
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
if s = 36 then
mu = 6
elseif s = 22 then
mu = 2
else
mu = 0
end if
case 22, 23, 24, 25, 16
mu = 7
case 47, 50, 45
mu = 8
case 42
s = 0
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
if s = 37 then
mu = 9
else
mu = 0
end if
case 40, 41
mu = 9
case 21
s = 0
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
' stop
'8396800
if 0 = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
if s = 21 then
mu = 2
else
mu = 4
end if
case else
end select
pas = trim(pas & mu)
debug.print s & ": " & mu
end sub
private sub command6_click()
dim width5 as long, heigh5 as long, rgb5 as long
dim hdc5 as long, i as long, j as long
dim bblue as long, bred as long, bgreen as long
dim y as long
width5 = picture2.scalewidth
heigh5 = picture2.scaleheight
hdc5 = picture2.hdc
for i = 1 to width5
for j = 1 to heigh5
rgb5 = getpixel(hdc5, i, j)
' bblue = blue(rgb5) '獲得蘭色值
' bred = red(rgb5) '獲得紅色值
' bgreen = green(rgb5) '獲得綠色值
'將三原色轉(zhuǎn)換為灰度
' y = (9798 * bred + 19235 * bgreen + 3735 * bblue) / 32768
'將灰度轉(zhuǎn)換為rgb
' rgb5 = rgb(y, y, y)
if rgb5 > rgb(130, 130, 130) then
rgb5 = rgb(255, 255, 255)
else
rgb5 = rgb(0, 0, 0)
end if
setpixelv hdc5, i, j, rgb5
next j
next i
set picture2.picture = picture2.image
end sub
private sub command7_click()
thd
end sub
private sub command8_click()
timer3.enabled = true
end sub
private sub command9_click()
dim x1, y1 as integer
dim i as integer
dim h as integer
dim s as long
dim mu as long
s = 0
y1 = picture2.scaleheight
x1 = picture2.scalewidth
for i = 1 to x1
for h = 1 to y1 / 5 * 3
doevents
if val(text5.text) = getpixel(me.picture2.hdc, i, h) then
s = s + 1
end if
next h
next i
me.caption = s
end sub
private sub form_load()
on error resume next
fileno = freefile
smonth.text = val(format$(now, "mm"))
me.sday.text = val(format$(now, "dd"))
me.shour.text = val(format$(now, "hh"))
me.sminute.text = val(format$(now, "nn"))
enablewindow picture1.hwnd, 0
vscroll1.value = webbrowser1.top
text10.text = webbrowser1.top
'me.caption = app.path
end sub
private sub list1_click()
end sub
private sub picture2_dragdrop(source as control, x as single, y as single)
picture3.backcolor = getpixel(picture2.hdc, x, y)
end sub
private sub picture2_dragover(source as control, x as single, y as single, state as integer)
picture3.backcolor = getpixel(picture2.hdc, x, y)
end sub
private sub picture3_dragdrop(source as control, x as single, y as single)
picture3.backcolor = getdccolor()
text5.text = getdccolor()
end sub
private sub picture3_dragover(source as control, x as single, y as single, state as integer)
picture3.backcolor = getdccolor()
text5.text = getdccolor()
end sub
public function getdccolor() as double
dim deskhdc&, ret&
dim pxy as pointapi
' get desktop dc
deskhdc = getdc(0)
'get mouse position
getcursorpos pxy
getdccolor = getpixel(deskhdc, pxy.x, pxy.y) 'getcursorpos(pxy.x), getcursorpos(pxy.y))
ret& = releasedc(0&, deskhdc)
end function
private sub text10_keydown(keycode as integer, shift as integer)
if keycode = 13 then
webbrowser1.top = val(text10.text)
end if
end sub
private sub text2_change()
label2.caption = "內(nèi)容長度:" & len(text2.text)
end sub
private sub timer1_timer()
dim lu as long
dim currenttick as double
dim doc, objhtml as object
dim i as integer
dim strhtml as string
if not me.webbrowser1.busy then
set doc = webbrowser1.document
set objhtml = doc.body.createtextrange()
if not isnull(objhtml) then
on error resume next
dim allcol
dim tagname as string
dim allcount
label2.caption = "準(zhǔn)備讀取數(shù)據(jù)"
set allcol = webbrowser1.document.all
allcount = allcol.length
text4.text = objhtml.htmltext
if not longin then
lu = instr(text4.text, "用戶登陸")
if lu <> 0 then
'登陸未成功
me.label2.caption = "用戶密碼出錯(cuò)"
exit sub
else
'登陸成功
longin = true
label2.caption = "登陸成功"
end if
end if
currenttick = gettickcount()
do
doevents
loop while gettickcount - 100 < currenttick
'command1_click
for i = 0 to allcount - 1
tagname = allcol.item(i).tagname
if "input" = tagname then
tagname = allcol.item(i).name
select case tagname
case "userid"
userid = allcol.item(i).value
case "mobileno"
mobileno = allcol.item(i).value
end select
end if
next
' debug.print userid & mobileno
pas = ""
su = 0
ys = 0
timer5.enabled = true
timer2.enabled = false
' checkrnd
timer1.enabled = false
end if
end if
end sub
private sub timer2_timer()
dim lu as long
dim doc, objhtml as object
dim i as integer
dim strhtml as string
if not me.webbrowser1.busy then
set doc = webbrowser1.document
set objhtml = doc.body.createtextrange()
if not isnull(objhtml) then
text4.text = objhtml.htmltext
' stop
' msgbox text4.text
lu = instr(text4.text, "短信發(fā)送成功")
if lu <> 0 then
label2.caption = "信息發(fā)送成功"
if check1.value = checked then
if val(text12.text) < 2 then
接收手機(jī)號(hào)碼.text = val(接收手機(jī)號(hào)碼.text) + 1
else
接收手機(jī)號(hào)碼.text = val(接收手機(jī)號(hào)碼.text) + val(text12.text)
end if
if val(接收手機(jī)號(hào)碼.text) > val(me.text7.text) then check1.value = unchecked
end if
if val(trim$(text12.text)) > 1 then
for i = 1 to val(text12.text)
me.list1.additem (me.list1.listcount + 1) & ": " & val(接收手機(jī)號(hào)碼.text) - val(text12.text) + i & " " & "成功"
me.list1.selected(me.list1.listcount - 1) = true
next i
else
me.list1.additem (me.list1.listcount + 1) & ": " & val(接收手機(jī)號(hào)碼.text) & " " & "成功"
me.list1.selected(me.list1.listcount - 1) = true
end if
'____________________________________
me.webbrowser1.navigate "http://211.140.32.131//msgsendchoose.jsp?zmcccatalog=0801"
timer1.enabled = true
else
label2.caption = "信息發(fā)送失敗"
me.webbrowser1.navigate "http://211.140.32.131//msgsendchoose.jsp?zmcccatalog=0801"
timer1.enabled = true
timer5.enabled = false
timer2.enabled = false
'if 號(hào)碼重試.value = vbchecked then
' call 發(fā)送_click
'end if
' timer1.enabled = true
end if
timer2.enabled = false
end if
end if
end sub
private sub timer3_timer()
timer3.enabled = false
on error resume next
if not eof(fileno) then
line input #fileno, myline
me.接收手機(jī)號(hào)碼.text = trim(myline)
call 發(fā)送_click
else
me.check2.value = unchecked
exit sub
end if
end sub
private sub timer5_timer()
dim currenttick as double
if check3.value = vbchecked then
text1.text = su
command4_click
currenttick = gettickcount()
do
doevents
loop while gettickcount - 100 < currenttick
command6_click
currenttick = gettickcount()
do
doevents
loop while gettickcount - 100 < currenttick
command5_click
su = su + 1
ys = ys + 1
else
ys = 4
pas = text8.text
end if
if ys > 3 then
timer5.enabled = false
text8.text = pas
checkrndbox = val(text8.text)
label2.caption = "讀取數(shù)據(jù)成功"
'-------------------------------------------
if check1.value = checked then 發(fā)送_click
if check2.value = checked then timer3.enabled = true
end if
end sub
private sub timer6_timer()
dim doc, objhtml as object
if not me.webbrowser1.busy then
'錯(cuò)誤信息
set doc = webbrowser1.document
set objhtml = doc.body.createtextrange()
if not isnull(objhtml) then
dim sd as string
sd = objhtml.htmltext
if instr(sd, username.text) = 0 then
end
' msgbox sd
end if
timer6.enabled = false
call 登陸_click
timer1.enabled = true
'call command1_click
end if
end if
end sub
private sub userpass_keydown(keycode as integer, shift as integer)
if keycode = 13 then
call 登陸_click
timer1.enabled = true
label2.caption = "正在登陸..."
end if
end sub
private sub vscroll1_change()
webbrowser1.top = vscroll1.value
text10.text = webbrowser1.top
end sub
private sub webbrowser1_newwindow2(ppdisp as object, cancel as boolean)
' cancel = true
end sub
private sub webbrowser1_progresschange(byval progress as long, byval progressmax as long)
on error resume next
progressbar1.max = progressmax
progressbar1.value = progress
end sub
private sub 登陸_click()
dim cparamname as string
dim cparamflavor as string
dim cseparator as string
dim cpostdata as string
redim abyte(0) as byte
dim edtpostdata as string
dim i as integer
cparamname = "username="
cparamflavor = "userpass="
cseparator = "&"
cpostdata = cparamname & username.text _
& cseparator & cparamflavor & userpass.text & cseparator & "refer=/msgsendchoose.jsp?zmcccatalog=0801"
packbytes abyte(), cpostdata
for i = lbound(abyte) to ubound(abyte)
edtpostdata = edtpostdata + chr(abyte(i))
next
dim vpost as variant
vpost = abyte
dim vflags as variant
dim vtarget as variant
dim vheaders as variant
vheaders = _
"content-type: application/x-www-form-urlencoded" _
+ chr(10) + chr(13)
form1.webbrowser1.navigate "http://211.140.32.131//loginaction.do", _
vflags, vtarget, vpost, vheaders
ys = 0
su = 0
pas = ""
end sub
private sub 發(fā)送_click()
' sum = sum + 1
dim st as string
dim cparamname as string
dim cparamflavor as string
dim cseparator as string
dim i as integer
dim cpostdata as string
dim edtpostdata as string
dim cpara as string
redim abyte(0) as byte
dim sum1 as double
dim cmode as string
' if (60 - len(trim$(text2.text))) >= 1 then st = space$(2 * (60 - len(trim$(text2.text))))
label2.caption = "準(zhǔn)備發(fā)送信息"
doevents
body.text = urlencode(text2.text & st)
if me.是否定時(shí).value then
cmode = "mode=1"
else
cmode = "mode=0"
end if
'& mobileno
cseparator = "&"
if val(text12.text) < 2 and check1.value <> vbchecked then
' stop '-----(len(text2.text) - 11)
cpostdata = "userid=" & userid & cseparator & "mobileno=" & mobileno & cseparator & "body=" & body.text & cseparator & "len=" & 10 & cseparator & "destaddr2=" & 接收手機(jī)號(hào)碼.text _
& cseparator & "checkrndbox=" & trim(text8.text) & cseparator & cmode _
& cseparator & "year=2004" & cseparator & "month=" & smonth.text & cseparator & "day=" & sday.text & cseparator & "hour=" & shour.text & cseparator & "minute=" & sminute.text & cseparator & cmode & cseparator & "radiobutton=radiobutton" & cseparator & "dx=" & cseparator & "dx2="
else
dim st1 as string
for i = 0 to val(text12.text)
st1 = st1 & (val(接收手機(jī)號(hào)碼.text) + i) & ";"
next i
' msgbox mid(st1, 1, len(st1) - 1)
'stop
cpostdata = "userid=" & userid & cseparator & "mobileno=" & mobileno & cseparator & "body=" & body.text & cseparator & "len=" & (len(text2.text) - 11) & cseparator & "destaddr2=" & st1 _
& cseparator & "checkrndbox=" & trim(text8.text) & cseparator & cmode _
& cseparator & "year=2004" & cseparator & "month=" & smonth.text & cseparator & "day=" & sday.text & cseparator & "hour=" & shour.text & cseparator & "minute=" & sminute.text & cseparator & cmode & cseparator & "radiobutton=radiobutton" & cseparator & "dx=" & cseparator & "dx2="
end if
packbytes abyte(), cpostdata
for i = lbound(abyte) to ubound(abyte)
edtpostdata = edtpostdata + chr(abyte(i))
next
dim vpost as variant
vpost = abyte
' debug.print cpostdata
dim vflags as variant
dim vtarget as variant
dim vheaders as variant
vheaders = _
"content-type: application/x-www-form-urlencoded" _
+ chr(10) + chr(13)
me.webbrowser1.navigate "http://211.140.32.131//msgsendchooseaction.do", _
vflags, vtarget, vpost, vheaders
label2.caption = "提交信息"
timer2.enabled = true
pas = ""
su = 0
ys = 0
'*******************************
' if sum > 100 then end
' password.text = ""
end sub
'********************************************************
'module1
public type pointapi
x as long
y as long
end type
public declare function setpixel lib "gdi32" (byval hdc as long, byval x as long, byval y as long, byval crcolor as long) as long
public declare function gettickcount lib "kernel32" () as long
public declare function enablewindow lib "user32" (byval hwnd as long, byval fenable as long) as long
public declare function getpixel lib "gdi32" (byval hdc as long, byval x as long, byval y as long) as long
public declare function getdc lib "user32" (byval hwnd as long) as long
public declare function stretchblt lib "gdi32" (byval hdc as long, byval x as long, byval y as long, byval nwidth as long, byval nheight as long, byval hsrcdc as long, byval xsrc as long, byval ysrc as long, byval nsrcwidth as long, byval nsrcheight as long, byval dwrop as long) as long
public const srccopy = &hcc0020
public declare function releasedc lib "user32" (byval hwnd as long, byval hdc as long) as long
public declare function bitblt lib "gdi32" (byval hdestdc as long, byval x as long, byval y as long, byval nwidth as long, byval nheight as long, byval hsrcdc as long, byval xsrc as long, byval ysrc as long, byval dwrop as long) as long
public declare function getcursorpos lib "user32" (lppoint as pointapi) as long
public declare function setpixelv lib "gdi32" _
(byval hdc as long, byval x as long, _
byval y as long, byval crcolor as long) as long
private declare function createthread lib "kernel32" (byval lpthreadattributes as any, byval dwstacksize as long, byval lpstartaddress as long, lpparameter as any, byval dwcreationflags as long, lpthreadid as long) as long
private declare function resumethread lib "kernel32" (byval hthread as long) as long
private declare function setthreadpriority lib "kernel32" (byval hthread as long, byval npriority as long) as long
private declare function getthreadpriority lib "kernel32" (byval hthread as long) as long
private declare function suspendthread lib "kernel32" (byval hthread as long) as long
private declare function terminatethread lib "kernel32" (byval hthread as long, byval dwexitcode as long) as long
public declare function closehandle lib "kernel32" (byval hobject as long) as long
private h1 as integer, h2 as integer, h3 as integer
private s_run4 as boolean, s_run3 as boolean, s_run2 as boolean, s_run1 as boolean
public function urlencode(byref strurl as string) as string
dim i as long
dim tempstr as string
for i = 1 to len(strurl)
if asc(mid(strurl, i, 1)) < 0 then
tempstr = "%" & right(cstr(hex(asc(mid(strurl, i, 1)))), 2)
tempstr = "%" & left(cstr(hex(asc(mid(strurl, i, 1)))), len(cstr(hex(asc(mid(strurl, i, 1))))) - 2) & tempstr
urlencode = urlencode & tempstr
elseif (asc(mid(strurl, i, 1)) >= 65 and asc(mid(strurl, i, 1)) <= 90) or (asc(mid(strurl, i, 1)) >= 97 and asc(mid(strurl, i, 1)) <= 122) then
urlencode = urlencode & mid(strurl, i, 1)
else
urlencode = urlencode & "%" & hex(asc(mid(strurl, i, 1)))
end if
doevents
next
end function
public function urldecode(byref strurl as string) as string
dim i as long
if instr(strurl, "%") = 0 then urldecode = strurl: exit function
for i = 1 to len(strurl)
if mid(strurl, i, 1) = "%" then
if val("&h" & mid(strurl, i + 1, 2)) > 127 then
urldecode = urldecode & chr(val("&h" & mid(strurl, i + 1, 2) & mid(strurl, i + 4, 2)))
i = i + 5
else
urldecode = urldecode & chr(val("&h" & mid(strurl, i + 1, 2)))
i = i + 2
end if
else
urldecode = urldecode & mid(strurl, i, 1)
end if
doevents
next
end function
public sub packbytes(bytearray() as byte, byval postdata as string)
dim inewbytes as long
inewbytes = len(postdata) - 1
if inewbytes < 0 then
exit sub
end if
redim bytearray(inewbytes)
for i = 0 to inewbytes
ch = mid(postdata, i + 1, 1)
doevents
if ch = space(1) then
ch = "+"
end if
bytearray(i) = asc(ch)
next
end sub
