procedure LoadDefaultRulesOfExchange1C();
var
dsc: TDSDesc;
begin
if not CheckPassw('Требуются привилегии на загрузку правил обмена. Пароль:', '999') then
begin
SMsg('Неверный пароль ! Обратитесь к администратору.');
Exit;
end;

try
try
Dsc := DscQueryCreate('Exchange1C');
Dsc.Clear;
Dsc.Add('DELETE FROM #TABLE');
Dsc.ExecSQL;
Dsc.Close;
CloseDsc(Dsc);

Dsc := MakeInsertDscQuery('Exchange1C');

// >> контрагенты
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'Name'); Dsc.PBN('Field1C', ftString, 'Наименование'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'PASSPORTS'); Dsc.PBN('Field1C', ftString, 'ДокументСерия'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'PASSPORTN'); Dsc.PBN('Field1C', ftString, 'ДокументНомер'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'PASSPORTG'); Dsc.PBN('Field1C', ftString, 'ДокументКемВыдан'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'PASSPORTD'); Dsc.PBN('Field1C', ftString, 'ДокументДатаВыдачи'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'FName'); Dsc.PBN('Field1C', ftString, 'ПолнНаименование'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'Address'); Dsc.PBN('Field1C', ftString, 'ПочтовыйАдрес'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'JAddress'); Dsc.PBN('Field1C', ftString, 'ЮридическийАдрес'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'Telf'); Dsc.PBN('Field1C', ftString, 'Телефоны'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 1); Dsc.PBN('FieldE2', ftString, 'INN'); Dsc.PBN('Field1C', ftString, 'ИНН'); Dsc.ExecSQL;
// << контрагенты

// >> сотрудники
Dsc.PBN('Sbk', ftInteger, 2); Dsc.PBN('FieldE2', ftString, 'Name'); Dsc.PBN('Field1C', ftString, 'Наименование'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 2); Dsc.PBN('FieldE2', ftString, 'PASSPORTS'); Dsc.PBN('Field1C', ftString, 'ДокументСерия'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 2); Dsc.PBN('FieldE2', ftString, 'PASSPORTN'); Dsc.PBN('Field1C', ftString, 'ДокументНомер'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 2); Dsc.PBN('FieldE2', ftString, 'PASSPORTG'); Dsc.PBN('Field1C', ftString, 'ДокументКемВыдан'); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 2); Dsc.PBN('FieldE2', ftString, 'PASSPORTD'); Dsc.PBN('Field1C', ftString, 'ДокументДатаВыдачи'); Dsc.ExecSQL;
// << сотрудники

// >> Перечисление.Налоги
Dsc.PBN('Sbk', ftInteger, 118); Dsc.PBN('FieldE2', ftString, 'Name'); Dsc.PBN('Field1C', ftString, ''); Dsc.ExecSQL;
Dsc.PBN('Sbk', ftInteger, 118); Dsc.PBN('FieldE2', ftString, 'FName'); Dsc.PBN('Field1C', ftString, ''); Dsc.ExecSQL;
// << Перечисление.Налоги

// >> Места хранения
Dsc.PBN('Sbk', ftInteger, 116); Dsc.PBN('FieldE2', ftString, 'Name'); Dsc.PBN('Field1C', ftString, 'Наименование'); Dsc.ExecSQL;
// << Перечисление.Налоги

SMsg('Загрузка правил обмена с 1С по умолчанию завершена успешно.')
finally
Dsc.CommitDB;
CloseDsc(Dsc);
end;
except
SMsg('Загрузка правил обмена с 1С по умолчанию завершена не успешно.')
end;
end;

procedure Imp1CDirect(ClickSbk: string); // ИМПОРТ
var
V77, V77Obj, V77RS, V77Bank, V77P: OleVariant;
aSubk, aMSubk, rules: TEraList;
Kod, cnt, i, k: integer;
ObjName, PName, fields: string;
IsDict: boolean; // Является ли данный тип 1C справочником или перечислением
FieldsE2, Fields1C: TStringList;
finded: boolean;

wc: string;
Sbk: integer;
T_Dsc, dscMSubk: TDSDesc;
I_MSubk: TErQuery;
begin
try
MeterOpen('Импорт данных из 1С...');

V77 := Open1C(False);

ClickSbk := SindGetStrings(ClickSbk);
wc := 'SBK IN ('+ClickSbk+')';

aSubk := erLoadDF('Subk', wc, '');

