Сделайте такую программу (копирования файлов из одной папки в другую)

[Serge_Bliznykov]

Сообщение от Syns1992

Хотя нет , замечаю опять в папке уже txt на пол гига

в моём коде стоит проверка и если файл TXT с таким же именем уже есть в папке, куда копируется, то ему даётся новое имя (перед именем добавляется нарастающее число).
Это если используется тот код, что я дал.

А так абсолютно непонятно, что за код Вы используете, где назначаете имя исходной папки, какие файлы есть в исходной папке, какие файлы "на пол гига" появляются в папке назначения.
если нужна конкретная помощь - то приводите больше конкретных фактов (код, описания, листинги папок до и после, скриншоты и т.д.)

Иначе - отладчик Вам в руки!

[Syns1992]

Спасибо за ответы, с копированием разобрался , все прекрасно работает.
Теперь есть проблемка.
Мне нужно запустить jar файл , средствами делфи не получилось .

Создал bat файл , который из директории в которой разположен jar , запускает его.
В виндовсе он работает, вот код:

java -jar LongLatPicker.jar

Jar запускается и выполняет свои действия.
Теперь нужно открыть bat файл в делфи , пробовал 2 функции , они работают, но jar не запускается .
Вот первая :

function FileExec( const CmdLine: String; bHide, bWait: Boolean): Boolean;
var
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
begin
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
with StartupInfo do
begin
cb := SizeOf(TStartupInfo);
dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
if bHide then
wShowWindow := SW_HIDE
else
wShowWindow := SW_SHOWNORMAL;
end;

Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
if Result then
CloseHandle(ProcessInfo.hThread);

if bWait then
if Result then
begin
WaitForInputIdle(ProcessInfo.hProce ss, INFINITE);
WaitForSingleObject(ProcessInfo.hPr ocess, INFINITE);
end;
if Result then
CloseHandle(ProcessInfo.hProcess);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
FileExec('C:\0brabotka\Ships\LatLon gPicker\storm.bat',False,True);
end;

написал в бат файле PAUSE (задержка) - и там была ошибка

C:\Users\User\Desktop\x>java -jar LongLatPicker.jar
Error: Unable to access jarfile LongLatPicker.jar

Тоесть файл всетаки запустился (батник) , но вот привычно не открыл jar

Также аналогично и с этой функцией, та же самая ошибка в командной строке :

ShellExecute(handle,'c:\autoexec.ba t',nil,nil,nil,SW_SHOW);

Подозреваю может что-то с правами администратора , или может ктото подскажет как открыть именно JAR ? , или может какой ни буть другой скрипт создать , чтоб потом запустить его в Делфи .

[Serge_Bliznykov]

попробуйте перед запуском jar файла сделать директорию с этим самым jar файлом текущей:

procedure TForm1.btn1Click(Sender: TObject);
begin
  SetCurrentDir('C:\0brabotka\Ships\LatLongPicker');
  FileExec('C:\0brabotka\Ships\LatLongPicker\storm.bat',False,True);
end;

или

procedure TForm1.btn1Click(Sender: TObject);
begin
  ChDir('C:\0brabotka\Ships\LatLongPicker');
  FileExec('C:\0brabotka\Ships\LatLongPicker\storm.bat',False,True);
end;

[Sciv]

Ага, с правами админа. Запускаем бат - бат для открытия jar ищет джаву (скорее всего через переменную среды JAVA_HOME) - находит в программ файлз и пытается запустить жабу.

Но поскольку сам батник (кстати, под виндой лучше юзать cmd) запущен не из под админа - то и доступа на запуск java из системной папки PF может не быть

Хотя вот из этого

Error: Unable to access jarfile LongLatPicker.jar

Скорее всего, Сергей прав, нужно прописывать полный путь до жара

[z-wer]

Может исходную директорию неправильно прописал, оно и будет тебе копировать файлы со всего диска с расширением .тхт

[Syns1992]

Спасибо помогло , но при отдельной программе и отдельной компиляции.
Но как только я добавляю в свою основную программу , выбивает ошибку.
Помогите в последний раз .

Вот весь код , пустая форма и одна кнопка :

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls, ShlObj, Buttons, ShellAPI, Masks, ExtCtrls;

type
  TForm1 = class(TForm)
    pnl1: TPanel;
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CopyDir(fromDir, toDir: string): boolean;
var
fos: TSHFileOpStruct;
todir2: string;
begin
todir2:=todir;
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
//fFlags := FOF_FILESONLY;
fFlags:= FOF_SIMPLEPROGRESS;
fflags:= fflags or FOF_NOCONFIRMATION;
fflags:= fflags or FOF_SILENT;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir2);
end;
Result := (0 = ShFileOperation(fos));
end;

const
  SELDIRHELP = 1000;


var curFileCount : integer;

procedure DirSearchAndCopy(Dir: string; Mask : string; DirDest : string);
var
  SearchRec: TSearchRec;
  destFileName : string; 
begin
  Dir := IncludeTrailingBackslash(Dir);

  if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      Application.ProcessMessages;

      if (SearchRec.Attr and faDirectory) <> 0 then begin
         // рекурсия 
         if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
                   DirSearchAndCopy(Dir + SearchRec.name, Mask, DirDest )

      end
      else begin
        if MatchesMask(ExtractFileName(SearchRec.Name), Mask) then begin
          destFileName := DirDest + '\' + SearchRec.Name;
          while FileExists( destFileName ) do begin
             Inc(curFileCount);
             destFileName := DirDest + '\' + IntToStr(curFileCount) + SearchRec.Name
          end; 
          CopyFile( PChar(Dir + SearchRec.Name), PChar( destFileName ), false);
        end;
      end;
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;





