2011年6月30日木曜日

→→→チェックデジットをつける

Private Function pass( ByRef result As String)
              Dim wk(5) , syo , amari , rp1 , rp2 , hiku , cy As Integer
              Dim ans , answer As String
              Dim stw(5)  As string
              For  rp2 = 0  To  5
                        stw( rp2 ) = result.Substring( rp2 , 1 )
                        wk( rp2 ) = Val( stw( rp2 ))
                        ans = String.concat( stw )
              Next
              syo = ( wk(0) * 7 ) + ( wk(1) * 6 ) + ( wk(2) * 5 ) + _
                      ( wk(3) * 4 ) + ( wk(4) * 3 ) + ( wk(5) * 2 )
              amari = syo Mod 11
              hiku = 11 - amari
         
              If hiku <= 9 Then
                    cy = hiku
              Else
                    cy = 0
              End If
              answer = ans & cy
              result = answer
              return result
End Function

→→→反転する処理

Private Function Pass(ByRef result As String)
      Dim k,l,j,m,n,o As Integer
      Dim han() As String
      Dim answer As String = ""
      k = Microsoft.VisualBasic.Len(result)
      l = k - 1
      ReDim han(l)
      For j = 0 To k - 1
         If k < 5  Then
           answer = ""
           Exit For
         End If
         han(l) = result.SubString(j , 1)
         If j = 0 Then
            n = StrComp( han(l) , "0" )
            If n = 0 Then
                 han(l) = ""
            End If
            m = StrComp( han(l) , "-" )
            n = StrComp( han(l) , " " )
            If m <> 0 And o <> 0 Then
                  answer = String.Concat( han )
            End If
         Next
         result = answer
         return result
End Function

2011年6月29日水曜日

→→→連続する空白を埋める

文字列途中の連続した余分な空白を詰める処理をしたときのやつ。
データはテキスト形式でタブ区切り。

テストデータ例
連番・空白を詰めたい列
1・テ  ス    ト
2・テ    ス        ト
3・テ ス ト
結果は
すべて"テ ス ト"になる


フォームにBUTTONを追加だけする
--------------------------------------------------------------



