?? unit1.pas
字號(hào):
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB, DBTables, StrUtils, ComObj,
OleServer, ExcelXP,WinSkinStore, WinSkinData;
type
TForm1 = class(TForm)
DataSource1: TDataSource;
DBGrid1: TDBGrid;
BtnE2OD: TButton;
OpenDialog1: TOpenDialog;
receive: TMemo;
Database1: TDatabase;
ADOQuery1: TADOQuery;
ADOCommand1: TADOCommand;
BtnExit: TButton;
BtnE2ND: TButton;
BtnE2Jc: TButton;
BtnJcdnb2Txt: TButton;
BtnE2Txt: TButton;
BtnAllDone: TButton;
ChkDxh: TCheckBox;
EdBH: TEdit;
Label1: TLabel;
RBRb: TRadioButton;
RBHg: TRadioButton;
procedure BtnE2ODClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnExitClick(Sender: TObject);
procedure BtnE2JcClick(Sender: TObject);
procedure BtnJcdnb2TxtClick(Sender: TObject);
procedure BtnE2NDClick(Sender: TObject);
procedure BtnE2TxtClick(Sender: TObject);
procedure BtnAllDoneClick(Sender: TObject);
private
{ Private declarations }
public
function PackDbf():Boolean;
function CopyDbfFile(NewFileStr,OldFileTp: string):Boolean;
function WriteFile(FileName,Buffer: string):Boolean;
function OpenDialogFun(FileExt: string):Boolean;
function Jcdnb2Txt(FileName: string):Boolean;
function E2OD():Boolean;
function E2Jc(Jc2Txt: Boolean;JcFlag: Byte):Boolean;
function E2ND():Boolean;
function E2Txt():Boolean;
procedure EnableButton(BEnable: Boolean);
end;
var
Form1: TForm1;
ConStr,JcdnbConStr,NewConStr: string;
DbfTmp,DbfTemp: string;
implementation
{$R *.dfm}
{
//修改記錄:
//修改日期:2009.3.31
//修改內(nèi)容:1、增加是否按段序排序功能;
2、增加新抄表庫(kù)表號(hào)補(bǔ)充字符功能
3、對(duì)數(shù)值型字段進(jìn)行容錯(cuò)處理
4、形成版本1.10
}
//選擇Excel表
procedure TForm1.BtnE2ODClick(Sender: TObject);
begin
if not OpenDialogFun('xls') then exit;
EnableButton(false);
E2OD();
EnableButton(true);
end;
//拷貝文件(NewFileName,OldFileName)
function TForm1.CopyDbfFile(NewFileStr,OldFileTp: string):Boolean;
var
NewFileName: string;
OldFileName: string;
NewFile: TFileStream;
OldFile: TFileStream;
begin
result := True;
NewFileName := ExtractFilePath(application.ExeName) + NewFileStr;
OldFileName := ExtractFilePath(application.ExeName) + OldFileTp;
OldFile := TFileStream.Create(OldFileName, fmOpenRead or fmShareDenyWrite);
try
if FileExists(NewFileName) then DeleteFile(NewFileName);
NewFile := TFileStream.Create(NewFileName, fmCreate {or fmShareDenyRead});
try
NewFile.CopyFrom(OldFile, OldFile.Size);
FreeAndNil(NewFile);
except
result := false;
FreeAndNil(NewFile);
FreeAndNil(OldFile);
exit;
end;
FreeAndNil(OldFile);
except
result := false;
FreeAndNil(OldFile);
end;
end;
//寫文件(NewFileName,OldFileName)
function TForm1.WriteFile(FileName,Buffer: string):Boolean;
var
FileHandle: TFileStream;
p: Array of Char;
begin
result := true;
FileName := ExtractFilePath(application.ExeName) + FileName;
try
FileHandle := TFileStream.Create(FileName, fmOpenReadWrite);
FileHandle.Seek(0,soEnd);
SetLength(p, length(Buffer));
StrPCopy(PChar(p), Buffer);
FileHandle.Write(p[0], length(p));
FreeAndNil(FileHandle);
except
FreeAndNil(FileHandle);
result := false;
end;
end;
//對(duì)話框公用函數(shù)(FileExt)
function TForm1.OpenDialogFun(FileExt: string):Boolean;
begin
result := false;
OpenDialog1.Title := '選擇文件';
OpenDialog1.Filter := '(*.*)|*.*';
OpenDialog1.FileName := '';
OpenDialog1.InitialDir := ExtractFilePath(application.ExeName);
if AnsiUpperCase(FileExt) = 'XLS' then
begin
OpenDialog1.Title := '選擇Excel文件';
OpenDialog1.Filter := 'Excel文件(*.xls)|*.xls';
end;
if AnsiUpperCase(FileExt) = 'DBF' then
begin
OpenDialog1.Title := '選擇抄表機(jī)調(diào)試庫(kù)文件';
OpenDialog1.Filter := 'Foxpro自由表文件(*.dbf)|*.dbf';
end;
if not OpenDialog1.Execute then exit;
if OpenDialog1.FileName = '' then exit;
result := true;
end;
function TForm1.Jcdnb2Txt(FileName: string):Boolean;
var
ExcelStr, dbfstr: string;
FileNum : integer;
begin
result := true;
try
receive.Lines.Add(OpenDialog1.Files.CommaText);
self.Cursor := crhelp;
for FileNum := 0 to (OpenDialog1.Files.Count-1) do
begin
dbfstr := ExtractFileName(OpenDialog1.Files.Strings[FileNum]);
if FileName <> '' then dbfstr := FileName;
if AnsiUpperCase(rightstr(dbfstr, 3)) = 'DBF' then
receive.Lines.Add('正在處理' + dbfstr + ',請(qǐng)稍后...');
ExcelStr := dbfstr;
ExcelStr := ChangeFileExt(ExcelStr, '.txt'); //改后綴名
ExcelStr := StringReplace(ExcelStr, ' ', '', [rfReplaceAll]); //'Abcd' 置換字符串
if Pos('jcdnb', ExcelStr) = 1 then
ExcelStr := rightbstr(ExcelStr, length(ExcelStr)-5);
receive.Lines.Add('正在處理' + trim(ExcelStr));
CopyDbfFile('Txt\' + trim(ExcelStr),'Temp.tx');
ADOQuery1.ConnectionString := JcdnbConStr;
ADOQuery1.SQL.Clear;
if FileExists(ExtractFilePath(application.ExeName) + 'jcdnb\' + DbfTemp) then
DeleteFile(ExtractFilePath(application.ExeName) + 'jcdnb\' + DbfTemp);
RenameFile(ExtractFilePath(application.ExeName) + 'jcdnb\' + dbfstr,
ExtractFilePath(application.ExeName) + 'jcdnb\' + DbfTemp);
ADOQuery1.SQL.Add('select * from ' + DbfTemp);
ADOQuery1.Open;
Application.ProcessMessages;
while not ADOQuery1.Eof do
begin
receive.Lines.Add(ADOQuery1.Fields[7].AsString+ ' , '+
ADOQuery1.Fields[13].AsString);
WriteFile('Txt\' + trim(ExcelStr),ADOQuery1.Fields[7].AsString +
ADOQuery1.Fields[13].AsString+#13#10);
ADOQuery1.Next;
end;
ADOQuery1.Close;
if FileExists(ExtractFilePath(application.ExeName) + 'jcdnb\' + dbfstr) then
DeleteFile(ExtractFilePath(application.ExeName) + 'jcdnb\' + dbfstr);
RenameFile(ExtractFilePath(application.ExeName) + 'jcdnb\' + DbfTemp,
ExtractFilePath(application.ExeName) + 'jcdnb\' + dbfstr);
receive.Lines.Add('處理' + OpenDialog1.Files.Strings[FileNum] + '完畢,進(jìn)行下一個(gè)操作!');
if FileName <> '' then exit;
end;
receive.Lines.Add(' 處理dbf文件完畢,謝謝使用!!');
self.Cursor := crdefault;
except
ADOQuery1.Close;
receive.Lines.Add('請(qǐng)檢查dbf文件,確認(rèn)信息正確!!');
self.Cursor := crdefault;
result := false;
end;
end;
function TForm1.E2Jc(Jc2Txt: Boolean;JcFlag: Byte) :Boolean;
var
ExcelStr, dbfstr, tempstr: string;
i, j, FileNum, RowStart: integer;
BH,DZ,CLDH,CJZDCLDH,JZQH,CJQH: integer;
ExcelApp, aSheet: Variant;
begin
result := true;
try
receive.Lines.Add(OpenDialog1.Files.CommaText);
self.Cursor := crAppStart;
ExcelApp := CreateOLEObject('Excel.Application');
for FileNum := 0 to (OpenDialog1.Files.Count-1) do
begin
dbfstr := ExtractFileName(OpenDialog1.Files.Strings[FileNum]);
if AnsiUpperCase(rightstr(dbfstr, 3)) = 'XLS' then
receive.Lines.Add('正在處理' + OpenDialog1.Files.Strings[FileNum] + ',請(qǐng)稍后...');
ExcelStr := ExtractFileName(OpenDialog1.Files.Strings[FileNum]);
ExcelStr := ChangeFileExt(ExcelStr, '.dbf'); //改后綴名
if JcFlag = 0 then
ExcelStr := 'Rbjcdnb' + StringReplace(ExcelStr, ' ', '', [rfReplaceAll]); //'Abcd' 置換字符串
if JcFlag = 1 then
ExcelStr := 'Hgjcdnb' + StringReplace(ExcelStr, ' ', '', [rfReplaceAll]); //'Abcd' 置換字符串
receive.Lines.Add('正在處理' + trim(ExcelStr));
CopyDbfFile('jcdnb\' + DbfTmp,'jcdnb.db');
ADOQuery1.ConnectionString := JcdnbConStr;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('select * from ' + DbfTmp);
ADOQuery1.Open;
ExcelApp.workBooks.Open(OpenDialog1.Files.Strings[FileNum]);
aSheet := ExcelApp.Worksheets[1];
ExcelApp.Worksheets[1].activate;
//判斷起始行
for RowStart := 1 to 10 do
begin
j := 0;
for i := 1 to 10 do
begin
if length(VarToStrDef(ExcelApp.Cells[RowStart, i].Value, '')) > 0 then
j := j + 1;
end;
if j >= 2 then break;
end;
if j < 2 then
begin
// showmessage('起始行!'+inttostr(RowStart));
// showmessage('此Excel文件錯(cuò)誤!');
// exit;
end;
//判斷起始行
//判斷 項(xiàng)目XMNUM 表號(hào)BHNUM 地址DZNUM 段號(hào)DHNUM 段序號(hào)DXHNUM
for i := 1 to 50 do
begin //i is column
if Pos('表號(hào)', VarToStrDef(ExcelApp.Cells[RowStart, i].Value, '')) > 0 then
BH := i;
if Pos('地址', VarToStrDef(ExcelApp.Cells[RowStart, i].Value, '')) > 0 then
DZ := i;
if Pos('集中器', VarToStrDef(ExcelApp.Cells[RowStart, i].Value, '')) > 0 then
JZQH := i;
if Pos('采集器', VarToStrDef(ExcelApp.Cells[RowStart, i].Value, '')) > 0 then
CJQH := i;
end;
{ ExcelWorksheet1.UsedRange.Sort();
aSheet.UsedRange.sort(A2,xlAscending,B2,
xlSortValues,xlAscending,C2,xlDescending,xlYes,1,
False,xlSortRows,xlPinYin,xlSortNormal,xlSortNormal,xlSortNormal);
}
Application.ProcessMessages;
tempstr := FormatDateTime('yyyy-mm-dd hh:mm:ss', now);
CLDH := 1;
CJZDCLDH := 1;
for i := RowStart + 1 to aSheet.UsedRange.Rows.Count do
begin // aSheet.UsedRange.Rows.Count
if VarToStrDef(ExcelApp.Cells[i, BH].Value, '') = '' then continue; //遇到總戶號(hào)為空跳過
if dbfstr = rightstr('000000000' +
VarToStrDef(ExcelApp.Cells[i, BH].Value, ''), 9) then continue;//表號(hào)相同跳過
receive.Lines.Add(rightstr('000000000' + VarToStrDef(ExcelApp.Cells[i, BH].Value, ''), 9)+ ' , '+
rightstr('000000000000' + VarToStrDef(ExcelApp.Cells[i, JZQH].Value, ''), 12));
ADOQuery1.Append;
ADOQuery1.Fields[0].AsString := rightstr('000000000000' + VarToStrDef(ExcelApp.Cells[i, JZQH].Value, ''), 12); //JZQH
ADOQuery1.Fields[1].AsString := rightstr('000000000' + VarToStrDef(ExcelApp.Cells[i, BH].Value, ''), 9); //BH
ADOQuery1.Fields[2].AsString := VarToStrDef(ExcelApp.Cells[i, DZ].Value, ''); //DZ
ADOQuery1.Fields[3].AsString := inttostr(CLDH); //CLDH
ADOQuery1.Fields[4].AsString := '3'; //DKH
ADOQuery1.Fields[5].AsString := '1'; //TXGY
if JcFlag = 0 then
ADOQuery1.Fields[6].AsString := '1'; //DBLX
if JcFlag = 1 then
ADOQuery1.Fields[6].AsString := '0'; //DBLX
ADOQuery1.Fields[7].AsString := rightstr('000000000000' + VarToStrDef(ExcelApp.Cells[i, BH].Value, ''), 12); //TXDZ
if JcFlag = 0 then
ADOQuery1.Fields[8].AsString := '0000'; //TXMM
if JcFlag = 1 then
ADOQuery1.Fields[8].AsString := '123456'; //TXMM
if JcFlag = 0 then
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -