Перевести код с С++ на Delphi

@kirill98402 · Регистрация: 06.09.2017

Студворк — интернет-сервис помощи студентам

Есть код формы архивации и распаковки БД написанный на С++, необходимо перевести на Delphi

C++
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
//---------------------------------------------------------------------------
 
#include <vcl.h>
#include <FileCtrl.hpp>
 
#pragma hdrstop
 
#include "F1Start.h"
#include "F2Category.h"
#include "F3Vud.h"
#include "F4Room.h"
#include "F5Arkhiv.h"
#include "F6Serchprintt.h"
#include "ShellAPI.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TF5Arkhivations *F5Arkhivations;
//---------------------------------------------------------------------------
__fastcall TF5Arkhivations::TF5Arkhivations(TComponent* Owner)
    : TForm(Owner)
{
}
//---------------------------------------------------------------------------
void __fastcall TF5Arkhivations::Button2Click(TObject *Sender)
{
TDateTime time_now;
time_now=time_now.CurrentDate();
 
AnsiString rar_name="Hotel_"+time_now;
AnsiString db_path=ExtractFileDir(Application->ExeName)+"\\Hotel.mdb";
AnsiString command_str=ExtractFileDir(Application->ExeName)+"\\rar.exe a -dh \""+Edit1->Text+"\\"+rar_name+".rar\" "+"\""+db_path+"\"";
system(command_str.c_str());
ShowMessage("Успішно.");
}
//---------------------------------------------------------------------------
void __fastcall TF5Arkhivations::Button1Click(TObject *Sender)
{
String Dir = Edit1->Text;
  if ( SelectDirectory(Dir, TSelectDirOpts() ,0) )
        Edit1->Text=Dir;
}
//---------------------------------------------------------------------------
void __fastcall TF5Arkhivations::Button3Click(TObject *Sender)
{
if (MessageDlg("Ви дійсно хочете відновити базу даних?\nІСНУЮЧА БАЗА ДАНИХ БУДЕ ВИДАЛЕНА!!!", mtConfirmation, TMsgDlgButtons() << mbYes << mbNo,0) == mrYes)
{
if (OpenDialog1->Execute())
    {
        F1Vxid->ADOConnection1->Connected=false;
        AnsiString un_path=OpenDialog1->FileName;
        AnsiString delete_db=ExtractFileDir(Application->ExeName)+"\\Hotel.mdb";
        AnsiString cmd="Del /q \""+delete_db+"\"";
        system(cmd.c_str());
        cmd=ExtractFileDir(Application->ExeName)+"\\rar.exe e \""+OpenDialog1->FileName+"\" \""+ExtractFileDir(Application->ExeName)+"\"";
        system(cmd.c_str());
        ShowMessage("База даних успішно відновлена.");
        F1Vxid->ADOConnection1->Connected=true;
    }
}
}
//---------------------------------------------------------------------------
void __fastcall TF5Arkhivations::FormKeyDown(TObject *Sender, WORD &Key, TShiftState Shift)
 
{
if (Key == VK_F1)
{
ShellExecuteW(Application->Handle,L"open",L"Help\\index.htm",NULL,NULL,SW_SHOWNORMAL);
}
}
//---------------------------------------------------------------------------

@GoodWeather · 12.06.2019, 01:06

Итоговый код какой получился у Вас?

@kirill98402 · 12.06.2019, 01:49 **[ТС]**

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

Итоговый код какой получился у Вас?

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
procedure TArkhivations.Button2Click(Sender: TObject);
var
time_now : string;
rar_name : AnsiString;
db_path : AnsiString;
command_str : AnsiString;
begin
time_now:=DateToStr(date);
rar_name:='Data_'+time_now;
db_path:=ExtractFileDir(Application.ExeName)+'\Data.mdb';
command_str:=ExtractFileDir(Application.ExeName)+'\Rar.exe a -dh '+Edit1.Text+'\'+rar_name+'.rar '+''+db_path+'';
ShowMessage(command_str);
Clipboard.AsText:=command_str;
ShellExecute(0, nil, 'cmd.exe', PChar('/C ' + command_str), nil, SW_HIDE);
ShowMessage('Успішно.');
end;

Проблема где-то в этой строке

