Topic: [Скрипт] Импорт и Экспорт записей
Пример универсального скрипта для экспорта и импорта данных из таблиц (Import-Export.zip). Вам просто необходимо указать столбцы в параметрах процедуры, которые должны быть импортированы или экспортированы.
В файле "Import-Export with autofill dictionaries.zip" вы найдете проект с примером, который работает и со словарями, автоматически дополняя их, если значение отсутствует в таблице.
procedure Form1_bExport_OnClick (Sender: string; var Cancel: boolean);
begin
Export('SELECT lastname, firstname, salary, dateofbirth, isSmoke, comment FROM employees', '1.csv');
end;
procedure Form1_bImport_OnClick (Sender: string; var Cancel: boolean);
begin
Import('employees', 'lastname,firstname,salary,dateofbirth,isSmoke,comment', '1.csv');
end;
procedure Form1_bImportCheckDup_OnClick (Sender: string; var Cancel: boolean);
begin
Import('employees', 'lastname,firstname,salary,dateofbirth,isSmoke,comment', '1.csv', 'lastname,firstname');
end;
procedure Export (SQL: string; FileName: string);
var
Results: TDataSet;
i,c: integer;
sl: TStringList;
sValue, sValues: string;
begin
SQLQuery(sql, Results);
sl := TStringList.Create;
c := Results.FieldCount-1;
while not Results.eof do
begin
sValues := '';
for i := 0 to c do
begin
if not Results.Fields.Fields[i].isNull then
begin
sValue := Results.Fields.Fields[i].AsString;
if (Results.Fields.Fields[i].DataType = ftFloat) or (Results.Fields.Fields[i].DataType = ftLargeint) then
sValue := ReplaceStr(sValue, ',', '.')
else
begin
sValue := ReplaceStr(sValue, ',', ',');
sValue := ReplaceStr(sValue, #13#10, '|');
sValue := '''' + escape_special_characters(sValue) + '''';
end;
end else sValue := 'NULL';
sValues := sValues + sValue+',';
end;
if sValues <> '' then SetLength(sValues, Length(sValues)-1);
sl.Add(sValues);
Results.next;
end;
sl.SaveToFile(FileName);
sl.Free;
Results.Close;
end;
procedure Import(TableName, Fields: string; FileName: string; CheckDuplicateFields: string = '');
function ArrayInCheck(a: array of string; sValue: string): boolean;
var
i,c: integer;
begin
result := False;
c := Length(a)-1;
for i := 0 to c do
begin
if LowerCase(a[i])=LowerCase(sValue) then
begin
result := true;
break;
end;
end;
end;
var
iField, cField: integer;
iLine, cLine: integer;
sl: TStringList;
arrValues: array of string;
arrFields: array of string;
arrFieldsDuplicate: array of string;
sValue, sValues: string;
sWhereDuplicate: string;
begin
if CheckDuplicateFields <> '' then arrFieldsDuplicate := SplitString(CheckDuplicateFields, ',');
sl := TStringList.Create;
sl.LoadFromFile(FileName);
arrFields := SplitString(Fields, ',');
cLine := sl.Count-1;
for iLine := 0 to cLine do
begin
sValues := '';
arrValues := SplitString(sl[iLine], ',');
if Length(arrFields) <= Length(arrValues) then
begin
sWhereDuplicate := '';
cField := Length(arrFields)-1;
for iField := 0 to cField do
begin
sValue := arrValues[iField];
sValue := ReplaceStr(sValue, ',', ',');
sValue := ReplaceStr(sValue, '|', #13#10);
sValues := sValues + sValue+',';
if ArrayInCheck(arrFieldsDuplicate, arrFields[iField]) then
sWhereDuplicate := sWhereDuplicate +'('+ arrFields[iField]+'='+sValue + ') AND ';
end;
if sValues <> '' then
begin
SetLength(sValues, Length(sValues)-1);
if sWhereDuplicate <> '' then
begin
SetLength(sWhereDuplicate, Length(sWhereDuplicate)-5);
if SQLExecute('SELECT COUNT(id) FROM '+TableName+' WHERE '+sWhereDuplicate)=0 then
SQLExecute('INSERT INTO '+TableName+' ('+Fields+') VALUES ('+sValues+')');
end else
SQLExecute('INSERT INTO '+TableName+' ('+Fields+') VALUES ('+sValues+')');
end;
end;
end;
sl.Free;
end;
Проект с примером: