| {\rtf1\ansi\deff0{\fonttbl{\f0\fnil\fcharset0 MS Sans Serif;}} {\colortbl ;\red0\green0\blue0;\red0\green0\blue255;} \viewkind4\uc1\pard\cf1\lang1044\f0\fs16 Option Explicit \par \par Private Type lbdRecord \par Machine(31) As Byte \par User(31) As Byte \par End Type \par \par Private Sub Command1_Click() \par GetUsers (Text1.Text) 'Put your data path \par End Sub \par \par Public Function GetUsers(Datapath As String) \par On Error GoTo error \par Dim LdbFile As Integer \par Dim lbdRecord As lbdRecord \par Dim Output As String \par ' we take the databasename to get the LBD name \par Dim Dummy As Integer \par Dummy = InStr(1, Datapath, ".") \par Datapath = Left(Datapath, Dummy) + "LDB" \par LdbFile = FreeFile \par ' now we open the file for read record to record \par Open Datapath For Binary Access Read Shared As LdbFile \par Do While Not EOF(LdbFile) \par Get LdbFile, , lbdRecord \par Output = Output & vbCr & vbLf & ByteArray2String(lbdRecord.Machine) & " " & ByteArray2String(lbdRecord.User) \par Loop \par Close LdbFile \par MsgBox Output, vbInformation \par Exit Function \par \par error: \par Dim Code As String \par Code = "GetUsers" \par MsgBox "Error On (" & Code & ")", vbCritical \par Resume Next \par Close LdbFile \par End Function \par \par Private Function ByteArray2String(ByteArray() As Byte) As String \par Dim Counter As Integer \par For Counter = 0 To UBound(ByteArray) \par ByteArray2String = ByteArray2String & IIf(ByteArray(Counter) = 0, "", Chr(ByteArray(Counter))) \par Next \par ByteArray2String = Trim(ByteArray2String) \par End Function \par \cf2\fs20 \par } |
Get Access Users to your program |
India web developer web development India | India web development company India ecommerce web developer