library EduMetrics;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  Windows,
  Forms,
  ShellAPI,
  System.SysUtils,
  System.DateUtils,
  System.Diagnostics,
  System.IOUtils,
  System.Win.Registry,
  Classes,
  Types,
  Dialogs,
  Graphics,
  IniFiles,
  Sparkle.Http.Client,
  Sparkle.Http.Headers,
  HashObj, // TMS cryptography
  MiscObj, // TMS cryptography
  uHCDefines in '..\..\shared\pascal\uHCDefines.pas',
  uHCTypeDefs in '..\..\shared\pascal\uHCTypeDefs.pas';

type
  THCLicenseInfo = record
    matrix_sn_hash: String;
    hclicense_dt_expire: Int64;
    hclicense_licensee: String;
    usblicense_desc: String;
  end;

const
  DLLVERN = 4;
  DLLVERINTN = 36;
  LOGFILENAME = '\ExportDLLs\GE\EduMetrics.log';
  METRICSURL = 'https://harpgamer.com/util/edu_metrics_v002.php';

var
  gHTTPClient: THttpClient;
  gGEGameTimeSeconds: UInt;
  gIdInstallGUID: String;
  gIdSessionGUID: String;
  gHCBuild: String;
  gHCLicInfo: THCLicenseInfo;
  gStopWatch: TStopWatch;
  gLog: TStringList;
  gPathHC: String;
  hwndDLL: HWND;


function Is64BitWindows(): Boolean;
var
  lDir: array[0..MAX_PATH] of Char;
  lSysWow64: String;
begin
  GetWindowsDirectory(lDir, MAX_PATH);
  lSysWow64 := TPath.Combine(lDir, 'SysWOW64');
  Result := DirectoryExists(lSysWow64);
end;

function GetHCSN(): String;
var
  lReg: TRegistry;
begin
  if Is64BitWindows then
    lReg := TRegistry.Create(KEY_READ OR KEY_WOW64_64KEY)
  else
    lReg := TRegistry.Create(KEY_READ);

  lReg.RootKey := HKEY_LOCAL_MACHINE;
  if NOT lReg.OpenKeyReadOnly('\SOFTWARE\Matrix Games\Harpoon Ultimate Commanders Edition') then
    lReg.OpenKeyReadOnly('\SOFTWARE\WOW6432Node\Matrix Games\Harpoon Ultimate Commanders Edition');
  Result := lReg.ReadString('authorized');
  lReg.CloseKey;

  lReg.Free;
end;

function HashHCSN(pSN: String): String;
var
  lSHA3: TSHA3Hash;
begin
 lSHA3:= TSHA3Hash.Create(nil);
 lSHA3.AType:= tsha;
 lSHA3.hashSize := 512;
 lSHA3.Version:= 512;
 lSHA3.OutputFormat:= hexa; //base64;
 lSHA3.Unicode := yesUni;
 Result:= lSHA3.Hash('sdfjklsvnafn' + pSN + 'DSKFLJWEMSDFMASDKLFAJ');  // ALE 20201119 keyboard mashing salts!
 lSHA3.Free;
end;

function BuildJSON(pGEStart: Boolean): String;
var
  lJSON: String;
  lLicenseJSON: String;
begin
  lLicenseJSON := '{"matrix_sn_hash": "' + gHCLicInfo.matrix_sn_hash + '", '
   + '"hclicense": {"dt_expire": ' + gHCLicInfo.hclicense_dt_expire.ToString + ', '
   + '"licensee": "' + gHCLicInfo.hclicense_licensee + '"}, '
   + '"usblicense": {"desc": "' + gHCLicInfo.usblicense_desc + '"}}';

  if pGEStart then
  begin
    // ALE 20201119 don't send time elapsed
    lJSON := '{"id_install": "' + gIdInstallGUID + '", '
     + '"harpoon_uuid_session": "' + gIdSessionGUID + '", '
     + '"hc_build": "' + gHCBuild + '", '
     + '"license": ' + lLicenseJSON + '}';
  end
  else
  begin
    // ALE 20201119 do send time elapsed
    lJSON := '{"id_install": "' + gIdInstallGUID + '", '
     + '"ge_seconds": ' + (gStopWatch.ElapsedMilliseconds div 1000).ToString  + ', '
     + '"ge_gametime_seconds": ' + gGEGameTimeSeconds.ToString  + ', '
     + '"harpoon_uuid_session": "' + gIdSessionGUID + '", '
     + '"hc_build": "' + gHCBuild + '", '
     + '"license": ' + lLicenseJSON + '}';
  end;
  Result := lJSON;