aSubk.First(); // Удаляем поля с пустыми строками в TYPESUBK_1C
while not aSubk.eof do
begin
ObjName := aSubk.fbn('TYPESUBK_1C').AsString;
IsDict := (Pos(UpperCase('Справочник'), UpperCase(ObjName)) > 0) or
(Pos(UpperCase('Перечисление'), UpperCase(ObjName)) > 0);

if not IsDict then aSubk.Del else aSubk.Next;
end;

aSubk.First();
while not aSubk.eof do
begin
Sbk := aSubk.fbn('Sbk').Value;

ObjName := aSubk.fbn('TYPESUBK_1C').AsString;
IsDict := Pos(UpperCase('Справочник'), UpperCase(ObjName)) > 0;
if not IsDict then PName := copy(ObjName, 14, length(ObjName)); // Название вида перечисления

rules := erLoadDF('Exchange1C', 'Sbk='+ITS(Sbk));
if rules.Count <= 0 then
begin
fields := 'Name;FName';
FieldsE2 := TStringList.Create;
Fields1C := TStringList.Create;
FieldsE2.Add('Name');
Fields1C.Add('Наименование'); // ??? GRN 13.07.2004
FieldsE2.Add('FName');
Fields1C.Add('Наименование'); // ??? GRN 13.07.2004
end else
begin
rules.First();
fields := '';
FieldsE2 := TStringList.Create;
Fields1C := TStringList.Create;
while not rules.eof do
begin
fields := fields + rules.fbn('FieldE2').AsString + ';';
FieldsE2.Add(rules.fbn('FieldE2').AsString);
if Trim(rules.fbn('Field1C').AsString) <> '' then
Fields1C.Add(rules.fbn('Field1C').AsString);
rules.Next;
end;
end;
if Sbk = 1 then
fields := fields + 'DefRS;NAMEBANK;BANKCITY;BIK;KS';

FreeAndNil(rules);

aMSubk := erLoadDF('MSubk', 'SBK='+ITS(Sbk), 'Ako;'+fields);

cnt := 1;
if IsDict then
begin
V77Obj := V77.CreateObject(ObjName);
V77Obj.SelectItems;
V77Obj.SelectGroup(0);

if Sbk = 1 then V77RS := V77.CreateObject('Справочник.РасчетныеСчета');

while V77Obj.GetItem > 0 do // Выборка
begin
Kod := V77Obj.GetAttrib('Код');
if V77Obj.IsGroup('') = 1 then
begin
MeterMove('- ' + NumStr(Kod, 4));
Continue;
end;

finded := aMSubk.FindKey(Kod);
if finded then
begin
MeterMove('Выборка субконто ' + ITS(Sbk) + ' :' + ITS(cnt));
inc(cnt);
Continue;
end else aMSubk.Insert;

aMSubk.FBN('Ako').Value := Kod;
for i := 0 to FieldsE2.Count-1 do
if aMSubk.FBN(FieldsE2.Strings ).DataType = ftString then
aMSubk.FBN(FieldsE2.Strings).Value := Trim(V77Obj.GetAttrib(Fields1C.Strings))
else
aMSubk.FBN(FieldsE2.Strings).Value := V77Obj.GetAttrib(Fields1C.Strings);

if Sbk = 1 then
begin
V77RS.ИспользоватьВладельца(V77Obj.Текущийэлемент);
V77RS.ВыбратьЭлементы;
while V77RS.ПолучитьЭлемент = 1 do
begin
if V77RS.ПометкаУдаления = 1 then Continue;

aMSubk.FBN('DefRS').Value := V77RS.Номер;
if (V77.ПустоеЗначение(V77RS.БанкОрганизации) = 0) then
begin
V77Bank := V77RS.БанкОрганизации;
aMSubk.FBN('NAMEBANK').Value := V77Bank.Наименование;
aMSubk.FBN('BANKCITY').Value := V77Bank.Местонахождение;
aMSubk.FBN('BIK').Value := V77Bank.Код;
aMSubk.FBN('KS').Value := V77Bank.КоррСчет;
Break;
end;
end;
end;

aMSubk.Post;
MeterMove('Выборка субконто ' + ITS(Sbk) + ' :' + ITS(cnt));
inc(cnt);
end;
end else
begin
V77Obj := V77.EvalExpr('Перечисление.ПолучитьАтрибут("'+ PName + '")');
for k := 1 to V77Obj.КоличествоЗначений('') do
begin
V77P := V77Obj.ЗначениеПоНомеру(k);

Kod := V77P.ПорядковыйНомер('');

