DBR Delphi-Ecke

// Hiermit wird zur Laufzeit ein global eindeutiger Bezeichner (GUID)
// erzeugt und angezeigt.
// Falls Sie einen GUID zur Entwicklerzeit brauchen, drücken Sie
// in der IDE die Tastenkombination Strg+Shift+G

// Getestet mit D4 unter XP

uses activex, comobj; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var aGuid: TGuid; 
begin 
// erzeugen 
  CoCreateGuid(aGuid); 
// anzeigen 
  Label1.caption := GuidToString(aGuid); 
end;

// Falls Sie wegen einem GUID nicht gleich zwei Units einbinden wollen,
// dann können Sie ihn auch "zu Fuß" programmieren:

procedure BuildGUID(out GUID: TGUID); 
var x, w, b: integer; 
begin 
  Randomize; 
  w := 65536; 
  b := 256; 
  with GUID do begin 
    D1 := MakeLong(Random(w), Random(w)); 
    D2 := Random(w); 
    D3 := Random(w); 
    for x := 0 to 7 do D4[x] := Random(b); 
  end; 
end; 
 
function GuidToStr(GUID: TGUID): string; 
var x: integer; 
begin 
  Result := '{'; 
  with GUID do begin 
    Result := Result + inttohex(D1, 8); 
    Result := Result + '-'; 
    Result := Result + inttohex(D2, 4); 
    Result := Result + '-'; 
    Result := Result + inttohex(D3, 4); 
    Result := Result + '-'; 
    Result := Result + inttohex(D4[0], 2); 
    Result := Result + inttohex(D4[1], 2); 
    Result := Result + '-'; 
    for x := 2 to 7 do 
      Result := Result + inttohex(D4[x], 2); 
  end; 
  Result := Result + '}'; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var aGUID: TGUID; 
begin 
// erzeugen 
  BuildGUID(aGuid); 
// anzeigen 
  Label1.caption := GuidToStr(aGuid); 
end;

// Und falls Sie nur den String brauchen und keinen TGuid, dann geht das auch:

function buildGUIDstr: string; 
var y: integer; 
  function ziffer: char; 
  var i: integer; 
  begin 
    i := Random(16); 
    inc(i, 48 + ord(i > 9) * 7); 
    Result := chr(i); 
  end; 
  procedure dazu(z: integer; strich: boolean); 
  var x: integer; 
  begin 
    for x := 0 to z do 
      Result := Result + ziffer; 
    if strich then Result := Result + '-'; 
  end; 
begin 
  Result := '{'; 
  Randomize; 
  dazu(7, true); 
  for y := 0 to 2 do dazu(3, true); 
  dazu(11, false); 
  Result := Result + '}'; 
end;

// Natürlich kann man den String auch in einen TGuid wandeln:

function StrToGuid(s: string): TGUID; 
var i: integer; 
  function zeichenOK: boolean; 
  const chars = ['0'..'9', 'A'..'F']; 
  var x: integer; 
  begin 
    for x := 1 to 32 do 
      if not (s[x] in chars) then begin 
        result := false; 
        exit; 
      end; 
    result := true; 
  end; 
begin 
  if (length(s) = 38) and (s[1] = '{') and (s[38] = '}') then begin 
    s := uppercase(stringreplace(copy(s, 2, 36), '-', '', [rfReplaceall])); 
    if (length(s) = 32) and zeichenOK then begin 
      with Result do begin 
        D1 := strtoint('$' + copy(s, 1, 8)); 
        D2 := strtoint('$' + copy(s, 9, 4)); 
        D3 := strtoint('$' + copy(s, 13, 4)); 
        i := 17; 
        while i < 32 do begin 
          D4[(i - 17) div 2] := strtoint('$' + copy(s, i, 2)); 
          inc(i, 2); 
        end; 
      end; 
      exit; 
    end; 
  end; 
  raise exception.create('Ungültige Klassenzeichenfolge.'); 
end;