Delphi
1
ShellExecute(0, nil, 'cmd.exe', PChar('/C ' + command_str), nil, SW_HIDE);

Ибо уже cmd открывает но путь не пишет

@D1973 · 12.06.2019, 04:33

А так?

Delphi
1
2
3
ChDir(ExtractFilePath(ParamStr(0)));
command_str:=Format('rar.exe a -dh %s.rar %s', [rar_name, db_path]);
ShellExecute (0, 'open', PChar(command_str), nil, nil, SW_SHOWNORMAL);

Добавлено через 1 минуту
Базу, естественно, предварительно надо отконнектить...

@kirill98402 · 12.06.2019, 10:19 **[ТС]**

[QUOTE=D1973;13649120]А так?

Delphi
1
2
3
ChDir(ExtractFilePath(ParamStr(0)));
command_str:=Format('rar.exe a -dh %s.rar %s', [rar_name, db_path]);
ShellExecute (0, 'open', PChar(command_str), nil, nil, SW_SHOWNORMAL);

Добавлено через 1 минуту
Базу, естественно, предварительно надо отконнектить

Не работает, может как то програмно создавать bat файл в него писать и его запускать?

Добавлено через 2 минуты
Оно попросту почему-то не записует мою строку с командой

@Пытливый · 12.06.2019, 11:41

Нет, не так... Погорячился

Добавлено через 23 минуты
Все дружно пишем одну и ту-же глупость

Должно быть так:

Delphi
1
ShellExecute (0, 'open', 'rar.exe', PChar(Format('a -dh "%s" "%s"', [rar_name, db_path])), nil, SW_SHOWNORMAL)

И еще один, чисто визуальный момент, лучше использовать WinRar.exe т.к. для rar.exe у вас запустится консолька и это некрасиво, а вот WinRar уже создаст нормально окно с процессом.

@kirill98402 · 12.06.2019, 13:32 **[ТС]**

Сообщение от Пытливый

Нет, не так... Погорячился

Добавлено через 23 минуты
Все дружно пишем одну и ту-же глупость

Должно быть так:

Delphi
1
ShellExecute (0, 'open', 'rar.exe', PChar(Format('a -dh "%s" "%s"', [rar_name, db_path])), nil, SW_SHOWNORMAL)

И еще один, чисто визуальный момент, лучше использовать WinRar.exe т.к. для rar.exe у вас запустится консолька и это некрасиво, а вот WinRar уже создаст нормально окно с процессом.

Ооо, спасибо огромное, только оно создало не архив а файл, без расширения
В чём трабла? Нету формата файла

Добавлено через 4 минуты
+ архивирует не только БД а и создаёт каталог Realese в который ложит БД, нужно чтобы только БД в архиве лежала

Добавлено через 34 минуты

Сообщение от Пытливый

Нет, не так... Погорячился

Добавлено через 23 минуты
Все дружно пишем одну и ту-же глупость

Должно быть так:

Delphi
1
ShellExecute (0, 'open', 'rar.exe', PChar(Format('a -dh "%s" "%s"', [rar_name, db_path])), nil, SW_SHOWNORMAL)

И еще один, чисто визуальный момент, лучше использовать WinRar.exe т.к. для rar.exe у вас запустится консолька и это некрасиво, а вот WinRar уже создаст нормально окно с процессом.

А какой код на розархивирование и удаление предедущей базы?

@Пытливый · 12.06.2019, 14:27

За правильное архивирование отвечают ключи, которые вы передаете вторым параметром. У архиватора целая туча настроек для этого. Разархивирование тоже определяется ключами и порядком файлов переданных в качестве параметров. Все это вы можете узнать если в консольке запустите rar.exe без параметров. Он вам выдаст на пару листов справку.

@drvolodko · 12.06.2019, 14:33

Ключик к рару в папке с раром есть?
используй cmd, bat, а внутри robocopy, copy, rar, zip для создания копий и не парь людям и себе мозг

Такие пути..... жесть

@kirill98402 · 12.06.2019, 19:52 **[ТС]**

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

Ключик к рару в папке с раром есть?
используй cmd, bat, а внутри robocopy, copy, rar, zip для создания копий и не парь людям и себе мозг

Такие пути..... жесть

Можно примеры с сopy позжалуйста? Протещу

@Пытливый · 12.06.2019, 21:24