Public Class Form1
    Private Structure Info
        Public str() As String
    End Structure
    Dim strOcc() As String
    Dim FileName As String
    Dim outFileName As String
    Dim openFile1 As New OpenFileDialog
    Dim saveFile1 As New SaveFileDialog
    Dim FileNum As Integer
    Dim FileOutNum As Integer
    Dim i As Integer = 0
    Dim j As Integer = 0
    Dim DataBuff As String
    Private pInfo(1500000) As Info

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        ReadTab()
        PWrite()
    End Sub


    Private Sub ReadTab()
        Dim k As Integer
        openFile1.DefaultExt = "*.*"
        openFile1.Filter = "テキスト|*.txt|すべてのファイル|*.*"
        If openFile1.ShowDialog = DialogResult.OK Then
            Cursor.Current = Cursors.WaitCursor
            FileName = openFile1.FileName
        Else
            Exit Sub
        End If
        FileNum = FreeFile()
        FileOpen(FileNum, FileName, OpenMode.Input)
        Do Until EOF(FileNum)
            If i > 1499999 Then
                MessageBox.Show("150万超えたためSTOP", "ERR", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Me.Close()
                Exit Sub
            End If
            DataBuff = LineInput(FileNum)
            strOcc = Split(DataBuff, vbTab)
            j = UBound(strOcc)
            ReDim pInfo(i).str(j)
            For k = 0 To j
                pInfo(i).str(k) = strOcc(k)
                If k = j Then
                    pass(pInfo(i).str(j))
                End If
            Next
            i += 1
        Loop
        Cursor.Current = Cursors.Default
        FileClose(FileNum)
    End Sub


    Private Sub PWrite()
        Dim p As Integer = 0
        Dim q As Integer = 0
        saveFile1.DefaultExt = "*.txt"
        saveFile1.Filter = "保存するファイル名|*.txt"
        If saveFile1.ShowDialog = Windows.Forms.DialogResult.OK Then
            outFileName = saveFile1.FileName
        Else
            Exit Sub
        End If
        FileOutNum = FreeFile()
        FileOpen(FileOutNum, outFileName, OpenMode.Output)
        For p = 0 To i - 1
            For q = 0 To j - 1
                Write(FileOutNum, pInfo(p).str(q))
            Next
            WriteLine(FileOutNum, pInfo(p).str(j))
        Next
        MessageBox.Show(i & "件のデータを保存しました", "名前を付けて保存")
        FileClose(FileNum)
    End Sub

    Private Function pass(ByRef result As String)
        Dim rp1, rp2, rp3, FLG As Integer
        Dim txt As String = ""
        Dim stw() As String
        rp2 = Len(result)
        ReDim stw(rp2 - 1)
        For rp1 = 0 To rp2 - 1
            stw(rp1) = result.Substring(rp1, 1)
            rp3 = StrComp(stw(rp1), " ")
            If rp3 = 0 Then
                If FLG = 0 Then
                    FLG = 1
                    txt = txt & stw(rp1)
                Else
                    '何もしない
                End If
            Else
                txt = txt & stw(rp1)
                FLG = 0
            End If
        Next
        result = txt
        Return result
    End Function
End Class

2011年6月28日火曜日

→→→webページ①-実際

フォーム読み込み

Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Try
            WebBrowser1.Url = New Uri("http://******.jp/")
        Catch ex As Exception
            MessageBox.Show(ex.Message)
        End Try
End Sub

WebページからRichTextBoxにソースを


Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Try
          Dim buff(60000) As Byte
          Dim str As String
          WebBrowser1.DocumentStream.Read(buff, 0, WebBrowser1.DocumentStream.Length)
          str = System.Text.Encoding.GetEncoding(WebBrowser1.Document.Encoding).GetString(buff)
          RichTextBox1.Text = str
        Catch ex As Exception
          MessageBox.Show(ex.Message)
        End Try

        source = RichTextBox1.Text
End Sub

→→→webページ①

・XmlDocument
   XmlDocumentクラスはXML文書全体を表すクラス
      ファイルを読み込んで、それを元にしてXMLDocumentクラスの
      オブジェクトを生成するとXML文書の構造が解析される
    Dim doc As New XMLDocument()
      doc.LoadXML(source)
・XMLNode
   XMLNodeクラスはXML文書内の個々の要素を表すクラス
      XML文書内の最初の子要素を得て、変数xNodeに
      割り当てた後、その子要素の名前と値を表示するには
      Dim xNode As XMLNode
      xNode = doc.FirstChild
      Msgbox("名前=" & xNode.Name & "値=" & xNode.Value)


------------------------------------------------------------
Imports SystemNet
Imports System.Text
Imports System.IO
Imports System.Xml

Public Class Form1
  Private Sub Form1_Load(・・・
    Dim source As String = ""
    Dim doc As New XmlDocument
    Dim xNode As XmlNode
    Dim dataStr As String
    Dim dbDataStr As Date
    Dim weather As String = ""
    Dim isGetOK As Boolean
    Dim con As New OleDbConnection
    Dim cmd As New OleDbCommand
    Dim rdr As OleDbDataReader

    Try
            GetWebPageSource("http://・・・", Source ,"Uft-8")
            doc.LoadXml( source )
            xNode = doc.item("lwws").item("forecastdate")
            dataStr = xNode.lnnerXml
            dbDatestr = Format( CDate ( dateStr ), "yyyy/MM/dd" )
            xNode = doc.Item("lwws").item("telop")
            weather = xNode.InnerXml
            isGetOk = True
     Catch ex As Exception
            isGetOk = False
     End Try
------------------------------------------------------------

XML例
1: <?Xml Version="1.0"?>
2: <person>
3:      <name>山田太郎</name>
4:      <birthday format="jp">1980/3/15</age>
5:</person>


person要素

name要素          birth要素
値 = 山田太郎       値 = 1985/3/15

XmlNode.InnerXml ・・・ このノードの子ノードだけを表すマークアップを取得または設定
          Dim instance As XmlNode
          Dim value As String
          value = instance.InnerXml
          instance.InnerXml = value


------------------------------------------------------------
 Try
      with con
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                                    My.Application.Info.DirectoryPath & "\test.accdb"
        .Open()
     End with
     with cmd
        .CommandText = "SELECT COUNT(*) FROM weather WHERE 日付=" & _
                                dbDateStr & "'"
        .Connection = con
     End with
     If cmd.ExecuteScalar() = 0 And isGetOk Then
      with cmd
         .CommandText = "INSERT INTO weather value(" &_
                                 dbDataStr  & "','" & weather & "')"
         .Connection = con
      End with
      cmd.ExecuteNonQuert() 
     End If
     with cmd
         .CommandText = "SELECT * FROM weather ORDER BY 日付 DESC"
         .Connection = con
     End with
     rdr = cmd.ExecuteReader()


     Do while rdr.Read()
        Dim rowData As String = {rdr.GetString(0), rdr.GetString(1)}
        DataGridView1.Rows.Add(rowData)
     LOOP
     rdr.Close()
     con.Close()
 Catch ex As Exception
     MsgBox(ex.Message)
 End Try
End Sub
------------------------------------------------------------
WebRequestはインターネットからのデータにアクセスするための.NET Frameworkの要求/応答
モデル用のabstract基本クラス

Webページのソースを読み出すFunctionプロシージャ
------------------------------------------------------
Private Sub btnClick(・・・
 Dim TARGET As String = "http://dl.google.com/picasoweb-current-setup.exe"
  Dim DOWNLOADFILENAME As String = "D:\picasawbe-current-setup.exe"
  Dim request As HttpWebRequest
  Dim response As HttpWebResponse
  Dim stream As stream
  Dim fs As FileStream
  Dim buffer As Byte()
  Dim count As Integer


  request = CType( webRequest.Create(TARGET) , HttpWebRequest )
  response = CType( request.GetResponse() , HttpWebRespose )
  stream = response.GetResponseStream()
  fs = New FileStream( DOWNLOADFILENAME , FileMode.CreateNew )
  buffer = New Byte(1024){}
  Do
    count = Stream.Read( buffer , 0 , buffer.Length )
    fs.Write( buffer , 0, count )
  Loop while count <> 0


  Stream.Close()
  fs.Close()
  response.Close()
End Sub
------------------------------------------------------


-----------------------------------------------------------------
Function GetWebPageSource (ByVal URL As String, ByRef source As String, ByVal charCode As String) As Boolean

    Dim request As WebRequest
    Dim response As HttpWebResponse
    Dim dataStream As Stream
    Dim reader As StreamReader
    Try
           request = WebRequest.Create(URL)     '指定されたURLへのリクエストを生成する
           response = CType( request.GetResponse() , HttpWebResponse )  'レスポンスを得る
dataStream = Response.GetResponseStream()       'データストリームを得る
           reader = New StreamReader( dataStream, Encoding.GetEncoding( charCode ))
                                   'webページのソースを読み出すためのストリームリーダーを生成する
 source = reader.ReadToEnd          'webページのソースを読み出す
           reader.Close()
           dataStream.Close()
           response.Close()
           GetWebPageSource = True
      Catch ex As Exception
           GetWebPafeSource = False
      End Try
End Function









     

2011年6月27日月曜日

→→→いらない文字を詰める処理

文字列の中で<p>~</p>の間の集まりを削除したいときの処理


in:"あいう<p>削除したい文字列</p>えお<p>削除したい文字列</p>かきくけこ" 
                
out:"あいうえおかきくけこ"   (青文字のところをカットする)

Private Function Reverse(ByRef data As String)
      Dim k, l, m, n, p As Integer
      Dim han() As String
      Dim answer As String = ""
      Dim x, y As String
      Dim r As Intger = 0
     k = Microsoft.VisualBasic.Len(data)
      If  k = 0  Then
          Exit Function
      End If
      l = k - 1
      ReDim han(l)
   
      For j = 0 to k - 1
          han(j) = data.SubString(j , 1)
          If  ( k - 1 ) - 3 >=  j  Then
              x = data.SubString( j , 3 )
          Else
              x = data.SubString( j , 1 )
          End If
          n = StrComp( x , "<p>" )
          '******************************
          If  ( k - 1 ) - 4 >= j Then
             y = data.SubString( j , 4 )
          Else
             y = data.SubString( j , 1 )
          End If
          m = StrComp( y , "</p>")
          '******************************
          If  r = 0 Then
             If  n = 0  Then
                    p = 1
            End If
         Else
                    p = 0
                    r = 0
               If   n = 0  Then
                       p = 1
               End If
         End If
         '********************************
         If p = 1  Then
                  han(j) = ""
         Else
                  answer  =  String.Concat(han)
         End If
         If  m = 0 Then
              r = 1
              j += 3
         End If
    Next
         data = answer
         return 0
 End Function

   

2011年6月24日金曜日

→→→エクスポート(Read/Write)

----Export ----------------------------------
Dim sr As IO.StreamWriter
Dim exfolder As String
Dim linetext As String

Me.Cursor = Cursors.WaitCursor
exfolder = Application.StartUpPath & "データ出力"
If IO.Directory.Exists(exfolder) = False Then
    IO.Directory.CreateDirectory(exfolder)
End If
sr = New IO.StreamWriter( exfolder & "保存データ.txt", False, 
                  System.Text.Encoding.GetEncoding("Shift-JIS"))
Using connection As New SqlClient.SqlConnection
    connection.connectionString  = "Data source = \SQLEXPRESS;
         AttachDbFilename = " & My.Application.Info.DirectoryPath &
         " \TEST.mdf; Integrated Security = True; Connect TimeOut = 30;
         User Instance = True"
    Dim command As New SqlClient.SqlCommand("SELECT * FROM デーブル" , connection)
    connection.Open()
    Dim dr As SqlClient.SqlDataReader = command.ExecuteReader()
    Do while dr.Read
        linetext = dr("項目1") & ","
        linetext &= dr("項目2")
        sr.writeline( linetext )
    Loop
    dr.close()
    connection.close()
End Using
sr.close()
Me.cursor = Cursor.Default
Msgbox("終了")

-------------------------------------------------------------------------
Private Structure Info
      Public strA As String
      Public strB As String
End Structure


Private Structure Wri
      Public strW As String
      Public strX As String
End Structure
Private pInfo(1000) As Info
Private pWri(1000) As Wri
const FileName = "D:\in.txt"
const FileOutName = "D:\out.txt"

Dim FileNum , FileOutNum As Integer
Dim i , j As Integer

FileNum = FreeFile()
FileOpen( FileNum , FileName , OpenMode.Input )
i = 0 
Do Until EOF ( FileNum )
    Input ( FileNum , pInfo(i).strA )
    Input ( FileNum , pInfo(i).strB )
Loop

FileOutNum = FreeFile()
FileOpen( FileOutNum , FileOutName , OpenMode.Output )

For j = 0 To i - 1
    pWri(j).strW = pInfo(j).strA
    pWri(j).strX = pInfo(j).strB
    writeLine( FileOutNum , pWri(j).strW , pWri(j).strX )
Next

FileClose( FileNum )
FileClose( FileOutNum )
------------------------------------------------------------------------
Read/Write基本形



Private Structure Info
      Public str() As String
End Structure

Dim strOcc() As String
Dim FileName As String
Dim OutFileName As String
Dim OpenFile1 As New OpenFileDialog()
Dim SaveFile1 As New SaveFileDialog()
Dim FileNum , FileOutNum As Integer
Dim i , j As Integer

Dim DataBuff As String
Private pInfo(150000) As Info


Private Sub ReadTab()
    OpenFile1.DefaultExt = "*.*"
    OpenFile1.Filter = "テキスト(*.txt)|*.txt|すべてのファイル|*.*"
    If OpenFile1.ShowDialog() = DialogResult.OK Then
          Cursor.current = cursors.waitcursor
          FileName = OpenFile1.FileName
    Else
          Exit Sub
    End If
    FileNum = FreeFile()
    FileOpen( FileNum , FileName , OpenMode.Input )

    Do Until EOF ( FileNum )
        If i > 149999 Then 
            MessageBox.Show("エラー")
            Me.Close()
            Exit Sub
       End If   
       DataBuff = LineInput( FileNum )
       strOcc = Split( DataBuff , vbTab )
       j = UBound( strOcc )
       ReDim pInfo(i).str(j)
       For k As Integer = 0 To j
            pInfo(i).str(k)  = strOcc(k)
       Next
       i += 1
     Loop
     Cursor.Current = Cursors.Default
     FileClose( FileNum )
End Sub

Private Sub Write()
      Dim p,q As Integer
      SaveFile1.DefaultExt = "*.txt"
      SaveFile1.Filter = "保存するファイル名|*.txt"
      If SaveFile1.ShowDialog() = Windows.Forms.DialogResult.OK Then
         OutFileName  = SaveFile1.FileName
      Else
         Exit Sub
      End If

      FileOutNum = FreeFile()
      FileOpen( FileOutNum , OutFileName , OpenMode.OutPut )
      For p = 0 To i - 1
         For  q = 0  To j - 1
             Write( FileOutNum , pInfo(p).str(q))
         Next
         WriteLine( FileOutNum , pInfo(p).str(j))
      Next
      MessageBox.show( i & "件のデータを保存しました")
      FileClose( FileOutNum )
End Sub  


2011年6月21日火曜日

→→→Internet Explorer 9の力(1)

HTML5 対応 
ローカルDBが使える


IE9はHTML5に対応しているがFirefoxやChromeと比べて機能が少ない

  1. 文章構造を記述(article要素やsection要素)
  2. canvas(JavaScriptで図を描画)
  3. SVG(SVG画像を描画)
  4. audio/video(オーディオ/ビデオ機能)
  5. Webストレージ(ブラウザー側で動作するシンプルなKVS)
  6. Indexed Database(ブラウザー側で動作する高機能なKVS。トランザクション機能やデータ検索)
  7. Webワーカー(JavaScriptをマルチスレッドで動作させ重い処理をバックグウンドで実行させる)
  8. オフラインWebアプリケーション(HTML,JavaScript,CSSなどをキャッシュしてオフラインでも利用できる)
  9. File API(ローカルファイルを読み書きする)
  10. WebSocket(ブラウザーとWebサーバー間の双方向通信)
  11. Server-Sent Events(Webサーバー側からクライアントに向けてDOMイベントを通知する)
  12. 入力フォームの強化(フォームのバリデーション機能や新しいコントロールなど)

1~5まではIE9は対応するが6以降は対応していない(2011.6現在)


5. Webストレージは、キーと値のペアでデータを読み書きするシンプルなKVS(Key-Value Store)

Webストレージには、ブラウザーの
ウィンドーが開いている間だけデータが保持される「sessionStorage」と、
ウィンドウを閉じたあともデータが保持される「localStorage」の2種類がある。

Webストレージを使えばユーザーデータをPC側に保持できる。データサイズは10Mバイト。

IE9は、データをローカルファイルに書き出すHTML5の機能である「File API」を備えていないため、
Webストレージ上のデータをPC側でバックアップする手段がない。
バックアップはサーバー側で行い、サーバー側のDBとWebストレージ上のデータを
常に同期させるような使い方になる。
また、localStorageは、ブラウザーでCookieを削除する操作をすると消えてしまう。

2011年6月20日月曜日

→→→ひとつのファイルを多数のファイルに

ひとつのファイルを255ファイルまでに分割する処理

Buttonを配置

<ファイル名,内容1,内容2>という例のファイル

先頭のファイル名をファイル名.txtというふうになる為重複注意。
Dドライブに作成

--------------------------------------------------
Private Structure Info
        Public str() As String
    End Structure

    Dim WORK(1) As String
    Dim ans(1) As String

    Dim strOcc() As String
    Dim FileName As String
    Dim openFile1 As New OpenFileDialog()

    Dim FileNum As Integer
    Dim FileOutNum As Integer
    Dim OutFileName(100) As String

    Dim i As Integer = 0
    Dim j As Integer = 0
    Dim outcount As Integer = 0
    Dim total As Integer = 0
    Dim DataBuff As String
    Private pInfo(1500000) As Info



------------------------------------------------------
    Private Sub Button1_Click(・・・) Handles Button1.Click
        ReadTab()
     
        ReDim WORK(i - 1)
        ReDim ans(i - 1)
        Dim l, x, z, count As Integer

        For l = 0 To i - 1
            WORK(l) = pInfo(l).str(0)
            If l = i - 1 Then
                ans(l) = pInfo(l).str(0)
                Write(count, x, WORK(l))
            Else
                ans(l) = pInfo(l + 1).str(0)
            End If
            z = StrComp(WORK(l), ans(l))
            If z = 0 Then
                x += 1
            Else
                Write(count, x, WORK(l))
                x = 0
                count += 1
            End If
        Next
        Me.Close()
    End Sub
------------------------------------------------------


 Private Sub Write(ByVal count As Integer, ByVal x As Integer, ByVal fn As String)
        FileOutNum = FreeFile()
        OutFileName(count) = "D:\" & fn & ".txt"
        FileOpen(FileOutNum, OutFileName(count), OpenMode.Output)
        Dim n, l As Integer
        For n = 0 To x
            l = total
            total += 1
            Print(FileOutNum, pInfo(l).str(1))
            Print(FileOutNum, ",")
            PrintLine(FileOutNum, pInfo(l).str(2))
        Next
        FileClose(FileOutNum)
 End Sub


-------------------------------------------------------

 Private Sub ReadTab()
        Dim k As Integer
        openFile1.DefaultExt = "*.*"
        openFile1.Filter = "テキスト(*.txt)|*.txt|すべてのファイル|*.*"
        If openFile1.ShowDialog() = DialogResult.OK Then
            Cursor.Current = Cursors.WaitCursor
            FileName = openFile1.FileName
        Else
            Exit Sub
        End If
        FileNum = FreeFile()
        FileOpen(FileNum, FileName, OpenMode.Input)
        i = 0
        Do Until EOF(FileNum)
            If i > 1499999 Then
                MessageBox.Show("読み込みデータが150万件を超えたため処理を中止します", "読み込みエラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Me.Close()
                Exit Sub
            End If
            DataBuff = LineInput(FileNum)
            strOcc = Split(DataBuff, ",")
            j = UBound(strOcc)
            ReDim pInfo(i).str(j)
            For k = 0 To j
                pInfo(i).str(k) = strOcc(k)
            Next
            i += 1
        Loop
        FileClose(FileNum)
    End Sub

2011年6月17日金曜日

→→→多数のファイルをひとつに

同一のレイアウトのテキスト200ファイルをひとつにしたときのソース

要メモリ1G

ListBoxとButtonを1つずつForm1に配置してからコーディング

----------------------------------


    Dim FileName As String
    Dim OutFileName As String
    Dim openFile1 As New OpenFileDialog()
    Dim saveFile1 As New SaveFileDialog()
    Dim FileNum As Integer
    Dim FileOutNum As Integer
    Dim j As Integer = 0
    Dim i As Integer = 0
    Dim DataBuff As String
    Private Structure Info
        Public str0 As String
    End Structure
    Private pInfo(2000000) As Info


 Private Sub Button1_Click(・・・) Handles Button1.Click
        saveFile1.DefaultExt = "*.txt"
        saveFile1.Filter = "保存するファイル名|*.txt"
        If saveFile1.ShowDialog() = DialogResult.OK Then
            OutFileName = saveFile1.FileName
        Else
            Exit Sub
        End If
        FileOutNum = FreeFile()
        FileOpen(FileOutNum, OutFileName, OpenMode.Output)
        For j = 0 To i - 1
            PrintLine(FileOutNum, pInfo(j).str0)
        Next
        FileClose(FileOutNum)
        MessageBox.Show(i, "保存完了")
        Me.Close()     
  End Sub

 
  Private Sub ListBox1_DragDrop(・・・) Handles ListBox1.DragDrop
        Dim k, ans As Integer
        Dim fName As String() = CType(e.Data.GetData(DataFormats.FileDrop, False), String())
        ListBox1.Items.AddRange(fName)
        ans = UBound(fName)
        For k = 0 To ans
            FileNum = FreeFile()
            FileOpen(FileNum, fName(k), OpenMode.Input)
            Do Until EOF(FileNum)
                DataBuff = LineInput(FileNum)
                pInfo(i).str0 = DataBuff
                i += 1
            Loop
        Next
        FileClose(FileNum)
  End Sub


  Private Sub ListBox1_DragEnter(・・・) Handles ListBox1.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop) Then
            e.Effect = DragDropEffects.Copy
        Else
            e.Effect = DragDropEffects.None
        End If
  End Sub

2011年6月16日木曜日

→→→乱数を作成

乱数を作成するときの資料用

Int(Rnd() * 55 ) + 1


ArrayListの数の分だけ55のところに数字を入れる


------------------------------------------------------------------



 Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim ans, j As Integer
        Dim kigo As New ArrayList(New String() {"a", "b", "c", "d", "e", "f", "g", "h", "j", "k", "m", _
                                                "A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", _
                                                "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
                                                "n", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", _
                                                "z", "1", "2", "3", "4", "5", "6", "7", "8", "9", "M", "N"})
        Dim strOcc(7) As String
        Dim result As String = ""
        ReDim pInfo(10).str(7)       


        For i As Integer = 0 To 10
            For j = 0 To 7
                ans = Int(Rnd() * 45) + 1
                strOcc(j) = kigo(ans)
                result = String.Concat(strOcc)            
            Next
            pInfo(i).str(j) = result
        Next

        For i = 0 To 10
            For j = 0 To 7
                PWrite(10, 7)
            Next
        Next
 End Sub


----------------------------------------------------------------------
Private Function Pass( ByRef result As String )
       Dim ans  As Integer
       Dim Kigo As New ArrayList( New String() { "a" , "b" , "c" , "d" ,.....(使用する単語)})
       Dim password(7) As String
       For i = 0  To 6
            ans = Int( Rnd() * 45 ) + 1
            password(i) = Kigo( ans )
            result = String.Concat(Password)
       Next
       Return result
End Function