Skip to content

Commit

Permalink
VLIB first upload
Browse files Browse the repository at this point in the history
  • Loading branch information
@Ernikas
Ernikas committed Jan 6, 2013
1 parent 199f0da commit b6cf09f
Show file tree
Hide file tree
Showing 6 changed files with 508 additions and 0 deletions.
103 changes: 103 additions & 0 deletions VLib/MainUNT.dfm
View file
Original file line number Diff line number Diff line change
@@ -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 = (
'<HTML></HTML>')
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
244 changes: 244 additions & 0 deletions VLib/MainUNT.pas
View file
Original file line number Diff line number Diff line change
@@ -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.
14 changes: 14 additions & 0 deletions VLib/VLib.dpr
View file
Original file line number Diff line number Diff line change
@@ -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.
Loading

0 comments on commit b6cf09f

Please sign in to comment.