finded := aMSubk.FindKey(Kod);
if finded then
begin
MeterMove('Выборка субконто ' + ITS(Sbk) + ' :' + ITS(cnt));
inc(cnt);
Continue;
end else aMSubk.Insert;

aMSubk.FBN('Ako').Value := Kod;
aMSubk.FBN('Name').Value := Trim(V77P.Идентификатор);
aMSubk.FBN('FName').Value := Trim(V77P.Идентификатор);

aMSubk.Post;
MeterMove('Выборка субконто ' + ITS(Sbk) + ' :' + ITS(cnt));
inc(cnt);
end;
end;

try
T_Dsc := DscQueryCreate('MSUBK');
T_Dsc.StartTransaction;

dscMSubk := OpenDsc('MSUBK');
dscMSubk.LoadNewOrderClause(' ');
dscMSubk.LoadWhereClause('A.SBK=:SBK AND A.AKO=:AKO');
dscMSubk.GenerateQuery;

I_MSubk := MakeInsertErQuery('MSUBK');
if I_MSubk = nil then Exit;

aMSubk.First; cnt := 1;
while not aMSubk.eof do
with aMSubk do begin
MeterMove('Сохранение в БД: ' + ITS(cnt));

Kod := fbn('Ako').Value;

dscMSubk.PBN('SBK', ftInteger, Sbk);
dscMSubk.PBN('AKO', ftInteger, Kod);
dscMSubk.FastReopen;
if not dscMSubk.DataSet.EOF then // Уже есть такая запись
begin
Next;
Inc(cnt);
Continue;
end;

I_MSubk.PBN('SBK', ftInteger, Sbk);
I_MSubk.PBN('AKO', ftInteger, Kod);
for i := 0 to Fields.Count-1 do
I_MSubk.PBN(Fields.FieldName, Fields.DataType, fbn(Fields.FieldName).Value);

I_MSubk.ExecSQL;

aMSubk.Next;
Inc(cnt);
end;
// I_MSubk.CommitDB;
T_Dsc.Commit;
finally
T_Dsc.Rollback;
CloseDsc(dscMSubk);
CloseDsc(T_Dsc);
I_MSubk.Free;
end;

FreeAndNil(FieldsE2);
FreeAndNil(Fields1C);
aSubk.Next;
end;

SMsg('Импорт завершен успешно!');
finally
v77 := UnAssigned; V77Obj := UnAssigned; V77RS := UnAssigned; V77Bank := UnAssigned;
FreeAndNil(aSubk);
FreeAndNil(aMSubk);
if rules <> nil then FreeAndNil(rules);
if FieldsE2 <> nil then FreeAndNil(FieldsE2);
if Fields1C <> nil then FreeAndNil(Fields1C);
MeterClose;
end;
end;

procedure Exp1CDirect(ClickSbk: string; // Список субконто справочника
ReplaceData: boolean // Заменять существующие данные в 1С или оставить без изменения
); // ЭКСПОРТ

function Key1S(kod: integer): string;
begin
result := LPad(ITS(kod), 9);
end;

var
V77, V77Obj, V77RS, V77Bank: OleVariant;
aSubk, aMSubk, rules: TEraList;
Kod, kod2, cnt, i, kodPC: integer;
ObjName, fields: string;
IsDict: boolean; // Является ли данный тип 1C справочником или перечислением
FieldsE2, Fields1C: TStringList;

wc: string;
Sbk: integer;
begin
try
MeterOpen('Экспорт данных в 1С...');

V77 := Open1C(False);

ClickSbk := SindGetStrings(ClickSbk);
wc := 'SBK IN ('+ClickSbk+')';

aSubk := erLoadDF('Subk', wc, '');

aSubk.First(); // Удаляем перечисления и поля с пустыми строками в TYPESUBK_1C
while not aSubk.eof do
begin
ObjName := aSubk.fbn('TYPESUBK_1C').AsString;
IsDict := Pos(UpperCase('Справочник'), UpperCase(ObjName)) > 0;

if not IsDict then aSubk.Del else aSubk.Next;
end;

aSubk.First();
while not aSubk.eof do
begin
Sbk := aSubk.fbn('Sbk').Value;

ObjName := aSubk.fbn('TYPESUBK_1C').AsString;