end;

function IsTextResponse(ContentType: string): boolean;
begin
  ContentType := LowerCase(ContentType);
  Result :=
    (ContentType = 'application/json') or
    (ContentType = 'application/xml') or
    (Copy(ContentType, 1, Length('text/')) = 'text/');
end;

procedure FillResponse(Resp: THttpResponse);
var
  Info: THttpHeaderInfo;
begin
  if IsTextResponse(Resp.ContentType) then
  begin
    // Use UTF-8 as default encoding. It's not the scope of this demo to
    // provide exact encoding for the string response.
    gLog[gLog.Count - 1] := Format('%s; Response: %s', [gLog[gLog.Count - 1], TEncoding.UTF8.GetString(Resp.ContentAsBytes)]);
  end
  else
  begin
    gLog[gLog.Count - 1] := Format('%s; Response: Unspecified Error', [gLog[gLog.Count - 1], TEncoding.UTF8.GetString(Resp.ContentAsBytes)]);
  end;
end;

procedure DoHTTPRequest(pGEStart: Boolean);
var
  Req: THttpRequest;
  Resp: THttpResponse;
  I: integer;
  HeaderName, HeaderValue: string;
  lJSON: String;
begin
  Resp := nil;
  Req := gHTTPClient.CreateRequest;
  try
    //mmResponseBody.Lines.SaveToFile('EduMetrics.txt');

    // set uri
    Req.Uri := METRICSURL;

    // set request method
    Req.Method := 'POST';

    // set custom headers, if any
    {
    for I := 1 to grHeaders.RowCount - 1 do
    begin
      HeaderName := Trim(grHeaders.Cells[0, I]);
      HeaderValue := grHeaders.Cells[1, I];
      if HeaderName <> '' then
        Req.Headers.SetValue(HeaderName, HeaderValue);
    end;
    }

    // ALE 20200112 build the JSON request
    //SysUtils.GUIDToString(gGUID);
    lJSON := BuildJSON(pGEStart);

    // set content body, if available. Use UTF8 as default encoding,
    // we will not worry about this in this simple demo
    Req.SetContent(TEncoding.UTF8.GetBytes(lJSON));
    Req.Headers.SetValue('content-type', 'application/json');

    gLog.Add(Format('%s; Request: %s', [FormatDateTime('yyyy-mm-dd hh:nn:ss', Now), lJSON]));

    // perform request
    Resp := gHTTPClient.Send(Req);

    // Fill response
    FillResponse(Resp);
    //mmResponseBody.Lines.SaveToFile('EduMetrics.txt');
  finally
    Req.Free;
    Resp.Free;
  end;
end;

{*** Return DLL internal version, i.e. revision 5 of my DLL ***}
function DLLVer():word;export;cdecl;
begin
  result := DLLVERN;
end;

{*** Return DLL interface version, i.e. revision 1 of my HCE interface spec ***}
function DLLVerInt():word;export;cdecl;
begin
  result := DLLVERINTN;
end;

{*** Return DLL description, 255 characters max ***}
function DLLDesc():PAnsiChar;export;cdecl;
begin
  result := 'EduMetrics Integration DLL';
end;

{*** Init DLL ***}
// DLLFunc(hwndHC, harpoon_path, APP_BUILD, SaveVersion, &dllFuncRefs, &GEClosing,
//  &DLLExport[i].DLLBusy, dllVerInterface, srandSeed, harpoon_uuid_session,
//   HCLicense->TimeExpire, HCLicense->Licensee, usblicense_desc);
procedure DLLInit(hwndHC: HWND; pathHC: PAnsiChar; verHC: PAnsiChar;
  verSaveGame: longword; funcRefs: PHCDLL_FUNC_REF; PGEClosing: Pointer;
  PDLLBusy: Pointer; verInterface: longword; srandSeed: longword;
  harpoon_uuid_session: PAnsiChar; hclicense_dt_expire: Int64;
  hclicense_licensee: PAnsiChar; usblicense_desc: PAnsiChar;
  RESRSRStructureVersion: ulong;
  AnnexVersion: ushort); export; cdecl;
