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
2011年6月30日木曜日
→→→反転する処理
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
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
データはテキスト形式でタブ区切り。
テストデータ例
連番・空白を詰めたい列
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
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
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
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
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基本形
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~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を削除する操作をすると消えてしまう。
ローカルDBが使える
IE9はHTML5に対応しているがFirefoxやChromeと比べて機能が少ない
- 文章構造を記述(article要素やsection要素)
- canvas(JavaScriptで図を描画)
- SVG(SVG画像を描画)
- audio/video(オーディオ/ビデオ機能)
- Webストレージ(ブラウザー側で動作するシンプルなKVS)
- Indexed Database(ブラウザー側で動作する高機能なKVS。トランザクション機能やデータ検索)
- Webワーカー(JavaScriptをマルチスレッドで動作させ重い処理をバックグウンドで実行させる)
- オフラインWebアプリケーション(HTML,JavaScript,CSSなどをキャッシュしてオフラインでも利用できる)
- File API(ローカルファイルを読み書きする)
- WebSocket(ブラウザーとWebサーバー間の双方向通信)
- Server-Sent Events(Webサーバー側からクライアントに向けてDOMイベントを通知する)
- 入力フォームの強化(フォームのバリデーション機能や新しいコントロールなど)
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
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
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
要メモリ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
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
登録:
投稿 (Atom)