оптимизон от нейронки, доделал автоматические действия, добавил глобальный лог, сделал реконекты к ДА

2025-08-08 14:57:56 +03:00
parent 1936c9c9c0
commit 71cdcc9909
23 changed files with 721 additions and 249 deletions
@@ -4,7 +4,7 @@ interface

 uses
  System.SysUtils, System.Classes, IdContext, IdCustomHTTPServer, IdHTTPServer,
-  IdComponent, ShellAPI;
+  IdComponent, ShellAPI, System.Threading, Windows;

 type
  TmyEvent = procedure(txt: string) of object;
@@ -25,7 +25,6 @@ type
      AResponseInfo: TIdHTTPResponseInfo);
    procedure OnStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
-
  public
    constructor Create;
    destructor Destroy; override;
@@ -33,44 +32,74 @@ type
    procedure StopServer;
    property OnToken: TmyEvent read FmyEvent write FmyEvent;
    property OnError: TmyEvent read FmyEvent write FmyEvent;
-
  end;

 implementation

+{ TTTWAuth }
+
 constructor TTTWAuth.Create;
 begin
+  inherited Create;
  FHTTPServer := TIdHTTPServer.Create(nil);
  FHTTPServer.OnCommandGet := HandleRequest;
  FHTTPServer.OnStatus := OnStatus;
+  // Íå âêëþ÷àåì Active çäåñü
 end;

 destructor TTTWAuth.Destroy;
 begin
-  FHTTPServer.Free;
+  try
+    if Assigned(FHTTPServer) then
+    begin
+      try
+        if FHTTPServer.Active then
+          FHTTPServer.Active := False;
+      except
+      end;
+      FreeAndNil(FHTTPServer);
+    end;
+  except
+  end;
  inherited;
 end;

 procedure TTTWAuth.StartServer(aURL: string);
 begin
+  // Çàùèòà îò ïîâòîðíîãî çàïóñêà
+  if Assigned(FHTTPServer) and FHTTPServer.Active then
+    Exit;
+
+  // Î÷èñòèì ñòàðûå áèíäèíãè, ÷òîáû íå íàêàïëèâàòü èõ
+  FHTTPServer.Bindings.Clear;
+
  FHTTPServer.DefaultPort := 80;
+  // Äîáàâëÿåì áèíäèíã ÿâíî
  FHTTPServer.Bindings.Add.SetBinding('127.0.0.1', 80);
  FURL := aURL;
  FHTTPServer.Active := True;
  if FURL <> '' then
-    ShellExecute(0, 'open', pwidechar(FURL), nil, nil, 1);
+    ShellExecute(0, 'open', PWideChar(FURL), nil, nil, SW_SHOWNORMAL);
 end;

 procedure TTTWAuth.StopServer;
 begin
