คำสั่งควรทราบ
unload me

คำสั่งควรทราบ
Text1 = Text1 + 1

คำสั่งควรทราบ
Shape1.Shape = 1
Shape1.Shape = 2

คำสั่งควรทราบ
Label1.FontSize = 10

คำสั่งควรทราบ
Unload Me
Unload Form2
Form1.Show

คำสั่งควรทราบ
Frame1.Visible = False
Frame1.Visible = True

คำสั่งควรทราบ
Randomize (Timer)
For i = 1 To 20
List1.AddItem Int(Rnd * 100)
Next

List1.Clear

List1.RemoveItem (Text2)

Text1 = List1
Text2 = List1.ListIndex

คำสั่งควรทราบ
List1.SetFocus
List1.ListIndex = 5

Combo1.AddItem List1
Text1 = Combo1.ListCount

คำสั่งควรทราบ
y = Split(List1, ",", -1, vbTextCompare)
z = Int(y(0)) + Int(y(1))
Combo1.AddItem z
Combo1.Text = z
List1.RemoveItem List1.ListIndex
Text2 = "Even"
If z Mod 2 = 1 Then Text2 = "Odd"
Text1 = Combo1.ListCount
List1.SetFocus
List1.ListIndex = z

คำสั่งควรทราบ
Randomize (Timer) x = 1 & ",thaiall," & Int(Rnd * 10000) List1.AddItem x For i = 2 To 5 x = i & "," & Chr(Int(Rnd * 26) + 65) & Chr(Int(Rnd * 26) + 65) x = x & Chr(Int(Rnd * 26) + 65) & "," & Int(Rnd * 10000) List1.AddItem x Next List1.SetFocus List1.ListIndex = 0 y = Split(List1, ",", -1, vbTextCompare) Text1 = y(0) Text2 = y(1) Text3 = y(2) x = Text1 & "," & Text2 & "," & Text3 xid = Text1 i = List1.ListIndex If Command5.Caption = "save add" Then List1.AddItem x i = List1.ListCount - 1 ElseIf Command5.Caption = "delete confirm" Then List1.RemoveItem List1.ListIndex ElseIf Command5.Caption = "edit updated" Then Dim z(1000) t = List1.ListCount - 1 For j = 0 To t List1.ListIndex = j y = Split(List1, ",", -1, vbTextCompare) If y(0) = xid Then z(j) = x Else z(j) = y(0) & "," & y(1) & "," & y(2) End If Next List1.Clear For j = 0 To t List1.AddItem z(j) Next End If List1.ListIndex = i

คำสั่งควรทราบ
List1.ListIndex = -1
For i = 1 To List1.ListCount
List1.ListIndex = List1.ListIndex + 1
If InStr(1, List1, Text1, vbTextCompare) > 0 Then
List2.AddItem List1
End If
Next

คำสั่งควรทราบ
For i = 1 To List1.ListCount
List1.ListIndex = List1.ListIndex + 1
y = Split(List1, ",", -1, vbTextCompare)
If y(0) = Val(Text2) Then
Text3 = y(1)
Text4 = y(2)
End If
Next

List1.ListIndex = -1
For i = 1 To List1.ListCount
List1.ListIndex = List1.ListIndex + 1
y = Split(List1, ",", -1, vbTextCompare)
If y(2) > Val(Text1) Then
List2.AddItem List1
End If
Next

คำสั่งควรทราบ
form2.visible = true
'
form2.show
'
end
'
unload form1

คำสั่งควรทราบ
Private Sub Timer1_Timer()
Text1 = Format(Time, "long time")
End Sub

Source code ที่ใช้งาน
Private Sub Form_Load() Form1.WindowState = 2 ' maximized Form1.Caption = "Photo game" Text1 = 3 Command1.Caption = "ปากคนเสื้อเหลือง" Command2.Caption = "ปากคนเสื้อน้ำเงิน" Command3.Caption = "ตาคนเสื้อม่วง" Command4.Caption = "หน้าคนที่ยังไม่ถูก click" Command5.Caption = "Click ที่วันที่" Label1.Caption = "" Label2.Caption = "" Label3.Caption = "" Label4.Caption = "" Label5.Caption = "" Label6.Caption = "" Label1.BackStyle = transparent Label2.BackStyle = transparent Label3.BackStyle = transparent Label4.BackStyle = transparent Label5.BackStyle = transparent Label6.BackStyle = transparent Label3.Enabled = False Label4.Enabled = False Label5.Enabled = False Label6.Enabled = False Command2.Visible = False Command3.Visible = False Command4.Visible = False Command5.Visible = False End Sub Private Sub Form_Resize() Label1.Width = Me.Width Label1.Height = Me.Height End Sub Private Sub Label1_Click() Text1 = Text1 - 1 If Text1 = 0 Then MsgBox "จบเกม" End End If MsgBox "ท่านพลาด ขณะนี้ท่านเหลือคะแนน " & Str(Text1) End Sub Private Sub Label2_Click() Label2.Enabled = False Label3.Enabled = True Command1.Visible = False Command2.Visible = True End Sub Private Sub Label3_Click() Label3.Enabled = False Label4.Enabled = True Command2.Visible = False Command3.Visible = True End Sub Private Sub Label4_Click() Label4.Enabled = False Label5.Enabled = True Command3.Visible = False Command4.Visible = True End Sub Private Sub Label5_Click() Label5.Enabled = False Label6.Enabled = True Command4.Visible = False Command5.Visible = True End Sub Private Sub Label6_Click() MsgBox "ท่านชนะ โปรแกรมจะปิดตัวเอง" End End Sub

Source code ที่ใช้งาน
Dim d1 As Integer Dim d2 As Integer Dim topblank As Integer Dim leftblank As Integer Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Load() Me.WindowState = 2 Me.Width = 7000 Me.Height = 7000 Me.BorderStyle = 0 Shape1.Shape = 3 Timer1.Interval = 100 Randomize (Timer) Shape1.Width = 100 Command1.Caption = "&CLose" topblank = -600 leftblank = -120 d1 = 50 d2 = 60 End Sub Private Sub Timer1_Timer() Shape1.Top = Shape1.Top + d1 Shape1.Left = Shape1.Left + d2 If Shape1.Top < Shape1.Width + topblank Then d1 = Rnd(30) * 30 + 40 * 2 If Shape1.Left < Shape1.Width + leftblank Then d2 = Rnd(30) * 30 + 40 * 2 If Shape1.Top > Me.Height + topblank Then d1 = Rnd(30) * 30 + 40 * -2 If Shape1.Left > Me.Width + leftblank Then d2 = Rnd(30) * 30 + 40 * -2 End Sub

Source code ที่ใช้งาน
Private Sub Form_Load() Me.WindowState = 2 Me.Caption = "จับผิดภาพเหมือน" Text1 = 3 Text2 = 0 Label1.Caption = "" Label2.Caption = "" Label3.Caption = "" bg.Caption = "" Label1.BackStyle = transparent Label2.BackStyle = transparent Label3.BackStyle = transparent bg.BackStyle = transparent End Sub Private Sub Form_Resize() bg.Width = Me.Width bg.Height = Me.Height Me.Text1 = Form1.Text1 Me.Text2 = Form1.Text2 End Sub Private Sub bg_Click() Text1 = Text1 - 1 If Text1 = 0 Then MsgBox "จบเกม" End End If MsgBox "ท่านพลาด ขณะนี้ท่านเหลือคะแนน " & Str(Text1) End Sub Private Sub Label1_Click() Label1.Enabled = False Label1.BackStyle = 1 Text2 = Text2 + 1 Call checklevel End Sub Private Sub Label2_Click() Label2.Enabled = False Label2.BackStyle = 1 Text2 = Text2 + 1 Call checklevel End Sub Private Sub Label3_Click() Label3.Enabled = False Label3.BackStyle = 1 Text2 = Text2 + 1 Call checklevel End Sub Sub checklevel() If Text2 = 6 Then Form3.Show End Sub

