Fórum Converter VB para Delphi #326110

Option Compare Database
Option Explicit

´*************************************************************

´This module is based in part on a VB4 sample that is referenced
´by the white paper "Understanding Jet Locking".  Instructions
´for this and other utilities can be referenced in that paper

´MSLdbUsr.DLL was written and developed by
´Kevin Collins (73760.1047@compuserve.com)
´and Bob Delavan

´This Access for Windows 95 sample was written and developed
´by Michael Kaplan (102363.1726@compuserve.com, or also at
´MichaelK_TSI@msn.com).

´*************************************************************

´You use the following constants with the LDBUser_GetUsers
´function´s "nOptions" parameter below.
Public Const OptAllLDBUsers = &H1
Public Const OptLDBLoggedUsers = &H2
Public Const OptLDBCorruptUsers = &H4
Public Const OptLDBUserCount = &H8
Public Const OptLDBUserAuthor = &HB0B

´Takes a string array buffer, a currently existing database
´filename, and one of the above constants as its parameters.
´When successful it will return the number of people in the
´database or "0" if there are no people in it.  It returns a
´negative number in case of an error, and you can then use
´LDBUser_GetError to retrieve extended error information.
Declare Function LDBUser_GetUsers Lib "MSLDBUSR.DLL" _
  (lpszUserBuffer() As String, ByVal lpszFilename As String, _
  ByVal nOptions As Long) As Integer
  
´Takes the error code returned by another MSLDBUSR.DLL function
´call and returns the error text associated with that error.
Declare Function LDBUser_GetError Lib "MSLDBUSR.DLL" _
  (ByVal nErrorNo As Long) As String _
  

Function GetComputerNames(ByVal strMDB As String, _
                          ByVal lngOptions As Long, _
                          ByRef varArray As Variant) _
                          As Integer

´In:
´   strMDB      Name of MDB file (including MDB file type suffix)
´   lngOptions  The value of the OptMDB constant to be used.
´   varArray    A variant that will hold either the error code
´               and error message OR the array of user names that
´               was requested.
´Out:
´   On Success  The number of users (0-255) that meet the
´               specified criteria.
´   On Failure  The error code. Extended info can be retrieved
´               with LDBUser_GetError.
                
    Dim intReturn As Integer
    
    ReDim astrBuffer(1) As String
    
    strMDB = MDBName(strMDB)
    
    intReturn = LDBUser_GetUsers(astrBuffer, strMDB, lngOptions)
    
    GetComputerNames = intReturn
    
    If intReturn < 0 Then
        varArray = LDBUser_GetError(intReturn)
    Else
        varArray = astrBuffer()
    End If
End Function


Private Function MDBName(strMDB As String)
´Formats the MDB filename string and adds on the file type
´extension, if it does not already exist.
´    If Len(strMDB) <> 0 Then
´        If InStr(UCase(strMDB), ".MDB") = 0 Then
´            strMDB = strMDB & ".MDB"
´        End If
´        strMDB = strMDB + Chr$(0) + Chr$(0)
        MDBName = strMDB
´    End If
End Function

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    aUserList : array of ansistring;
  end;

var
  Form1: TForm1;

implementation

function LDBUser_GetUsers (var lpszUserBuffer : array of ansistring; const lpszFilename : ansistring; const nOptions : longint) : longint; external ´MSLDBUSR.DLL´;

function LDBUser_GetError (nErrorNo : longint) : shortstring; external ´MSLDBUSR.DLL´;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
   cArq : AnsiString = ´C:\DADOS\PRINCIPAL.MDB´;
   nUs : longint = 1;
var
   nUser : longint;
begin
   SetLength(aUserList, 1);

   nUser := LDBUser_GetUsers(aUserList, cArq, nUs);

   if nUser > 0 then
      ShowMessage(aUserList[0])
   else
      ShowMessage(LDBUser_GetError(nUser))
end;

end.