Eilt! Problem beim Einlesen eines Registrywertes

[Andreas Käding]

Ich will einen Wert aus der Registry einer Caption zuweisen. Folgender Code funktioniert aber nicht. Wer kann mir helfen?

function GetRegistryValue: string;
var
R: TRegistry;
begin
R:=TRegistry.Create;
R.RootKey:=HKEY_CURRENT_USER;
R.OpenKeyReadOnly('\Software\VB and VBA Program Settings\KLX\System');
Result :=R.ReadString('Kunde');
R.CloseKey;
R.Free;
end;
begin
//Startformular erstellen
frmStart:= TfrmStart.Create(Application);
with frmStart do
begin
//lblKunde.Caption
Caption:= GetRegistryValue;

[Andreas Mack]

Hallo Andreas,
Du solltest ein paar Fehler abfangen.
Erkläre doch mal was nicht geht.

<PRE><CODE>
function GetRegistryValue: string;
var R: TRegistry;
begin
R:=TRegistry.Create;
// R.RootKey:=HKEY_CURRENT_USER; bereits Standardmäßig
if R.OpenKeyReadOnly('Software\VB and VBA Program Settings\KLX\System') then begin//VB and VBA Program Settings\KLX\System');
if R.ValueExists('Kunde') then Result := R.ReadString('Kunde')
else Result := 'Der Wert existiert nicht !';
R.CloseKey;
end else Result := 'Der Key existiert nicht !';
R.Free;
end;
</PRE></CODE&gt

[Marc - Pierré Gubler]

Hi Andreas,

hier ist die Lösung zu deinem Problem. Ich hoffe es funktioniert bei dir genau so gut wie bei mir:

Bsp.:

Funktion zum auslesen eines Wertes aus der Registry:

function GetCompanyName9x : string;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.OpenKey('\Software\Microsoft\Windows\CurrentVe rsion',True);
result:=Reg.ReadString('RegisteredOrganization');
Reg.CloseKey;
Reg.Free;
end;

Funktion um den Wert auszugeben:

procedure TForm1.FormCreate(Sender: TObject);
begin
Irgendeinlabel.Caption:=GetCompanyName9x;
end;

bis dann mar

[Andreas Käding]

Vielen Dank es hat jetzt geklappt!
Kannst Du mir vielleicht noch bei einem anderen Problem helfen?
Ich will, wenn mein Programm zum zweiten Mal geöffnet wird einen Yes/No Dialog ausgeben. Wie bekomme ich das hin

[Andreas Käding]

Ich danke Dir!!

[Andreas Mack]

Hallo Andreas,
Du musst lediglich diese Unit Deinem Projekt hinzufügen.
Beim Starten wird dann geprüft, ob das Prog bereits läuft.

<PRE><CODE>
unit RunOnce;

interface

implementation

uses windows, sysutils, Dialogs, Controls;

var mHandle : THandle; // Mutexhandle der ersten Instanz
send : string;
recv : string[255];
d : Byte absolute recv;
re : DWord;
pipe : String;
i: Integer;

Initialization
mhandle := CreateMutex(nil, True, PChar(ExtractFileName(ParamStr(0))));
If GetLastError = ERROR_ALREADY_EXISTS then
begin // Anwendung läuft bereits !!
if MessageDlg('Soll die zweite Instanz beendet werden ?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then Halt; // 2. Instanz beenden
end;

finalization
if mHandle <> 0 then CloseHandle(mHandle);
end.
</PRE></CODE&gt

[Andreas Käding]

Danke, das funktioniert!

Gruß Andrea

[Andreas Käding]

Entschuldige aber ich will es auf die Spitze treiben.
Kann ich wenn im Dialog 'Nein' gesagt wird der zweiten Instanz ein anderes Anwendungssymbol und einen anderen Titel zuweisen

[Andreas Mack]

Hallo nochmal,
in diesem Fall würde ich die Prüfung der zweiten Instanz in das OnCreate-Ereignis des Formulares verschieben.
Mit einer ImageList auf dem Formular kannst Du dann verschiedene Icons auswählen.

<PRE><CODE>
procedure TForm1.FormCreate(Sender: TObject);
var mHandle : THandle; // Mutexhandle der ersten Instanz
begin
mhandle := CreateMutex(nil, True, PChar(ExtractFileName(ParamStr(0))));
If GetLastError = ERROR_ALREADY_EXISTS then
begin // Anwendung läuft bereits !!
case MessageDlg('Soll die zweite Instanz beendet werden ?', mtConfirmation, [mbYes, mbNo], 0) of
mrYes: Halt; // 2. Instanz beenden
mrNo : begin // Änderungen am Formular..
<b>Caption := 'zweite Instanz';
ImageList1.GetIcon(1, Icon);</b>
end;
end; {Case}
end else ImageList1.GetIcon(0, Icon);
end;
<PRE><CODE>

Gruß Andrea

[Andreas Käding]

Hallo nochmal!
Ich danke Dir für den Tip es funktioniert aber nur wenn die exe nacheinander aus verschiedenen Verzeichnissen aufgerufen wird.
Fällt Dir dazu vielleicht noch was ein

[Andreas Mack]

Hi Andreas,
tut mir leid, bei mir funktioniert alles.
Kannst Du das Problem genauer beschreiben