(Resolvido) Componente BDE32

[António44]

Tenho bases de dados a funcionar com este componente BDE32 delphi 3 mas agora precisava usar num pc que não tem previlégio de administrador...acontece um erro penso que seja quando o componente quer escrever no registo,...haverá maneira de dar volta a isto sem mudar previlégios.????

agradeço ai aos amigos se puderem ajudar.

Abraços

[Jhonas]

acontece um erro penso que seja quando o componente quer escrever no registro

seja sempre explicito na sua colocação .... erro ??? ( que erro ?) escrever no registro ??? ( onde esta o código ?)

quanto mais informações fornecer, mais facil fica para ajuda-lo

abraço

[António44]

''acontece um erro penso que seja quando o componente quer escrever no registro''

ERegistryException in Module Gestor.exe Failed set data for 'ConfigFile01'

Este é o erro quando o tenta escrever no registro.o codigo está no proprio componente BDE32.

constructor TBDE32.Create(AOwner:TComponent);
var
   ConfigFile, DLLPath: string;
begin
     {Create: 1. Discover if BDE is installed by checing registry
              2. If not then look for BDE files and write loctations to Registry
              3. If unable to find BDE files then ask for them
              4. Finally read key settings from CFG file (if available)}
     inherited Create(AOwner);
     with TRegistry.create do begin
        Rootkey := HKEY_LOCAL_MACHINE;
        if not (OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false) and FileExists(ReadString('DLLPATH') + '\idapi32.dll')) then begin
           if GetPaths(ConfigFile, DLLPath) then begin
             Rootkey := HKEY_LOCAL_MACHINE;
             OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', True);
             WriteString('CONFIGFILE01', ConfigFile);
             WriteString('DLLPATH', DLLPath);
             WriteString('RESOURCE', '0009');
             WriteString('SAVECONFIG', 'WIN31');
             WriteString('UseCount', '1');
           end
           else begin
             ShowMessage('Please put BDE files in ' + ExtractFilePath(application.ExeName) + 'BDE');
             halt;
           end;
        end;
        Free;
     end;
     ReadSettings;

Obrigado,

abraço

Editado Março 27, 2012 por António44

[Jhonas]

compare o seu codigo com esse do link e descobrirá o problema

http://coding.derkeiler.com/Archive/Delphi...04-10/0170.html

abraço

[António44]

O cod que estava usando era esse funciona bem excepto em pc que previlégio de admin...eu queria que funcionasse sem o usuário ter esse previlégio

directamente de uma USB

unit BDE32;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry;

type
  TBDE32 = class(TComponent)
  private
    FLocalShare: Boolean;
    FPdxNetDir: String;
    FMaxBufSize, FMaxFileHandles, FMemSize, FSharedMemSize: integer;
    function GetRegistryDir(RegKey, DefaultDir: string): String;
    procedure TestBDEDir(TestDir: string; var CF: string; var DLLP: string);
    function GetPaths(var CF: string; var DLLP: string): boolean;
    procedure writeToCFG(Item: string;  Val: string);
    function ReadFromCFG(Item: string;  DefStr: string): string;
  protected
    { Protected declarations }
  public
    constructor Create(AOwner:TComponent); override;
  published
    property LocalShare: boolean read FLocalShare write FLocalShare;
    property PdxNetDir: String read FPdxNetDir write FPdxNetDir;
    property MaxBufSize: integer read FMaxBufSize write FMaxBufSize;
    property MaxFileHandles: integer read FMaxFileHandles write FMaxFileHandles;
    property MemSize: integer read FMemSize write FMemSize;
    property SharedMemSize: integer read FSharedMemSize write FSharedMemSize;
    procedure WriteSettings;
    procedure ReadSettings;
  end;

function FilePos(FileName, What: string; startFrom: integer):integer;

procedure Register;

implementation
                    
{thanks to Andrea Sessa (asessa@nest.it) for the leading '\' on all registry paths...
 and to Remy Vincent (remyvincent@hotmail.com) for the GetCommonFilesDir function and for providing key dirs to look for BDE files...
 anyone else who improves BDE32 will get a mention - email paul@kestrelsoftware.co.uk with your improvements}




