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.