diff --git a/VLib/MainUNT.dfm b/VLib/MainUNT.dfm new file mode 100644 index 0000000..c1d1de8 --- /dev/null +++ b/VLib/MainUNT.dfm @@ -0,0 +1,103 @@ +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'Main' + ClientHeight = 645 + ClientWidth = 739 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + DesignSize = ( + 739 + 645) + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 8 + Top = 19 + Width = 29 + Height = 13 + Caption = 'Code:' + end + object Label2: TLabel + Left = 8 + Top = 43 + Width = 34 + Height = 13 + Caption = 'Result:' + end + object Button1: TButton + Left = 275 + Top = 14 + Width = 75 + Height = 25 + Caption = 'Get' + TabOrder = 0 + OnClick = Button1Click + end + object WB1: TEmbeddedWB + Left = 0 + Top = 296 + Width = 737 + Height = 241 + Anchors = [akLeft, akTop, akRight, akBottom] + TabOrder = 1 + Silent = False + OnNavigateComplete2 = WB1NavigateComplete2 + OnDocumentComplete = WB1DocumentComplete + DisableCtrlShortcuts = 'N' + DownloadOptions = [DownloadVideos, DownloadBGSounds] + UserInterfaceOptions = [EnablesFormsAutoComplete, EnableThemes] + About = ' EmbeddedWB http://bsalsa.com/' + PrintOptions.Header = '&w&bPage &p of &P' + PrintOptions.HTMLHeader.Strings = ( + '') + PrintOptions.Footer = '&u&b&d' + PrintOptions.Orientation = poPortrait + ControlData = { + 4C0000002C4C0000452A00000000000000000000000000000000000000000000 + 000000004C000000000000000000000001000000E0D057007335CF11AE690800 + 2B2E126208000000000000004C0000000114020000000000C000000000000046 + 8000000000000000000000000000000000000000000000000000000000000000 + 00000000000000000100000000000000000000000000000000000000} + end + object Button2: TButton + Left = 559 + Top = 14 + Width = 75 + Height = 25 + Caption = 'Button2' + TabOrder = 2 + OnClick = Button2Click + end + object Button3: TButton + Left = 640 + Top = 14 + Width = 75 + Height = 25 + Caption = 'Button3' + TabOrder = 3 + OnClick = Button3Click + end + object txtCode: TEdit + Left = 43 + Top = 16 + Width = 216 + Height = 21 + NumbersOnly = True + TabOrder = 4 + Text = '46008281120' + end + object memResult: TMemo + Left = 8 + Top = 62 + Width = 449 + Height = 219 + ScrollBars = ssBoth + TabOrder = 5 + end +end diff --git a/VLib/MainUNT.pas b/VLib/MainUNT.pas new file mode 100644 index 0000000..c2f4f42 --- /dev/null +++ b/VLib/MainUNT.pas @@ -0,0 +1,244 @@ +unit MainUNT; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, + System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw_EWB, + EwbCore, EmbeddedWB, MSHTML_EWB; + +type + TfrmMain = class(TForm) + Button1: TButton; + WB1: TEmbeddedWB; + Button2: TButton; + Button3: TButton; + txtCode: TEdit; + Label1: TLabel; + memResult: TMemo; + Label2: TLabel; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure WB1DocumentComplete(ASender: TObject; const pDisp: IDispatch; + var URL: OleVariant); + procedure WB1NavigateComplete2(ASender: TObject; const pDisp: IDispatch; + var URL: OleVariant); + private + { Private declarations } + function Proceed1(ACode: String): Boolean; + function Proceed2(ACode: String): Boolean; + function Parse1(ASource: String; ASourceText: String): Boolean; + public + { Public declarations } + end; + +var + frmMain: TfrmMain; + gloURL1: String = 'http://www.vmi.lt/lt/?itemId=1003741'; + gloURL2: String = 'http://www.vmi.lt/lt/?itemId=1003740'; + gloCount: Integer; + +implementation + +{$R *.dfm} + +procedure TfrmMain.Button1Click(Sender: TObject); +Var + aElement: IhtmlElement; + ATimeout: Integer; + ARepeatCount: Integer; +begin + memResult.Lines.Clear; + gloCount := 0; + ATimeout := 0; + ARepeatCount := 0; + WB1.Stop; + WB1.Navigate('about:blank'); + WB1.Navigate(gloURL1); + + while WB1.ReadyState < READYSTATE_INTERACTIVE do + Application.ProcessMessages; + + // Antra karta paleidus tinka ir gloCount1 ??? + while (gloCount < 1) and (ATimeout < 199999999) do + begin + Application.ProcessMessages; + Inc(ATimeout); + end; + + if ATimeout >= 199999999 then + begin + WB1.Stop; + // WB1.Quit; + WB1.Navigate('about:blank'); + WB1.Navigate(gloURL1); + ShowMessage('TimeOut'); + // Exit; + end; + + // Check emty string + if trim(txtCode.Text) = '' then + Exit; + + // If Recognize person code or company code try proceed + if (length(trim(txtCode.Text)) = 11) or (length(trim(txtCode.Text)) = 13) then + Proceed1(txtCode.Text) + else + Proceed2(txtCode.Text); + +end; + +procedure TfrmMain.Button2Click(Sender: TObject); +var + aElement: IhtmlElement; +begin + WB1.FillForm('InputByPerson_code', '36205301333'); + // WB1.FillFormAndExcecute; + + aElement := WB1.ElementByID['LNGSubmit']; + if aElement <> nil then + begin + aElement.click; + end; +end; + +procedure TfrmMain.Button3Click(Sender: TObject); +var + aElement: IhtmlElement; +begin + aElement := WB1.ElementByID['inpPerson_code']; + if aElement <> nil then + begin + aElement.click; + end; +end; + +function TfrmMain.Parse1(ASource, ASourceText: String): Boolean; +var + AStart: Integer; + AEnd: Integer; + AResult: String; +begin + Result := False; + + // Result parse + if Pos('Įrašų nerasta', WB1.DocumentSource) > 0 then + begin + memResult.Lines.Add('Įrašų nerasta'); + Exit; + end; + + AStart := Pos('Paieškos rezultatai', ASourceText); + + AResult := ASourceText; + Delete(AResult, 1, AStart-1); + + AEnd := Pos('Konsultacijos mokesčių klausimais telefonu 1882', AResult); + Delete(AResult, AEnd, length(AResult)-AEnd); + + memResult.Lines.Text := Trim(AResult); + +end; + +function TfrmMain.Proceed1(ACode: String): Boolean; +var + aElement: IhtmlElement; +begin + Result := False; + + // Recognize person code and select person code radio button + if length(trim(txtCode.Text)) = 11 then + begin + // Person code 11 symbols + aElement := WB1.ElementByID['inpPerson_code']; + if aElement <> nil then + begin + aElement.click; + WB1.FillForm('InputByPerson_code', ACode); + WB1.FillFormAndExcecute; + end; + end; + + // Recognize company code and select company code radio button + if length(trim(txtCode.Text)) = 13 then + begin + // Company code 13 symbols + aElement := WB1.ElementByID['inpCode']; + if aElement <> nil then + begin + aElement.click; + WB1.FillForm('InputByCode', ACode); + WB1.FillFormAndExcecute; + end; + end; + + aElement := nil; + + aElement := WB1.ElementByID['LNGSubmit']; + if aElement <> nil then + begin + aElement.click; + end + else + Exit; + + // TODO: timeout padaryti + while gloCount < 2 do + Application.ProcessMessages; + + // Result parse + // ShowMessage(WB1.DocumentSource); + // ShowMessage(WB1.DocumentSourceText); + // WB1.DocumentSourceText + + // memResult.Lines.Text := WB1.DocumentSourceText; + + Parse1(WB1.DocumentSource, WB1.DocumentSourceText); +end; + +function TfrmMain.Proceed2(ACode: String): Boolean; +begin + +end; + +procedure TfrmMain.WB1DocumentComplete(ASender: TObject; const pDisp: IDispatch; + var URL: OleVariant); +var + aElement: IhtmlElement; +begin + Inc(gloCount); + Application.ProcessMessages; + // if gloCount = 1 then + // begin + // aElement := WB1.ElementByID['inpPerson_code']; + // if aElement <> nil then + // begin + // aElement.click; + // end; + // end; + // + // if gloCount = 2 then + // begin + // aElement := WB1.ElementByID['inpPerson_code']; + // if aElement <> nil then + // begin + // aElement.click; + // end; + // end; +end; + +procedure TfrmMain.WB1NavigateComplete2(ASender: TObject; + const pDisp: IDispatch; var URL: OleVariant); +var + aElement: IhtmlElement; +begin + // aElement := WB1.ElementByID['inpPerson_code']; + // if aElement <> nil then + // begin + // aElement.click; + // end; +end; + +end. diff --git a/VLib/VLib.dpr b/VLib/VLib.dpr new file mode 100644 index 0000000..9e975e6 --- /dev/null +++ b/VLib/VLib.dpr @@ -0,0 +1,14 @@ +program VLib; + +uses + Vcl.Forms, + MainUNT in 'MainUNT.pas' {frmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/VLib/VLib.dproj b/VLib/VLib.dproj new file mode 100644 index 0000000..1da51f3 --- /dev/null +++ b/VLib/VLib.dproj @@ -0,0 +1,147 @@ + + + {807F38E5-EDA8-4784-A188-DC84522B0F69} + 13.4 + VCL + VLib.dpr + True + Debug + Win32 + 1 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + bindcompfmx;fmx;rtl;dbrtl;IndySystem;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;DataSnapClient;DataSnapServer;DataSnapProviderClient;xmlrtl;ibxpress;DbxCommonDriver;IndyProtocols;DBXMySQLDriver;dbxcds;FMXTee;bindengine;soaprtl;DBXOracleDriver;CustomIPTransport;dsnap;DBXInformixDriver;fmxase;IndyCore;CloudService;FmxTeeUI;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;IPIndyImpl;dbexpress;DataSnapIndy10ServerTransport;$(DCC_UsePackage) + $(BDS)\bin\delphi_PROJECTICON.ico + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + + + TeeDB;vclib;Tee;DBXOdbcDriver;DBXSybaseASEDriver;vclimg;TeeUI;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;DBXDb2Driver;websnap;vclribbon;VclSmp;vcl;DataSnapConnectors;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;adortl;$(DCC_UsePackage) + + + vcldbx;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;svnui;DBXSybaseASEDriver;vclimg;fmi;intrawebdb_120_160;frxDB16;fs16;TeeUI;vclactnband;vcldb;vcldsnap;bindcompvcl;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;VclSmp;fsDB16;frxe16;vcl;DataSnapConnectors;DBXMSSQLDriver;CodeSiteExpressPkg;dsnapcon;vclx;webdsnap;svn;bdertl;adortl;$(DCC_UsePackage) + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + 1033 + $(BDS)\bin\default_app.manifest + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + DEBUG;$(DCC_Define) + false + true + true + true + + + false + + + false + RELEASE;$(DCC_Define) + 0 + false + + + + MainSource + + +
frmMain
+ dfm + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1063 + 1257 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + VLib.dpr + + + + + False + True + + + 12 + + + + diff --git a/VLib/VLib.res b/VLib/VLib.res new file mode 100644 index 0000000..c287ee9 Binary files /dev/null and b/VLib/VLib.res differ diff --git a/VLib/Win32/Debug/VLib.exe b/VLib/Win32/Debug/VLib.exe new file mode 100644 index 0000000..26994b3 Binary files /dev/null and b/VLib/Win32/Debug/VLib.exe differ