Показать сообщение отдельно
  #5  
Старый 10.05.2011, 11:52
Sleipnir Sleipnir вне форума
Прохожий
 
Регистрация: 06.05.2011
Сообщения: 18
Репутация: 10
По умолчанию

Код:
procedure TForm1.FormCreate(Sender: TObject);
var   Result: boolean;
var F: TextFile; S: String;
begin
Result := SQLConfigDataSource(0, 1,
  'Microsoft dBase Driver (*.dbf)', 'DSN=MYODBC;DBQ=C:\1C;DefaultDir=C:\1C;DriverId=277;FIL=dBase IV;MaxBufferSize=2048;PageTimeout=5'#0);

  ADOTable1.Active    := false;

  ADOTable1.LockType  := ltBatchOptimistic;

  if FileExists('C:\1C\PassStore.ini') then
    begin
      AssignFile(F,'C:\1C\PassStore.ini');
      Reset(F);
      ReadLn(F,S);
      S := Decrypt(S, StartKey, MultKey, AddKey);
      CloseFile(F);
      if FileExists('C:\1C\' + S + '.dbf') then
          begin
            CopyFile(PChar('C:\1C\' + S + '.dbf'), PChar('C:\1C\' + S + '_order.dbf'), false);
            ADOTable1.TableName := S + '_order';
            ADOTable1.Active    :=  true;
            DBGreedNames();
            ColumnResize();
          end
      else
        begin
          ADOTable1.Active    :=  false;
          ShowMessage('Загрузите прайс-лист');
        end
    end
  else
    begin
      ADOTable1.Active    :=  false;
      ShowMessage('Не обнаружен файл с сохраненным паролем.' + #13 +
                  'Настройте имя пользователя и пароль и сохраните их в файл.');
    end;
  if not DirectoryExists('C:\1C\Orders') then
    try
      CreateDir('C:\1C\Orders');
    except
      ShowMessage('При создании директории произошла ошибка');
    end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var F: TextFile; S, SS: String;
var   today : TDateTime;
begin
  ADOTable1.UpdateBatch();
  if FileExists('C:\1C\PassStore.ini') then
    begin
      AssignFile(F,'C:\1C\PassStore.ini');
      Reset(F);
      ReadLn(F,S);
      IdFTP1.Username := Decrypt(S, StartKey, MultKey, AddKey);
      ReadLn(F,S);
      IdFTP1.Password := Decrypt(S, StartKey, MultKey, AddKey);
      CloseFile(F);
    end;
  if IdFTP1.Connected = true then
  Begin
    IdFTP1.Abort;
    IdFTP1.Quit;
  End;
  try
    IdFTP1.Connect(true, 5000);
  except
    ShowMessage('Подключение не удалось.');
  end;

  if not DirectoryExists('C:\1C\Orders') then
    try
      CreateDir('C:\1C\Orders');
    except
      ShowMessage('При создании директории произошла ошибка');
    end;

  if DirectoryExists('C:\1C\Orders') then
    begin
      SS    := '';
      today := Now;
      SS    := SS + DateToStr(today);
      SS    := SS + TimeToStr(today);
      SS    := Replace(SS, '.', '');
      SS    := Replace(SS, ':', '');
      SS    := '_' + SS;
      CopyFile(PChar('C:\1C\' + IdFTP1.Username + '_order.dbf'), PChar('C:\1C\Orders\' + IdFTP1.Username + SS +'.dbf'), false);
    end;

  if IdFTP1.Connected = true then
    begin
      try
        IdFTP1.ChangeDir('/');
        IdFTP1.Put('C:\1C\Orders\' + IdFTP1.Username + SS + '.dbf', IdFTP1.Username + SS + '.dbf', false);

        ShowMessage('Заказ отправлен');
      except
        ShowMessage('Передача заказа не удалась');
      end;
    end;
  if IdFTP1.Connected = true then
  Begin
   IdFTP1.Abort;
   IdFTP1.Quit;
  End;
  if FileExists('C:\1C\' + IdFTP1.Username + '.dbf') then
    begin
      ADOTable1.Active    :=  false;
      CopyFile(PChar('C:\1C\' + IdFTP1.Username + '.dbf'), PChar('C:\1C\' + IdFTP1.Username + '_order.dbf'), false);
      ADOTable1.TableName := IdFTP1.Username + '_order';
      ADOTable1.Active    :=  true;
      DBGreedNames();
      ColumnResize();
    end;
  SumZakaz.Caption  := 'Сумма заказа 0 руб.';
end;
Aristarh Dark: ПРО ТЭГИ НЕ ЗАБЫВАЕМ!!!!
Ответить с цитированием