--- ---
uses ActiveX; function GenerateKey: String; var MyGUID: TGUID; MyWideChar: array[0..100] of WideChar; begin {First, generate the GUID:} CoCreateGUID(MyGUID); {Now convert it to a wide-character string:} StringFromGUID2(MyGUID, MyWideChar, 39); {Now convert it to a Delphi string:} Result := WideCharToString(MyWideChar); {Get rid of the three dashes that StringFromGUID2() puts in the result string:} while Pos( '-', Result ) > 0 do Delete( Result, Pos( '-', Result ), 1 ); {Get rid of the left and right brackets in the string:} while Pos( '{', Result ) > 0 do Delete( Result, Pos( '{', Result ), 1 ); while Pos( '}', Result ) > 0 do Delete( Result, Pos( '}', Result ), 1 ); end;
Tip author unknown
Using RAW API:
{ ... } var Form1: TForm1; UuidCreateFunc : function (var guid: TGUID):HResult;stdcall; implementation {$R *.DFM} uses ComObj; procedure TForm1.Button1Click(Sender: TObject); var hr: HRESULT; m_TGUID: TGUID; handle: THandle; begin handle := LoadLibrary('RPCRT4.DLL'); @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreate') ; hr := UuidCreateFunc(m_TGUID); if failed(hr) then RaiseLastWin32Error; ShowMessage(GUIDToString(m_TGUID)); end;
With WIN2K support:
{ ... } var Form1: TForm1; UuidCreateFunc: function (var guid: TGUID): HResult; stdcall; implementation {$R *.DFM} uses ComObj; procedure TForm1.Button1Click(Sender: TObject); var hr: HRESULT; m_TGUID: TGUID; handle: THandle; WinVer: _OSVersionInfoA; begin handle := LoadLibrary('RPCRT4.DLL'); WinVer.dwOSVersionInfoSize := sizeof(WinVer); getversionex(WinVer); if WinVer.dwMajorVersion >= 5 then {Windows 2000 } @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreateSequential') else @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreate') ; hr := UuidCreateFunc(m_TGUID); if failed(hr) then RaiseLastWin32Error; ShowMessage(GUIDToString(m_TGUID)); end;
Tip by Ivan Kozhuharov