Unit importfrm;
Interface
Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, jvexcontrols, jvcomponent, jvwizard, stdctrls, buttons, extctrls,
ActiveX, grids, jvexgrids, jvstringgrid, comobj, jvprogressbar,
Jvcomponentbase, jvthread, easylistview;
Type
Tfrmimport = Class (tform)
Jvwizard: tjvwizard;
Pgselectfile: tjvwizardinteriorpage;
Edtfilename: tlabelededit;
Btnbrowse: tbitbtn;
Dlgopen: topendialog;
Pgpreview: tjvwizardinteriorpage;
Label1: tlabel;
Cmbsheets: tcombobox;
ChkHeader: TCheckBox;
JSgView: TJvStringGrid;
PgSelectTelCol: TJvWizardInteriorPage;
Label2: TLabel;
CmbSimpleTel: TComboBox;
PgProgress: TJvWizardInteriorPage;
BtnCancel: TBitBtn;
PbProgress: TJvGradientProgressBar;
LblPerCount: TLabel;
LblTotal: TLabel;
LblCurr: TLabel;
LblErr: TLabel;
LblRep: TLabel;
ImportThread: TJvThread;
Procedure BtnBrowseClick (Sender: TObject );
Procedure PgSelectFileNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Procedure CmbSheetsChange (Sender: TObject );
Procedure FormClose (Sender: TObject; var Action: TCloseAction );
Procedure PgPreviewNextButtonClick (Sender: TObject; var Stop: Boolean );
Procedure PgSelectTelColNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Procedure ImportThreadExecute (Sender: TObject; Params: Pointer );
Procedure ImportThreadFinish (Sender: TObject );
Procedure BtnCancelClick (Sender: TObject );
Private
{Private declarations}
Public
{Public declarations}
FParams: Pointer;
Excel, books: olevariant;
Ftotal, fcurr, fper, ferr, FREP: integer;
Procedure updatedisplay;
Class procedure execute (Params: pointer );
End;
VaR
Frmimport: tfrmimport;
Implementation
Uses sendfrm;
{$ R *. DFM}
{Tfrmimport}
Class procedure tfrmimport. Execute (Params: pointer );
Begin
With tfrmimport. Create (Application) Do
Try
Fparams: = Params;
Showmodal;
Finally
Free;
End;
End;
Procedure tfrmimport. btnbrowseclick (Sender: tobject );
Begin
If not dlgopen. Execute then
Exit;
Edtfilename. Text: = dlgopen. filename;
End;
Procedure tfrmimport. pgselectfilenextbuttonclick (Sender: tobject;
VaR stop: Boolean );
VaR
I: integer;
Begin
Stop: = edtfilename. Text = '';
If stop then exit;
Try
If varisempty (Excel) then
Excel: = createoleobject ('excel. application ');
If varisempty (books) then
Books: = createoleobject ('excel. Sheet ');
Except
MessageBox (handle, 'check whether Excel is installed ', 'error', mb_iconerror + mb_ OK );
Exit;
End;
Cmbsheets. Clear;
Books: = excel. workbooks. Open (edtfilename. Text );
For I: = 1 to books. Sheets. Count do
Cmbsheets. Items. Add (books. Sheets [I]. Name );
Cmbsheets. itemindex: = 0;
Cmbsheetschange (NiL );
End;
Procedure tfrmimport. cmbsheetschange (Sender: tobject );
VaR
Row, Col: integer;
Begin
Books. Sheets [cmbsheets. text]. Activate;
Jsgview. colcount: = books. activesheet. usedrange. Columns. count;
For Col: = 1 to jsgview. colcount do
Begin
If chkheader. Checked then
Jsgview. cells [col-1, 0]: = books. activesheet. cells [1, Col]
Else
JSgView. Cells [Col-1, 0]: = Format ('f % d', [Col]);
End;
For Row: = 1 to JSgView. RowCount do
For Col: = 1 to JSgView. ColCount do
Begin
If ChkHeader. Checked then
JSgView. Cells [Col-1, Row]: = Books. ActiveSheet. Cells [Row + 1, Col]
Else
JSgView. Cells [Col-1, Row]: = Books. ActiveSheet. Cells [Row, Col];
End;
End;
Procedure TFrmImport. FormClose (Sender: TObject; var Action: TCloseAction );
Begin
If not VarIsEmpty (Books) then
Books. Close;
If not VarIsEmpty (Excel) then
Excel. Quit;
Books: = Unassigned;
Excel: = Unassigned;
End;
Procedure TFrmImport. PgPreviewNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Var
Col: Integer;
Begin
For Col: = 1 to Books. ActiveSheet. UsedRange. Columns. Count do
If ChkHeader. Checked then
CmbSimpleTel. Items. Add (Books. ActiveSheet. Cells [1, Col])
Else
CmbSimpleTel. Items. Add (Format ('f % d', [Col]);
CmbSimpleTel. ItemIndex: = 0;
End;
Procedure TFrmImport. PgSelectTelColNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Begin
BtnCancel. Visible: = True;
FPer: = 0;
If ChkHeader. Checked then
FTotal: = Books. ActiveSheet. UsedRange. Rows. Count-1
Else
FTotal: = Books. ActiveSheet. UsedRange. Rows. Count;
FCurr: = 0;
FErr: = 0;
FRep: = 0;
UpdateDisplay;
ImportThread. Execute (Self );
End;
Procedure TFrmImport. UpdateDisplay;
Begin
PbProgress. Position: = FPer;
LblPerCount. Caption: = Format ('% d %', [FPer]);
LblTotal. Caption: = Format ('total import: % d', [FTotal]);
LblCurr. Caption: = Format ('current import: % d', [FCurr]);
LblErr. Caption: = Format ('error data: % d', [FErr]);
LblRep. Caption: = Format ('duplicate data: % d', [FRep]);
End;
Procedure TFrmImport. ImportThreadExecute (Sender: TObject; Params: Pointer );
Var
E, B: OleVariant;
Col, Row: Integer;
F: TFrmSend;
S: string;
Item: TEasyItem;
Begin
CoInitialize (nil );
E: = CreateOleObject ('excel. application ');
B: = CreateOleObject ('excel. Sheet ');
B: = E. WorkBooks. Open (TFrmImport (Params). EdtFileName. Text );
B. Sheets [TFrmImport (Params). CmbSheets. Text]. Activate;
F: = TFrmSend (TFrmImport (Params). FParams );
Col: = TFrmImport (Params). CmbSimpleTel. ItemIndex + 1;
For Row: = 1 to TFrmImport (Params). FTotal do
Begin
If TFrmImport (Params). ChkHeader. Checked then
S: = B. ActiveSheet. Cells [Row + 1, Col]
Else
S: = B. ActiveSheet. Cells [Row, Col];
If F. IsMobile (S) then
Inc (F. FMobileCount)
Else if F. IsUnicom (S) then
Inc (F. FUnicomCount)
Else if F. IsTelecom (S) then
Inc (F. FTelecomCount)
Else begin
Inc (TFrmImport (Params). FCurr );
Inc (TFrmImport (Params). FErr );
TFrmImport (Params). FPer: = Trunc (TFrmImport (Params). FCurr/TFrmImport (Params). FTotal) * 100 );
ImportThread. Synchronize (TFrmImport (Params). UpdateDisplay );
Continue;
End;
If F. CheckRepeat (S) then
Begin
Inc (TFrmImport (Params). FCurr );
Inc (TFrmImport (Params). FRep );
TFrmImport (Params). FPer: = Trunc (TFrmImport (Params). FCurr/TFrmImport (Params). FTotal) * 100 );
ImportThread. Synchronize (TFrmImport (Params). UpdateDisplay );
Continue;
End;
Item: = F. ELVCache. Items. Add;
Item. Caption: = S;
Item. ImageIndex: = 0;
F. FCacheHash. Add (S, Item );
Inc (TFrmImport (Params). FCurr );
TFrmImport (Params). FPer: = Trunc (TFrmImport (Params). FCurr/TFrmImport (Params). FTotal) * 100 );
ImportThread. Synchronize (TFrmImport (Params). UpdateDisplay );
If ImportThread. Terminated then
Break;
End;
If not VarIsEmpty (B) then
B. Close;
If not VarIsEmpty (E) then
E. Quit;
B: = Unassigned;
E: = Unassigned;
CoUninitialize;
End;
Procedure TFrmImport. ImportThreadFinish (Sender: TObject );
Begin
BtnCancel. Visible: = False;
PgProgress. EnableButton (bkFinish, True );
PgProgress. Title. Text: = 'import finished ';
PgProgress. Subtitle. Text: = 'data import complete, click <finish> close wizard ';
End;
Procedure TFrmImport. BtnCancelClick (Sender: TObject );
Begin
If not ImportThread. Terminated then
ImportThread. Terminate
Else
Application. ProcessMessages;
End;
Initialization
CoInitialize (nil );
Finalization
CoUninitialize;
End.