Я тут подумал, а нафига вам вообще этот rar? Вам ведь просто архивировать надо, а чем именно, не столь важно. А раз так, то вот вам модуль работы с Zip. Там есть весь необходимый вам функционал:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
unit ZipTools;
 
interface
 
uses Classes;
 
Type
  TZipOption = (zoMove);
  TZipOptions = set of TZipOption;
 
  function ZipFile(ArchiveName: String; Filename: String; Options: TZipOptions = []): Boolean; overload;
  function ZipFile(ArchiveName: String; FileList: TStrings; Options: TZipOptions = []): Boolean; overload;
  function UnZipFile(ArchiveName, Path: String): Boolean;
 
implementation
 
uses SysUtils, Zip;
 
function ZipFile(ArchiveName: String; FileList: TStrings; Options: TZipOptions): Boolean;
var Zip: TZipFile;
    Filename: String;
begin
 Zip := TZipFile.Create;
 try
   if FileExists(ArchiveName)
   then DeleteFile(ArchiveName);
   Zip.Open(ArchiveName, zmWrite);
   for Filename in FileList
   do Zip.Add(Filename);
   Zip.Close;
   if zoMove in Options
   then for Filename in FileList
        do DeleteFile(FileName);
   Result := True;
 except
   Result := False;
 end;
 FreeAndNil(Zip);
end;
 
function ZipFile(ArchiveName: String; Filename: String; Options: TZipOptions): Boolean;
var Zip: TZipFile;
begin
 Zip := TZipFile.Create;
 try
   if FileExists(ArchiveName)
   then DeleteFile(ArchiveName);
   Zip.Open(ArchiveName, zmWrite);
   Zip.Add(Filename);
   Zip.Close;
   if zoMove in Options
   then DeleteFile(FileName);
   Result := True;
 except
   Result := False;
 end;
 FreeAndNil(Zip);
end;
 
function UnZipFile(ArchiveName, Path: String): Boolean;
var Zip: TZipFile;
begin
 Zip := TZipFile.Create;
 try
   Zip.Open(ArchiveName, zmRead);
   Zip.ExtractAll(Path);
   Zip.Close;
   Result := True;
 except
   Result := False;
 end;
 Zip.Free;
end;
 
end.

А работать с ним просто.

Delphi
1
2
3
4
5
6
7
8
9
Uses ZipTools; 
...
 
 ZipFile('I:\2\test.zip', 'I:\2\test.xml'); // Упаковываем один файл
 
 ZipFile('I:\2\test1.zip', OpenDialog1.Files); // Упаковываем пачку файлов
 ZipFile('I:\2\test1.zip', OpenDialog1.Files, [zoMove]); // Упаковываем пачку файлов с удалением 
 
 UnZipFile('I:\2\test.zip', 'I:\2\'); // Распаковываем архив

@GoodWeather · 13.06.2019, 00:31

Просто оставлю здесь: https://www.cyberforum.ru/post10316633.html, вторая половина поста.

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@GoodWeather 886 / 588 / 179 Регистрация: 28.02.2017 Сообщений: 2,359 Записей в блоге: 1
	12.06.2019, 01:06
	Итоговый код какой получился у Вас? 0

@Пытливый 3765 / 2272 / 706 Регистрация: 29.05.2013 Сообщений: 9,622
	12.06.2019, 14:27
	За правильное архивирование отвечают ключи, которые вы передаете вторым параметром. У архиватора целая туча настроек для этого. Разархивирование тоже определяется ключами и порядком файлов переданных в качестве параметров. Все это вы можете узнать если в консольке запустите rar.exe без параметров. Он вам выдаст на пару листов справку. 0

@drvolodko 224 / 68 / 33 Регистрация: 23.05.2014 Сообщений: 758
	12.06.2019, 14:33
	Ключик к рару в папке с раром есть? используй cmd, bat, а внутри robocopy, copy, rar, zip для создания копий и не парь людям и себе мозг Такие пути..... жесть 0

@GoodWeather 886 / 588 / 179 Регистрация: 28.02.2017 Сообщений: 2,359 Записей в блоге: 1
	13.06.2019, 00:31
	Просто оставлю здесь: https://www.cyberforum.ru/post10316633.html, вторая половина поста. 0