html parse repeat

[ercanskose]

teşekkürler arkadaşlar. bilgileri çekerek veritabanına kaydettim. şimdi içerik sayfasındaki bilgileri çekicem. birazda onunla uğraşayım. ön bilgileri çeken ve veritabanına kaydeden kodu paylaşıyorum ihtiyacı olan arkadaşlar olaiblir. 3 buton kullandım 1. sayfaya gidiyor. 2. memdata ya çekiyor. 3. veritabanına kaydediyor.

unit Unit2;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, Vcl.StdCtrls,
 cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer,
 cxEdit, dxSkinsCore, dxSkinBasic, dxSkinBlack, dxSkinBlue, dxSkinBlueprint,
 dxSkinCaramel, dxSkinCoffee, dxSkinDarkroom, dxSkinDarkSide,
 dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
 dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
 dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
 dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
 dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
 dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
 dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray,
 dxSkinOffice2013White, dxSkinOffice2016Colorful, dxSkinOffice2016Dark,
 dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray,
 dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
 dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust,
 dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier, dxSkinValentine,
 dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
 dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint, dxSkinWXI,
 dxSkinXmas2008Blue, cxTextEdit, cxMemo, Xml.xmldom, Xml.XMLIntf, Xml.XMLDoc,MSHTML,
 System.RegularExpressions, cxStyles, cxCustomData, cxFilter, cxData,
 cxDataStorage, cxNavigator, dxDateRanges, dxScrollbarAnnotations, Data.DB,
 cxDBData, dxmdaset, cxGridLevel, cxClasses, cxGridCustomView,
 cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid,System.Generics.Collections,
 MemDS, DBAccess, Uni, UniProvider, MySQLUniProvider, Vcl.Menus, System.Win.Registry;

