VB2008 初心者が作る入門プログラム

NVelocityっていう
テンプレートエンジンがあるみたい

PHPだと

Smarty

とかが有名だし
Perlだと

数か数の

moduleがあるから
それ入れればいいんだけど

しかし

それらは

if
とか

foreach
とか
使うだけだと

重い
単に置換するだけなら

replaceで

いけるけど

問題は

if
と

foreach

をどうやって
実現するかなんだけど

ちょっと

考えて
簡易テンプレートエンジンを

作ってみたいなあ

そうしたら

PCで

Movable type
みたいなのを

FTP

使って
できるような

気がする

そうすると

サーバーに
重いって

文句いわれない

（数々文句いわれ続けてます）
NVelocity NVelocity テンプレート テンプレート

objIEがObject でいいのかどうか？だが

こんな感じで
いつも使っている

リダイレクトするURLだと
ちゃんと読み込みを確認してはくれないこともある

Public Sub OpenIE(ByVal objIE As Object, ByVal URL As String)

objIE.Navigate(URL)

Do While objIE.Busy
DoEvents()
Loop

Do While (objIE.document.readyState <> "complete")
DoEvents()
Loop

Do While objIE.readyState <> "4"
DoEvents()
Loop

Sleep(1000)
End Sub
でもつかえているんで
いいかな
IE internet explorer

Movable typeや他のブログでも
インポートするときに

ItemのDictionaryにそれぞれの値を入力して

MTImportItem(Item)

とすると

インポートのフォーットで1記事分を返してくれます。 

Public Function MTImportItem(ByVal Item As Dictionary(Of String, String)) As String
        Dim Import As String
        Dim LF As String = Chr(10)

        Import = "AUTHOR: " & Item("Author") & LF
        Import &= "TITLE: " & Item("Title") & LF
        'Import &= "BASENAME: " & "post" & Item("No") & ".html" & LF
        Import &= "STATUS: " & Item("Status") & LF
        Import &= "CONVERT BREAKS: " & Item("Breaks") & LF
        Import &= "PRIMARY CATEGORY: " & Item("Category") & LF
        Import &= "DATE: " & Item("Date") & LF

        If Item("Tags").Length > 0 Then
            Import &= "TAGS: " & Item("Tags") & LF
        End If

        Import &= "-----" & LF
        Import &= "BODY:" & LF
        Import &= Item("Body") & LF
        Import &= "-----" & LF

        If Item("Extended").Length > 0 Then
            Import &= "EXTENDED BODY:" & LF
            Import &= Item("Extended") & LF
            Import &= "-----" & LF
        End If

        If Item("Excerpt").Length > 0 Then
            Import &= "EXCERPT:" & LF
            Import &= Item("Excerpt") & LF
            Import &= "-----" & LF
        End If

        If Item("Keywords").Length > 0 Then
            Import &= "KEYWORDS:" & LF
            Import &= Item("Keywords") & LF
            Import &= "-----" & LF
        End If

        If Item("Comment").Length > 0 Then
            Import &= "COMMENT:" & LF
            Import &= Item("Comment") & LF
            Import &= "-----" & LF
        End If
        Import &= "--------" & LF

        Return Import
    End Function

VB2008で今までつくったものの中でも
今でも使っている、アフィリ用のブログ投稿ツールを

公開しました

URLは

http://www.affiliate-tool.com/

です。

これは

Yahooニュースからアクセスを引っ張ってくるために
無料ブログを使って

かんたんに複数のブログに投稿できるようにしたツールです。
公開から２週間くらいたったけど

なんと

予想を上回る現在約６００人くらいのダウンロード

うれしいんだけど

ちゃんと動いているのかなあとかってとっても心配。

まだ、使っているツールはあるので
そのうち公開しようと思う。

やっぱり

使ってくれるひとがいると
うれしいなあ。
アフィリエイト

フォームの大きさを変更したときのコード そして フォームを最小化したら タスクトレイにアイコンを表示して フォーム自身は表示しないようにする Private Sub FormResize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Resize 'FormResizeのときの動作 If Me.WindowState = FormWindowState.Minimized Then Me.Visible = False NotifyIcon1.Visible = True Exit Sub End If SplitContainer3.Height = TabControl1.Height - 25 SplitContainer3.Width = TabControl1.Width - 8 TableLayoutPanel11.Height = SplitContainer3.Height - 60 TableLayoutPanel11.Width = SplitContainer3.Panel1.Width - 10 ListView1.Width = SplitContainer3.Panel1.Width - 10 ListView1.Height = (TableLayoutPanel11.Height - 70) / 2 ListView2.Width = SplitContainer3.Panel1.Width - 10 ListView2.Height = (TableLayoutPanel11.Height - 70) / 2 End Sub そうとうはしょって書きましたが タブコントロールを使っていて フォームをリサイズしたときに まず タブコントロールのサイズを変更します タブの中にSplitContainer3があって それをまた変更します その中のTableLayoutPanel11を変更 そして TableLayoutPanel11の中の Listview1 Listview2 のサイズも変更します 面倒ですが変更するものは 回りから内側に変更していけばエラーになりにくい VB2008 resize

LivedoorにAtomで投稿するときのXML

カテゴリに前に書いたカテゴリを取得して
カテゴリの名前を入れれば
カテゴリを設定して投稿してくれます


Public Function AtomXML(ByVal Title As String, ByVal Body As String, ByVal Category As String)
        Dim XMLString As String

        XMLString = "<?xml version=""1.0"" encoding=""UTF-8""?>"
        XMLString &= "<entry xmlns=""http://purl.org/atom/ns#"" xmlns:dc=""http://purl.org/dc/elements/1.1/"">"
        XMLString &= "<title>" & Title & "</title>"
        XMLString &= "<dc:subject>" & Category & "</dc:subject>"
        XMLString &= "<content type=""text/html"" mode=""escaped"">"
        XMLString &= "<![CDATA[" & Body & "]]>"
        XMLString &= "</content>"
        XMLString &= "</entry>"

        Return XMLString
    End Function

