Look IP Address

Add Microsoft Winsock Control 6.0 component
Insert 1 Textbox
Insert 2 Command Buttons Rename Caption as Display and Clear
Private Sub Command1_Click()
If Text1.Text = “” Then
    Command1.Enabled = False
    Text1.Text = Winsock1.LocalIP
Else
    Command1.Enabled = True
End If
End Sub

Private Sub Command2_Click()
Text1.Text = “”
If Text1.Text = “” Then
    Command1.Enabled = True
Else
    Command1.Enabled = False
End If
End Sub

Private Sub Form_Load()
Text1.Text = “”
If Text1.Text = “” Then
    Command1.Enabled = False
Else
    Command1.Enabled = True
End If
Text1.Text = Winsock1.LocalIP
End Sub

Ping Pong

Public counter As Integer, direction As String

 
Private Sub cmdDown_Click()
cmdDown.Tag
End Sub

Private Sub Form_Load()
For T = Line1.LBound To Line1.UBound
    Let Line1(T).X1 = Main.Width / 2
    Let Line1(T).X2 = Main.Width / 2
Next T
counter = 0

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Const Inc = 1

If KeyCode = Asc(“A”) Or KeyCode = Asc(“a”) Then
    Let Shape2.Top = Shape2.Top – Inc
    If Shape2.Top < 0 Then Let Shape2.Top = 0
End If
If KeyCode = Asc(“Z”) Or KeyCode = Asc(“z”) Then
    Let Shape2.Top = Shape2.Top + Inc
    If Shape2.Top > 4920 Then Let Shape2.Top = 4920
End If
If KeyCode = Asc(“P”) Or KeyCode = Asc(“p”) Then
    Let Shape1.Top = Shape1.Top – Inc
    If Shape1.Top < 0 Then Let Shape1.Top = 0
End If
If KeyCode = Asc(“L”) Or KeyCode = Asc(“l”) Then
    Let Shape1.Top = Shape1.Top + Inc
    If Shape1.Top > 4920 Then Let Shape1.Top = 4920
End If
If KeyCode = Asc(“q”) Or KeyCode = Asc(“Q”) Then
End
End If
If KeyCode = Asc(“c”) Or KeyCode = Asc(“C”) Then
frmCredits.Show
Timer1.Enabled = False

End If

Let Text1.Text = “”
counter = 0
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
counter = -1
End Sub

Private Sub Timer1_Timer()
Let speed = Val(Shape3.Tag)
Let Vspeed = Val(Text1.Tag)
Const Vmax = 220

If speed = 0 Then Let speed = 250
If Vspeed = 0 Then Let Vspeed = 110

Let Shape3.Left = Shape3.Left + speed
Let Shape3.Top = Shape3.Top + Vspeed

If ((Shape3.Left + Shape3.Width) > Shape1.Left) And (Shape3.Top > Shape1.Top) And (Shape1.Top + Shape1.Height > Shape3.Top) Then
    If (Shape3.Left > (Shape1.Left + Shape1.Width)) Then
        Let Label2.Caption = Val(Label2.Caption) + 1
        Let Shape3.Left = Main.Width / 2
        Shape1.Top = Main.Height / 2
        Shape2.Top = Main.Height / 2
        counter = -1
        MsgBox “You lose, but it was close”
    End If
    Let speed = -speed
   
    If Vspeed > 0 Then Let Vspeed = -Int(Rnd * Vmax)
    If Vspeed < 0 Then Let Vspeed = Int(Rnd * Vmax)
End If

If ((Shape3.Left) < (Shape2.Left + Shape2.Width)) And Shape3.Top > Shape2.Top And Shape2.Top + Shape2.Height > Shape3.Top Then
    If (Shape3.Left < (Shape2.Left)) Then
   
        Let Label1.Caption = Val(Label1.Caption) + 1
        Let Shape3.Left = Main.Width / 2
        Shape2.Top = Main.Height / 2
        Shape1.Top = Main.Height / 2
        counter = -1
        MsgBox “You lose, but it was close”
    End If
    Let speed = -speed
   
    If Vspeed > 0 Then Let Vspeed = -Int(Rnd * Vmax)
    If Vspeed < 0 Then Let Vspeed = Int(Rnd * Vmax)
End If

If Shape3.Left > Main.Width Then
    Let Label2.Caption = Val(Label2.Caption) + 1
    Let Shape3.Left = Main.Width / 2
    MsgBox “Another Point For The guy on the Left”
    Let Shape3.Left = Main.Width / 2
        Shape2.Top = Main.Height / 2
        Shape1.Top = Main.Height / 2
End If

If Shape3.Left < 0 Then
    Let Label1.Caption = Val(Label1.Caption) + 1
    Let Shape3.Left = Main.Width / 2
    MsgBox “Another Point For The guy on the Right”
    Let Shape3.Left = Main.Width / 2
        Shape2.Top = Main.Height / 2
        Shape1.Top = Main.Height / 2
End If

If Shape3.Top < 0 Then
    Let Vspeed = -Vspeed
    Let Shape3.Top = 0
End If

If Shape3.Top > 5400 Then
    Let Vspeed = -Vspeed
    Let Shape3.Top = 5400
End If

Let Shape3.Tag = speed
Let Text1.Tag = Vspeed

Inc = 245

If (speed > 0) Then
    direction = “Right”
ElseIf (speed < 0) Then
    direction = “Left”
End If

 

If (counter <> -1) Then
    If (direction = “Left”) Then
        If Text1.Text = “A” Or Text1.Text = “a” Then
            Let Shape2.Top = Shape2.Top – Inc
            If Shape2.Top < 0 Then Let Shape2.Top = 0
        End If
        If Text1.Text = “Z” Or Text1.Text = “z” Then
            Let Shape2.Top = Shape2.Top + Inc
            If Shape2.Top > 4920 Then Let Shape2.Top = 4920
        End If
    ElseIf (direction = “Right”) Then
        If Text1.Text = “P” Or Text1.Text = “p” Then
            Let Shape1.Top = Shape1.Top – Inc
            If Shape1.Top < 0 Then Let Shape1.Top = 0
        End If
        If Text1.Text = “L” Or Text1.Text = “l” Then
            Let Shape1.Top = Shape1.Top + Inc
            If Shape1.Top > 4920 Then Let Shape1.Top = 4920
        End If
    End If
End If
End Sub

 

Change Date Format

‘Declaration

Public Const LOCALE_SSHORTDATE As Long = &H1F
Public Const LOCALE_USER_DEFAULT As Long = &H400

Public Declare Function GetLocaleInfo Lib “kernel32″ _
    Alias “GetLocaleInfoA” (ByVal lLocale As Long, _
        ByVal lLocaleType As Long, ByVal sLCData As String, _
        ByVal lBufferLength As Long) As Long
Public Declare Function SetLocaleInfo Lib “kernel32″ _
    Alias “SetLocaleInfoA” (ByVal Locale As Long, _
        ByVal LCType As Long, ByVal lpLCData As String) As Long

‘Form
‘put this code at form
‘i have used for short date format similarly it can be used for long
‘date format

    Dim shortDateFormat As String
    Dim lBuffSize As String
    Dim sBuffer As String
    Dim lRetGet As Long
    Dim lRetSet As Long
   
    lBuffSize = 256
    sBuffer = String$(lBuffSize, vbNullChar)
    ‘get the date information in buffer
    lRetGet = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SSHORTDATE, sBuffer, lBuffSize)
 
    If lRetGet > 0 Then
        shortDateFormat = Left$(sBuffer, lRetGet – 1)
        ‘this is the existing format of machine
   End If
    ‘to change the format if doesn’t matches ur format
 ’MM should be used in capital for monyhs,small m are for minutes
    If LCase(shortDateFormat) <> “dd/mm/yyyy” Then
        lRetSet = SetLocaleInfo(LOCALE_USER_DEFAULT,_ LOCALE_SSHORTDATE, “dd/MM/yyyy”)
‘on sucess lretset have value greater than 0
        If lRetSet <= 0 Then
             msgbox “date format not changed
        End If
    End If

Add Customer Record To Database

Private Sub cmdAdd_Click()
Dim db As Database, Table As Recordset, KiraRekod As Recordset, Total As Integer
Set db = Workspaces(0).OpenDatabase(App.Path & “\daftar.mdb”)
Set Table = db.OpenRecordset(“pendaftaran”, dbOpenDynaset)
Text1.Text = “”
Text2.Text = “”
Text3.Text = “”
Text4.Text = “”
Table.AddNew
End Sub

Private Sub cmdsubmit_Click()

simpanrekod
senaraicustomer
End Sub

Sub simpanrekod()
Dim db As Database, Table As Recordset, KiraTable As Recordset
Set db = Workspaces(0).OpenDatabase(App.Path & “\daftar.mdb”)
Set Table = db.OpenRecordset(“pendaftaran”, dbOpenDynaset)
Set KiraTable = db.OpenRecordset(“pendaftaran”)
Table.AddNew
Table(“Name”) = Text1.Text
Table(“User Login”) = Text2.Text
Table(“Password”) = Text3.Text
Table(“Email”) = Text4.Text
Table.Update
End Sub

Private Sub Command1_Click()
Text1.Text = “”
End Sub

Private Sub Command2_Click()
Text2.Text = “”
End Sub

Private Sub Command3_Click()
Text3.Text = “”
End Sub

Private Sub Command4_Click()
Text4.Text = “”
End Sub

Private Sub Command5_Click()
Text1.Text = “”
Text2.Text = “”
Text3.Text = “”
Text4.Text = “”
End Sub

Private Sub Form_Load()
Dim db As Database, Table As Recordset, KiraRekod As Recordset, Total As Integer
Set db = Workspaces(0).OpenDatabase(App.Path & “\daftar.mdb”)
Set Table = db.OpenRecordset(“pendaftaran”, dbOpenDynaset)
Set KiraRekod = db.OpenRecordset(“pendaftaran”)
senaraicustomer
End Sub

Sub senaraicustomer()
Dim db As Database, Table As Recordset, KiraRekod As Recordset, Total As Integer
Set db = Workspaces(0).OpenDatabase(App.Path & “\daftar.mdb”)
Set Table = db.OpenRecordset(“pendaftaran”, dbOpenDynaset)
Set KiraRekod = db.OpenRecordset(“pendaftaran”)
If Table.RecordCount = 0 Then
Exit Sub
Else
End If
List1.Clear
Table.MoveFirst
While Not Table.EOF
List1.AddItem Table(“Name”)
Table.MoveNext
Wend
End Sub