var
  lHCSN: String;
  lIniHC: TIniFile;
  lGUID: TGUID;
  lStr: String;
begin
  // here we initialize globals and such for the life of the DLL
  gStopWatch := TStopwatch.StartNew;
  gGEGameTimeSeconds := 0;
  gPathHC := pathHC;
  OutputDebugString(PChar('DLLInit pathHC=' + gPathHC));

  // set up some global utilities
  gHTTPClient := THttpClient.Create;
  gLog := TStringList.Create;
  if (FileExists(gPathHC + LOGFILENAME)) then
    gLog.LoadFromFile(gPathHC + LOGFILENAME);

  // ALE 20200120 we need a GUID, try to load it from main game dir
  try
    lIniHC := TIniFile.Create(ExtractFilePath(Application.ExeName) + HCINIFILENAME);
    gIdInstallGUID := LowerCase(lIniHC.ReadString('MAIN', 'InstallUUID', ''));
  if (gIdInstallGUID = '') then
  begin
    CreateGUID(lGUID);
    gIdInstallGUID := LowerCase(Copy(GUIDToString(lGUID), 2, 36));
    lIniHC.WriteString('MAIN', 'InstallUUID', gIdInstallGUID);
  end;
  except
    on E: Exception do
    begin
      lStr := E.ClassName + ' ' + E.Message;
      lStr := AdjustLineBreaks(lStr, tlbsLF);
      lStr := StringReplace(lStr, #10, '', [rfReplaceAll]);
      gLog.Add(Format('%s; Error: %s', [FormatDateTime('yyyy-mm-dd hh:nn:ss', Now), lStr]));
    end;
  end;

  // ALE 20201119 added for v002
  gIdSessionGUID := harpoon_uuid_session;
  lHCSN := GetHCSN();
  if lHCSN <> '' then
    gHCLicInfo.matrix_sn_hash := HashHCSN(GetHCSN())
  else
    gHCLicInfo.matrix_sn_hash := '';

  if hclicense_dt_expire <> 0 then
    gHCLicInfo.hclicense_dt_expire := hclicense_dt_expire //UnixToDateTime(hclicense_dt_expire, True)
  else
    gHCLicInfo.hclicense_dt_expire := 0;
  gHCLicInfo.hclicense_licensee := hclicense_licensee;
  gHCLicInfo.usblicense_desc := usblicense_desc;
  gHCBuild := verHC;

  // ALE 20200120 submit our request to HarpGamer
  try
    DoHTTPRequest(True);
  except
    on E: Exception do
    begin
      lStr := E.ClassName + ' ' + E.Message;
      lStr := AdjustLineBreaks(lStr, tlbsLF);
      lStr := StringReplace(lStr, #10, '', [rfReplaceAll]);
      gLog.Add(Format('%s; Error: %s', [FormatDateTime('yyyy-mm-dd hh:nn:ss', Now), lStr]));
    end;
  end;

end;

procedure GameTime(GameTime: Long; GameTimeLeft: Long); export; cdecl;
begin
  Inc(gGEGameTimeSeconds);
end;

{*** Free DLL ***}
procedure DLLFree();export;cdecl;
var
  lStr: String;
begin
  // Do any cleanup here, this is the end
  // ALE 20200120 submit our request to HarpGamer
  try
    DoHTTPRequest(False);
  except
    on E: Exception do
    begin
      lStr := E.ClassName + ' ' + E.Message;
      lStr := AdjustLineBreaks(lStr, tlbsLF);
      lStr := StringReplace(lStr, #10, '', [rfReplaceAll]);
      gLog.Add(Format('%s; Error: %s', [FormatDateTime('yyyy-mm-dd hh:nn:ss', Now), lStr]));
    end;
  end;
  gLog.SaveToFile(gPathHC + LOGFILENAME);
  gHTTPClient.Free;
  //Application.Handle := hwndDll;
end;

exports
  DLLVer,
  DLLVerInt,
  DLLDesc,
  DLLFree,
  DLLInit,
  GameTime;
end.