System, Retrieve Listing of Program Group

‘Description: Uses DDE to retrieve a complete listing of Program Groups
‘             in List1 and Program Items in List2

‘Uses 2 listBoxes and 2 TextBoxes. Use default names.
‘Sub Form_Load ()
Text1.Visible = False
Text2.Visible = False
GetGroups List1
‘End Sub

‘Sub List1_Click ()
GetItems List2
‘End Sub

‘Sub GetGroups (OutPutCtl As ListBox)
On Error GoTo GError
Text1.LinkTopic = “Progman|Progman”
Text1.LinkMode = 2
Text1.LinkItem = “groups”
Text1.LinkRequest
OutPutCtl.Clear
sGroups$ = Text1
pos% = InStr(1, sGroups$, Chr$(13))
While pos%
OutPutCtl.AddItem RTrim$(Mid$(sGroups$, 1, pos% – 1))
sGroups$ = LTrim$(Mid$(sGroups$, pos% + 2))
pos% = InStr(1, sGroups$, Chr$(13))
Wend
OutPutCtl.ListIndex = 0
Text1.LinkMode = 0
Exit Sub

GError:
MsgBox Error
Resume Next
‘End Sub

‘Sub GetItems (OutPutCtl As ListBox)
On Error GoTo IError
OutPutCtl.Clear
If Len(List1.Text) Then
Text2.LinkTopic = “Progman|Progman”
Text2.LinkMode = 2
Text2.LinkItem = List1
Text2.LinkRequest
sItems$ = Text2
pos% = InStr(1, sItems$, Chr$(44))
temp% = InStr(1, sItems$, Chr$(10))
If temp% < pos% Then pos% = temp%
While pos%
sItems$ = LTrim$(Mid$(sItems$, pos% + 1))
pos% = InStr(1, sItems$, Chr$(44))
temp% = InStr(1, sItems$, Chr$(10))
If temp% < pos% Then pos% = temp%
cnt% = cnt% + 1
If Int((cnt% – 4) / 9) = (cnt% – 4) / 9 Then
tststr$ = RTrim$(Mid$(sItems$, 1, pos% – 1))
Sppos1% = InStr(1, tststr$, Chr$(34))
SpPos2% = InStr(Sppos1% + 1, tststr$, Chr$(34))
OutPutCtl.AddItem Mid$(tststr$, Sppos1% + 1, (SpPos2% – Sppos1%) – 1)
End If
Wend
End If
Text2.LinkMode = 0
Exit Sub
IError:
MsgBox Error
Resume Next
‘End Sub

Internet, Returning Host name from WinShock

‘Description: Asynchronous routine which returns the true host name given
‘             an IP address, or Web address.

‘Usage
‘Handle = WSAAsyncGetHostByNameAlias(Text1.hWnd, &H202, “www.intrstar.net”)

‘Public Function WSAAsyncGetHostByNameAlias(hWnd As Integer, wMsg As Integer, Host As String) As Long
Dim retIP As Long
retIP = inet_addr(Host)
If retIP = INADDR_NONE Then
retIP = WSAAsyncGetHostByName(hWnd, wMsg, Host, hostentbuffer, hostentasync_size)
Else
retIP = WSAAsyncGetHostByAddr(hWnd, wMsg, retIP, 4, AF_INET, hostentbuffer, hostentasync_size)
End If
WSAAsyncGetHostByNameAlias = retIP
‘End Function

Create ActiveX Control

1. Create project and choose ActiveX Control template, save with name Jam;

2. And save your control user with name ControlJam;

3. Create  control label and component timer.

and here code:

Private sub lblJamz_DblClick()

msgbox “Time” & Time & vbCrlf & “Date” & Date,vbInformation,”ActiveXControl”

End Sub

Private sub tmr_timer()

lblJa.Caption=Time

End Sub

Private sub UserControl_Initialize()

tmr.Interval=1000

tmr.enabled=true

lblJam.Caption=Time

lblJam.ToolTipText=Now

End Sub

Stored Procedure

Private cnn As ADODB.Connection

Private Sub Form_Load()

Set cnn=New ADODB.Connection

cnn.ConnectionString=”Provider=Microsoft.Jet.OLEDB.4.0;”&”Data Source=_

” & App.Path & “\TTVB2.mdb;”

cnn.Open

’stored procedure

Me.txtSP.Text=”Create Procedure SupProc AS” & “Select TdSup,Nama,Alamat_

,Telp From Supplier”

End Sub

Private Sub cmdCreate_Click()

On Error Resume Next

cnn.Execute Me.txtSp.text

Debug.Print “StoredProcedure created”

Dim rs As NewADODB.RecordSet

rs.CursorLocation=adUseClient

rs.Open “Execute SupProc”, cnn

Set me.grd.DataSource=rs

End Sub