to ：bensonhe
Win98 ＋ Delphi5；
全文如下,多谢关注！！！
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,comobj,
StdCtrls, Menus, ComCtrls,ExtCtrls, Db, ADODB,
Mask, ToolEdit, Grids, DBGridEh, Buttons, DBGridEhImpExp, TLHelp32;
type
TfmMain = class(TForm)
adoqryMain: TADOQuery;
cbWorkBooks: TComboBox;
lbWorkBooks: TLabel;
lbSheets: TLabel;
cbSheets: TComboBox;
Panel1: TPanel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
fe2000: TFilenameEdit;
fe2001: TFilenameEdit;
fe2002: TFilenameEdit;
cbMain: TCheckBox;
Panel2: TPanel;
cbSlave: TCheckBox;
feSlave: TFilenameEdit;
Label5: TLabel;
adoqrySlave: TADOQuery;
DBGridEh1: TDBGridEh;
adoqryTmp: TADOQuery;
adocntSlave: TADOConnection;
adocntMain: TADOConnection;
adoMainTmp: TADOQuery;
Panel3: TPanel;
Label6: TLabel;
feResult: TFilenameEdit;
cbResult: TCheckBox;
mmHelp: TMemo;
BitBtn1: TBitBtn;
DataSource1: TDataSource;
procedure btExample1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure fe2000ButtonClick(Sender: TObject);
procedure feSlaveButtonClick(Sender: TObject);
procedure cbSlaveClick(Sender: TObject);
procedure cbMainClick(Sender: TObject);
procedure feResultButtonClick(Sender: TObject);
procedure cbResultClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
Excel: Variant;
procedure ImportMain(FileN: string; Y: string = '');
procedure ImportSlave(SlaveName, TName: string);
procedure CompareData(FN: string);
procedure CompareMain(var FindSum: Integer; TName, SName: string);
procedure InsertSame(TName: string);
procedure UpdateMain(TName, SName: string);
procedure InsertDiff;
procedure SaveResult(FN: string);
public
procedure InsertToAccess(Money, No, TName: string; Y: string = '');
procedure ImportMainTable(SysDir: string);
procedure ImportSlaveTable(SysDir: string);
end;
const
CS1 = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=';
CS2 = ';Persist Security Info=False';
var
fmMain: TfmMain;
implementation
uses ShareUnit;
{$R *.DFM}
(*var
WorkBook:Variant;*)
procedure TfmMain.btExample1Click(Sender: TObject);
begin
try
Excel := Unassigned;
Excel := CreateOleObject('Excel.Application'); //创建Excel对象
if not VarIsEmpty(Excel) then
Excel.Quit;
finally
adocntMain.Close;
adocntSlave.Close;
Excel := Unassigned;
end;
end;
procedure TfmMain.FormDestroy(Sender: TObject);
begin
if VarIsEmpty(Excel) = False then
Excel.Quit;
Excel := Unassigned;
end;
procedure TfmMain.InsertToAccess(Money, No, TName: string; Y: string = '');
var
S: string;
begin
if Y <> '' then
begin
S := 'Insert Into T_Main' + Y + ' (cMoney, cNo) Values(''' + Money + ''',''' + No + ''')';
Share.ExecuteSQL(adoMainTmp, S);
end
else
begin
S := 'Insert Into T_Slave Values(''' + Money + ''',''' + No + ''',''' + TName + ''')';
Share.ExecuteSQL(adoqryTmp, S);
end;
end;
procedure TfmMain.ImportMain(FileN, Y: string);
var
WorkBook, Sheet: Variant;
Row, RowCount: Integer;
Money, No: string;
begin
Excel.WorkBooks.Open(FileN);
try
WorkBook := Excel.WorkBooks[1];
Sheet := WorkBook.WorkSheets[1];
RowCount := Excel.ActiveSheet.UsedRange.Rows.Count;
for Row := 1 to RowCount do
begin
Application.ProcessMessages;
Money := Sheet.Cells[Row, 1];
No := Sheet.Cells[Row, 2];
if No <> '' then
try
InsertToAccess(Money, Format('%0.8d', [StrToInt(No)]),'', Y);
except
Continue;
end;
Caption := '[' + ExtractFileName(FileN) + '] ' + IntToStr(Row) + '/' + IntToStr(RowCount);
end;
finally
Excel.WorkBooks[1].Close;
end;
end;
procedure TfmMain.ImportSlave(SlaveName, TName: string);
var
WorkBook, Sheet: Variant;
Row, RowCount: Integer;
Money, No: string;
begin
Excel.WorkBooks.Open(feSlave.Text);
try
WorkBook := Excel.WorkBooks[1];
Sheet := WorkBook.WorkSheets[1];
RowCount := Excel.ActiveSheet.UsedRange.Rows.Count;
for Row := 1 to RowCount do
begin
Application.ProcessMessages;
Money := Sheet.Cells[Row, 1];
No := Sheet.Cells[Row, 2];
if No <> '' then
try
InsertToAccess(Money, Format('%0.8d', [StrToInt(No)]), TName, '');
except
Continue;
end;
Caption := IntToStr(Row);
end;
finally
WorkBook.Close;
end;
adoqrySlave.Close;
adocntSlave.Close;
end;
procedure TfmMain.CompareData(FN: string);
var
FindSum: Integer;
S: string;
begin
if not FileExists(FN) then
begin
Share.HintMsgBox('目的表不存在，需要导入从表');
Exit;
end;
S := 'Delete From T_SameData';
Share.ExecuteSQL(adoqryTmp, S);
S := 'Delete From T_DiffData';
Share.ExecuteSQL(adoqryTmp, S);
S := 'SELECT * FROM T_SLAVE';
Share.SelectSQL(adoqrySlave, S);
with adoqrySlave do
begin
while not Eof do
begin
FindSum := 0;
CompareMain(FindSum, 'T_Main2000', ExtractFileName(FN)); //与主表2000比较
CompareMain(FindSum, 'T_Main2001', ExtractFileName(FN)); //与主表2001比较
CompareMain(FindSum, 'T_Main2002', ExtractFileName(FN)); //与主表2002比较
if FindSum = 0 then
InsertDiff; //如果3个主表中均无此条数据，则插入T_DiffData
// SaveResult(FN);
Next;
end;
end;
end;
procedure TfmMain.CompareMain(var FindSum: Integer; TName, SName: string);
var
S: string;
C: Integer;
begin
S := 'SELECT COUNT(*) FROM ' + TName
+ ' WHERE CMONEY = ''' + adoqrySlave.FieldByName('cMoney').AsString
+ ''' AND CNO = ''' + adoqrySlave.FieldByName('cNo').AsString + ''' ';
Share.SelectSQL(adoQryMain, S);
C := adoqryMain.Fields[0].AsInteger;
if C > 0 then //有相同记录
begin
FindSum := C;
InsertSame(TName); //写相同记录表
UpdateMain(TName, SName); //将主表作标记
end;
end;
procedure TfmMain.InsertSame(TName: string);
var
S, cMoney, cNo: string;
begin
cMoney := adoqrySlave.FieldByName('cMoney').AsString;
cNo := adoqrySlave.FieldByName('cNo').AsString;
S := 'Insert Into T_SameData Values(''' + cMoney
+ ''', ''' + cNo + ''',''' + TName + ''')';
Share.ExecuteSQL(adoqryTmp, S);
end;
procedure TfmMain.UpdateMain(TName, SName: string);
var
S: string;
begin
S := 'SELECT * FROM ' + TName
+ ' WHERE CMONEY = ''' + adoqrySlave.FieldByName('cMoney').AsString
+ ''' AND CNO = ''' + adoqrySlave.FieldByName('cNo').AsString + ''' ';
Share.SelectSQL(adoMainTmp, S);
with adoMainTmp do
begin
Edit;
FieldByName('nCount').AsInteger := FieldByName('nCount').AsInteger + 1;
FieldByName('cSlaveName').AsString := FieldByName('cSlaveName').AsString + ', ' + SName;
Post;
end;
{S := 'Update ' + TName
+ ' Set cCount = cCount + 1, cSlaveName = ''' + SName
+ ''' Where cMoney = ''' + Money + ''' and cNo = ''' + No + ''' ';
Share.ExecuteSQL(adoMainTmp, S); }
end;
procedure TfmMain.InsertDiff;
var
S, cMoney, cNo: string;
begin
cMoney := adoqrySlave.FieldByName('cMoney').AsString;
cNo := adoqrySlave.FieldByName('cNo').AsString;
S := 'Insert Into T_DiffData Values(''' + cMoney + ''', ''' + cNo + ''')';
Share.ExecuteSQL(adoqryTmp, S);
end;
procedure TfmMain.fe2000ButtonClick(Sender: TObject);
begin
if not cbMain.Checked then
cbMain.Checked := True;
end;
procedure TfmMain.feSlaveButtonClick(Sender: TObject);
begin
if not cbSlave.Checked then
cbSlave.Checked := True;
end;
procedure TfmMain.cbSlaveClick(Sender: TObject);
begin
if cbSlave.Checked then
feSlave.SetFocus;
end;
procedure TfmMain.cbMainClick(Sender: TObject);
begin
if cbMain.Checked then
fe2000.SetFocus;
end;
procedure TfmMain.feResultButtonClick(Sender: TObject);
begin
if not cbResult.Checked then
cbResult.Checked := True;
end;
procedure TfmMain.cbResultClick(Sender: TObject);
begin
if cbResult.Checked then
feResult.SetFocus;
end;
procedure TfmMain.FormCreate(Sender: TObject);
var
SysDir: string;
begin
SysDir := ExtractFileDir(Application.ExeName);
mmHelp.Lines.LoadFromFile(SysDir + '/help.txt');
fe2000.InitialDir := SysDir + '/主表';
fe2001.InitialDir := SysDir + '/主表';
fe2002.InitialDir := SysDir + '/主表';
feSlave.InitialDir := SysDir + '/从表';
feResult.InitialDir := SysDir + '/结果表';
end;
procedure TfmMain.SaveResult(FN: string);
var
S, Tmp, FSame, FDiff: string;
begin
DataSource1.DataSet := adoqrySlave;
//重复的数据
Tmp := Copy(FN, 1, Length(FN) - 4);
FSame := Tmp + '(重复).xls';
S := 'Select cMoney as 金额, cNo as 票号, (Count(*) - 1) as 重复次数 From T_SameData '
+ 'Group By cMoney, cNo Having Count(*) > 2';
Share.SelectSQL(adoqrySlave, S);
SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1, FSame, True);
//不重复的数据
FDiff := Tmp + '（不重复）.xls';
S := 'Select cMoney as 金额, cNo as 票号 From T_DiffData ';
Share.SelectSQL(adoqrySlave, S);
SaveDBGridEhToExportFile(TDBGridEhExportAsXLS,DBGridEh1, FDiff, True);
end;
procedure TerminateOLE;
var
FSnapshotHandle:THandle;
FProcessEntry32:TProcessEntry32;
Ret : BOOL;
ProcessID : integer;
s:string;
begin
FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
FProcessEntry32.dwSize:=Sizeof(FProcessEntry32);
Ret:=Process32First(FSnapshotHandle,FProcessEntry32);
while Ret do
begin
s:=ExtractFileName(FProcessEntry32.szExeFile);
if s='EXCEL.EXE' then
begin
ProcessID:=FProcessEntry32.th32ProcessID;
TerminateProcess(OpenProcess(PROCESS_TERMINATE,false,ProcessID),1);
s:='';
end;
Ret:=Process32Next(FSnapshotHandle,FProcessEntry32);
end;
end;
procedure TfmMain.BitBtn1Click(Sender: TObject);
var
SysDir: string;
begin
try
Excel := Unassigned;
Excel := CreateOleObject('Excel.Application'); //创建Excel对象
SysDir := ExtractFileDir(Application.ExeName); //系统路径
ImportMainTable(SysDir); //导入指定主表
ImportSlaveTable(SysDir); //导入指定副表
if not VarIsEmpty(Excel) then
Excel.Quit;
finally
adocntMain.Close;
adocntSlave.Close;
Excel := Unassigned;
TerminateOLE; //结束进程
end;
Share.HintMsgBox('处理完毕！');
end;
procedure TfmMain.ImportMainTable(SysDir: string);
var
MainTable: string;
begin
MainTable := SysDir + '/主表/主表.mdb';
adocntMain.ConnectionString := CS1 + MainTable + CS2;
//导入3个主表
if cbMain.Checked then
begin
Share.ExecuteSQL(adoqryMain, 'DELETE FROM T_MAIN2000');
Share.ExecuteSQL(adoqryMain, 'DELETE FROM T_MAIN2001');
Share.ExecuteSQL(adoqryMain, 'DELETE FROM T_MAIN2002');
if fe2000.Text <> '' then
ImportMain(fe2000.Text, '2000');
if fe2001.Text <> '' then
ImportMain(fe2001.Text, '2001');
if fe2002.Text <> '' then
ImportMain(fe2002.Text, '2002');
end;
end;
procedure TfmMain.ImportSlaveTable(SysDir: string);
var
FN, STable, DTable: string;
begin
if cbSlave.Checked then
begin
STable := SysDir + '/从表/从表.mdb';
FN := ExtractFileName(feSlave.Text);
DTable := SysDir + '/结果表/' + Copy(FN, 1, Length(FN) - 4) + '.mdb';
if FileExists(DTable) then
if not Share.ConfirmMsgBox('【' + DTable + '】:该文件已存在，是否覆盖') then Exit;
if CopyFile(PChar(STable), PChar(DTable), False) then
begin
adocntSlave.ConnectionString := CS1 + DTable + CS2;
ImportSlave(feSlave.Text, FN); //导入从表
CompareData(DTable); //处理数据
SaveResult(DTable); //保存结果
end
else
Share.HintMsgBox('拷贝从表模板文件失败！');
end;
end;
end.
