Wah...iya aku hampir lupa. Beberapa waktu lalu, dikomputer kawan mengalami hal serupa. Coba ini:
Function for_date()
Dim xx As Variant
xx = CInt(Left(CStr(DateSerial(2012, 1, 2)), 2))
xx = Replace(xx, "/", "")
If CInt(X) <= 2 Then
for_date = "yyyy/mm/dd"
Else
for_date = "mm/dd/yyyy"
End If
End Function
--------------------------------------------
On Fri, 20/6/14, Ira Idotel iraidotel@yahoo.com [belajar-access] <belajar-access@yahoogroups.com> wrote:
Subject: Re: [belajar-access] IP User [1 Attachment]
To: belajar-access@yahoogroups.com
Date: Friday, 20 June, 2014, 8:38 AM
[Attachment(s) from Ira Idotel
iraidotel@yahoo.com [belajar-access] included below]
Dear Pak Hariyanto ,
Surabaya
Dh, saya
coba setting di beberapa computer , da jalan IP bisa di
monitortapi
ada 2 computer yang script ya tidak bisa jalan .terlampir
problem script nya berwarna kuning.Mohon
bantuan pencerahan nyaterimakasih
. tetap semangat Pak
salam,
Ira Borneo
On Tuesday, June 17, 2014 10:53 PM, "hari
yanto har_i20002000@yahoo.com [belajar-access]"
<belajar-access@yahoogroups.com> wrote:
Bisa. Ms Access memungkinkan untuk merekam setiap
IP yang mengakses data. Dengan catatan akses tersebut
melalui form yang sudah kita tetapkan. Kalau langsung akses
ke database (table), misal dengan link, saya belum tahu.
(kalau di Mysql, bisa ketahuan melalui information schema
prosess list).
Yang pertama dilakukan adalah membuat tabel setidaknya field
id, ip, jam. Isi tabel apabila user membuka form utama.
Untuk tampilan beri form khusus yang hanya bisa dibuka oleh
user admin.
Script untuk mendefisikan IP (saya beri nama module
module1):
Option Compare Database
Option Explicit
' ******** Code Start ********
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
'IP Lookup:
' Print
fGetHostIPAddresses("machineName").Item(1)
' 192.0.09.121 ' Bogus IP listed here
' fGetHostIPAddresses(ThisComputerName).Item(1) -- lihat
Module KomName
'Name resolution:
' Print fGetHostName("192.0.09.121")
' machineName
Private Const MAX_WSADescription = 256
Private Const MAX_WSASYSStatus = 128
Private Const AF_INET = 2
Private Type WSADATA
wversion As Integer
wHighVersion As Integer
szDescription(MAX_WSADescription) As Byte
szSystemStatus(MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Type HOSTENT
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
' returns the standard host name for the local
machine
Private Declare Function apiGetHostName _
Lib "wsock32" Alias "gethostname"
_
(ByVal name As String, _
ByVal nameLen As Long) _
As Long
' retrieves host information corresponding to a host
name
' from a host database
Private Declare Function apiGetHostByName _
Lib "wsock32" Alias "gethostbyname"
_
(ByVal hostname As String) _
As Long
' retrieves the host information corresponding to a
network address
Private Declare Function apiGetHostByAddress _
Lib "wsock32" Alias "gethostbyaddr"
_
(addr As Long, _
ByVal dwLen As Long, _
ByVal dwType As Long) _
As Long
' moves memory either forward or backward, aligned or
unaligned,
' in 4-byte blocks, followed by any remaining bytes
Private Declare Sub sapiCopyMem _
Lib "kernel32" Alias "RtlMoveMemory"
_
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
' converts a string containing an (Ipv4) Internet
Protocol
' dotted address into a proper address for the IN_ADDR
structure
Private Declare Function apiInetAddress _
Lib "wsock32" Alias "inet_addr" _
(ByVal cp As String) _
As Long
' function initiates use of Ws2_32.dll by a process
Private Declare Function apiWSAStartup _
Lib "wsock32" Alias "WSAStartup"
_
(ByVal wVersionRequired As Integer, _
lpWsaData As WSADATA) _
As Long
Private Declare Function apilstrlen _
Lib "kernel32" Alias "lstrlen" _
(ByVal lpString As Long) _
As Long
Private Declare Function apilstrlenW _
Lib "kernel32" Alias "lstrlenW" _
(ByVal lpString As Long) _
As Long
' function terminates use of the Ws2_32.dll
Private Declare Function apiWSACleanup _
Lib "wsock32" Alias "WSACleanup"
_
() As Long
Function fGetHostIPAddresses(strHostName As String) As
Collection
'
' Resolves the English HostName and returns
' a collection with all the IPs bound to the card
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpHostEnt As HOSTENT
Dim strOut As String
Dim colOut As Collection
Dim lngIPAddr As Long
Dim abytIPs() As Byte
Dim i As Integer
Set colOut = New Collection
If fInitializeSockets() Then
strOut = String$(255, vbNullChar)
lngRet = apiGetHostByName(strHostName)
If lngRet Then
Call sapiCopyMem( _
lpHostEnt, _
ByVal lngRet, _
Len(lpHostEnt))
Call sapiCopyMem( _
lngIPAddr, _
ByVal lpHostEnt.hAddrList, _
Len(lngIPAddr))
Do While (lngIPAddr)
With lpHostEnt
ReDim abytIPs(0 To .hLength - 1)
strOut = vbNullString
Call sapiCopyMem( _
abytIPs(0), _
ByVal lngIPAddr, _
.hLength)
For i = 0 To .hLength - 1
strOut = strOut & abytIPs(i)
& "."
Next
strOut = Left$(strOut, Len(strOut) -
1)
.hAddrList = .hAddrList +
Len(.hAddrList)
Call sapiCopyMem( _
lngIPAddr, _
ByVal lpHostEnt.hAddrList, _
Len(lngIPAddr))
If Len(Trim$(strOut)) Then colOut.Add
strOut
End With
Loop
End If
End If
Set fGetHostIPAddresses = colOut
ExitHere:
Call apiWSACleanup
Set colOut = Nothing
Exit Function
ErrHandler:
With Err
MsgBox "Error: " & .Number &
vbCrLf & .Description, _
vbOKOnly Or vbCritical, _
.Source
End With
Resume ExitHere
End Function
Function fGetHostName(strIPAddress As String) As String
'
' Looks up a given IP address and returns the
' machine name it's bound to
'
On Error GoTo ErrHandler
Dim lngRet As Long
Dim lpAddress As Long
Dim strOut As String
Dim lpHostEnt As HOSTENT
If fInitializeSockets() Then
lpAddress = apiInetAddress(strIPAddress)
lngRet = apiGetHostByAddress(lpAddress, 4,
AF_INET)
If lngRet Then
Call sapiCopyMem( _
lpHostEnt, _
ByVal lngRet, _
Len(lpHostEnt))
fGetHostName = fStrFromPtr(lpHostEnt.hName,
False)
End If
End If
ExitHere:
Call apiWSACleanup
Exit Function
ErrHandler:
With Err
MsgBox "Error: " & .Number &
vbCrLf & .Description, _
vbOKOnly Or vbCritical, _
.Source
End With
Resume ExitHere
End Function
Private Function fInitializeSockets() As Boolean
Dim lpWsaData As WSADATA
Dim wVersionRequired As Integer
wVersionRequired = fMakeWord(2, 2)
fInitializeSockets = ( _
apiWSAStartup(wVersionRequired, lpWsaData) = 0)
End Function
Private Function fMakeWord( _
ByVal low As Integer, _
ByVal hi As Integer) _
As Integer
Dim intOut As Integer
Call sapiCopyMem( _
ByVal VarPtr(intOut) + 1, _
ByVal VarPtr(hi), _
1)
Call sapiCopyMem( _
ByVal VarPtr(intOut), _
ByVal VarPtr(low), _
1)
fMakeWord = intOut
End Function
Private Function fStrFromPtr( _
pBuf As Long, _
Optional blnIsUnicode As
Boolean) _
As String
Dim lngLen As Long
Dim abytBuf() As Byte
If blnIsUnicode Then
lngLen = apilstrlenW(pBuf) * 2
Else
lngLen = apilstrlen(pBuf)
End If
' if it's not a ZLS
If lngLen Then
ReDim abytBuf(lngLen)
' return the buffer
If blnIsUnicode Then
'blnIsUnicode is True not tested
Call sapiCopyMem(abytBuf(0), ByVal pBuf,
lngLen)
fStrFromPtr = abytBuf
Else
ReDim Preserve abytBuf(UBound(abytBuf) - 1)
Call sapiCopyMem(abytBuf(0), ByVal pBuf,
lngLen)
fStrFromPtr = StrConv(abytBuf, vbUnicode)
End If
End If
End Function
' ******** Code End ********
Selanjutnya, sebagai pelengkap buat module baru (saya beri
nama KomNama):
Option Compare Database
Option Explicit
Private Declare Function GetComputerName Lib
"kernel32" Alias _
"GetComputerNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Private Const MAX_COMPUTERNAME_LENGTH = 31
Function ThisComputerName() As String
Dim lpBuffer As String
Dim nSize As Long
Dim lngRet As Long
nSize = MAX_COMPUTERNAME_LENGTH + 1
lpBuffer = Space(nSize)
lngRet = GetComputerName(lpBuffer, nSize)
If lngRet <> 0 Then
ThisComputerName = Left(lpBuffer, nSize)
End If
End Function
====
Sebagai pembanding, bisa pula menggunakan script sebagaimana
di
http://bytes.com/topic/access/insights/684989-how-generate-user-list
Semoga bisa membantu dan memberi semangat.
Hariyanto (Surabaya)
--------------------------------------------
On Tue, 17/6/14, Ira Idotel iraidotel@yahoo.com
[belajar-access] <belajar-access@yahoogroups.com>
wrote:
Subject: [belajar-access] IP User
To: belajar-access@yahoogroups.com
Date: Tuesday, 17 June, 2014, 4:48 PM
Dear All , Pakar,Suhu,
Rekan Access Sekaliansalam hormat, salam sehat
dan apa khabar semua.Dh,
Saya
mau coba apakah bisa ya?,DB Access sudah jalan dengan
SQL,
dengan sistem ODBC kebeberapa user yang di setting satu
persatu, untuk saya sebagai Admin nya yang bisa copy,
paste
dan edit, sedangkan user hanya bisa copy dan paste
saja.Nah
yang saya mau tanyakan apa bisa saya sebagai admin
melihat
IP Computer mana saja yang buka DB dan Jam nya.VBA
atau SQL nya hanya di pasang di Admin saja yang bisa
melihatnya dan mudah memonitor nya.dan data nya bisa
tampil
di satu tabel.
terimakasih
Salam,
Ira Borneo
#yiv2628866072 #yiv2628866072 --
#yiv2628866072ygrp-mkp {
border:1px solid #d8d8d8;font-family:Arial;margin:10px
0;padding:0 10px;}
#yiv2628866072 #yiv2628866072ygrp-mkp hr {
border:1px solid #d8d8d8;}
#yiv2628866072 #yiv2628866072ygrp-mkp #yiv2628866072hd {
color:#628c2a;font-size:85%;font-weight:700;line-height:122%;margin:10px
0;}
#yiv2628866072 #yiv2628866072ygrp-mkp #yiv2628866072ads {
margin-bottom:10px;}
#yiv2628866072 #yiv2628866072ygrp-mkp .yiv2628866072ad {
padding:0 0;}
#yiv2628866072 #yiv2628866072ygrp-mkp .yiv2628866072ad p {
margin:0;}
#yiv2628866072 #yiv2628866072ygrp-mkp .yiv2628866072ad a {
color:#0000ff;text-decoration:none;}
#yiv2628866072 #yiv2628866072ygrp-sponsor
#yiv2628866072ygrp-lc {
font-family:Arial;}
#yiv2628866072 #yiv2628866072ygrp-sponsor
#yiv2628866072ygrp-lc #yiv2628866072hd {
margin:10px
0px;font-weight:700;font-size:78%;line-height:122%;}
#yiv2628866072 #yiv2628866072ygrp-sponsor
#yiv2628866072ygrp-lc .yiv2628866072ad {
margin-bottom:10px;padding:0 0;}
#yiv2628866072 #yiv2628866072actions {
font-family:Verdana;font-size:11px;padding:10px 0;}
#yiv2628866072 #yiv2628866072activity {
background-color:#e0ecee;float:left;font-family:Verdana;font-size:10px;padding:10px;}
#yiv2628866072 #yiv2628866072activity span {
font-weight:700;}
#yiv2628866072 #yiv2628866072activity span:first-child {
text-transform:uppercase;}
#yiv2628866072 #yiv2628866072activity span a {
color:#5085b6;text-decoration:none;}
#yiv2628866072 #yiv2628866072activity span span {
color:#ff7900;}
#yiv2628866072 #yiv2628866072activity span
.yiv2628866072underline {
text-decoration:underline;}
#yiv2628866072 .yiv2628866072attach {
clear:both;display:table;font-family:Arial;font-size:12px;padding:10px
0;width:400px;}
#yiv2628866072 .yiv2628866072attach div a {
text-decoration:none;}
#yiv2628866072 .yiv2628866072attach img {
border:none;padding-right:5px;}
#yiv2628866072 .yiv2628866072attach label {
display:block;margin-bottom:5px;}
#yiv2628866072 .yiv2628866072attach label a {
text-decoration:none;}
#yiv2628866072 blockquote {
margin:0 0 0 4px;}
#yiv2628866072 .yiv2628866072bold {
font-family:Arial;font-size:13px;font-weight:700;}
#yiv2628866072 .yiv2628866072bold a {
text-decoration:none;}
#yiv2628866072 dd.yiv2628866072last p a {
font-family:Verdana;font-weight:700;}
#yiv2628866072 dd.yiv2628866072last p span {
margin-right:10px;font-family:Verdana;font-weight:700;}
#yiv2628866072 dd.yiv2628866072last p
span.yiv2628866072yshortcuts {
margin-right:0;}
#yiv2628866072 div.yiv2628866072attach-table div div a {
text-decoration:none;}
#yiv2628866072 div.yiv2628866072attach-table {
width:400px;}
#yiv2628866072 div.yiv2628866072file-title a, #yiv2628866072
div.yiv2628866072file-title a:active, #yiv2628866072
div.yiv2628866072file-title a:hover, #yiv2628866072
div.yiv2628866072file-title a:visited {
text-decoration:none;}
#yiv2628866072 div.yiv2628866072photo-title a,
#yiv2628866072 div.yiv2628866072photo-title a:active,
#yiv2628866072 div.yiv2628866072photo-title a:hover,
#yiv2628866072 div.yiv2628866072photo-title a:visited {
text-decoration:none;}
#yiv2628866072 div#yiv2628866072ygrp-mlmsg
#yiv2628866072ygrp-msg p a span.yiv2628866072yshortcuts {
font-family:Verdana;font-size:10px;font-weight:normal;}
#yiv2628866072 .yiv2628866072green {
color:#628c2a;}
#yiv2628866072 .yiv2628866072MsoNormal {
margin:0 0 0 0;}
#yiv2628866072 o {
font-size:0;}
#yiv2628866072 #yiv2628866072photos div {
float:left;width:72px;}
#yiv2628866072 #yiv2628866072photos div div {
border:1px solid
#666666;height:62px;overflow:hidden;width:62px;}
#yiv2628866072 #yiv2628866072photos div label {
color:#666666;font-size:10px;overflow:hidden;text-align:center;white-space:nowrap;width:64px;}
#yiv2628866072 #yiv2628866072reco-category {
font-size:77%;}
#yiv2628866072 #yiv2628866072reco-desc {
font-size:77%;}
#yiv2628866072 .yiv2628866072replbq {
margin:4px;}
#yiv2628866072 #yiv2628866072ygrp-actbar div a:first-child {
margin-right:2px;padding-right:5px;}
#yiv2628866072 #yiv2628866072ygrp-mlmsg {
font-size:13px;font-family:Arial, helvetica, clean,
sans-serif;}
#yiv2628866072 #yiv2628866072ygrp-mlmsg table {
font-size:inherit;font:100%;}
#yiv2628866072 #yiv2628866072ygrp-mlmsg select,
#yiv2628866072 input, #yiv2628866072 textarea {
font:99% Arial, Helvetica, clean, sans-serif;}
#yiv2628866072 #yiv2628866072ygrp-mlmsg pre, #yiv2628866072
code {
font:115% monospace;}
#yiv2628866072 #yiv2628866072ygrp-mlmsg * {
line-height:1.22em;}
#yiv2628866072 #yiv2628866072ygrp-mlmsg #yiv2628866072logo {
padding-bottom:10px;}
#yiv2628866072 #yiv2628866072ygrp-msg p a {
font-family:Verdana;}
#yiv2628866072 #yiv2628866072ygrp-msg
p#yiv2628866072attach-count span {
color:#1E66AE;font-weight:700;}
#yiv2628866072 #yiv2628866072ygrp-reco
#yiv2628866072reco-head {
color:#ff7900;font-weight:700;}
#yiv2628866072 #yiv2628866072ygrp-reco {
margin-bottom:20px;padding:0px;}
#yiv2628866072 #yiv2628866072ygrp-sponsor #yiv2628866072ov
li a {
font-size:130%;text-decoration:none;}
#yiv2628866072 #yiv2628866072ygrp-sponsor #yiv2628866072ov
li {
font-size:77%;list-style-type:square;padding:6px 0;}
#yiv2628866072 #yiv2628866072ygrp-sponsor #yiv2628866072ov
ul {
margin:0;padding:0 0 0 8px;}
#yiv2628866072 #yiv2628866072ygrp-text {
font-family:Georgia;}
#yiv2628866072 #yiv2628866072ygrp-text p {
margin:0 0 1em 0;}
#yiv2628866072 #yiv2628866072ygrp-text tt {
font-size:120%;}
#yiv2628866072 #yiv2628866072ygrp-vital ul li:last-child {
border-right:none !important;
}
#yiv2628866072
Posted by: hari yanto <har_i20002000@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (7) |
Tidak ada komentar:
Posting Komentar