Delphi7小工具,ParaDox 乱码处理

        Delphi已经没落了，很难能找到一些现成的小工具。工作中遇到了需要解析ParaDox数据库数据乱码的问题，本来想通过解决字符集的方式处理乱码，但是没能解决，也许是方法不正确吧，后来自己写了个小工具，通过Delphi7将数据读取一边再保存一下，就OK了，当然可以考虑将此功能集成到项目，而不用小工具单独处理。不常用的就记录下吧。

         

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls, DB, DBTables, SQLiteTable3;

type
  TForm1 = class(TForm)
    Button1: TButton;
    destTable: TTable;
    sourceTable: TTable;
    BatchMove1: TBatchMove;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

function Split(s,s1:string):TStringList;
begin
Result:=TStringList.Create;
while Pos(s1,s)>0 do
begin
Result.Add(Copy(s,1,Pos(s1,s)-1));
Delete(s,1,Pos(s1,s));
end;
Result.Add(s);
end;


//获取文件
PRocedure GetFileList(AStrings: TStrings ; ASourFile: string);
var sour_path,sour_file: string;
    TmpList:TStringList;
    FileRec:TSearchrec;
begin
   sour_path:=ExtractFilePath(ASourFile);
   sour_file:=ExtractFileName(ASourFile);
   if not DirectoryExists(sour_path) then
   begin
     AStrings.Clear;
     exit;
   end;
   TmpList:=TStringList.Create;
   TmpList.Clear;
   if FindFirst(sour_path+sour_file,faAnyfile,FileRec) = 0 then
   repeat
      if ((FileRec.Attr and faDirectory) = 0) then
         begin
           TmpList.Add(Split(FileRec.Name,'.')[0]);
         end;
   until FindNext(FileRec)<>0;
   SysUtils.FindClose(FileRec);
   AStrings.Assign(TmpList);
   TmpList.Free;
end;

function DeleteDirectory(NowPath: string): Boolean; // 删除整个目录
var
  search: TSearchRec;
  ret: integer;
  key: String;
begin
  if NowPath[Length(NowPath)] <> '\' then
    NowPath := NowPath + '\';
  key := NowPath + '*.*';
  ret := findFirst(key, faanyfile, search);
  while ret = 0 do
  begin
    if ((search.Attr and fadirectory) = fadirectory) then
    begin
      if (search.Name <> '.') and (search.name <> '..') then
        DeleteDirectory(NowPath + search.name);
    end
    else
    begin
      if ((search.Attr and fadirectory) <> fadirectory) then
      begin
        deletefile(NowPath + search.name);
      end;
    end;
    ret := FindNext(search);
  end;
  findClose(search);
  //removedir(NowPath); 如果需要删除文件夹则添加
  result := True;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
    strCaption,strDirectory:String;
    wstrRoot:WideString;
    filePaths:TStrings;
    i:integer;
    tabNames:TStrings;
    names:String;
    index:integer;
    message:String;

    //Sqlite
    slDBpath: String;
    sldb: TSQLiteDatabase;
    parentPath:String;
begin
    wstrRoot:='';
    strCaption:='请选择导出的Temp文件夹路径！';

    names:='A,B,C,D,E,F,G,H,I,J,K';
    tabNames:=TStringList.Create;
    tabNames.CommaText:=names;

    //Sqlite操作
    //创建本地数据库
    //if not Assigned(sldb) then
    //begin
    //   slDBpath := ExtractFilepath(application.exename)+ 'Temp';
    //   sldb := TSQLiteDatabase.Create(slDBpath);
    //end;

    //数据处理
    if SelectDirectory(strCaption,wstrRoot,strDirectory) then
    begin
       //ShowMessage(Pchar(strDirectory+'\*.db'));
       filePaths := TStringList.Create;
       GetFileList(filePaths,strDirectory+'\*.db');
       sourceTable.DatabaseName:=strDirectory;
       parentPath:=ExtractFilepath(application.exename)+ 'Temp';
       if not DirectoryExists(parentPath) then
       begin
       ForceDirectories(parentPath);
       end
       else
       begin
       DeleteDirectory(parentPath);
       end;
       destTable.DatabaseName:=ExtractFilepath(application.exename)+ 'Temp';

       for i:=0 to filePaths.Count-1 do
       begin
          //ShowMessage(filePaths[i]);
          index:=-1;
          index:=tabNames.IndexOf(filePaths[i]);
          if index>-1 then
             begin
             sourceTable.TableName:=filePaths[i];
             destTable.TableName:=filePaths[i];

             BatchMove1.Source:=sourceTable;
             BatchMove1.Destination:=destTable;
             batchmove1.Mode:=batCopy;
             batchmove1.Execute;

             tabNames.Delete(index);
             end;
       end;
       if tabNames.Count>0 then
          begin
             message:='';
             for i:=0 to tabNames.Count-1 do
                begin
                   message:=message+tabNames[i]+' '
                end;
             ShowMessage('数据中：'+ message +'表不存在！');
          end
       else
       begin
             ShowMessage('处理完成！');
       end;
    end;
end;
end.