HOME
はじめに

みなさんリードメールされていますか？私はリードメールマニアくらい？してます。リドメを始めたのはいいが三日坊主に終わっている方、比較的多いのではないでしょうか。とか言うわたくし、にゃんくろも初めの頃はそうでした。

リドメの問題点はいくつかありますが、やはり一通当たりの報酬単価が小さいことです。さらにそれに追い討ちをかけるように殆どのリドメが先着500クリック、1500クリックなど制限があることで、深夜まとめてクリックしようものなら、

「この広告は規定のクリック数に達しています。」

などと言う画面にうんざりさせられた経験があると思います。

それを防ぐためにはメールが届くたびにクリックするのが一番だと誰でも気づかれるはずです。がしかし、メールを受信してその後ヤフーなどのWebメールまたは、Outlookなどのメールソフトで開いてはクリックしなければならないのは始めのうちはよいのですが、慣れてくるとだんだん億劫になってきます。

ここではなるべくCMサイトのように動画CMを眺めるように、次々と広告が表示されるような使い勝手を実現されるべく、工夫してみんさんが楽しみながら報酬を得られるようなサイトにしていきたいと思っています。
　
流石メールPTCラクラク閲覧プログラム
　
まだVisual Basic5本体をインストールしてない方はコチラ
　
PTCプログラムPtcSasuga5.zipをダウンロード・解凍して下さい。
　
PTCのソースプログラムPtcSasuga5.vbpの内容
Dim Cnt As Byte
Dim LinksCnt As Byte
Dim Timer1Row As Integer

Private Sub Form_Load()
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php"
WebBrowser2.Navigate "http://sasuga.biz/pages/ptc.php"
Cnt = 0
vsFlexArray1.Rows = 1
WebBrowser1.Silent = True
WebBrowser2.Silent = True
End Sub

Private Sub Timer1_Timer()

Dim ChrNum As Long
Dim Len1 As Long
Dim Len2 As Long
Dim FRAMESET As Boolean

If WebBrowser2.Document.ReadyState = "complete" Then

Str1$ = WebBrowser2.Document.Body.outerhtml
RichTextBox1.Text = Str1$

Len1 = Val(Len(Str1$))
Str2$ = "FRAMESET"
Len2 = Val(Len(Str2$))

FRAMESET = False
For ChrNum = 1 To Len1 - Len2
Str3$ = Mid$(Str1$, ChrNum, Len2)
If Str2$ = Str3$ Then

FRAMESET = True
Exit For

End If
Next

On Error GoTo Error1
If FRAMESET = True Then

'Error1:
Str1$ = WebBrowser2.Document.frames(0).Document.Body.innerhtml
Error1:
RichTextBox2.Text = Str1$

Len1 = Val(Len(Str1$))
Str2$ = "報酬は加算されました"
Len2 = Val(Len(Str2$))

For ChrNum = 1 To Len1 - Len2
Str3$ = Mid$(Str1$, ChrNum, Len2)
If Str2$ = Str3$ Then

Call PTC
Exit For

End If
Next

End If

End If

End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim findURL1 As Boolean

LinksCnt = WebBrowser1.Document.Links.length

If WebBrowser1.Document.ReadyState = "complete" Then

Call ChkURL(findURL1)
If findURL1 = True Then
Call GetURL
Cnt = Cnt + 1
If Cnt = 1 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=5"
End If

If Cnt = 2 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=10"
End If

If Cnt = 3 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=15"
End If

If Cnt = 4 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=20"
End If

If Cnt = 5 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=25"
End If

If Cnt = 6 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=30"
End If

If Cnt = 7 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=35"
End If

If Cnt = 8 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=40"
End If

If Cnt = 9 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=45"
End If

If Cnt = 10 Then
WebBrowser1.Navigate "http://sasuga.biz/pages/ptc.php?startpos=50"
End If

Else
Timer1Row = vsFlexArray1.Rows

Call PTC

End If
End If

End Sub

Sub GetURL()
For Row1 = 0 To LinksCnt - 1

Str1$ = WebBrowser1.Document.Links(Row1).href
Str2$ = "http://sasuga.biz/scripts/runner.php?PA="

Len2 = Len(Str2$)
Left1$ = Left$(Str1$, Len2)
If Left1$ = Str2$ Then
vsFlexArray1.Rows = vsFlexArray1.Rows + 1
vsFlexArray1.TextMatrix(vsFlexArray1.Rows - 1, 0) = vsFlexArray1.Rows - 1
vsFlexArray1.TextMatrix(vsFlexArray1.Rows - 1, 1) = Str1$
End If
Next

End Sub

Sub ChkURL(FindURL2 As Boolean)

FindURL2 = False
For Row1 = 0 To LinksCnt - 1

Str1$ = WebBrowser1.Document.Links(Row1).href
Str2$ = "http://sasuga.biz/scripts/runner.php?PA="

Len2 = Len(Str2$)
Left1$ = Left$(Str1$, Len2)
If Left1$ = Str2$ Then
FindURL2 = True
Exit For
End If
Next

End Sub

Sub PTC()
Dim Size As Variant
Size = 4& 'IEのフォントサイズ、最大&4 大中小 最小&0
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, Size

Timer1Row = Timer1Row - 1

If Timer1Row > 0 Then
Text1.Text = Timer1Row
WebBrowser2.Navigate vsFlexArray1.TextMatrix(Timer1Row, 1)

End If

End Sub

Private Sub WebBrowser2_DownloadComplete()
Dim ChrNum As Long
Dim Len1 As Long
Dim Len2 As Long
Dim FRAMESET As Boolean

If WebBrowser2.Document.ReadyState = "complete" Then

Str1$ = WebBrowser2.Document.Body.outerhtml
RichTextBox1.Text = Str1$

Len1 = Val(Len(Str1$))
Str2$ = "FRAMESET"
Len2 = Val(Len(Str2$))

FRAMESET = False
For ChrNum = 1 To Len1 - Len2
Str3$ = Mid$(Str1$, ChrNum, Len2)
If Str2$ = Str3$ Then

FRAMESET = True
Exit For

End If
Next

On Error GoTo Error1
If FRAMESET = True Then
Str1$ = WebBrowser2.Document.frames(0).Document.Body.innerhtml
Error1:
RichTextBox2.Text = Str1$

Len1 = Val(Len(Str1$))
Str2$ = "報酬は加算されました"
Len2 = Val(Len(Str2$))

For ChrNum = 1 To Len1 - Len2
Str3$ = Mid$(Str1$, ChrNum, Len2)
If Str2$ = Str3$ Then

Call PTC
Exit For

End If
Next

End If

End If

End Sub
　
流石めーるに登録後、流石めーるログインしておきます。
VB5を起動させ閲覧プログラムPtcSasuga5を読み込みます。
ツールバー標準の開始ボタンでプログラムを走らせます。
VideoSoft Flex3のダイアログボックスが表示されたら[OK]ボタンを押します。
PTC広告が自動的に読み込まれ、広告が表示されます。

画像に表示されたものと同じ数字をクリックして下さい。

の番号をクリックすると次々と広告が表示され課金されていきます。

いかがしたか？うまく実行できたでしょうか？
かなり大雑把ですがサイトを更新していきながら、
これからもう少し詳しく解説していきたいと思っています。
　
　
HOME


SEO [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送