{**********************************************}
{   Custom Exception dialog                    }
{   Copyright (c) 2004-2020 by Steema Software }
{   All Rights Reserved                        }
{**********************************************}
unit TeeException;
{$I TeeDefs.inc}

interface

uses
  {$IFDEF USEWINDOWS}
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  {$ENDIF}
  Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, SysUtils;

type
  TTeeExceptionForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label2: TLabel;
    Label4: TLabel;
    LabelServer: TLabel;
    Panel1: TPanel;
    Label5: TLabel;
    Email: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    MemoComments: TMemo;
    PanelMain: TPanel;
    Label1: TLabel;
    Label3: TLabel;
    LabelError: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Label4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    TheCode : String;
    TheException : Exception;

    class function IDE:String;
    class function License:String;
    class function Product:String;
    class function SubProduct:String;

    class procedure Send(const Code:String; E:Exception);
  end;

implementation

{$IFNDEF LCL}
{$R *.DFM}
{$ELSE}
{$R *.lfm}
{$ENDIF}

uses
  TeeProcs, Registry, TeeConst;

function GetWinVersion: String;
{$IFDEF MSWINDOWS}
var
  osVerInfo: TOSVersionInfo;
  majorVersion, minorVersion: Cardinal;
  vResult : String;

begin
  Result := 'Unknown';

  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

  if GetVersionEx(osVerInfo) then
  begin
    minorVersion := osVerInfo.dwMinorVersion;
    majorVersion := osVerInfo.dwMajorVersion;

    result:='Version: '+IntToStr(majorVersion)+'.'+IntToStr(minorVersion)+' ';

    case osVerInfo.dwPlatformId of
      VER_PLATFORM_WIN32_NT:
      begin
        if majorVersion <= 4 then
          vResult := 'Windows NT'
        else if (majorVersion = 5) and (minorVersion = 0) then
          vResult := 'Windows 2000'
        else if (majorVersion = 5) and (minorVersion = 1) then
          vResult := 'Windows XP'
        else if (majorVersion = 6) then
        begin
          if minorVersion=0 then
             vResult := 'Windows Vista'
          else
          if minorVersion=0 then
             vResult := 'Windows 7'
          else
             vResult := 'Windows 8'
        end
        else
          vResult := 'Windows '+IntToStr(majorVersion);
      end;

      VER_PLATFORM_WIN32_WINDOWS:
      begin
        if (majorVersion = 4) and (minorVersion = 0) then
          vResult := 'Windows 95'
        else if (majorVersion = 4) and (minorVersion = 10) then
        begin
          if osVerInfo.szCSDVersion[1] = 'A' then
            vResult := 'Windows 98 SE'
          else
            vResult := 'Windows 98';
        end
        else if (majorVersion = 4) and (minorVersion = 90) then
          vResult := 'Windows ME'
        else
          vResult := 'Unknown';
      end;
    end;

    result:=result+'"'+vResult+'" Build: '+IntToStr(osVerInfo.dwBuildNumber);
  end;
{$ELSE}
begin
  {$IFDEF OSX}
  result:='OSX';
  {$ELSE}
  result:='?';
  {$ENDIF}
{$ENDIF}
end;

class procedure TTeeExceptionForm.Send(const Code:String; E:Exception);
begin
  //TeeTranslateControl(Self);

  if Assigned(TeeDownloadURLProc) then
  with TTeeExceptionForm.Create(nil) do
  try
    TheException:=E;
    TheCode:=Code;

    LabelError.Caption:=E.Message;
    ShowModal;
  finally
    Free;
  end;
end;

procedure TTeeExceptionForm.Button2Click(Sender: TObject);
begin
  ModalResult:=mrCancel;
end;

class function TTeeExceptionForm.IDE:String;
begin
  result:='XX';

  {$IFDEF D6}result:='D6';{$ENDIF}
  {$IFDEF D7}result:='D7';{$ENDIF}
  {$IFDEF D8}result:='D8';{$ENDIF}
  {$IFDEF D9}result:='D9';{$ENDIF}
  {$IFDEF D10}result:='D10';{$ENDIF}
  {$IFDEF D105}result:='D105';{$ENDIF}
  {$IFDEF D11}result:='D11';{$ENDIF}
  {$IFDEF D12}result:='D12';{$ENDIF}
  {$IFDEF D14}result:='D14';{$ENDIF}
  {$IFDEF D15}result:='D15';{$ENDIF}
  {$IFDEF D16}result:='D16';{$ENDIF}
  {$IFDEF D17}result:='D17';{$ENDIF}
  {$IFDEF D18}result:='D18';{$ENDIF}
  {$IFDEF D19}result:='D19';{$ENDIF}
  {$IFDEF D20}result:='D20';{$ENDIF}
  {$IFDEF D21}result:='D21';{$ENDIF}
  {$IFDEF D22}result:='D22';{$ENDIF}
  {$IFDEF D23}result:='D23';{$ENDIF}
  {$IFDEF D24}result:='D24';{$ENDIF}
  {$IFDEF D25}result:='D25';{$ENDIF}
end;

class function TTeeExceptionForm.Product:String;
begin
  {$IFDEF TEEOCX}
  result:='3';  // AX
  {$ELSE}
  result:='1';  // VCL / FMX
  {$ENDIF}