type
 TForm2 = class(TForm)
   WebBrowser1: TWebBrowser;
   Edit1: TEdit;
   Button1: TButton;
   XMLDocument1: TXMLDocument;
   Button3: TButton;
   Memo1: TMemo;
   Memo2: TMemo;
   cxGrid1DBTableView1: TcxGridDBTableView;
   cxGrid1Level1: TcxGridLevel;
   cxGrid1: TcxGrid;
   DataSource1: TDataSource;
   dxMemData1: TdxMemData;
   dxMemData1URUN_ADI: TStringField;
   dxMemData1TIPI: TStringField;
   dxMemData1VOLTAJ: TStringField;
   dxMemData1HFE: TStringField;
   dxMemData1AKIM: TStringField;
   dxMemData1KILIF: TStringField;
   cxGrid1DBTableView1RecId: TcxGridDBColumn;
   cxGrid1DBTableView1URUN_ADI: TcxGridDBColumn;
   cxGrid1DBTableView1TIPI: TcxGridDBColumn;
   cxGrid1DBTableView1VOLTAJ: TcxGridDBColumn;
   cxGrid1DBTableView1HFE: TcxGridDBColumn;
   cxGrid1DBTableView1AKIM: TcxGridDBColumn;
   cxGrid1DBTableView1KILIF: TcxGridDBColumn;
   Button4: TButton;
   UniConnection1: TUniConnection;
   transistor: TUniQuery;
   MySQLUniProvider1: TMySQLUniProvider;
   MainMenu1: TMainMenu;
   ransistorDetay1: TMenuItem;
   Mosfet1: TMenuItem;
   MosfetDetay1: TMenuItem;
   Diyot1: TMenuItem;
   DiyotDetay1: TMenuItem;
   ZenerDiyot1: TMenuItem;
   ZenerDiyotDetay1: TMenuItem;
   KprDiyot1: TMenuItem;
   KprDiyotDetay1: TMenuItem;
   procedure Button1Click(Sender: TObject);

   procedure Button2Click(Sender: TObject);
   procedure Button3Click(Sender: TObject);
   procedure Button4Click(Sender: TObject);
   procedure ransistorDetay1Click(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure WebBrowser1DocumentComplete(ASender: TObject;
     const pDisp: IDispatch; const URL: OleVariant);

 private
   procedure ExtractTDsAndSave(const SourceText: string);
    procedure SetIEFeatureBrowserEmulation;
   procedure InjectSuppressScript;
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;

implementation
            uses Unit1, Winapi.ActiveX;
{$R *.dfm}


procedure TForm2.SetIEFeatureBrowserEmulation;
var
 Reg: TRegistry;
 AppName: string;
begin
 AppName := ExtractFileName(ParamStr(0));
 Reg := TRegistry.Create(KEY_WRITE);
 try
   Reg.RootKey := HKEY_CURRENT_USER;
   if Reg.OpenKey('\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION', True) then
   begin
     // IE11 modu (11001) — uygulamanızın adını anahtar olarak yaz
     Reg.WriteInteger(AppName, 11001);
     Reg.CloseKey;
   end;
 finally
   Reg.Free;
 end;
end;

procedure TForm2.WebBrowser1DocumentComplete(ASender: TObject;
 const pDisp: IDispatch; const URL: OleVariant);
var
 Doc: IHTMLDocument2;
begin
      Memo1.Text:=WebBrowser1.OleObject.Document.Body.InnerHTML;
 // pDisp kontrolü: bize gelen event bizim webbrowser'a aitse çalıştır
 if Assigned(pDisp) and Assigned(WebBrowser1.ControlInterface) then
 begin
   // bazen birden fazla DocumentComplete gelir (frame'ler için).
   // Bu kontrol ensures we inject only for top-level document:
   if pDisp = IWebBrowser2(WebBrowser1.ControlInterface) then
   begin
     try
       Doc := WebBrowser1.Document as IHTMLDocument2;
       if Assigned(Doc) then
         InjectSuppressScript; // JS'i enjekte et
     except
       // boş bırak — hata olsa da uygulama çökmemeli
     end;
   end;
 end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
 // Sessiz modu aç
 WebBrowser1.Silent := True;

 // IE emülasyon ayarı (kullanıcı hesabı seviyesinde)
 try
   SetIEFeatureBrowserEmulation;
 except
   // Registry'e yazılamazsa uygulama yine çalışır; hatayı gizle
 end;
end;

procedure TForm2.InjectSuppressScript;
var
 Doc2: IHTMLDocument2;
 Win: IHTMLWindow2;
 Script: WideString;
begin
 // Güvenli bir JS snippet: hataları yutar ve alert/confirm/prompt/console fonksiyonlarını devre dışı bırakır.
 Script :=
   'try {' +
   '  window.onerror = function(msg, url, line, col, error) { return true; };' +
   '  window.alert = function() { return null; };' +
   '  window.confirm = function() { return false; };' +
   '  window.prompt = function() { return null; };' +
   '  if (typeof console !== "undefined") {' +
   '    if (!console.error) console.error = function(){};' +
   '    console.error = function(){}; console.warn = function(){}; console.log = function(){}; ' +
   '  }' +
   '} catch(e) { /* ignore */ }';

 try
   Doc2 := WebBrowser1.Document as IHTMLDocument2;
   if Assigned(Doc2) then
   begin
     Win := Doc2.parentWindow;
     if Assigned(Win) then
     begin
       // execScript ile JavaScript çalıştır
       Win.execScript(Script, 'JavaScript');
     end;
   end;
 except
   // eğer Document veya parentWindow alınamazsa sessizce geç
 end;
end;
//
procedure TForm2.ExtractTDsAndSave(const SourceText: string);
var
 CellMatches: TMatchCollection;
 CellMatch: TMatch;
 Cells: TStringList;
 i, recCount, savedCount: Integer;
 v: string;
begin
 Cells := TStringList.Create;
 try
   // Tüm <TD> içeriğini yakala
   CellMatches := TRegEx.Matches(SourceText, '<TD\b[^>]*>(.*?)</TD>', [roSingleLine, roIgnoreCase]);

   for CellMatch in CellMatches do
   begin
     v := CellMatch.Groups[1].Value;
     // İçerideki diğer HTML etiketlerini temizle
     v := TRegEx.Replace(v, '<[^>]+>', '', [roSingleLine]);
     v := Trim(v);
     Cells.Add(v);
   end;

   if Cells.Count = 0 then
   begin
     ShowMessage('Hiç <TD> bulunamadı.');
     Exit;
   end;

//    if not FDConnection1.Connected then
//      FDConnection1.Connected := True;
//
//    FDQuery1.SQL.Text :=
//      'INSERT INTO td_veriler (alan1, alan2, alan3, alan4, alan5, alan6) ' +
//      'VALUES (:a1, :a2, :a3, :a4, :a5, :a6)';
//    FDQuery1.Prepared := True;
//
//    FDConnection1.StartTransaction;


   try
     savedCount := 0;
     recCount := 0;
     i := 0;
     while i < Cells.Count do
     begin
       // Her bir parametre için index kontrolü yapıyoruz
       dxMemData1.Append;
       if i < Cells.Count then
         dxMemData1.FieldByName('URUN_ADI').AsString := Cells[i]
       else
         dxMemData1.FieldByName('URUN_ADI').AsString := '';

       if (i+1) < Cells.Count then
         dxMemData1.FieldByName('TIPI').AsString := Cells[i+1]
       else
         dxMemData1.FieldByName('TIPI').AsString := '';

       if (i+2) < Cells.Count then
         dxMemData1.FieldByName('VOLTAJ').AsString := Cells[i+2]
       else
         dxMemData1.FieldByName('VOLTAJ').AsString := '';

       if (i+3) < Cells.Count then
         dxMemData1.FieldByName('HFE').AsString := Cells[i+3]
       else
         dxMemData1.FieldByName('HFE').AsString := '';

       if (i+4) < Cells.Count then
         dxMemData1.FieldByName('AKIM').AsString := Cells[i+4]
       else
         dxMemData1.FieldByName('AKIM').AsString := '';

       if (i+5) < Cells.Count then
         dxMemData1.FieldByName('KILIF').AsString := Cells[i+5]
       else
         dxMemData1.FieldByName('KILIF').AsString := '';

         dxMemData1.Post;

            Application.ProcessMessages;
     // FDQuery1.ExecSQL;
       Inc(savedCount);
       Inc(recCount);

       // Memo'ya ekle (kontrol amaçlı)
       memo2.Lines.Add(Format('Kayıt %d: %s | %s | %s | %s | %s | %s',
         [recCount,
           dxMemData1.FieldByName('URUN_ADI').AsString,
           dxMemData1.FieldByName('TIPI').AsString,
           dxMemData1.FieldByName('VOLTAJ').AsString,
           dxMemData1.FieldByName('HFE').AsString,
           dxMemData1.FieldByName('AKIM').AsString,
           dxMemData1.FieldByName('KILIF').AsString]));

       Inc(i, 6);
     end;

  //   FDConnection1.Commit;
  //   ShowMessage(Format('%d TD bulundu, %d kayıt veritabanına eklendi.', [Cells.Count, savedCount]));
   except
     on E: Exception do
     begin
    //   FDConnection1.Rollback;
       raise;
     end;
   end;
 finally
   Cells.Free;
     WebBrowser1.Navigate(edit1.text);
 end;
end;



procedure TForm2.ransistorDetay1Click(Sender: TObject);
begin
Form1.Show;
end;

Function aradansec(text, ilk, son:String ): String;
begin
 Delete(Text, 1, pos(ilk, Text) + Length(ilk)-1);
 Result := Copy(Text, 1, Pos(Son, Text)-1);

end;

procedure TForm2.Button1Click(Sender: TObject);
begin
Memo1.Clear;
WebBrowser1.Navigate(edit1.Text);
dxMemData1.Close;
dxMemData1.Open;

// Örnek: bir URL aç
//  WebBrowser1.Navigate('https://ornek.com');

 // veya MemoHTML içeriğini doğrudan WebBrowser'a yükleyip DocumentComplete sonrasında enjeksiyon gerçekleşir:
 // WebBrowser1.Navigate('about:blank');
 // if Assigned(WebBrowser1.Document) then
 // begin
 //   (WebBrowser1.Document as IHTMLDocument2).write(MemoHTML.Lines.Text);
 // end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
form1.show;
end;



procedure TForm2.Button3Click(Sender: TObject);
var
i,s:Integer;
begin
i:=1;
s:=1;
// memo2.Clear;
for i := 1 to 345 do
begin
s:=i+1;

 ExtractTDsAndSave(memo1.Lines.Text);
 Edit1.text:='https://www.el-component.com/bipolar-transistors-page'+inttostr(s);



//ShowMessage('İşlem tamamlandı. Veriler 6 sütun olarak kaydedildi.');
end;
end;



procedure TForm2.Button4Click(Sender: TObject);
begin
dxMemData1.First;
while not dxMemData1.Eof do
begin
transistor.Close;
transistor.SQL.Clear;
transistor.SQL.Add
 ('INSERT INTO transistor (PARCA_ADI,TIPI,CB_VOLT,HFE,CCURRENT,KILIF) values '
 + '(ARCA_ADI,:TIPI,:CB_VOLT,:HFE,:CCURRENT,:KILIF)');
transistor.Params.ParamByName('PARCA_ADI').AsString := trim(dxMemData1.FieldByName('URUN_ADI').AsString);
transistor.Params.ParamByName('TIPI').AsString := trim(dxMemData1.FieldByName('TIPI').AsString);
transistor.Params.ParamByName('CB_VOLT').AsString := trim(dxMemData1.FieldByName('VOLTAJ').AsString);
transistor.Params.ParamByName('HFE').AsString := trim(dxMemData1.FieldByName('HFE').AsString);
transistor.Params.ParamByName('CCURRENT').AsString := trim(dxMemData1.FieldByName('AKIM').AsString);
transistor.Params.ParamByName('KILIF').AsString := trim(dxMemData1.FieldByName('KILIF').AsString);
transistor.ExecSQL;

dxMemData1.Next;
Application.ProcessMessages;
end;
end;



end.