Перевести код с С++ на 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, вторая половина поста.

Новые блоги и статьи Все статьи Все блоги /
Оказывается, Unreal Engine позволяет качество на порядки выше, чем было в Lineedge Etyuhibosecyu 05.07.2026 Жаль, конечно, что я не узнал об этом, пока Lineedge существовала, а то бы Noname2331 написал, что волки превращаются в пиксельную кашу, а я бы его попросил скачать какую-нибудь бриллиантовую или Pro. . .	Doom для терминала без стрельбы и монстров. 3D Raycasting на ascii. dcc0 05.07.2026 Попросил нейронную сеть deepai. org написать рейкастинг 3D с библиотекой ncurses для Linux. Чтобы можно было ходить на стрелочки. Чтобы стены были отрисованы символами. Справилась. Первый вариант. . .	Установка статуса документа по условию Maks 05.07.2026 Алгоритм из решения ниже реализован на нетиповом документе "НарядПутевка" разработанного в КА2. Задача: в табличной части "Материалы" документа при записи автоматически устанавливать статус. . .	Сезонность и суточность закисления почв anaschu 04.07.2026 200 часов это все равно моловато. Есть ситуации, но нестандартные, когда смена происходит за 5 лет. Но обычно это 50 лет и более. Наверное, закисление почвы происходит сезонно в средней. . .
В чем ценность человеческого опыта в глобальном смысле? kumehtar 03.07.2026 Возможно, ценность человека не в том, что он однажды достигает мудрости, а в том, что он становится носителем карты пути. Он знает не только истину, но и последовательность внутренних изменений,. . .	интеграция AnyLogic с самописным REST API и переход на Odoo anaschu 03.07.2026 Успешная интеграция AnyLogic с самописным REST API и переход на промышленную Odoo WMS Сегодня проделал огромный путь от простой симуляции физических процессов до построения полноценной. . .	Поиск всех путей на ориентированном графе. Linux dcc0 02.07.2026 Переработка старого кода из моей статьи. Через несколько переработок от PHP кода к C89 (надеюсь, 89). Но довольно запутанно получилось. Код для Linux. Но если убрать time и то, что с ним. . .	Сам себя обучал rest api anaschu 02.07.2026 Педагогический лайфхак: Почему чистый REST API для ученика намного круче, чем готовые библиотеки Когда мы отказались от капризного JAR-файла AnyLogic и переписали код на стандартный HttpClient,. . .

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

@Пытливый 3764 / 2272 / 705 Регистрация: 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