end;

class function TTeeExceptionForm.SubProduct:String;
begin
  {$IFDEF TEELITEEMB}result:='4';{$ELSE}
  {$IFDEF TEELITE}result:='1';{$ELSE}
  result:='2';
  {$ENDIF}
  {$ENDIF}
end;

class function TTeeExceptionForm.License:String;
var tmp : TStrings;
begin
  result:='';

  with TRegistry.Create(KEY_READ) do
  try
    {$IFDEF TEEOCX}
    if OpenKeyReadOnly('Software\Steema Software\Licenses\AX\'+TeeProductName+TeeAXMinorVersion) then
    {$ELSE}
    if OpenKeyReadOnly('Software\Steema Software\Licenses\VCL\'+TeeProductName+TeeVCLMinorVersion) then
    {$ENDIF}
    begin
      tmp:=TStringList.Create;
      try
        GetValueNames(tmp);

        if tmp.Count>0 then
           result:=tmp[tmp.Count-1];
      finally
        tmp.Free;
      end;

      CloseKey;
    end;
  finally
    Free;
  end;
end;

procedure TTeeExceptionForm.Button1Click(Sender: TObject);

  function Version:String;
  begin
    {$IFDEF TEEOCX}
    result:=AXVer;
    {$ELSE}
    result:=TeeProductName+TeeVCLMinorVersion+'.'+TeeVCLBuildVersion;
    {$ENDIF}
  end;

  function Language:String;
  begin
    {$IFDEF BCB}
    result:='C++'
    {$ELSE}
    result:='Delphi';
    {$ENDIF}
  end;

  function PlatformString:String;
  begin
    {$IFDEF ANDROID}
    result:='Android';
    {$ELSE}
    {$IFDEF IOS}
    result:='iOS';
    {$ELSE}
    {$IFDEF MACOS}
    result:='OSX';
    {$ELSE}
    result:='';
    {$ENDIF}
    {$ENDIF}
    {$ENDIF}

    {$IFDEF CPUX64}
    result:=result+' x64';
    {$ELSE}
    result:=result+' 32bit';
    {$ENDIF}
  end;

  function ReadEmailRegistry:String;
  begin
    result:='';

    with TRegistry.Create do
    try
      if OpenKeyReadOnly('Software\Steema Software\TeeException') then
      begin
        if ValueExists('Email') then
           result:=ReadString('Email');
           
        CloseKey;
      end;
    finally
      Free;
    end;
  end;

  procedure StoreEmailRegistry;
  begin
    with TRegistry.Create do
    try
      if OpenKey('Software\Steema Software\TeeException',True) then
      begin
         WriteString('Email',Email.Text);
         CloseKey;
      end;
    finally
      Free;
    end;
  end;

var tmp : TStringStream;
    URL : String;
begin
  if Panel1.Visible then
  begin
    Button1.Visible:=False;

    StoreEmailRegistry;

    tmp:=TStringStream.Create('');
    try
      URL:='http://www.steema.com/exceptions/add.php?ide='+IDE+'&product='+Product+
           '&code='+TheCode+
           '&lic='+License+'&error='+TheException.Message+'&class='+TheException.ClassName+'&build='+Version+
           '&lang='+Language+'&osversion='+GetWinVersion+'&platform='+PlatformString;

      if Trim(Email.Text)<>'' then
           URL:=URL+'&email='+Trim(Email.Text);

      if Trim(MemoComments.Text)<>'' then
           URL:=URL+'&comments='+Trim(MemoComments.Text);

      Screen.Cursor:=crHourGlass;
      try
        TeeDownloadURLProc(URL,tmp);
      finally
        Screen.Cursor:=crDefault;
      end;

      if Copy(tmp.DataString,1,2)<>'OK' then
      begin
        LabelServer.Caption:=TeeMsg_ServerError;
        Exit;
      end
      else
      begin
        {$IFDEF D16}

        {$ENDIF}
      end;
    finally
      tmp.Free;
    end;

    LabelServer.Caption:=TeeMsg_ServerCaption;
  end
  else
  begin
    {$IFDEF TEEJAPANESE}
    Label2.Visible:=False;
    {$ENDIF}
    PanelMain.Visible:=False;
    Panel1.Visible:=True;
    Panel1.Align:=alTop;
    Panel1.Height:=Button1.Top-12;
    MemoComments.Height:=Button1.Top-80;
    MemoComments.Width:=Self.Width-40;
    Button1.Caption:=TeeMsg_ExceptionSend;
    Email.Text:=ReadEmailRegistry;

    if Email.Text='' then
       Email.SetFocus
    else
       MemoComments.SetFocus;
  end;
end;

procedure TTeeExceptionForm.Label4Click(Sender: TObject);
begin
  TeeGotoURL(0,'http://support.steema.com');
end;

procedure TTeeExceptionForm.FormShow(Sender: TObject);
begin
  TeeTranslateControl(Self);

  {$IFDEF TEEJAPANESE}
  Label1.Font.Name := TeeMsg_DefaultFontName;
  Label3.Font.Name := TeeMsg_DefaultFontName;
  Label7.Font.Name := TeeMsg_DefaultFontName;
  LabelServer.Font.Name := TeeMsg_DefaultFontName;
  {$ENDIF}
end;

end.
