Einzelnen Beitrag anzeigen

Inspur1

Registriert seit: 28. Aug 2024
10 Beiträge
 
#17

AW: Threadklasse mit Event aktualisiert nicht

  Alt 28. Aug 2024, 21:25
Das ist ein Teil vom Projekt:

Delphi-Quellcode:
unit uSeriesThread;

interface

uses Classes, Types;

type
  TSeriesThread = class(TThread)
  private
    FTitle: string;
    FUser: string;
    FPwd: string;
    FEpisodes: TStrings;
    FOnHtml: TNotifyEvent;
  protected
    procedure DoHtml; virtual;
    procedure Execute; override;
    procedure SetTitle(Value: string); virtual;
  public
    constructor Create(CreateSuspended: Boolean; OnHtml: TNotifyEvent); overload;
    destructor Destroy; override;
    function GetHtml(Url: string): string;
    procedure Login(User: string; Pwd: string); virtual;
    property Title: string read FTitle write SetTitle;
    property Episodes: TStrings read FEpisodes write FEpisodes;
    property OnHtml: TNotifyEvent read FOnHtml write FOnHtml;
  end;

implementation

// < API >

type
  HINTERNET = Pointer;
  DWORD_PTR = Cardinal;

const
  WININET_DLL = 'Wininet.dll';
  INTERNET_OPEN_TYPE_PRECONFIG = 0;

function InternetOpen(lpszAgent: PChar; dwAccessType: DWORD;
  lpszProxy, lpszProxyBypass: PChar; dwFlags: DWORD): HINTERNET;
  stdcall; external WININET_DLL name {$IFDEF UNICODE}'InternetOpenW'{$ELSE}'InternetOpenA'{$ENDIF};

function InternetOpenUrl(hInet: HINTERNET; lpszUrl, lpszHeaders: PChar;
  dwHeadersLength, dwFlags: DWORD; dwContext: DWORD_PTR): HINTERNET;
  stdcall; external WININET_DLL name {$IFDEF UNICODE}'InternetOpenUrlW'{$ELSE}'InternetOpenUrlA'{$ENDIF};

function InternetReadFile(hFile: HINTERNET; lpBuffer: Pointer;
  dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): Boolean;
  stdcall; external WININET_DLL;

function InternetCloseHandle(hInet: HINTERNET): Boolean;
  stdcall; external WININET_DLL;

// < /API >

// < TSeriesThread >

constructor TSeriesThread.Create(CreateSuspended: Boolean; OnHtml: TNotifyEvent);
begin
  inherited Create(CreateSuspended);
  FEpisodes := TStringList.Create;
  FOnHtml := OnHtml;
end;

destructor TSeriesThread.Destroy;
begin
  FEpisodes.Free;
  inherited;
end;

function TSeriesThread.GetHtml(Url: string): string; // starts with 'www.'
var
  hOpen, hUrl: HINTERNET;
  buff: array[0..4095] of Char;
  buffLen: DWORD;
  i: Integer;
begin
  hOpen := InternetOpen(PChar('SeriesBrowser'), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    hUrl := InternetOpenUrl(hOpen, PChar(Url), nil, 0, 0, 0);
    try
      repeat
        InternetReadFile(hURL, @buff[0], SizeOf(buff), buffLen);
        if buffLen = SizeOf(buff) then
          result := result + string(buff)
        else if buffLen > 0 then
          for i := 0 to buffLen - 1 do
            result := result + string(buff[i]);
      until buffLen = 0;
    finally
      InternetCloseHandle(hUrl);
    end;
  finally
    InternetCloseHandle(hOpen);
  end;
end;

procedure TSeriesThread.Execute;
begin
  Synchronize(DoHtml);
end;

procedure TSeriesThread.Login(User: string; Pwd: string);
begin
  FUser := User;
  FPwd := Pwd;
end;

procedure TSeriesThread.DoHtml;
begin
  if Assigned(FOnHtml) then
    FOnHtml(self);
end;

procedure TSeriesThread.SetTitle(Value: string);
begin
  FTitle := Value;
end;

// < /TSeriesThread >

end.
Das Ziel ist:

Delphi-Quellcode:
private
  FTest: TSeriesThread;
  procedure MyTest(Sender: TObject);

procedure TForm1.MyTest(Sender: TObject);
begin
  // do login
  // search by title
  // get html
  // parse html
  // loop
  // --> FTest.Episodes.Add('episode0... url');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FTest := TSeriesThread.Create(false, MyTest);
  try
    FTest.FreeOnTerminate := false;
    FTest.Resume;
    ListBox1.Items.AddStrings(FTest.Episodes);
  finally
    FTest.Free;
  end;
end;
Die Liste und das Title bleiben leer. Das ist das Problem.
  Mit Zitat antworten Zitat