Livedoor にカテゴリを設定して投稿する準備
LivedoorにVisual Basic2008からカテゴリを設定して投稿できるようにした。
投稿のURLと
設定してあるカテゴリを取得するURL
そしてアップロードするURL

エンドポイントっていうのかなあ
それを取得するには

http://cms.blog.livedoor.com/atom/

にAtomAPIで
こんな感じで
xml=atomget(username,password,endurl)
   Function atomget(ByVal username As String, ByVal password As String, ByVal endurl As String) As String

        'HTTP接続の作成
        Dim webreq As HttpWebRequest = CType(WebRequest.Create(endurl), HttpWebRequest)
        webreq.Method = "GET" 'GET指定
        webreq.UserAgent = "Blogposter" 'UA設定(ソフト名)

        'WSSE認証の作成
        Dim shasp As New System.Security.Cryptography.SHA1CryptoServiceProvider() 'SHA処理用
        Dim nowt As DateTime = DateTime.Now '現在の時間取得
        Dim tim As String = nowt.ToString("yyyy-MM-ddTHH:mm:ssZ") '文字列にする(2005-12-11T22:39:56Z)の形式
        Dim non As String = "inininininininininin" 'Nonce(WSSEに必須の20文字の文字列)
        Dim b64 As String = System.Convert.ToBase64String(shasp.ComputeHash(System.Text.Encoding.UTF8.GetBytes(non & tim & password))) 'NonceTimePasswordをSHA→Base64エンコード
        Dim ninsyou As String = "UsernameToken Username=""" & username & """, PasswordDigest=""" & b64 & """, Nonce=""" & System.Convert.ToBase64String(System.Text.Encoding.ASCII.GetBytes(non)) & """, Created=""" & tim & """" '認証文の完成
        webreq.Headers.Add("X-WSSE", ninsyou) 'HTTP接続に付ける

        'HTTP接続を実行
        Dim st As System.IO.Stream = webreq.GetResponse().GetResponseStream() '接続
        Dim sr As New System.IO.StreamReader(st, System.Text.Encoding.GetEncoding("UTF-8")) 'デコード
        Return sr.ReadToEnd() '応答を文字列化

    End Function

これで

以下のような
xmlが得られる

<?xml version="1.0" encoding="UTF-8"?>
<feed xmlns="http://purl.org/atom/ns#">
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.post" href="http://cms.blog.livedoor.com/atom/blog_id=123" title="テニス"/>
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.feed" href="http://cms.blog.livedoor.com/atom/blog_id=123" title="テニス"/>
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.categories" href="http://cms.blog.livedoor.com/atom/blog_id=123/svc=categories" title="テニス" />
  <link xmlns="http://purl.org/atom/ns#" type="application/x.atom+xml" rel="service.upload" href="http://cms.blog.livedoor.com/atom/blog_id=123/svc=upload" title="テニス" />
</feed>

テキストボックスからなど文字を入力してもらい

それを（フォルダ）ディレクトリ名とかファイル名に用いる場合がある

ファイル名やフォルダ名には使えない文字がある
たとえば

: // ? | などはファイル名に使えない

これらはいちいちチェックすることは大変に面倒くさいことである


あるんだなあそんな関数が！

Path.GetInvalidFileNameChars()
に配列で、ファイル名に使えない文字が入っている

凄い

ということで

テキストを入力すると
使えない文字を返すというべたなFunction

最初に見つかった使えない文字を返します

  Public FunctionNotFileName(ByVal InputText As String) As String

        Dim invalidch As Char() = Path.GetInvalidFileNameChars()
        Dim ReturnText As String = ""
        For Each c As Char In invalidch

            If InStr(InputText, c) > 0 Then
                ReturnText = c
                Exit For
            End If

        Next
        Return ReturnText

    End Function

Basp21という
http://www.hi-ho.ne.jp/babaq/basp21.html からダウンロードできるDLLがあります

これをパソコンにインストールすると

メールを送ったり、FTPのアップロードなんかも

むちゃくちゃ簡単にできます。

以下は、Sendmail before pop に対応して

一度

メールサーバーにログインをかましています。

それから、いまどきのプロバイダのメールように、587のポートで送信しています。

エラーがあればERRにはいります

       Dim objBsp As Object

        objBsp = CreateObject("Basp21")

        Dim Err As String

        'MailServerにログイン
        objBsp.RcvMail(MailServer, MailUser, MailPass, "STAT", Dirname)

        Sleep(500)

        'メールを送ってエラーがあると、ERRに番号を入れます
        'これは587でメール送信しています
        Err = objBsp.SendMail(MailServer & ":587", MailTo, MailFrom, MailTitle, MailBody, FileName)

        Return Err

文字を変換、置換してみたい

たとえば

今日は晴れでした。気分がよかった

という文章を

ホームページに使うために

<p>今日は晴れでした。</p>
<p>気分がよかった</p>

というようにVB2008で置換するための関数です。

PTag("今日は晴れでした。気分がよかった")

と使うと、上記のように変換してくれます


Public Function PTag(ByVal Desc As String) As String
Dim OUT As String

OUT = Replace(Desc, "。", "。

")
OUT = "

" & OUT & "
"
OUT = Replace(OUT, "  
", "")
Return OUT
End Function

簡単で応用がいろいろ利くと思いますので
もっと上手な方法もあるかと思うのですが

簡単で、あとから見ても分かりやすいと。。。

難しいのはわからないだけですが。

ではまた