rules := erLoadDF('Exchange1C', 'Sbk='+ITS(Sbk));
if rules.Count <= 0 then
begin
fields := 'Name';
FieldsE2 := TStringList.Create;
Fields1C := TStringList.Create;
FieldsE2.Add('Name');
Fields1C.Add('Наименование');
end else
begin
rules.First();
fields := '';
FieldsE2 := TStringList.Create;
Fields1C := TStringList.Create;
while not rules.eof do
begin
fields := fields + rules.fbn('FieldE2').AsString + ';';
FieldsE2.Add(rules.fbn('FieldE2').AsString);
if Trim(rules.fbn('Field1C').AsString) <> '' then
Fields1C.Add(rules.fbn('Field1C').AsString);
rules.Next;
end;
end;
if Sbk = 1 then
fields := fields + 'DefRS;NAMEBANK;BANKCITY;BIK;KS';

FreeAndNil(rules);

aMSubk := erLoadDF('MSubk', 'SBK='+ITS(Sbk), 'Ako;'+fields);

if aMSubk.Count <= 0 then
begin
FieldsE2.Free; Fields1C.Free;
aSubk.Next;
Continue;
end;

cnt := 1;

aMSubk.First();

V77Obj := V77.CreateObject(ObjName);
V77Obj.SelectItems;
V77Obj.SelectGroup(0);

while not aMSubk.eof do // Выборка
begin
Kod := aMSubk.fbn('Ako').Value;

if v77Obj.FindByCode(Key1S(Kod)) then
begin
if ReplaceData then
begin
for i := 0 to FieldsE2.Count-1 do
V77Obj.SetAttrib(Fields1C.Strings , aMSubk.fbn(FieldsE2.Strings).AsString);
v77Obj.Write;
end;
end else
begin
v77Obj.New;
V77Obj.Код := Kod;
for i := 0 to FieldsE2.Count-1 do
V77Obj.SetAttrib(Fields1C.Strings, aMSubk.fbn(FieldsE2.Strings).AsString);
v77Obj.Write;
end;

{ if Sbk = 1 then
begin
if Trim(aMSubk.fbn('DefRS').AsString) <> '' then
begin
V77RS := V77.CreateObject('Справочник.РасчетныеСчета');
V77RS.ИспользоватьВладельца(V77Obj.ТекущийЭлемент);

kodPC := 1;
while V77RS.НайтиПоКоду(ITS(kodPC)) > 0 do inc(kodPC);

V77RS.Новый;
V77RS.Код := kodPC;
V77RS.Наименование := 'Основной';
V77RS.Номер := aMSubk.fbn('DefRS').AsString;

V77Bank := V77.CreateObject('Справочник.Банки');
V77Bank.Новый;

V77Bank.Наименование := aMSubk.fbn('NAMEBANK').AsString;
V77Bank.Местонахождение := aMSubk.fbn('BANKCITY').AsString;
V77Bank.КоррСчет := aMSubk.fbn('KS').AsString;

try
kod2 := STI(aMSubk.fbn('BIK').Value);
except
kod2 := -1;
end;

if kod2 <> -1 then V77Bank.Код := kod2;

// V77RS.БанкОрганизации := V77Bank; // ??????????? КАК ?????
// ПроверкаБанка()
V77Bank.Записать;
V77RS.Записать;
end;
end;
}

aMSubk.Next;
MeterMove('Выгрузка в 1С субконто ' + ITS(Sbk) + ' :' + ITS(cnt));
inc(cnt);
end;

FreeAndNil(FieldsE2); FreeAndNil(Fields1C);
aSubk.Next;
end;

SMsg('Экспорт завершен успешно!');
finally
v77 := UnAssigned; V77Obj := UnAssigned; V77RS := UnAssigned; V77Bank := UnAssigned;
FreeAndNil(aSubk);
FreeAndNil(aMSubk);
if rules <> nil then FreeAndNil(rules);
if Assigned(FieldsE2) then FreeAndNil(FieldsE2);
if Assigned(Fields1C) then FreeAndNil(Fields1C);
MeterClose;
end;
end;

Работаем так года 4-ре

1 - В 1С блокируем добавление новых контраагентов, персонал, мест хранения и пр
2 - ввод новых идет только в наших программах
3 - модуль экспорта приведен выше
4 - структуры для связи с 1С имеют вид

Subk
Номер субконто, Имя субконто, Имя субконто в 1С
MSubk
Номер субконто. Код аналитики, Имя, ..........

PS: При некртрой смекалке проблем больших не возникает.
Проблема одна - скорость записи в 1С.
На чтение скорость более -менее.

Валентин К GRNPS: При некртрой смекалке проблем больших не возникает.
Проблема одна - скорость записи в 1С.
На чтение скорость более -менее.
Используется v7plus.dll ???

Если COM-сервер находится в ней , то.