Bang.... emang ngak muncul di control... di aktifkan lewat dll
ini scrip nya dalam form
Option Compare Database
Public WithEvents SockLib As bsSocketLibrary.SocketLibrary
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Dim CallHandle As Long 'Handle to the calling socket
Dim UpSock As Long 'Handle to the uploading socket
Dim DownSock As Long 'Handle to the downloading socket
Dim UpFile As Long 'Handle to the uploaded file
Dim DownFile As Long 'Handle to the downloaded file
Dim UpCount As Long 'Number of the uploaded bytes so far
Dim DownCount As Long 'Number of the downloaded bytes so far
Dim UpSize As Long 'Size of the uploaded file
Dim DownSize As Long 'Size of the downloaded file
Dim UpName As String 'Name of the uploaded file
Dim DownName As String 'Name of the downloaded file
Dim DownPath As String 'Path to the downloaded file
Const pcALERT = 10 'Alert message ID
Const pcCHAT = 20 'Chat message ID
Const pcHAVE_FILE_HEAD = 30 'This is a file header
Const pcGIVE_FILE_BODY = 31 'Ask for file data
Const pcHAVE_FILE_BODY = 32 'This is file data
Const pcSTOP_UPLOAD = 33 'Stop the uploading transfer
Const pcSTOP_DOWNLOAD = 34 'Stop the downloading transfer
Const pcBUSY_DOWNLOAD = 35 'The download channel is taken
Const psDISCONNECTED = 0
Const psCONNECTING = 1
Const psCONNECTED = 2
Function fnSendChat(txtMsg As String)
Dim Line As String
Dim li As ListItem
Call SockLib.TextToBuffer(lvPeers.SelectedItem.Tag, txtMsg)
Call SockLib.SendPacket(lvPeers.SelectedItem.Tag, pcCHAT, False)
Line = ""
Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Me: " + txtMsg
txtChatMsg = ""
Set li = Me.lvChat.ListItems.Add(, , Line)
End Function
Private Sub btnAlert_Click()
Call SockLib.TextToBuffer(lvPeers.SelectedItem.Tag, txtAlertMsg) 'Store the message
Call SockLib.SendPacket(lvPeers.SelectedItem.Tag, pcALERT, False) 'Send an alert message
txtAlertMsg = ""
End Sub
Function fnAlert(ByVal aHandle As Long, strAlert As String)
Call SockLib.TextToBuffer(aHandle, strAlert) 'Store the message
Call SockLib.SendPacket(aHandle, pcALERT, False) 'Send an alert message
Line = ""
Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Alert to: " + strAlert
Set li = Me.lvChat.ListItems.Add(, , Line)
txtAlertMsg = ""
End Function
Private Sub btnCancel_Click()
If CallHandle > 0 Then
SockLib.CloseSession (CallHandle)
CallHandle = 0
UpdateStatus
End If
End Sub
Private Sub btnChat_Click()
fnSendChat (Me.txtChatMsg)
End Sub
Private Sub btnConnect_Click()
'start the call operation
'CallHandle = SockLib.OpenSession(txtIP, Val(txtPort), "BIGSPEED_SOCKETS", "", "")
CallHandle = SockLib.OpenSession(txtIP, Val(txtPort), "BIGSPEED_SOCKETS", Me.txtUserName, fnEncPass(Me.txtPassword))
If CallHandle = 0 Then
Call MsgRoes("Cannot initiate a call", "Error")
CallHandle = 0
End If
UpdateStatus
End Sub
Private Sub btnListen_Click()
SetProperties
UpdateStatus
End Sub
Private Sub btnRemove_Click()
Dim UsrName As String
If lvPeers.SelectedItem Is Nothing Then Exit Sub
UsrName = lvPeers.SelectedItem.SubItems(3)
fnRemoveUser (UsrName)
SockLib.CloseSession (lvPeers.SelectedItem.Tag)
lvPeers.SelectedItem = Nothing
End Sub
Private Sub btnSendAll_Click()
Dim Line As String
Dim li As ListItem
Dim i As Long
For i = lvPeers.ListItems.Count To 1 Step -1
Call SockLib.TextToBuffer(lvPeers.ListItems.Item(i).Tag, txtChatMsg)
Call SockLib.SendPacket(lvPeers.ListItems.Item(i).Tag, pcCHAT, False)
Line = ""
Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Me: " + txtChatMsg
Next i
txtChatMsg = ""
Set li = Me.lvChat.ListItems.Add(, , Line)
End Sub
Private Sub cmdMyIP_Click()
Call MsgRoes(SockLib.LocalIPList, "Information")
End Sub
Private Sub Form_Close()
Set SockLib = Nothing
CloseActUser
End Sub
Private Sub Form_Load()
Gkey = "Bc4p1t4lRF"
Set SockLib = Nothing
Set SockLib = New bsSocketLibrary.SocketLibrary
CallHandle = 0
UpdateStatus
End Sub
'-----------------------
'-----------Server------
Private Sub SetProperties()
SockLib.SecurityMode = 1
SockLib.SecretKey = Gkey
SockLib.StopListening
If chkServer.Value = -1 Then
SockLib.StartListening (Val(txtListenPort))
End If
End Sub
Private Sub UpdateStatus()
Dim St As String
' Dim LI As ListItem
Dim i, Sk, ConCnt As Long
'Buttons
If CallHandle > 0 Then
'a call is in progress
btnCancel.Enabled = True
btnCancel.SetFocus
btnConnect.Enabled = False
Else
'a new call can be initiated
btnConnect.Enabled = True
btnConnect.SetFocus
btnCancel.Enabled = False
End If
If lvPeers.SelectedItem Is Nothing Then
btnRemove.Enabled = False
btnChat.Enabled = False
btnAlert.Enabled = False
Else
btnRemove.Enabled = True
btnChat.Enabled = SockLib.GetPeerState(lvPeers.SelectedItem.Tag) = psCONNECTED
btnAlert.Enabled = SockLib.GetPeerState(lvPeers.SelectedItem.Tag) = psCONNECTED
End If
'Status bar
If Gkey <> "" Then
StatusBar.Panels.Item(1) = "Encryption: ON"
Else
StatusBar.Panels.Item(1) = "Encryption: OFF"
End If
If Me.chkServer.Value = -1 Then
StatusBar.Panels.Item(2) = "Server: ON"
Else
StatusBar.Panels.Item(2) = "Server: OFF"
End If
If lvPeers.ListItems.Count = 0 Then
St = "No active connection"
Else
St = str(lvPeers.ListItems.Count) + " connected peer(s)"
End If
StatusBar.Panels.Item(3) = St
End Sub
'----------
'Client
Private Sub HaveAlert(ByVal aHandle As Long)
Dim Line As String
Line = "From " + SockLib.GetRemoteAddress(aHandle) + " at " + Format(Now, "hh:mm:ss") + Chr(13) + Chr(13)
Line = Line + SockLib.TextFromBuffer(aHandle)
Call MsgRoes(Line, "Alert")
End Sub
Private Sub Form_Unload(Cancel As Integer)
End Sub
Private Sub lvPeers_ItemClick(ByVal Item As Object)
UpdateStatus
End Sub
Private Sub lvUsers_ColumnClick(ByVal ColumnHeader As Object)
If lvUsers.Sorted And _
ColumnHeader.Index - 1 = lvUsers.SortKey Then
lvUsers.SortOrder = 1 - lvUsers.SortOrder
Else
lvUsers.SortOrder = lvwAscending
lvUsers.SortKey = ColumnHeader.Index - 1
End If
lvUsers.Sorted = True
End Sub
' *** Socket event handlers
'Request for a new incoming connection
Private Sub SockLib_OnSessionRequest(ByVal aHandle As Long, ByVal aProtocol As String, ByVal aUsername As String, aPassword As String, aAccept As Boolean)
Dim strPass As String
aAccept = False
If aProtocol <> "BIGSPEED_SOCKETS" Then Exit Sub
aAccept = True
strPass = fnGetPass(aUsername)
If strPass = "UserExist" Then
fnAlert aHandle, aUsername & " on IP : " & SockLib.GetRemoteAddress(aHandle) & " already exist/logon to server "
aAccept = False
Exit Sub
End If
If aUsername > "" Then aPassword = strPass
End Sub
'A new session is opened due to an incoming call
Private Sub SockLib_OnSessionInvoked(ByVal aHandle As Long)
Dim li As ListItem
Set li = lvPeers.ListItems.Add(, , SockLib.GetRemoteAddress(aHandle))
li.SubItems(1) = SockLib.GetRemotePort(aHandle)
li.SubItems(2) = "server"
li.SubItems(3) = SockLib.GetUsername(aHandle)
li.Tag = aHandle
UpdateStatus
End Sub
'Successful call
Private Sub SockLib_OnSessionOpen(ByVal aHandle As Long)
Dim li As ListItem
Set li = lvPeers.ListItems.Add(, , SockLib.GetRemoteAddress(aHandle))
li.SubItems(1) = SockLib.GetRemotePort(aHandle)
li.SubItems(2) = "client"
li.SubItems(3) = SockLib.GetUsername(aHandle)
li.Tag = aHandle
CallHandle = 0
If lvPeers.SelectedItem Is Nothing Then
lvPeers.SelectedItem = li
End If
UpdateStatus
End Sub
'Unsuccessful call
Private Sub SockLib_OnSessionRejected(ByVal aHandle As Long, ByVal aCode As Long)
CallHandle = 0
UpdateStatus
Call MsgRoes("Cannot connect to " + txtIP + ":" + str(txtPort) + " Error Code:" + str(aCode), fnChatErrorCode(aCode))
End Sub
'The socket is disconnected
Private Sub SockLib_OnSessionClosed(ByVal aHandle As Long, ByVal aCode As Long)
Dim i As Long
Dim UsrName As String
i = 0
For i = lvPeers.ListItems.Count To 1 Step -1
If lvPeers.ListItems.Item(i).Tag = aHandle Then
UsrName = lvPeers.ListItems.Item(i).SubItems(3)
fnRemoveUser (UsrName)
lvPeers.ListItems.Remove (i)
End If
Next i
UpdateStatus
End Sub
'A new packet is available
Private Sub SockLib_OnPacketReceived(ByVal aHandle As Long, ByVal aCode As Long)
Select Case aCode
Case pcALERT
Call HaveAlert(aHandle) 'alert message
Case pcCHAT
Call HaveChat(aHandle) 'chat message
End Select
End Sub
Private Sub HaveChat(ByVal aHandle As Long)
Dim strClientMsg As String
Dim li As ListItem
'Line = Line + "[" & SockLib.GetRemoteAddress(aHandle) & "--> " & Format(Now, "hh:mm:ss") + "] Peer: "
strClientMsg = ""
strClientMsg = SockLib.TextFromBuffer(aHandle)
'Set li = lvChat.ListItems.Add(, , Line)
CheckMsg (strClientMsg)
End Sub
Function fnChatErrorCode(ErrNo As Long) As String
Dim str As String
fnChatErrorCode = ""
Select Case ErrNo
Case Is = 0
str = "no Error"
Case Is = 1
str = "User Action"
Case Is = 2
str = "Unknown Error"
Case Is = 3
str = "Invalid Handle"
Case Is = 4
str = "Invalid Data"
Case Is = 5
str = "There is no assigned event handler"
Case Is = 6
str = "Illegal Operation"
Case Is = 7
str = "Event handler error"
Case Is = 8
str = "Bad encryption key"
Case Is = 10
str = "Connection is refused"
Case Is = 11
str = "Connection timeout"
Case Is = 12
str = "Broken Connection"
Case Is = 13
str = "Not connected"
Case Is = 14
str = "Too many connections"
Case Is = 20
str = "Cannot start server"
Case Is = 21
str = "Cannot connect to SOCKS server"
Case Is = 22
str = "Wrong username Or password"
Case Is = 23
str = "Access is denied"
Case Is = 24
str = "peer is not signed-in"
Case Is = 30
str = "Operation is already running"
Case Is = 31
str = "Operation is not running"
Case Is = 100
str = "Cannot create folder"
Case Is = 101
str = "Cannot delete folder"
Case Is = 102
str = "Cannot delete file"
Case Is = 103
str = "Cannot rename folder"
Case Is = 104
str = "Cannot rename file"
Case Is = 105
str = "Cannot open file"
Case Is = 106
str = "Cannot create file"
Case Is = 107
str = "Cannot read from file"
Case Is = 108
str = "Cannot write to file"
Case Is = 109
str = "Cannot rename temporary file"
Case Is = 110
str = "Non-supported format"
Case Is = 111
str = "Error searching file"
Case Is = 112
str = "Wrong checksum"
End Select
fnChatErrorCode = str
End Function
Sub CheckMsg(msg As String)
Dim strMsg As String
Dim SecId As String
strMsg = GetToken(msg, 1)
Select Case strMsg
Case Is = "ReqSec"
SecId = GetToken(msg, 2)
oJonec.SecuritiesAttributeRequest JonecUser, "C", 0, "0RG", SecId
End Select
End Sub
Best regard
Erwin Sugiawan
Dari: aksankurdin <aksan.kurdin@gmail.com>
Kepada: belajar-access@yahoogroups.com
Terkirim: Kam, 30 September, 2010 14:15:14
Judul: Bls: [belajar-access] Re: Antrian
sayang sekali untuk BIGSPEED tidak muncul di control activex access 2007.... :(
aksan kurdin
--- In belajar-access@yahoogroups.com, Erwin Sugiawan <esugiawan@...> wrote:
>
> Untuk winsock sebaik nya mempergunakan bigspeed dari
> http://www.bigspeed.net/index.php?page=bssocklib
> hasil nya lebih baik dan tidak pusing. contoh program sudah ada disana.
>
> dan pasti nya sudah sangat REAL TIME :)
> note :
> 1. jangan lupa melakukan refensi dll
> 2. untuk versi gratis bisa di gunakan sampai dgn 5 komputer
> 3. kalo mau lebih bayar 150 $
>
> kalo mau TETAP pake winsock referensi nya ada di sini
> http://support.microsoft.com/kb/163999
> note :
> 1. jgn lupa meletakkan object winsock nya di dalam form ms.access
> 2. winsock jika di gunakan dalam access TIDAK bisa di array beda dgn vb
>
> program winsock / bigspped socket tidak membutuhkan refresh data, krn object
> tersebut sudah ada event on receive
>
>
> Best regard
> Erwin Sugiawan
>
>
>
>
> ________________________________
> Dari: aksankurdin <aksan.kurdin@...>
> Kepada: belajar-access@yahoogroups.com
> Terkirim: Kam, 30 September, 2010 13:16:51
> Judul: [belajar-access] Re: Antrian
>
> rekan2, ada yang bisa bantu kasus ini dengan semacam winsock programming atau
> sejenisnya yang bisa di terapkan di access ?
> selain antrian ini, juga bisa jadi contoh adalah aplikasi biling warnet.
>
>
> aksan kurdin
>
>
> --- In belajar-access@yahoogroups.com, "epilambret" <epilambret@> wrote:
> >
> > betul sekali bang Aksan. antrian seperti yg di Bank atau di Telkom. lebih
> >minimalist lah. cuman tampilan nomor doang di layar utama. sementara di
> >kasir/opr tampilan nomor terakhir yang diklik kemudian dilanjutkan ke nomor
> >selanjutnya. tidak disertakan info tentang meja mana selanjutnya. hanya tampilan
> >nomor saja.
> >
> > klo untuk output masih menggunakan monitor biasa/lebar atau display khusus
> >hardware antrian. ada rekaman suara sesuai nomor.
> >
> > Sistem LAN dengan 1 server. (sorry dulu masih buta sama sekali dg
> >programming/database Baca: Gaptok!)
> >
> > pertanyaan sy apa betul lebih ringkas dari Aplikasi Penjualan?
> > -bagaimana konsep modul2 nya (query dan tabel nya)
> > -pembagian koneksi tampilan di layar utama yg realtime dg di operator
> > -handal kah dg menggunakan FE BE murni access/vba?
> > -ada prototype gak? mungkin bisa share? :))
> >
> > Thanks My Master!
> >
> > --- In belajar-access@yahoogroups.com, Aksan Kurdin <aksan.kurdin@> wrote:
> > >
> > > Coba berikan contoh kasus antrian yang dimaksud. Apakah sama dengan
> > > antrian di bank, kita ambil nomor, dan cs akan melayani satu per satu
> > > nomornya ?
> > >
> > >
> > > aksan kurdin
> > >
> > >
> > >
> > > On 9/17/2010 10:38 PM, epilambret wrote:
> > > >
> > > > Mau tanya saja. apa bisa ya buat aplikasi antrian(queque) di access.
> > > > kira2 gmn konsep dan cara kerja nya. soale px tmn yg pernah buat pake
> > > > tools lain, katanya sih paling gampang ketimbang bikin aplikasi POS
> > > > dan harga jual nya bisa lebih tinggi. support audio untuk rekam suara
> > > > dan output display.
> > > >
> > > > terima kasih
> > > >
> > > >
> > >
> >
>
>
>
>
> ------------------------------------
>
> SPAM IS PROHIBITEDYahoo! Groups Links
>
------------------------------------
SPAM IS PROHIBITEDYahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/belajar-access/
<*> Your email settings:
Individual Email | Traditional
<*> To change settings online go to:
http://groups.yahoo.com/group/belajar-access/join
(Yahoo! ID required)
<*> To change settings via email:
belajar-access-digest@yahoogroups.com
belajar-access-fullfeatured@yahoogroups.com
<*> To unsubscribe from this group, send an email to:
belajar-access-unsubscribe@yahoogroups.com
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
ini scrip nya dalam form
Option Compare Database
Public WithEvents SockLib As bsSocketLibrary.SocketLibrary
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Dim CallHandle As Long 'Handle to the calling socket
Dim UpSock As Long 'Handle to the uploading socket
Dim DownSock As Long 'Handle to the downloading socket
Dim UpFile As Long 'Handle to the uploaded file
Dim DownFile As Long 'Handle to the downloaded file
Dim UpCount As Long 'Number of the uploaded bytes so far
Dim DownCount As Long 'Number of the downloaded bytes so far
Dim UpSize As Long 'Size of the uploaded file
Dim DownSize As Long 'Size of the downloaded file
Dim UpName As String 'Name of the uploaded file
Dim DownName As String 'Name of the downloaded file
Dim DownPath As String 'Path to the downloaded file
Const pcALERT = 10 'Alert message ID
Const pcCHAT = 20 'Chat message ID
Const pcHAVE_FILE_HEAD = 30 'This is a file header
Const pcGIVE_FILE_BODY = 31 'Ask for file data
Const pcHAVE_FILE_BODY = 32 'This is file data
Const pcSTOP_UPLOAD = 33 'Stop the uploading transfer
Const pcSTOP_DOWNLOAD = 34 'Stop the downloading transfer
Const pcBUSY_DOWNLOAD = 35 'The download channel is taken
Const psDISCONNECTED = 0
Const psCONNECTING = 1
Const psCONNECTED = 2
Function fnSendChat(txtMsg As String)
Dim Line As String
Dim li As ListItem
Call SockLib.TextToBuffer(lvPeers.SelectedItem.Tag, txtMsg)
Call SockLib.SendPacket(lvPeers.SelectedItem.Tag, pcCHAT, False)
Line = ""
Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Me: " + txtMsg
txtChatMsg = ""
Set li = Me.lvChat.ListItems.Add(, , Line)
End Function
Private Sub btnAlert_Click()
Call SockLib.TextToBuffer(lvPeers.SelectedItem.Tag, txtAlertMsg) 'Store the message
Call SockLib.SendPacket(lvPeers.SelectedItem.Tag, pcALERT, False) 'Send an alert message
txtAlertMsg = ""
End Sub
Function fnAlert(ByVal aHandle As Long, strAlert As String)
Call SockLib.TextToBuffer(aHandle, strAlert) 'Store the message
Call SockLib.SendPacket(aHandle, pcALERT, False) 'Send an alert message
Line = ""
Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Alert to: " + strAlert
Set li = Me.lvChat.ListItems.Add(, , Line)
txtAlertMsg = ""
End Function
Private Sub btnCancel_Click()
If CallHandle > 0 Then
SockLib.CloseSession (CallHandle)
CallHandle = 0
UpdateStatus
End If
End Sub
Private Sub btnChat_Click()
fnSendChat (Me.txtChatMsg)
End Sub
Private Sub btnConnect_Click()
'start the call operation
'CallHandle = SockLib.OpenSession(txtIP, Val(txtPort), "BIGSPEED_SOCKETS", "", "")
CallHandle = SockLib.OpenSession(txtIP, Val(txtPort), "BIGSPEED_SOCKETS", Me.txtUserName, fnEncPass(Me.txtPassword))
If CallHandle = 0 Then
Call MsgRoes("Cannot initiate a call", "Error")
CallHandle = 0
End If
UpdateStatus
End Sub
Private Sub btnListen_Click()
SetProperties
UpdateStatus
End Sub
Private Sub btnRemove_Click()
Dim UsrName As String
If lvPeers.SelectedItem Is Nothing Then Exit Sub
UsrName = lvPeers.SelectedItem.SubItems(3)
fnRemoveUser (UsrName)
SockLib.CloseSession (lvPeers.SelectedItem.Tag)
lvPeers.SelectedItem = Nothing
End Sub
Private Sub btnSendAll_Click()
Dim Line As String
Dim li As ListItem
Dim i As Long
For i = lvPeers.ListItems.Count To 1 Step -1
Call SockLib.TextToBuffer(lvPeers.ListItems.Item(i).Tag, txtChatMsg)
Call SockLib.SendPacket(lvPeers.ListItems.Item(i).Tag, pcCHAT, False)
Line = ""
Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Me: " + txtChatMsg
Next i
txtChatMsg = ""
Set li = Me.lvChat.ListItems.Add(, , Line)
End Sub
Private Sub cmdMyIP_Click()
Call MsgRoes(SockLib.LocalIPList, "Information")
End Sub
Private Sub Form_Close()
Set SockLib = Nothing
CloseActUser
End Sub
Private Sub Form_Load()
Gkey = "Bc4p1t4lRF"
Set SockLib = Nothing
Set SockLib = New bsSocketLibrary.SocketLibrary
CallHandle = 0
UpdateStatus
End Sub
'-----------------------
'-----------Server------
Private Sub SetProperties()
SockLib.SecurityMode = 1
SockLib.SecretKey = Gkey
SockLib.StopListening
If chkServer.Value = -1 Then
SockLib.StartListening (Val(txtListenPort))
End If
End Sub
Private Sub UpdateStatus()
Dim St As String
' Dim LI As ListItem
Dim i, Sk, ConCnt As Long
'Buttons
If CallHandle > 0 Then
'a call is in progress
btnCancel.Enabled = True
btnCancel.SetFocus
btnConnect.Enabled = False
Else
'a new call can be initiated
btnConnect.Enabled = True
btnConnect.SetFocus
btnCancel.Enabled = False
End If
If lvPeers.SelectedItem Is Nothing Then
btnRemove.Enabled = False
btnChat.Enabled = False
btnAlert.Enabled = False
Else
btnRemove.Enabled = True
btnChat.Enabled = SockLib.GetPeerState(lvPeers.SelectedItem.Tag) = psCONNECTED
btnAlert.Enabled = SockLib.GetPeerState(lvPeers.SelectedItem.Tag) = psCONNECTED
End If
'Status bar
If Gkey <> "" Then
StatusBar.Panels.Item(1) = "Encryption: ON"
Else
StatusBar.Panels.Item(1) = "Encryption: OFF"
End If
If Me.chkServer.Value = -1 Then
StatusBar.Panels.Item(2) = "Server: ON"
Else
StatusBar.Panels.Item(2) = "Server: OFF"
End If
If lvPeers.ListItems.Count = 0 Then
St = "No active connection"
Else
St = str(lvPeers.ListItems.Count) + " connected peer(s)"
End If
StatusBar.Panels.Item(3) = St
End Sub
'----------
'Client
Private Sub HaveAlert(ByVal aHandle As Long)
Dim Line As String
Line = "From " + SockLib.GetRemoteAddress(aHandle) + " at " + Format(Now, "hh:mm:ss") + Chr(13) + Chr(13)
Line = Line + SockLib.TextFromBuffer(aHandle)
Call MsgRoes(Line, "Alert")
End Sub
Private Sub Form_Unload(Cancel As Integer)
End Sub
Private Sub lvPeers_ItemClick(ByVal Item As Object)
UpdateStatus
End Sub
Private Sub lvUsers_ColumnClick(ByVal ColumnHeader As Object)
If lvUsers.Sorted And _
ColumnHeader.Index - 1 = lvUsers.SortKey Then
lvUsers.SortOrder = 1 - lvUsers.SortOrder
Else
lvUsers.SortOrder = lvwAscending
lvUsers.SortKey = ColumnHeader.Index - 1
End If
lvUsers.Sorted = True
End Sub
' *** Socket event handlers
'Request for a new incoming connection
Private Sub SockLib_OnSessionRequest(ByVal aHandle As Long, ByVal aProtocol As String, ByVal aUsername As String, aPassword As String, aAccept As Boolean)
Dim strPass As String
aAccept = False
If aProtocol <> "BIGSPEED_SOCKETS" Then Exit Sub
aAccept = True
strPass = fnGetPass(aUsername)
If strPass = "UserExist" Then
fnAlert aHandle, aUsername & " on IP : " & SockLib.GetRemoteAddress(aHandle) & " already exist/logon to server "
aAccept = False
Exit Sub
End If
If aUsername > "" Then aPassword = strPass
End Sub
'A new session is opened due to an incoming call
Private Sub SockLib_OnSessionInvoked(ByVal aHandle As Long)
Dim li As ListItem
Set li = lvPeers.ListItems.Add(, , SockLib.GetRemoteAddress(aHandle))
li.SubItems(1) = SockLib.GetRemotePort(aHandle)
li.SubItems(2) = "server"
li.SubItems(3) = SockLib.GetUsername(aHandle)
li.Tag = aHandle
UpdateStatus
End Sub
'Successful call
Private Sub SockLib_OnSessionOpen(ByVal aHandle As Long)
Dim li As ListItem
Set li = lvPeers.ListItems.Add(, , SockLib.GetRemoteAddress(aHandle))
li.SubItems(1) = SockLib.GetRemotePort(aHandle)
li.SubItems(2) = "client"
li.SubItems(3) = SockLib.GetUsername(aHandle)
li.Tag = aHandle
CallHandle = 0
If lvPeers.SelectedItem Is Nothing Then
lvPeers.SelectedItem = li
End If
UpdateStatus
End Sub
'Unsuccessful call
Private Sub SockLib_OnSessionRejected(ByVal aHandle As Long, ByVal aCode As Long)
CallHandle = 0
UpdateStatus
Call MsgRoes("Cannot connect to " + txtIP + ":" + str(txtPort) + " Error Code:" + str(aCode), fnChatErrorCode(aCode))
End Sub
'The socket is disconnected
Private Sub SockLib_OnSessionClosed(ByVal aHandle As Long, ByVal aCode As Long)
Dim i As Long
Dim UsrName As String
i = 0
For i = lvPeers.ListItems.Count To 1 Step -1
If lvPeers.ListItems.Item(i).Tag = aHandle Then
UsrName = lvPeers.ListItems.Item(i).SubItems(3)
fnRemoveUser (UsrName)
lvPeers.ListItems.Remove (i)
End If
Next i
UpdateStatus
End Sub
'A new packet is available
Private Sub SockLib_OnPacketReceived(ByVal aHandle As Long, ByVal aCode As Long)
Select Case aCode
Case pcALERT
Call HaveAlert(aHandle) 'alert message
Case pcCHAT
Call HaveChat(aHandle) 'chat message
End Select
End Sub
Private Sub HaveChat(ByVal aHandle As Long)
Dim strClientMsg As String
Dim li As ListItem
'Line = Line + "[" & SockLib.GetRemoteAddress(aHandle) & "--> " & Format(Now, "hh:mm:ss") + "] Peer: "
strClientMsg = ""
strClientMsg = SockLib.TextFromBuffer(aHandle)
'Set li = lvChat.ListItems.Add(, , Line)
CheckMsg (strClientMsg)
End Sub
Function fnChatErrorCode(ErrNo As Long) As String
Dim str As String
fnChatErrorCode = ""
Select Case ErrNo
Case Is = 0
str = "no Error"
Case Is = 1
str = "User Action"
Case Is = 2
str = "Unknown Error"
Case Is = 3
str = "Invalid Handle"
Case Is = 4
str = "Invalid Data"
Case Is = 5
str = "There is no assigned event handler"
Case Is = 6
str = "Illegal Operation"
Case Is = 7
str = "Event handler error"
Case Is = 8
str = "Bad encryption key"
Case Is = 10
str = "Connection is refused"
Case Is = 11
str = "Connection timeout"
Case Is = 12
str = "Broken Connection"
Case Is = 13
str = "Not connected"
Case Is = 14
str = "Too many connections"
Case Is = 20
str = "Cannot start server"
Case Is = 21
str = "Cannot connect to SOCKS server"
Case Is = 22
str = "Wrong username Or password"
Case Is = 23
str = "Access is denied"
Case Is = 24
str = "peer is not signed-in"
Case Is = 30
str = "Operation is already running"
Case Is = 31
str = "Operation is not running"
Case Is = 100
str = "Cannot create folder"
Case Is = 101
str = "Cannot delete folder"
Case Is = 102
str = "Cannot delete file"
Case Is = 103
str = "Cannot rename folder"
Case Is = 104
str = "Cannot rename file"
Case Is = 105
str = "Cannot open file"
Case Is = 106
str = "Cannot create file"
Case Is = 107
str = "Cannot read from file"
Case Is = 108
str = "Cannot write to file"
Case Is = 109
str = "Cannot rename temporary file"
Case Is = 110
str = "Non-supported format"
Case Is = 111
str = "Error searching file"
Case Is = 112
str = "Wrong checksum"
End Select
fnChatErrorCode = str
End Function
Sub CheckMsg(msg As String)
Dim strMsg As String
Dim SecId As String
strMsg = GetToken(msg, 1)
Select Case strMsg
Case Is = "ReqSec"
SecId = GetToken(msg, 2)
oJonec.SecuritiesAttributeRequest JonecUser, "C", 0, "0RG", SecId
End Select
End Sub
Erwin Sugiawan
Dari: aksankurdin <aksan.kurdin@gmail.com>
Kepada: belajar-access@yahoogroups.com
Terkirim: Kam, 30 September, 2010 14:15:14
Judul: Bls: [belajar-access] Re: Antrian
sayang sekali untuk BIGSPEED tidak muncul di control activex access 2007.... :(
aksan kurdin
--- In belajar-access@yahoogroups.com, Erwin Sugiawan <esugiawan@...> wrote:
>
> Untuk winsock sebaik nya mempergunakan bigspeed dari
> http://www.bigspeed.net/index.php?page=bssocklib
> hasil nya lebih baik dan tidak pusing. contoh program sudah ada disana.
>
> dan pasti nya sudah sangat REAL TIME :)
> note :
> 1. jangan lupa melakukan refensi dll
> 2. untuk versi gratis bisa di gunakan sampai dgn 5 komputer
> 3. kalo mau lebih bayar 150 $
>
> kalo mau TETAP pake winsock referensi nya ada di sini
> http://support.microsoft.com/kb/163999
> note :
> 1. jgn lupa meletakkan object winsock nya di dalam form ms.access
> 2. winsock jika di gunakan dalam access TIDAK bisa di array beda dgn vb
>
> program winsock / bigspped socket tidak membutuhkan refresh data, krn object
> tersebut sudah ada event on receive
>
>
> Best regard
> Erwin Sugiawan
>
>
>
>
> ________________________________
> Dari: aksankurdin <aksan.kurdin@...>
> Kepada: belajar-access@yahoogroups.com
> Terkirim: Kam, 30 September, 2010 13:16:51
> Judul: [belajar-access] Re: Antrian
>
> rekan2, ada yang bisa bantu kasus ini dengan semacam winsock programming atau
> sejenisnya yang bisa di terapkan di access ?
> selain antrian ini, juga bisa jadi contoh adalah aplikasi biling warnet.
>
>
> aksan kurdin
>
>
> --- In belajar-access@yahoogroups.com, "epilambret" <epilambret@> wrote:
> >
> > betul sekali bang Aksan. antrian seperti yg di Bank atau di Telkom. lebih
> >minimalist lah. cuman tampilan nomor doang di layar utama. sementara di
> >kasir/opr tampilan nomor terakhir yang diklik kemudian dilanjutkan ke nomor
> >selanjutnya. tidak disertakan info tentang meja mana selanjutnya. hanya tampilan
> >nomor saja.
> >
> > klo untuk output masih menggunakan monitor biasa/lebar atau display khusus
> >hardware antrian. ada rekaman suara sesuai nomor.
> >
> > Sistem LAN dengan 1 server. (sorry dulu masih buta sama sekali dg
> >programming/database Baca: Gaptok!)
> >
> > pertanyaan sy apa betul lebih ringkas dari Aplikasi Penjualan?
> > -bagaimana konsep modul2 nya (query dan tabel nya)
> > -pembagian koneksi tampilan di layar utama yg realtime dg di operator
> > -handal kah dg menggunakan FE BE murni access/vba?
> > -ada prototype gak? mungkin bisa share? :))
> >
> > Thanks My Master!
> >
> > --- In belajar-access@yahoogroups.com, Aksan Kurdin <aksan.kurdin@> wrote:
> > >
> > > Coba berikan contoh kasus antrian yang dimaksud. Apakah sama dengan
> > > antrian di bank, kita ambil nomor, dan cs akan melayani satu per satu
> > > nomornya ?
> > >
> > >
> > > aksan kurdin
> > >
> > >
> > >
> > > On 9/17/2010 10:38 PM, epilambret wrote:
> > > >
> > > > Mau tanya saja. apa bisa ya buat aplikasi antrian(queque) di access.
> > > > kira2 gmn konsep dan cara kerja nya. soale px tmn yg pernah buat pake
> > > > tools lain, katanya sih paling gampang ketimbang bikin aplikasi POS
> > > > dan harga jual nya bisa lebih tinggi. support audio untuk rekam suara
> > > > dan output display.
> > > >
> > > > terima kasih
> > > >
> > > >
> > >
> >
>
>
>
>
> ------------------------------------
>
> SPAM IS PROHIBITEDYahoo! Groups Links
>
------------------------------------
SPAM IS PROHIBITEDYahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/belajar-access/
<*> Your email settings:
Individual Email | Traditional
<*> To change settings online go to:
http://groups.yahoo.com/group/belajar-access/join
(Yahoo! ID required)
<*> To change settings via email:
belajar-access-digest@yahoogroups.com
belajar-access-fullfeatured@yahoogroups.com
<*> To unsubscribe from this group, send an email to:
belajar-access-unsubscribe@yahoogroups.com
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
__._,_.___
SPAM IS PROHIBITED
Your email settings: Individual Email|Traditional
Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Daily Digest | Switch to Fully Featured
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe
Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Daily Digest | Switch to Fully Featured
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe
__,_._,___
No comments:
Post a Comment