procedure TForm1.btn1Click(Sender: TObject);
var
  chosenDirectory : string;
begin

  if SelectDirectory('Выберете папку с кораблями!', '\\192.168.0.140\Na_obrabotku\14_Sentinel-1\2018', chosenDirectory)
  then ShowMessage('Обработка началась')
  else ShowMessage('Ошибка выбора папки');
  CopyDir(PChar (chosenDirectory), PChar ('C:\0_TEMP7'));
  curFileCount := 1;
  DirSearchAndCopy(chosenDirectory,'*.txt', 'C:\0brabotka\Ships\LatLongPicker\in')
  ChDir('C:\0brabotka\Ships\LatLongPicker');
  ShellExecute(0, nil,'C:\0brabotka\Ships\LatLongPicker\storm.bat',nil,nil,1);

end;

end.

Вот если с кнопки убрать две последние строки :
- там где устанавливаем текущую папку
- запускаем Бат ,

то программа выполняется замечательно .

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[Syns1992]

Нет ошибка возникает тогда , когда я не выбираю папку . Тоесть выполнение программы по расписанию , обязательно должно иметь главную причину : Выбранную папку , а вот когда я нажимаю отмену , у меня код продолжает обрабатываться , и так копирует все txt c всего ПК.

Вот в начале при выборе папки , нужно как то дописать , что когда я не выбираю папку , то программа сразу закрывается .

[Alex11223]

Причем тут права админа? Просто надо узнать об относительных/абсолютных путях и либо указать/изменить нужную текущую директорию, либо писать полные пути.

Сообщение от Sciv

батник (кстати, под виндой лучше юзать cmd)

А где тогда лучше батник? Под линуксом что ли?
И чем лучше?

Сообщение от Sciv

доступа на запуск java из системной папки PF может не быть

Не может, по крайней мере в стандартной конфигурации (без каких-нибудь изменений групповой политики для запрета всего подряд и т.п.)

[Serge_Bliznykov]

Сообщение от Syns1992

Вот в начале при выборе папки , нужно как то дописать , что когда я не выбираю папку , то программа сразу закрывается .

procedure TForm1.btn1Click(Sender: TObject);
var
  chosenDirectory : string;
begin

  if SelectDirectory('Выберете папку с кораблями!', '\\192.168.0.140\Na_obrabotku\14_Sentinel-1\2018', chosenDirectory)
  then begin
      ShowMessage('Обработка началась');
      CopyDir(PChar (chosenDirectory), PChar ('C:\0_TEMP7'));
      curFileCount := 1;
      DirSearchAndCopy(chosenDirectory,'*.txt', 'C:\0brabotka\Ships\LatLongPicker\in')
      ChDir('C:\0brabotka\Ships\LatLongPicker');
      ShellExecute(0, nil,'C:\0brabotka\Ships\LatLongPicker\storm.bat',nil,nil,1);
  end
  else ShowMessage('Ошибка выбора папки');

end;

[Syns1992]

Ошибка компиляции к сожалению не пропала (
Вот не пойму , убираю из тела кнопки 2 последние строчки , то компилируется , а так нет.
Снимок Ошибок , после компиляцией , перед компиляцией я очистил журнал.
Снимок.JPG
Вот еще раз полностью код:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls, ShlObj, Buttons, ShellAPI, Masks, ExtCtrls;

type
  TForm1 = class(TForm)
    pnl1: TPanel;
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CopyDir(fromDir, toDir: string): boolean;
var
fos: TSHFileOpStruct;
todir2: string;
begin
todir2:=todir;
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
//fFlags := FOF_FILESONLY;
fFlags:= FOF_SIMPLEPROGRESS;
fflags:= fflags or FOF_NOCONFIRMATION;
fflags:= fflags or FOF_SILENT;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir2);
end;
Result := (0 = ShFileOperation(fos));
end;

const
  SELDIRHELP = 1000;


var curFileCount : integer;

procedure DirSearchAndCopy(Dir: string; Mask : string; DirDest : string);
var
  SearchRec: TSearchRec;
  destFileName : string; 
begin
  Dir := IncludeTrailingBackslash(Dir);

  if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      Application.ProcessMessages;

      if (SearchRec.Attr and faDirectory) <> 0 then begin
         // рекурсия 
         if (SearchRec.name <> '.') and (SearchRec.name <> '..') then
                   DirSearchAndCopy(Dir + SearchRec.name, Mask, DirDest )

      end
      else begin
        if MatchesMask(ExtractFileName(SearchRec.Name), Mask) then begin
          destFileName := DirDest + '\' + SearchRec.Name;
          while FileExists( destFileName ) do begin
             Inc(curFileCount);
             destFileName := DirDest + '\' + IntToStr(curFileCount) + SearchRec.Name
          end; 
          CopyFile( PChar(Dir + SearchRec.Name), PChar( destFileName ), false);
        end;
      end;
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;





procedure TForm1.btn1Click(Sender: TObject);
var
  chosenDirectory : string;
begin

  if SelectDirectory('Выберете папку с кораблями!', '\\192.168.0.140\Na_obrabotku\14_Sentinel-1\2018', chosenDirectory)
  then begin
  ShowMessage('Обработка началась')
  CopyDir(PChar (chosenDirectory), PChar ('C:\0_TEMP7'));
  curFileCount := 1;
  DirSearchAndCopy(chosenDirectory,'*.txt', 'C:\0brabotka\Ships\LatLongPicker\in')
  ChDir('C:\0brabotka\Ships\LatLongPicker');
  ShellExecute(0, nil,'C:\0brabotka\Ships\LatLongPicker\storm.bat',nil,nil,1);
  end
  else  ShowMessage('Ошибка выбора папки);

end;

end.