Source code ที่ใช้งาน
Private Sub Command1_Click() End End Sub Private Sub Form_Load() Text1 = 0 Text2 = "ศูนย์" Text2.Appearance = 0 Text2.Enabled = False Command1.Caption = "&Close" End Sub Private Sub Text1_Change() Dim lenMax As Integer, i As Byte, Satang As String, Baht As String lenMax = Len(Text1.Text) For i = 1 To lenMax If Mid(Text1.Text, i, 1) = "." Then Satang = Right(Text1.Text, lenMax - i) Baht = Left(Text1.Text, i - 1) Exit For Else Baht = Left(Text1.Text, i) End If Next If Baht <> "" Then Text2 = changenum(Baht) & "บาท" If Satang <> "" Then Text2 = Text2 & changenum(Satang) & _ IIf(changenum(Satang) <> "", "สตางค์", "") End Sub Function changenum(num As String) As String Dim i As Integer, max As Integer, r As String, n As String num = Trim(Str(Val(num))) max = Len(num) For i = 1 To max r = Choose(((max - i + 1) Mod 6) + 1, "แสน", "", "สิบ", "ร้อย", "พัน", "หมื่น") n = Choose(Mid(num, i, 1) + 1, "ศูนย์", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า") If r = "สิบ" And n = "หนึ่ง" Then n = "" If n = "หนึ่ง" And r = "" And max <> 1 Then n = "เอ็ด" If i = 1 And n = "เอ็ด" And max > 1 Then n = "หนึ่ง" If r = "สิบ" And n = "สอง" Then n = "ยี่" If r = "" And max - i + 1 > 6 Then r = "ล้าน" If n <> "ศูนย์" Then changenum = changenum & n & r Else If r = "ล้าน" Then changenum = changenum & r End If Next End Function

Source code ที่ใช้งาน
Dim i As Integer Dim iold As Integer Dim lf As String Private Sub Command1_Click() iold = i i = i - 1 If i < 1 Then i = 3 Call puttext(i) End Sub Private Sub Command2_Click() iold = i i = i + 1 If i > 3 Then i = 1 Call puttext(i) End Sub Private Sub Form_Load() lf = Chr(13) + Chr(10) i = 1 iold = 1 Image1(1).Visible = False Image1(2).Visible = False Image1(3).Visible = False Call puttext(i) End Sub Sub puttext(x As Integer) ' text1 ต้องกำหนด multiline เป็น true นะครับ Image1(i).Top = 100 Image1(i).Left = 100 Image1(iold).Visible = False Image1(i).Visible = True Select Case i Case 1 Text1 = "นักร้องสาว ชื่อ แคท รัตติกาล" + lf Text1 = Text1 + "เป็นชาวลำปาง ร้องเพลงภาษาเหนือ" + lf Case 2 Text1 = "นางสาวลำปางปี 46" + lf Text1 = Text1 + "จบอาชีวศึกษาลำปาง เรียนตรีอยู่ ปัจจุบันทำงานอยู่อาชีวศึกษา" + lf Case 3 Text1 = "ศิษย์เก่าโยนก เคยทำงานที่โยนก" + lf Text1 = Text1 + "ต่อมาสมัครงานผ่าน net แล้วย้ายไปทำงานที่กรุงเทพฯ" + lf Case Else Text1 = "เลขผิดพลาด ไม่เข้าเงื่อนไขใด" End Select End Sub

Source code ที่ใช้งาน
'http://www.thanom.net/cal.asp เป็นอีกตัวอย่างหนึ่ง ที่สมบูรณ์กว่าที่นี่ Public mem As Double Public memo As Double Private Sub Command1_Click(Index As Integer) If Index = 10 Then mem = Text1 Text1 = 0 ElseIf Index = 11 Then Text1 = mem + Val(Text1) mem = memo * 1 ElseIf Index = 12 Then Text1 = 0 mem = 0 ElseIf Index = 13 Then Text1 = Left(Text1, Len(Text1) - 1) memo = Text1 Else Text1 = (Text1 * 10) + Index memo = Text1 End If End Sub

Source code ที่ใช้งาน
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal _ lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long Private Declare Function WaveOutGetNumDevs Lib "winmm.dll" () As Long Dim c As Integer Dim ar() Private Sub Command1_Click() Dim m For i = 0 To UBound(ar) If ar(i) = "ศูนย์" Then Call PlaySound("c:\number_wav\x0.wav", 0&, SND_ASYNC) If ar(i) = "สตางค์" Then Call PlaySound("c:\number_wav\xsatang.wav", 0&, SND_ASYNC) If ar(i) = "บาท" Then Call PlaySound("c:\number_wav\xbaht.wav", 0&, SND_ASYNC) If ar(i) = "สิบ" Then Call PlaySound("c:\number_wav\x10.wav", 0&, SND_ASYNC) If ar(i) = "ร้อย" Then Call PlaySound("c:\number_wav\x100.wav", 0&, SND_ASYNC) If ar(i) = "พัน" Then Call PlaySound("c:\number_wav\x1000.wav", 0&, SND_ASYNC) If ar(i) = "หมื่น" Then Call PlaySound("c:\number_wav\x10000.wav", 0&, SND_ASYNC) If ar(i) = "แสน" Then Call PlaySound("c:\number_wav\x100000.wav", 0&, SND_ASYNC) If ar(i) = "ล้าน" Then Call PlaySound("c:\number_wav\x1000000.wav", 0&, SND_ASYNC) If ar(i) = "หนึ่ง" Then Call PlaySound("c:\number_wav\x1.wav", 0&, SND_ASYNC) If ar(i) = "สอง" Then Call PlaySound("c:\number_wav\x2.wav", 0&, SND_ASYNC) If ar(i) = "สาม" Then Call PlaySound("c:\number_wav\x3.wav", 0&, SND_ASYNC) If ar(i) = "สี่" Then Call PlaySound("c:\number_wav\x4.wav", 0&, SND_ASYNC) If ar(i) = "ห้า" Then Call PlaySound("c:\number_wav\x5.wav", 0&, SND_ASYNC) If ar(i) = "หก" Then Call PlaySound("c:\number_wav\x6.wav", 0&, SND_ASYNC) If ar(i) = "เจ็ด" Then Call PlaySound("c:\number_wav\x7.wav", 0&, SND_ASYNC) If ar(i) = "แปด" Then Call PlaySound("c:\number_wav\x8.wav", 0&, SND_ASYNC) If ar(i) = "เก้า" Then Call PlaySound("c:\number_wav\x9.wav", 0&, SND_ASYNC) If ar(i) = "เอ็ด" Then Call PlaySound("c:\number_wav\x01.wav", 0&, SND_ASYNC) If ar(i) = "ยี่" Then Call PlaySound("c:\number_wav\x20.wav", 0&, SND_ASYNC) Next End Sub Private Sub Form_Load() Text1 = 0 Text2 = "ศูนย์" Text2.Appearance = 0 Text2.Enabled = False Command1.Caption = "&Sound" End Sub Private Sub Text1_Change() Dim lenMax As Integer, i As Byte, Satang As String, Baht As String, tmp As String lenMax = Len(Text1.Text) c = 0 ReDim ar(100) For i = 1 To lenMax If Mid(Text1.Text, i, 1) = "." Then Satang = Right(Text1.Text, lenMax - i) Baht = Left(Text1.Text, i - 1) Exit For Else Baht = Left(Text1.Text, i) End If Next If Baht <> "" Then Text2 = changenum(Baht) & "บาท" ar(c) = "บาท" c = c + 1 End If If Satang <> "" Then tmp = changenum(Satang) Text2 = Text2 & tmp ar(c) = tmp c = c + 1 End If If (tmp <> "") Then Text2 = Text2 & "สตางค์" ar(c) = "สตางค์" c = c + 1 End If End Sub Function changenum(num As String) As String Dim i As Integer, max As Integer, r As String, n As String num = Trim(Str(Val(num))) max = Len(num) For i = 1 To max r = Choose(((max - i + 1) Mod 6) + 1, "แสน", "", "สิบ", "ร้อย", "พัน", "หมื่น") n = Choose(Mid(num, i, 1) + 1, "ศูนย์", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า") If r = "สิบ" And n = "หนึ่ง" Then n = "" If n = "หนึ่ง" And r = "" And max <> 1 Then n = "เอ็ด" If i = 1 And n = "เอ็ด" And max > 1 Then n = "หนึ่ง" If r = "สิบ" And n = "สอง" Then n = "ยี่" If r = "" And max - i + 1 > 6 Then r = "ล้าน" If n <> "ศูนย์" Then changenum = changenum & n & r ar(c) = n c = c + 1 ar(c) = r c = c + 1 Else If r = "ล้าน" Then changenum = changenum & r ar(c) = r c = c + 1 End If End If Next End Function

ขั้นตอน
1. เปิด VB6.0 แล้วเลือก Standard EXE แล้ว Open
2. click Textbox จาก Toolbox
3. เลื่อน mouse ไปที่ form แล้ว click ค้างไว้ พร้อมลากไปทางขวาขนาดพอใส่ข้อมูลได้
4. ทำตามข้อ 3 สร้าง text2 และ text3 ไว้เตรียมแสดงข้อมูล
5. click Data หรือ Data control จาก Toolbox แล้วทำคล้ายข้อ 3
6. สรุปว่าใน form1 จะมี Object อยู่ 4 Object นะครับ
7. กำหนดคุณสมบัติ หรือ Properties ให้กับ Data1 3 อย่างดังข้อมูลด้านล่าง
8. กำหนดคุณสมบัติ หรือ Properties ให้กับ Text1 2 อย่างดังข้อมูลด้านล่าง
9. กำหนดคุณสมบัติ หรือ Properties ให้กับ Text2 2 อย่างดังข้อมูลด้านล่าง
10. กำหนดคุณสมบัติ หรือ Properties ให้กับ Text3 2 อย่างดังข้อมูลด้านล่าง
11. แล้วก็ save Project หาห้องเก็บให้เป็นระเบียน .. เวลาเรียกมาอีกจะได้หาเจอ
12. ผลการจัดเก็บจะได้ 2 แล้วคือ .vbp และ .frm ถ้า save แล้วก็ลองปิด VB
13. ลองเปิด VB และเปิดแฟ้ม .vbp ขึ้นมาใหม่ดูครับ
14. ถ้ามีปัญหาการทำตาม ให้ไปดูบทที่ 107 เพราะมีไม้เท้าวิเศษ ช่วยสร้างให้หมดครับ

ข้อกำหนดใน Properties
Data1 Properties
Databasename = C:\Program Files\Microsoft Visual Studio\VB98\Nwind.mdb
RecordType = Table
RecordSource = Categories
Text1 Properties
Datasource = Data1
Datafield = CategoryID
Text2 Properties
Datasource = Data1
Datafield = CategoryName
Text3 Properties
Datasource = Data1
Datafield = Description

ข้อกำหนดใน Properties
ส่วนของ Data control กำหนดเหมือน 101
DBGrid1 Properties
DataSource = Data1

ข้อกำหนดใน Properties
ส่วนของ Data control กำหนดเหมือน 101

คำสั่งควรทราบ
Data1.Recordset.AddNew

If Len(Trim((Text2)) > 0 Then
Data1.Recordset.Update
Else
Data1.Recordset.CancelUpdate
Msgbox "ไม่มีการปรับปรุงค่า"
End If

คำสั่งควรทราบ
Bookmark = Data1.Recordset.Bookmark
Data1.Recordset.Index = "PrimaryKey"
Data1.Recordset.Seek "=", Val(Text4)
If Data1.Recordset.NoMatch Then
  Data1.Recordset.Bookmark = Bookmark
Else
  Command2.Enabled = True
  Text1.Visible = True
  Text2.Visible = True
  Text3.Visible = True
End If

If MsgBox("Are you sure to delete?", vbYesNo) = vbYes Then
  Data1.Recordset.Delete
  Data1.Refresh
Else
  MsgBox "ไม่มีการปรับปรุงค่า"
End If

คำสั่งควรทราบ
ให้ Properties of DBGrid,Datasource = data1
ให้ Properties of DBGrid,AllowUpdate = false
Bookmark = Data1.Recordset.Bookmark
Data1.Recordset.Index = "PrimaryKey"
Data1.Recordset.Seek "=", Val(Text4)
If Data1.Recordset.NoMatch Then
  Data1.Recordset.Bookmark = Bookmark
Else
  Text1.Visible = True
  Text2.Visible = True
  Text3.Visible = True
End If

Private Sub DBGrid1_click()
Text4 = DBGrid1.columns(0)
Text4.Refresh
End Sub

คำสั่งควรทราบ
Private Sub Command1_Click()
Bookmark = Data1.Recordset.Bookmark
Data1.Recordset.Index = "PrimaryKey"
Data1.Recordset.Seek "=", Val(InputBox("Get categoryid"))
If Data1.Recordset.NoMatch Then
  MsgBox ("Not found")
  Data1.Recordset.Bookmark = Bookmark
End If
End Sub

Private Sub Command2_Click()
Bookmark = Data1.Recordset.Bookmark
Data1.Recordset.Index = "CategoryName"
Data1.Recordset.Seek "=", InputBox("Get categoryname")
If Data1.Recordset.NoMatch Then
  MsgBox ("Not found")
  Data1.Recordset.Bookmark = Bookmark
End If
End Sub

ขั้นตอน
1. click Project, References.. จาก menu bar
แล้วเพิ่ม Microsoft DAO 3.51 Object Library ด้วยการทำเครื่องหมายถูกใน check box
2. สร้าง Textbox ชื่อ Text1
3. สร้าง CommandButton ชื่อ Command1
4. Copy source code ด้านล่าง ไปใส่ในส่วนของ View code window
5. Run ได้เลยครับ

Source code ที่ใช้งาน
Public nwind As Workspace Public dbnwind As Database Public catrs As Recordset Private Sub Command1_Click() catrs.MoveNext Text1 = catrs.Fields("categoryid") & catrs.Fields("cn") End Sub Private Sub Form_Load() Set nwind = DBEngine.Workspaces(0) Set dbnwind = nwind.OpenDatabase("C:\Program Files\Microsoft Visual Studio\VB98\Nwind.mdb", False, False) Set catrs = dbnwind.OpenRecordset("select categoryid,categoryname as cn from categories", dbOpenSnapshot, dbReadOnly) Text1 = catrs.Fields("categoryid") & catrs.Fields("cn") End Sub

ขั้นตอน
1. click Project, References.. จาก menu bar
แล้วเพิ่ม Microsoft DAO 3.51 Object Library ด้วยการทำเครื่องหมายถูกใน check box
2. สร้าง Textbox ชื่อ Text1และ Text2
3. สร้าง CommandButton ชื่อ Command1 และ Command2
4. Copy source code ด้านล่าง ไปใส่ในส่วนของ View code window
5. Run ได้เลยครับ

Source code ที่ใช้งาน
Public nwind As Workspace Public dbnwind As Database Public catrs As Recordset Private Sub Command1_Click() SQL = "select categoryid,categoryname as cn from categories where categoryname = '" & Text2 & "'" Set catrs = dbnwind.OpenRecordset(SQL, dbOpenSnapshot, dbReadOnly) If catrs.EOF And Len(Text2) > 0 Then ' SQL = "insert into categories (categoryid,categoryname) values(" & Text1 & ",'" & Text2 & "')" ' dbnwind.Execute (SQL) Dim rs As Recordset Set rs = dbnwind.OpenRecordset("categories") rs.AddNew rs!categoryid = Text1 rs!categoryname = Text2 rs.Update Else MsgBox "invalid on categoryname" End If Call loadlast End Sub Private Sub Command2_Click() txt = "" catrs.Requery Do While Not catrs.EOF txt = txt & catrs.Fields("categoryid") & " " & catrs.Fields("cn") & Chr(13) catrs.MoveNext Loop MsgBox txt End Sub Private Sub Form_Load() Set nwind = DBEngine.Workspaces(0) Set dbnwind = nwind.OpenDatabase("C:\Program Files\Microsoft Visual Studio\VB98\Nwind.mdb", False, False) Text1.Enabled = False Call loadlast End Sub Sub loadlast() Set catrs = dbnwind.OpenRecordset("select categoryid,categoryname as cn from categories", dbOpenSnapshot, dbReadOnly) catrs.MoveLast Text1 = catrs.Fields("categoryid") + 1 Text2 = "" End Sub

Source code ที่ใช้ใน add_cat.frm Public z_addnew As Integer Public nwind As Workspace Public dbnwind As Database Public catrs As Recordset Private Sub Command1_Click(Index As Integer) If Index <> 6 And Index <> 9 Then z_addnew = 0 If z_addnew = 0 Then Command1(9).Enabled = False Command1(10).Enabled = False Else Command1(9).Enabled = True Command1(10).Enabled = True End If Text2.Enabled = False Text3.Enabled = False OLE1.Enabled = False Text2.Appearance = 0 Text3.Appearance = 0 Select Case Index Case 0: Unload Me Case 1: Data1.Recordset.MoveFirst Case 2: Data1.Recordset.MovePrevious If Data1.Recordset.BOF Then Data1.Recordset.MoveLast Case 3: Data1.Recordset.MoveNext If Data1.Recordset.EOF Then Data1.Recordset.MoveFirst Case 4: Data1.Recordset.MoveLast Case 5: Set catrs = dbnwind.OpenRecordset("categories") MsgBox catrs.RecordCount Case 6: Text2.Enabled = True Text3.Enabled = True Text2.Appearance = 1 Text3.Appearance = 1 OLE1.Enabled = True Data1.Recordset.AddNew z_addnew = 1 Command1(9).Enabled = True Command1(10).Enabled = True Case 7: Set catrs = dbnwind.OpenRecordset("select * from products where categoryid =" & Text1, dbOpenSnapshot, dbReadOnly) If catrs.EOF Then Data1.Recordset.Delete Else MsgBox "พบข้อมูลในแฟ้ม products จำนวน " & catrs.RecordCount & " ระเบียน" & Chr(13) & "จึงไม่สามารถลบระเบียนนี้ (Can not delete)" End If Data1.Recordset.MoveNext If Data1.Recordset.EOF Then Data1.Recordset.MoveFirst Case 8: Text2.Enabled = True Text3.Enabled = True Text2.Appearance = 1 Text3.Appearance = 1 OLE1.Enabled = True Command1(10).Enabled = True Case 9: If z_addnew = 1 Then Data1.Recordset.CancelUpdate Case 10: Data1.Refresh End Select End Sub Private Sub Form_Load() Set nwind = DBEngine.Workspaces(0) Set dbnwind = nwind.OpenDatabase("C:\Program Files\Microsoft Visual Studio\VB98\Nwind.mdb", False, False) 'Set catrs = dbnwind.OpenRecordset("select categoryid,categoryname as cn from categories", dbOpenSnapshot, dbReadOnly) With Me .Height = 8500 .Width = 12000 - 1200 .Left = (Screen.Width - 12000) / 2 + 1200 .Top = (Screen.Height - 9000) / 2 + 255 End With Text1.Appearance = 0 Text2.Appearance = 0 Text3.Appearance = 0 Command1(9).Enabled = False Command1(10).Enabled = False End Sub Private Sub OLE1_DblClick() OLE1.InsertObjDlg End Sub

ตัวอย่าง 1 : ทุกอย่างในฟอร์ม
Private Declare Function getdiskfreespacea _
Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal _
  iprootpathname As String, _
  ipsectorspercluster As Long, _
  ipbytespersector As Long, _
  ipnumberoffreeclusters As Long, _
  iptotalnumberofclusters As Long _
) As Long

Private Sub Command1_Click()
result = getdiskfreespacea("c:\", sectors, bytes, freecluster, totcluster)
Text1 = Format(sectors * bytes * freecluster, "##,###") & " Bytes"
Text1 = Text1 & "(" & sectors & "*" & bytes & "*" & freecluster & ")"
msgbox app.path
End Sub

ตัวอย่าง 2 : แยกประกาศในโมดูล และในฟอร์ม
' in module1 (if in form will be error)
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)

' in form1
Private Sub Command1_Click()
Dim x As SYSTEMTIME
GetSystemTime x
MsgBox x.wMilliseconds
End Sub

คำสั่งควรทราบ
List2.Clear
List3.Clear
If List1.ListCount > 255 Then j = List1.ListCount - 255 Else j = 1
For i = List1.ListCount To j Step -1
  List1.ListIndex = i - 1
  If (Mid(List1, 1, 1) = "[") Then 
    List2.AddItem List1 
  Else 
    List3.AddItem List1
  End if
Next
.
.
If Command1.Caption = "START &PING" Then
  checkip
  Timer1.Interval = Text6
  Command1.Caption = "STOP &PING"
Else
  Command1.Caption = "START &PING"
  Timer1.Interval = 0
End If

? ท่านเข้าใจตัวอย่าง code ข้างล่างนี้ว่าอย่างไร
 Dim buff As String
 Open "c:\test.txt" For Input As #1
 filestr = ""
   Do Until EOF(1)
     Line Input #1, TempStr
     filestr = filestr & TempStr & Chr$(13) & Chr$(10)
   Loop
 Close #1
 Text1.Text = filestr
 ' Open App.Path & "\output.txt" For Output As #2
 ' Print #2, s_Student, s_Grade
 

Source code ที่ใช้งาน
' YONOK Log 1.0 ' ขั้นตอน (ปรับปรุง : 2549-10-04) ' 1. เพิ่ม component ชื่อ Microsoft Internet Controls ' 2. สร้าง control ชื่อ webbrowser1 บน form ' 3. สร้าง control ชื่อ timer1 บน form ' 4. ใช้ code ด้านล่างนี้สั่ง connect เข้า web server แล้วปิดตัวเองไปใน 10 วินาที ' 5. กำหนดขนาดของ webbrowser1 กว้างยาวเป็น 1 ก็จะมองไม่เห็นครับ ' 6. Source คือ yonoklog1.frm และ yonoklog1.vbp เก็บใน c:\ ' http://www.cruto.com/Resources/VBScript/VBScript-Examples/network/client/list/List-Network-Adapter-Configuration-Properties.asp ' http://www.codeproject.com/vbscript/VvvHardwareInfo.asp?df=100&forumid=35020&exp=0&select=1464228 '====================== Private Const toserver = "http://www.yonok.ac.th/log/computer.php?q=" 'Private Declare Function GetIpAddrTable_API Lib "IpHlpApi" Alias "GetIpAddrTable" (pIPAddrTable As Any, pdwSize As Long, ByVal bOrder As Long) As Long Private Declare Function CreateRectRgn Lib _ "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, _ ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function CombineRgn Lib _ "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, _ ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Private Declare Function SetWindowRgn Lib _ "user32" (ByVal hWnd As Long, ByVal hRgn As Long, _ ByVal bRedraw As Boolean) As Long Private Declare Function DeleteObject Lib _ "gdi32" (ByVal hObject As Long) As Long ' Constants used by the CombineRgn function Private Const RGN_AND = 1 Private Const RGN_OR = 2 Private Const RGN_XOR = 3 Private Const RGN_DIFF = 4 Private Const RGN_COPY = 5 Private Sub cmdExit_Click() Unload Me End Sub ' Returns an array with the local IP addresses (as strings). ' Author: Christian d'Heureuse, www.source-code.biz 'Public Function GetIpAddrTable() ' Dim Buf(0 To 511) As Byte ' Dim BufSize As Long: BufSize = UBound(Buf) + 1 ' Dim rc As Long ' rc = GetIpAddrTable_API(Buf(0), BufSize, 1) ' If rc <> 0 Then Err.Raise vbObjectError, , "GetIpAddrTable failed with return value " & rc ' Dim NrOfEntries As Integer: NrOfEntries = Buf(1) * 256 + Buf(0) ' If NrOfEntries = 0 Then GetIpAddrTable = Array(): Exit Function ' ReDim IpAddrs(0 To NrOfEntries - 1) As String ' Dim i As Integer ' For i = 0 To NrOfEntries - 1 ' Dim j As Integer, s As String: s = "" ' For j = 0 To 3: s = s & IIf(j > 0, ".", "") & Buf(4 + i * 24 + j): Next ' IpAddrs(i) = s ' Next ' GetIpAddrTable = IpAddrs ' End Function Private Sub Form_Activate() Dim rgnForm As Long, rgnCombined As Long Dim rgnControl As Long, x As Long Dim formWidth As Single, formHeight As Single Dim borderWidth As Single, titleHeight As Single Dim ctlLeft As Single, ctlTop As Single Dim ctlWidth As Single, ctlHeight As Single Dim ctl As Control ' Calculate the form area borderWidth = (Me.Width - Me.ScaleWidth) / 2 titleHeight = Me.Height - Me.ScaleHeight - borderWidth ' Convert to Pixels borderWidth = ScaleX(borderWidth, vbTwips, vbPixels) titleHeight = ScaleY(titleHeight, vbTwips, vbPixels) formWidth = ScaleX(Me.Width, vbTwips, vbPixels) formHeight = ScaleY(Me.Height, vbTwips, vbPixels) ' Create a region for the whole form rgnForm = CreateRectRgn(0, 0, formWidth, formHeight) rgnCombined = CreateRectRgn(0, 0, 0, 0) ' Make the graphical area transparent by combining the two regions x = CombineRgn(rgnCombined, rgnForm, rgnForm, RGN_DIFF) ' Make the controls visible For Each ctl In Controls ' Make the regions of controls whose container is the form visible ' MsgBox ctl.Name If ctl.Name <> "Timer1" Then If TypeOf ctl.Container Is Form Then ctlLeft = ScaleX(ctl.Left, vbTwips, vbPixels) + borderWidth ctlTop = ScaleX(ctl.Top, vbTwips, vbPixels) + titleHeight ctlWidth = ScaleX(ctl.Width, vbTwips, vbPixels) + ctlLeft ctlHeight = ScaleX(ctl.Height, vbTwips, vbPixels) + ctlTop rgnControl = CreateRectRgn(ctlLeft, ctlTop, ctlWidth, ctlHeight) x = CombineRgn(rgnCombined, rgnCombined, rgnControl, RGN_OR) End If End If Next ctl ' Set the clipping area of the window using the resulting region SetWindowRgn hWnd, rgnCombined, True ' Tidy up x = DeleteObject(rgnCombined) x = DeleteObject(rgnControl) x = DeleteObject(rgnForm) End Sub Private Sub Form_Load() On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration") msg = "" lp = Chr(13) macaddr = "" For Each objItem In colItems msg = msg & lp & "ARP Always Source Route: " & objItem.ArpAlwaysSourceRoute msg = msg & lp & "ARP Use EtherSNAP: " & objItem.ArpUseEtherSNAP msg = msg & lp & "Caption: " & objItem.Caption msg = msg & lp & "Database Path: " & objItem.DatabasePath msg = msg & lp & "Dead GW Detection Enabled: " & objItem.DeadGWDetectEnabled msg = msg & lp & "Default IP Gateway: " & objItem.DefaultIPGateway msg = msg & lp & "Default TOS: " & objItem.DefaultTOS msg = msg & lp & "Default TTL: " & objItem.DefaultTTL msg = msg & lp & "Description: " & objItem.Description msg = msg & lp & "DHCP Enabled: " & objItem.DHCPEnabled msg = msg & lp & "DHCP Lease Expires: " & objItem.DHCPLeaseExpires msg = msg & lp & "DHCP Lease Obtained: " & objItem.DHCPLeaseObtained msg = msg & lp & "DHCP Server: " & objItem.DHCPServer msg = msg & lp & "DNS Domain: " & objItem.DNSDomain msg = msg & lp & "DNS Domain Suffix Search Order: " & objItem.DNSDomainSuffixSearchOrder msg = msg & lp & "DNS Enabled For WINS Resolution: " & objItem.DNSEnabledForWINSResolution msg = msg & lp & "DNS Server Search Order: " & objItem.DNSServerSearchOrder msg = msg & lp & "Domain DNS Registration Enabled: " & objItem.DomainDNSRegistrationEnabled msg = msg & lp & "Forward Buffer Memory: " & objItem.ForwardBufferMemory msg = msg & lp & "Full DNS Registration Enabled: " & objItem.FullDNSRegistrationEnabled msg = msg & lp & "Gateway Cost Metric: " & objItem.GatewayCostMetric msg = msg & lp & "IGMP Level: " & objItem.IGMPLevel msg = msg & lp & "Index: " & objItem.Index msg = msg & lp & "IP Address: " & objItem.IPAddress msg = msg & lp & "IP Connection Metric: " & objItem.IPConnectionMetric msg = msg & lp & "IP Enabled: " & objItem.IPEnabled msg = msg & lp & "IP Filter Security Enabled: " & objItem.IPFilterSecurityEnabled msg = msg & lp & "IP Port Security Enabled: " & objItem.IPPortSecurityEnabled msg = msg & lp & "IPSec Permit IP Protocols: " & objItem.IPSecPermitIPProtocols msg = msg & lp & "IPSec Permit TCP Ports: " & objItem.IPSecPermitTCPPorts msg = msg & lp & "IPSec Permit UDP Ports: " & objItem.IPSecPermitUDPPorts msg = msg & lp & "IP Subnet: " & objItem.IPSubnet msg = msg & lp & "IP Use Zero Broadcast: " & objItem.IPUseZeroBroadcast 'msg = msg & lp & "IPX Address: " & objItem.IPXAddress 'msg = msg & lp & "IPX Enabled: " & objItem.IPXEnabled 'msg = msg & lp & "IPX Frame Type: " & objItem.IPXFrameType 'msg = msg & lp & "IPX Media Type: " & objItem.IPXMediaType 'msg = msg & lp & "IPX Network Number: " & objItem.IPXNetworkNumber 'msg = msg & lp & "IPX Virtual Net Number: " & objItem.IPXVirtualNetNumber msg = msg & lp & "Keep Alive Interval: " & objItem.KeepAliveInterval msg = msg & lp & "Keep Alive Time: " & objItem.KeepAliveTime msg = msg & lp & "MTU: " & objItem.MTU msg = msg & lp & "Number of Forward Packets: " & objItem.NumForwardPackets msg = msg & lp & "PMTUBH Detect Enabled: " & objItem.PMTUBHDetectEnabled msg = msg & lp & "PMTU Discovery Enabled: " & objItem.PMTUDiscoveryEnabled msg = msg & lp & "Service Name: " & objItem.ServiceName msg = msg & lp & "Setting ID: " & objItem.SettingID msg = msg & lp & "TCPIP Netbios Options: " & objItem.TcpipNetbiosOptions msg = msg & lp & "TCP Maximum Connect Retransmissions: " & objItem.TcpMaxConnectRetransmissions msg = msg & lp & "TCP Maximum Data Retransmissions: " & objItem.TcpMaxDataRetransmissions msg = msg & lp & "TCP NumC onnections: " & objItem.TcpNumConnections msg = msg & lp & "TCP Use RFC1122 Urgent Pointer: " & objItem.TcpUseRFC1122UrgentPointer msg = msg & lp & "TCP Window Size: " & objItem.TcpWindowSize msg = msg & lp & "WINS Enable LMHosts Lookup: " & objItem.WINSEnableLMHostsLookup msg = msg & lp & "WINS Host Lookup File: " & objItem.WINSHostLookupFile msg = msg & lp & "WINS Primary Server: " & objItem.WINSPrimaryServer msg = msg & lp & "WINS Scope ID: " & objItem.WINSScopeID msg = msg & lp & "WINS Secondary Server: " & objItem.WINSSecondaryServer msg = "" capts = Split(objItem.Caption, " ") For Each capt In capts msg = msg & capt & lp If capt = "Ethernet" Then If macaddr = "" Then If (Len(objItem.DNSHostName) > 1) Then cname = objItem.DNSHostName msg = msg & lp & "DNS Host Name: " & cname If (Len(objItem.MACAddress) > 1) Then macaddr = objItem.MACAddress msg = msg & lp & "MAC Address: " & macaddr End If End If Next 'MsgBox msg Next ' 3 seconds = 3000 miliseconds Timer1.Interval = 3000 WebBrowser1.Navigate (toserver & macaddr & "&n=" & cname) ' Dim IpAddrs ' IpAddrs = GetIpAddrTable ' Dim i As Integer ' For i = LBound(IpAddrs) To UBound(IpAddrs) ' If (Not (IpAddrs(i) = "127.0.0.1")) Then MsgBox IpAddrs(i) ' Next End Sub Private Sub Timer1_Timer() Unload Me End Sub

ตัวอย่าง open.php
<?
$f = fopen("log.txt","a");
fputs($f, $_GET["q"].",".$_GET["n"]."\n");
fclose($f);
?>
ตัวอย่าง list.php
<?
$ar = file("log.txt");
foreach ($ar as $v) echo $v."<br>"; 
?>