| 'In the Module: Option Explicit Private Type lbdRecord Machine(31) As Byte User(31) As Byte End Type Public Function GetUsers(Datapath As String) On Error GoTo error Dim LdbFile As Integer Dim lbdRecord As lbdRecord Dim Output As String ' we take the data b name to get th LBD name Dim Dummy As Integer Dummy = InStr(1, Datapath, ".") Datapath = Left(Datapath, Dummy) + "LDB" LdbFile = FreeFile ' now we open the file for read record to record Open Datapath For Binary Access Read Shared As LdbFile Do While Not EOF(LdbFile) Get LdbFile, , lbdRecord Output = Output & vbCr & vbLf & ByteArray2String(lbdRecord.Machine) & " " & ByteArray2String(lbdRecord.User) Loop Close LdbFile MsgBox Output, vbInformation Exit Function error: Dim Code As String Code = "GetUsers" MsgBox "Error On (" & Code & ")", vbCritical Resume Next Close LdbFile End Function Private Function ByteArray2String(ByteArray() As Byte) As String Dim Counter As Integer For Counter = 0 To UBound(ByteArray) ByteArray2String = ByteArray2String & IIf(ByteArray(Counter) = 0, "", Chr(ByteArray(Counter))) Next ByteArray2String = Trim(ByteArray2String) End Function 'In the programme: Private Sub Command1_Click() GetUsers (Text1.Text) End Sub Private Sub Form_Load() Text1.Text = App.Path & "\" & App.EXEName End Sub |
Get number of users |
India web developer web development India | Freelance web development ecommerce web developer | Prayagasoft - web designer India, Ecommerce developer india, Ecommerce design