{########################### Check for BDE installation ###########################}
constructor TBDE32.Create(AOwner:TComponent);
var
   ConfigFile, DLLPath: string;
begin
     {Create: 1. Discover if BDE is installed by checing registry
              2. If not then look for BDE files and write loctations to Registry
              3. If unable to find BDE files then ask for them
              4. Finally read key settings from CFG file (if available)}
     inherited Create(AOwner);
     with TRegistry.create do begin
        Rootkey := HKEY_LOCAL_MACHINE;
        if not (OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false) and FileExists(ReadString('DLLPATH') + '\idapi32.dll')) then begin
           if GetPaths(ConfigFile, DLLPath) then begin
             Rootkey := HKEY_LOCAL_MACHINE;
             OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', True);
             WriteString('CONFIGFILE01', ConfigFile);
             WriteString('DLLPATH', DLLPath);
             WriteString('RESOURCE', '0009');
             WriteString('SAVECONFIG', 'WIN31');
             WriteString('UseCount', '1');
           end
           else begin
             ShowMessage('Please put BDE files in ' + ExtractFilePath(application.ExeName) + 'BDE');
             halt;
           end;
        end;
        Free;
     end;
     ReadSettings;
end;









{########################### Read/Write to CFG file ###########################}
procedure TBDE32.ReadSettings;
begin
     FPdxNetDir := ReadFromCFG('NET DIR', 'F:\');
     FLocalShare := ReadFromCFG('LOCAL SHARE', 'FALSE') = 'TRUE';
     FMaxBufSize := StrToInt(ReadFromCFG('MAXBUFSIZE', '2048'));
     FMaxFileHandles := StrToInt(ReadFromCFG('MAXFILEHANDLES', '48'));
     FMemSize := StrToInt(ReadFromCFG('MEMSIZE', '16'));
     FSharedMemSize := StrToInt(ReadFromCFG('SHAREDMEMSIZE', '2048'));
end;

procedure TBDE32.WriteSettings;
begin
     if FLocalShare then writeToCFG('LOCAL SHARE', 'TRUE')
     else writeToCFG('LOCAL SHARE', 'FALSE');
     writeToCFG('NET DIR', FPdxNetDir);
     writeToCFG('MAXBUFSIZE', IntToStr(FMaxBufSize));
     writeToCFG('MAXFILEHANDLES', IntToStr(FMaxFileHandles));
     writeToCFG('MEMSIZE', IntToStr(FMemSize));
     writeToCFG('SHAREDMEMSIZE', IntToStr(FSharedMemSize));
end;





procedure TBDE32.writeToCFG(Item: string;  Val: string);
Var
   CFGFile, TempFile: string;
   CFGStream, TempStream: TFileStream;
   FoundPos1, FoundPos2: integer;
   myBuf: array[0..255] of char;
begin
     with TRegistry.create do begin
        Rootkey := HKEY_LOCAL_MACHINE;
        OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false);
        CFGFile := ReadString('CONFIGFILE01');
        Free;
     end;
     TempFile := CFGFile + '2';
     FoundPos1 := FilePos(CFGFile, Item, 0);
     if FoundPos1 > 0 then begin
        FoundPos2 := FilePos(CFGFile, #0, FoundPos1  + Length(Item) + 3);
        CFGStream := TFileStream.Create(CFGFile, fmOpenRead);
        TempStream := TFileStream.Create(TempFile, fmOpenWrite or fmCreate);
        TempStream.CopyFrom(CFGStream, FoundPos1 + Length(Item) + 2);
        StrPCopy(MyBuf, Val);
        TempStream.Write(MyBuf, length(Val));
        CFGStream.Seek(FoundPos2 - 1, soFromBeginning);
        TempStream.CopyFrom(CFGStream, CFGStream.Size - FoundPos2 + 1);
        TempStream.Free;
        CFGStream.Free;
     end;
     DeleteFile(CFGFile);
     RenameFile(TempFile, CFGFile);
end;

function TBDE32.ReadFromCFG(Item: string;  DefStr: string): string;
Var
   CFGFile: string;
   FoundPos1, FoundPos2: integer;
   MyFile: TextFile;
   MyStr: string;
begin
     with TRegistry.create do begin
        Rootkey := HKEY_LOCAL_MACHINE;
        OpenKey('\SOFTWARE\BORLAND\DATABASE ENGINE', false);
        CFGFile := ReadString('CONFIGFILE01');
        Free;
     end;
     if FileExists(CFGFile) then begin
       AssignFile(MyFile, CFGFile);
       Reset(MyFile);
       ReadLn(MyFile, MyStr);
       CloseFile(MyFile);
       FoundPos1 := Pos(Item, MyStr);
       if FoundPos1 > 0 then begin
         Delete(MyStr, 1, FoundPos1 + Length(Item) + 2);
         foundPos2 := Pos(#0, MyStr);
         Result := Copy(MyStr, 0, FoundPos2 + 1);
       end   
       else result := DefStr;
     end
     else result := DefStr;
end;

function FilePos(FileName, What: string; startFrom: integer): integer;
var
   MyStr: string;
   MyFile: TextFile;
begin
     if FileExists(FileName) then begin
       AssignFile(MyFile, FileName);
       Reset(MyFile);
       ReadLn(MyFile, MyStr);
       Delete(MyStr, 1, StartFrom);
       Result := StartFrom + Pos(What, MyStr);
       CloseFile(MyFile);
     end
     else result := 0;
end;









{########################### Find a previous BDE ###########################}
function TBDE32.GetPaths(var CF: string; var DLLP: string): boolean;
var
   AppDir, CommonDir, ProgDir: string;

begin
     {GetPaths: looks for the BDE, assumed to be found if a ConfigFile (CF) and
                DLL Path (DLLP) are found.  You can add your own search paths to
                these ones, remember that they are checked in order, so
                if 2 BDE's are found then the second one will be used}
     AppDir := ExtractFilePath(Application.ExeName);
     AppDir := Copy(AppDir, 1, length(AppDir) - 1);  {get rid of the last '\'}
     CommonDir := GetRegistryDir('CommonFilesDir', 'C:\Program Files\Common Files');
     ProgDir := GetRegistryDir('ProgramFilesDir', 'C:\Program Files');

     TestBDEDir(AppDir, CF, DLLP);
     TestBDEDir(AppDir + '\BDE', CF, DLLP);
     TestBDEDir(ProgDir + '\borland\common files\BDE', CF, DLLP);
     TestBDEDir(CommonDir + '\BDE', CF, DLLP);
     TestBDEDir(CommonDir + '\Borland\BDE', CF, DLLP);
     TestBDEDir(CommonDir + '\Borland Shared\BDE', CF, DLLP);

     Result := FileExists(CF) and FileExists(DLLP + '\idapi32.dll');
end;

procedure TBDE32.TestBDEDir(TestDir: string; var CF: string; var DLLP: string);
begin
     if FileExists(TestDir + '\idapi.cfg') then CF := TestDir + '\idapi.cfg';
     if FileExists(TestDir + '\idapi32.cfg') then CF := TestDir + '\idapi32.cfg';
     if FileExists(TestDir + '\idapi32.dll') then DLLP := TestDir;
end;

function TBDE32.GetRegistryDir(RegKey, DefaultDir: string): String;
begin
   with TRegistry.create do begin
      Rootkey := HKEY_LOCAL_MACHINE;
      OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', false);
      Result := ReadString(RegKey);
      Free;
   end;
   if Result = '' then Result := DefaultDir;
end;




{########################### Register Component ###########################}
procedure Register;
begin
  RegisterComponents('Data Access', [TBDE32]);
end;

end.

unit BDE32; 


interface 


uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs, Registry; 


type 
  TBDE32 = class(TComponent) 
  private 
    FUsingCFG: Boolean; 
    FLocalShare: Boolean; 
    FPdxNetDir: String; 
    FMaxBufSize, FMaxFileHandles, FMemSize, FSharedMemSize: integer; 
    function GetPaths(var CF: string; var DLLP: string): boolean; 
    procedure writeToCFG(Item: string; Val: string); 
    function ReadFromCFG(Item: string; DefStr: string): string; 
  protected 
    { Protected declarations } 
  public 
    constructor Create(AOwner:TComponent); override; 
  published 
    property LocalShare: boolean read FLocalShare write FLocalShare; 
    property PdxNetDir: String read FPdxNetDir write FPdxNetDir; 
    property MaxBufSize: integer read FMaxBufSize write FMaxBufSize; 
    property MaxFileHandles: integer read FMaxFileHandles write 
FMaxFileHandles; 
    property MemSize: integer read FMemSize write FMemSize; 
    property SharedMemSize: integer read FSharedMemSize write 
FSharedMemSize; 
    procedure WriteSettings; 
    procedure ReadSettings; 
  end; 


function FilePos(FileName, What: string; startFrom: integer):integer; 


procedure Register; 


implementation 


constructor TBDE32.Create(AOwner:TComponent); 
var 
   ConfigFile, DLLPath: string; 
begin 
     inherited Create(AOwner); 
     with TRegistry.create do begin 
        Rootkey := HKEY_LOCAL_MACHINE; 
        if not 
         (OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false) 
          and FileExists(ReadString('DLLPATH') + '\idapi32.dll')) 
          then begin 
           if GetPaths(ConfigFile, DLLPath) then begin 
             Rootkey := HKEY_LOCAL_MACHINE; 
             OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', True); 
             WriteString('CONFIGFILE01', ConfigFile); 
             WriteString('DLLPATH', DLLPath); 
             WriteString('RESOURCE', '0009'); 
             WriteString('SAVECONFIG', 'WIN32'); 
             WriteString('UseCount', '15'); 
           end 
           else begin 
             ShowMessage('Please put BDE files in ' + 
ExtractFilePath(application.ExeName) + 'BDE'); 
             halt; 
           end; 
        end; 
        Free; 
     end; 
     ReadSettings; 
end; 



procedure TBDE32.ReadSettings; 
begin 
     FPdxNetDir := ReadFromCFG('NET DIR', 'G:\'); 
     FLocalShare := ReadFromCFG('LOCAL SHARE', 'FALSE') = 'TRUE'; 
     FMaxBufSize := StrToInt(ReadFromCFG('MAXBUFSIZE', '2048')); 
     FMaxFileHandles := StrToInt(ReadFromCFG('MAXFILEHANDLES', '48')); 
     FMemSize := StrToInt(ReadFromCFG('MEMSIZE', '16')); 
     FSharedMemSize := StrToInt(ReadFromCFG('SHAREDMEMSIZE', '2048')); 
end; 


procedure TBDE32.WriteSettings; 
begin 
     if FLocalShare then writeToCFG('LOCAL SHARE', 'TRUE') 
     else writeToCFG('LOCAL SHARE', 'FALSE'); 
     writeToCFG('NET DIR', FPdxNetDir); 
     writeToCFG('MAXBUFSIZE', IntToStr(FMaxBufSize)); 
     writeToCFG('MAXFILEHANDLES', IntToStr(FMaxFileHandles)); 
     writeToCFG('MEMSIZE', IntToStr(FMemSize)); 
     writeToCFG('SHAREDMEMSIZE', IntToStr(FSharedMemSize)); 
end; 


procedure TBDE32.writeToCFG(Item: string; Val: string); 
Var 
   CFGFile, TempFile: string; 
   CFGStream, TempStream: TFileStream; 
   FoundPos1, FoundPos2: integer; 
   myBuf: array[0..255] of char; 
begin 
     with TRegistry.create do begin 
        Rootkey := HKEY_LOCAL_MACHINE; 
        OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false); 
        CFGFile := ReadString('CONFIGFILE01'); 
        Free; 
     end; 
     TempFile := CFGFile + '2'; 
     FoundPos1 := FilePos(CFGFile, Item, 0); 
     if FoundPos1 > 0 then begin 
        FoundPos2 := FilePos(CFGFile, #0, FoundPos1 + Length(Item) + 
3); 
        CFGStream := TFileStream.Create(CFGFile, fmOpenRead); 
        TempStream := TFileStream.Create(TempFile, fmOpenWrite or 
fmCreate); 
        TempStream.CopyFrom(CFGStream, FoundPos1 + Length(Item) + 2); 
        StrPCopy(MyBuf, Val); 
        TempStream.Write(MyBuf, length(Val)); 
        CFGStream.Seek(FoundPos2 - 1, soFromBeginning); 
        TempStream.CopyFrom(CFGStream, CFGStream.Size - FoundPos2 + 
1); 
        TempStream.Free; 
        CFGStream.Free; 
     end; 
     DeleteFile(CFGFile); 
     RenameFile(TempFile, CFGFile); 
end; 


function TBDE32.ReadFromCFG(Item: string; DefStr: string): string; 
Var 
   CFGFile: string; 
   FoundPos1, FoundPos2: integer; 
   MyFile: TextFile; 
   MyStr: string; 
begin 
     with TRegistry.create do begin 
        Rootkey := HKEY_LOCAL_MACHINE; 
        OpenKey('SOFTWARE\BORLAND\DATABASE ENGINE', false); 
        CFGFile := ReadString('CONFIGFILE01'); 
        Free; 
     end; 
     if FileExists(CFGFile) then begin 
       AssignFile(MyFile, CFGFile); 
       Reset(MyFile); 
       ReadLn(MyFile, MyStr); 
       CloseFile(MyFile); 
       FoundPos1 := Pos(Item, MyStr); 
       if FoundPos1 > 0 then begin 
         Delete(MyStr, 1, FoundPos1 + Length(Item) + 2); 
         foundPos2 := Pos(#0, MyStr); 
         Result := Copy(MyStr, 0, FoundPos2 + 1); 
       end 
       else result := DefStr; 
     end 
     else result := DefStr; 
end; 


function FilePos(FileName, What: string; startFrom: integer): integer; 
var 
   MyStr: string; 
   MyFile: TextFile; 
begin 
     if FileExists(FileName) then begin 
       AssignFile(MyFile, FileName); 
       Reset(MyFile); 
       ReadLn(MyFile, MyStr); 
       Delete(MyStr, 1, StartFrom); 
       Result := StartFrom + Pos(What, MyStr); 
       CloseFile(MyFile); 
     end 
     else result := 0; 
end; 










function TBDE32.GetPaths(var CF: string; var DLLP: string): boolean; 
var 
   AppDir: string; 
begin 
     AppDir := ExtractFilePath(Application.ExeName); 
     if FileExists(AppDir + 'idapi32.cfg') then CF := AppDir + 
'idapi32.cfg'; 
     if FileExists(AppDir + 'idapi32.dll') then DLLP := Copy(AppDir, 
1, Length(AppDir) - 1); 


     if FileExists(AppDir + 'BDE\idapi32.cfg') then CF := AppDir + 
'BDE\idapi32.cfg'; 
     if FileExists(AppDir + 'BDE\idapi32.dll') then DLLP := AppDir + 
'BDE'; 


     if FileExists('c:\program files\borland\common .....................................erro aqui
files\BDE\idapi32.cfg') then CF := 'c:\program files\borland\common 
files\BDE\idapi32.cfg'; 
     if FileExists('c:\program files\borland\common 
files\BDE\idapi32.dll') then DLLP := 'c:\program files\borland\common 
files\BDE'; 


     Result := FileExists(CF) and FileExists(DLLP + '\idapi32.dll'); 
end; 


procedure Register; 
begin 
  RegisterComponents('DataAccess', [TBDE32]); 
end; 


end.

Este testei mas tb não dá...Erro logo na compilação marcado em cima tirei aquelas duas linhas compilou bem sem erro mas testando no pc sem privilégio de admin da o erro descrito acima....ERegistryException in Module Gestor.exe Failed set data for 'ConfigFile01'

Editado Março 29, 2012 por António44

[Jhonas]

compilou bem sem erro mas testando no pc sem privilégio de admin da o erro descrito acima....ERegistryException in Module Gestor.exe Failed set data for 'ConfigFile01'

voce não informou, mas o pc onde voce esta testando é XP ou Win7 ??? Se for o Win7, voce terá que definir em Painel de Controle > < Contas de Usuários > permissão para esse usuário alterar os registros do Windows.

abraço

[António44]

voce não informou, mas o pc onde voce esta testando é XP ou Win7 ??? Se for o Win7, voce terá que definir em Painel de Controle > < Contas de Usuários > permissão para esse usuário alterar os registros do Windows.

abraço

Estou testando em XP mas onde usuário não pode aceder ao Reg .E nem deixa escrever nada no reg.

Abraço amigo Jhonas.

Editado Março 30, 2012 por António44

[Jhonas]

se eu entendi direito, voce esta querendo criar uma instancia ( ou Alias ) no BDE via programa ?

[António44]

se eu entendi direito, voce esta querendo criar uma instancia ( ou Alias ) no BDE via programa ?

O que eu estou querendo é que o programa funcione completamente Portable via USB assim...Meu soft\BDE,a BDE fica na USB eu não uso um Alias para me ligar uso apenas assim para ligar aos dados

procedure TData.DataCreate(Sender: TObject);
var
   AppDir: string;
begin
AppDir := ExtractFilePath(Application.ExeName)+'Database';
TablePrincipal.DatabaseName := AppDir;
TablePrincipal.open;

procedure TReport3.FormCreate(Sender: TObject);
var
   AppDir: string;
begin
 AppDir := ExtractFilePath(Application.ExeName)+'Database';
RepQuery.DatabaseName := AppDir;
end;

Tudo funciona bem em pc que não tem a BDE instalada mas que deixe escrever no Registro por modo do componente BDE32...eu queria que funcionasse sem dar aos usuários permissão de aceder ao registro.

abraço

Editado Março 30, 2012 por António44

[Jhonas]

se houver mesmo a necessidade de escrever no registro do windows não tem jeito, voce tera que dar permissão para o usuario

abraço

[António44]

Resolvido