-  FHTTPServer.Active := False;
-
+  if Assigned(FHTTPServer) then
+  begin
+    try
+      FHTTPServer.Active := False;
+    except
+    end;
+    try
+      FHTTPServer.Bindings.Clear;
+    except
+    end;
+  end;
 end;

 procedure TTTWAuth.HandleRequest(ASender: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
 begin
-
  if ARequestInfo.Document = '/' then
    HandleRootRequest(ARequestInfo, AResponseInfo)
  else if ARequestInfo.Document = '/redirect' then
@@ -87,85 +116,174 @@ end;
 procedure TTTWAuth.HandleRootRequest(ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
 begin
-  AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
-    '<head>' + #13 + '  <title>Redirecting...</title>' + #13 + '</head>' + #13 +
-    '<body>' + #13 + ' <p>ïîëó÷àþ òîêåí:</p>' + #13 + '<script>' + #13 +
-    'var paragraph = window.location.href;' + #13 +
-    'var urrl = paragraph.replace(''localhost/'',''localhost/redirect'');' + #13
-    + 'urrl = urrl.replace(''#'',''?'');' + #13 + 'console.log(urrl);' + #13 +
-    'window.location.href =urrl;' + #13 + '	</script>' + #13 + '</body>' + #13 +
-    '</html>';
+  AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
+    sLineBreak + '<head>' + sLineBreak +
+    '  <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
+    '<body>' + sLineBreak + ' <p>ïîëó÷àþ òîêåí:</p>' + sLineBreak + '<script>' +
+    sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
+    'var urrl = paragraph.replace(''localhost/'',''localhost/redirect'');' +
+    sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
+    'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
+    sLineBreak + '	</script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
 end;

 procedure TTTWAuth.OnStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
 begin
-
+  // Ìîæíî ëîãèðîâàòü ñòàòóñ, íî íå îáÿçàòåëüíî
 end;

 procedure TTTWAuth.HandleDARequest(ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
 begin
-  AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
-    '<head>' + #13 + '  <title>Redirecting...</title>' + #13 + '</head>' + #13 +
-    '<body>' + #13 + ' <p>ïîëó÷àþ êîä</p>' + #13 + '<script>' + #13 +
-    'var paragraph = window.location.href;' + #13 +
+  AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
+    sLineBreak + '<head>' + sLineBreak +
+    '  <title>Redirecting...</title>' + sLineBreak + '</head>' + sLineBreak +
+    '<body>' + sLineBreak + ' <p>ïîëó÷àþ êîä</p>' + sLineBreak + '<script>' +
+    sLineBreak + 'var paragraph = window.location.href;' + sLineBreak +
    'var urrl = paragraph.replace(''localhost/da'',''localhost/redirect'');' +
-    #13 + 'urrl = urrl.replace(''#'',''?'');' + #13 + 'console.log(urrl);' + #13
-    + 'window.location.href =urrl;' + #13 + '	</script>' + #13 + '</body>' + #13
-    + '</html>';
+    sLineBreak + 'urrl = urrl.replace(''#'',''?'');' + sLineBreak +
+    'console.log(urrl);' + sLineBreak + 'window.location.href =urrl;' +
+    sLineBreak + '	</script>' + sLineBreak + '</body>' + sLineBreak + '</html>';
 end;

 procedure TTTWAuth.HandleRedirectRequest(ARequestInfo: TIdHTTPRequestInfo;
  AResponseInfo: TIdHTTPResponseInfo);
 var
-  i: integer;
+  i: Integer;
  AccessToken: string;
+  LTokenCopy: string;
 begin
+  // Åñëè ïîëó÷åí access_token
  if Pos('access_token=', ARequestInfo.Params.Text) > 0 then
  begin
    for i := 0 to ARequestInfo.Params.Count - 1 do
      if Pos('access_token', ARequestInfo.Params[i]) > 0 then
        AccessToken := ARequestInfo.Params[i];
-    AccessToken := StringReplace(AccessToken, 'access_token=', '',
-      [rfReplaceAll]);
-    AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
-      '<head>' + #13 + '  <title>Done...</title>' + #13 + '</head>' + #13 +
-      '<body>' + #13 + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + #13 + '</body>' + #13 +
-      '</html>';
+    AccessToken := StringReplace(AccessToken, 'access_token=', '', [rfReplaceAll]);
+
+    AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
+      sLineBreak + '<head>' + sLineBreak +
+      '  <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
+      '<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
+      '</body>' + sLineBreak + '</html>';
    AResponseInfo.WriteContent;
-    OnToken(AccessToken);
-    Destroy;
+
+    // Êîïèðóåì òîêåí, ÷òîáû êîððåêòíî ïåðåäàòü â main thread
+    LTokenCopy := AccessToken;
+    // Âûçûâàåì OnToken â main thread
+    if Assigned(FmyEvent) then
+      TThread.Queue(nil,
+        procedure
+        begin
+          try
+            FmyEvent(LTokenCopy);
+          except
+          end;
+        end);
+
+    // Îñòàíîâèì ñåðâåð è çàïëàíèðóåì î÷èñòêó îáúåêòà â main thread
+    try
+      StopServer;
+    except
+    end;
+    TThread.Queue(nil,
+      procedure
+      begin
+        try
+          Free;
+        except
+        end;
+      end);
+    Exit;
  end;
+
+  // Åñëè åñòü error_description
  if Pos('error_description=', ARequestInfo.Params.Text) > 0 then
  begin
    for i := 0 to ARequestInfo.Params.Count - 1 do
      if Pos('error_description', ARequestInfo.Params[i]) > 0 then
        AccessToken := ARequestInfo.Params[i];
-    AccessToken := StringReplace(AccessToken, 'error_description=', '',
-      [rfReplaceAll]);
-      AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
-      '<head>' + #13 + '  <title>ERROR...</title>' + #13 + '</head>' + #13 +
-      '<body>' + #13 + AccessToken + #13 + '</body>' + #13 +
-      '</html>';
+    AccessToken := StringReplace(AccessToken, 'error_description=', '', [rfReplaceAll]);
+
+    AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
+      sLineBreak + '<head>' + sLineBreak +
+      '  <title>ERROR...</title>' + sLineBreak + '</head>' + sLineBreak +
+      '<body>' + sLineBreak + AccessToken + sLineBreak + '</body>' + sLineBreak + '</html>';
    AResponseInfo.WriteContent;
-    OnError(AccessToken);
-    Destroy;
+
+    LTokenCopy := AccessToken;
+    if Assigned(FmyEvent) then
+      TThread.Queue(nil,
+        procedure
+        begin
+          try
+            FmyEvent(LTokenCopy);
+          except
+          end;
+        end);
+
+    try
+      StopServer;
+    except
+    end;
+    TThread.Queue(nil,
+      procedure
+      begin
+        try
+          Free;
+        except
+        end;
+      end);
+    Exit;
  end;
+
+  // Åñëè ïîëó÷åí code=
  if Pos('code=', ARequestInfo.Params.Text) > 0 then
  begin
    for i := 0 to ARequestInfo.Params.Count - 1 do
      if Pos('code', ARequestInfo.Params[i]) > 0 then
        AccessToken := ARequestInfo.Params[i];
    AccessToken := StringReplace(AccessToken, 'code=', '', [rfReplaceAll]);
-    AResponseInfo.ContentText := '<!DOCTYPE html>' + #13 + '<html>' + #13 +
-      '<head>' + #13 + '  <title>Done...</title>' + #13 + '</head>' + #13 +
-      '<body>' + #13 + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + #13 + '</body>' + #13 +
-      '</html>';
+
+    AResponseInfo.ContentText := '<!DOCTYPE html>' + sLineBreak + '<html>' +
+      sLineBreak + '<head>' + sLineBreak +
+      '  <title>Done...</title>' + sLineBreak + '</head>' + sLineBreak +
+      '<body>' + sLineBreak + 'Ýòó ñòðàíèöó ìîæíî çàêðûòü' + sLineBreak +
+      '</body>' + sLineBreak + '</html>';
    AResponseInfo.WriteContent;
-    OnToken(AccessToken);
-    Destroy;
+
+    LTokenCopy := AccessToken;
+    if Assigned(FmyEvent) then
+      TThread.Queue(nil,
+        procedure
+        begin
+          try
+            FmyEvent(LTokenCopy);
+          except
+          end;
+        end);
+
+    try
+      StopServer;
+    except
+    end;
+    TThread.Queue(nil,
+      procedure
+      begin
+        try
+          Free;
+        except
+        end;
+      end);
+    Exit;
  end;
+
+  // Ïî óìîë÷àíèþ — 404
+  AResponseInfo.ResponseNo := 404;
+  AResponseInfo.ContentText := 'Not Found';
+  AResponseInfo.WriteContent;
 end;

 end.
+