unit1.pas

用于数据格式的相互转换,可以将txt、dbf转换成excel。

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
//修改内容：1、增加是否按段序排序功能；
            2、增加新抄表库表号补充字符功能
            3、对数值型字段进行容错处理
            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;

//对话框公用函数（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 := '选择抄表机调试库文件';
        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 + ',请稍后...');
            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] + '完毕，进行下一个操作！');
            if FileName <> '' then exit;
        end;

        receive.Lines.Add(' 处理dbf文件完毕，谢谢使用！！');
        self.Cursor := crdefault;
    except
        ADOQuery1.Close;
        receive.Lines.Add('请检查dbf文件，确认信息正确！！');
        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] + ',请稍后...');
            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文件错误！');
                    // exit;
            end;
            //判断起始行


            //判断  项目XMNUM  表号BHNUM 地址DZNUM 段号DHNUM  段序号DXHNUM
            for i := 1 to 50 do
            begin //i is column

                if Pos('表号', 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; //遇到总户号为空跳过
                if dbfstr = rightstr('000000000' +
                    VarToStrDef(ExcelApp.Cells[i, BH].Value, ''), 9) then continue;//表号相同跳过

                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