...formatierte Fehlermeldungen ausgeben?
|
Autor:
Timo Jahn |
[ Tip ausdrucken ] | | |
{1.}
function GetLastErrorText(): string;
var
dwSize: DWORD;
lpszTemp: PAnsiChar;
begin
dwSize := 512;
lpszTemp := nil;
try
GetMem(lpszTemp, dwSize);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil,
GetLastError(),
LANG_NEUTRAL,
lpszTemp,
dwSize,
nil)
finally
Result := lpszTemp;
FreeMem(lpszTemp)
end
end;
{***********************************}
{2.}
function SystemErrorMessage: string;
var
P: PChar;
begin
if FormatMessage(Format_Message_Allocate_Buffer + Format_Message_From_System,
nil,
GetLastError,
0,
@P,
0,
nil) <> 0 then
begin
Result := P;
LocalFree(Integer(P))
end
else
Result := '';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(SystemErrorMessage);
end;
Bewerten Sie diesen Tipp:
|
|
|