unit LogThreads;

interface

uses
	Windows,
	SysUtils, Classes,
	Core;

type
	TPLogLink = ^TLogLink;
	TLogLink = packed record
		pNext: TPLogLink;
		LogStr: UTF16String;
	end;

	TLogThread = class(TThread)
	public
		constructor Create; virtual;
		destructor Destroy; override;
		procedure AfterConstruction; override;

	public
		procedure PostLog(LogStr: UTF16String);
		procedure PostKill;

	protected
		pEmptyLink: TPLogLink;
		hEmptyMutex: THandle;
		pFirstLink, pLastLink: TPLogLink;
		hQueueMutex, hQueueSem: THandle;

		procedure Execute; override;

		procedure DrainQueue(pLink: TPLogLink);
		procedure PostEmpty(pLink: TPLogLink);
		function GetEmptyLog: TPLogLink;
		function GetQueueLog: TPLogLink;
	end;

var
	LogThread: TLogThread;



implementation

uses
	Registry;

{ TLogThread }

procedure TLogThread.AfterConstruction;
begin
	inherited;

	Start;
end;

constructor TLogThread.Create;
begin
	inherited Create(True);

	hEmptyMutex := CreateMutex(nil, False, nil);
	hQueueMutex := CreateMutex(nil, False, nil);
	hQueueSem := CreateSemaphore(nil, 0, $0FFFFFFF, nil);
end;

destructor TLogThread.Destroy;
begin
	PostKill;

	inherited;

	CloseAndInvalidateHandle(hEmptyMutex);
	CloseAndInvalidateHandle(hQueueMutex);
	CloseAndInvalidateHandle(hQueueSem);

	DrainQueue(pEmptyLink);
	pEmptyLink := nil;
	DrainQueue(pFirstLink);
	pFirstLink := nil;
	pLastLink := nil;
end;

procedure TLogThread.DrainQueue(pLink: TPLogLink);
var
	pOLink: TPLogLink;

begin
	while pLink <> nil do begin
		pOLink := pLink;
		pLink := pLink.pNext;
		Dispose(pOLink);
	end;
end;

procedure TLogThread.Execute;
var
	pLink: TPLogLink;
	Reg: TRegistry;
	iLog: TUNative;

begin
	try
		Reg := nil;
		iLog := 0;
		repeat
			pLink := GetQueueLog;
			if pLink = nil then Break;

			if Reg = nil then begin
				Reg := TRegistry.Create(KEY_WRITE);
				//{$IFNDEF CPUX64}
				Reg.Access := Reg.Access or KEY_WOW64_64KEY;
				//{$ENDIF}
				Reg.RootKey := HKEY_CURRENT_USER;
				if not Reg.OpenKey('Software\ACCES\AIOAIO\', True) then begin
					{$IFDEF DEBUG}
						AnsiMessageBox('Failed to open key.', 'TLogThread.Execute', MB_ICONEXCLAMATION);
					{$ENDIF}
					Break;
				end;
			end;

			Reg.WriteString(IntToHex(iLog, 8), pLink.LogStr);
			Inc(iLog);
			Reg.WriteInteger('', iLog);

			pLink.LogStr := '';

			PostEmpty(pLink);
		until False;

		FreeAndNil(Reg);
	except
		on E: Exception do begin
		{$IFDEF DEBUG}
			AnsiMessageBox(AnsiString(E.ClassName) + ' in log thread: ' + AnsiString(E.Message), 'TLogThread.Execute', MB_ICONEXCLAMATION);
		{$ENDIF}
		end;
	end;
end;
function TLogThread.GetEmptyLog: TPLogLink;
begin
	WaitForSingleObject(hEmptyMutex, INFINITE);
		Result := pEmptyLink;
		if Result <> nil then pEmptyLink := Result.pNext;
	ReleaseMutex(hEmptyMutex);

	if Result = nil then New(Result);
end;

function TLogThread.GetQueueLog: TPLogLink;
begin
	WaitForSingleObject(hQueueSem, INFINITE);

	WaitForSingleObject(hQueueMutex, INFINITE);
		Result := pFirstLink;
		if Result = nil then begin
			//It's a kill.
		end
		else if Result.pNext = nil then begin
			pFirstLink := nil;
			pLastLink := nil;
		end
		else begin
			pFirstLink := Result.pNext;
		end;
	ReleaseMutex(hQueueMutex);
end;

procedure TLogThread.PostEmpty(pLink: TPLogLink);
begin
	WaitForSingleObject(hEmptyMutex, INFINITE);
		pLink.pNext := pEmptyLink;
		pEmptyLink := pLink;
	ReleaseMutex(hEmptyMutex);
end;

procedure TLogThread.PostKill;
begin
	if Self = nil then Exit;

	//Without adding to the list. A nil is a kill.

	ReleaseSemaphore(hQueueSem, 1, nil);
end;

procedure TLogThread.PostLog(LogStr: UTF16String);
var
	pLink: TPLogLink;

begin
	if Self = nil then Exit;

	pLink := GetEmptyLog;
	pLink.pNext := nil;
	pLink.LogStr := LogStr;

	WaitForSingleObject(hQueueMutex, INFINITE);
		if pLastLink = nil then
			pFirstLink := pLink
		else
			pLastLink.pNext := pLink
		;
		pLastLink := pLink;
	ReleaseMutex(hQueueMutex);

	ReleaseSemaphore(hQueueSem, 1, nil);
end;

end.
