Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> шифрование word и excel документа 
V
    Опции темы
MrDmitry
Дата 28.2.2012, 15:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Здравствуйте пишу небольшую программу под заказ по шифрованию данных. Шифровка строки или текстового файла происходит на ура. Но нужно еще и закодировать word и excel документ, а патом раскодировать. Решил делать шифровать по байтово. В общем примерно так

Код

procedure crypton_docxls(open_crypt_file,write_decrypt_file,key:string);
var
  h: THandle;
  data: array of string;
  len: Cardinal;
  dummy: Cardinal;
  i: Integer;
  crypt_file:TextFile;
  results,crypt:string;
begin
  h:=FileOpen(open_crypt_file,EmptyParam);
  len:=GetFileSize(h, nil);
  SetLength(data, len);
  ReadFile(h, data[0], len, dummy, nil);
  CloseHandle(h);
 assign(crypt_file, write_decrypt_file);
 rewrite(crypt_file);
  for i:=0 to dummy-1 do
   begin
     crypt:=crypton1(data[i],key,1); //кодируем 1 раз
     results:=crypton2(crypt);//Кодируем 2 раз
     Writeln(crypt_file, results); //Записываем результат 2 кодирования в файл
   end;
   CloseFile(crypt_file);
   CloseFile(crypt_file);
end;


Ошибка project crypt.exe raised exception class EvariantTypeCastError with message 'Could not convert variant of type (error) into type (Booleab)'

Решил сделать по другому


Код

procedure crypton_docxls(open_crypt_file,write_decrypt_file,key:string;mess:boolean);
var W:variant;
var f:TextFile;
var st:string;
var crypt, results:string;
begin
W:=CreateOleObject('Word.Application');// создаем объект для работы с ворд
 W.Documents.Open(open_crypt_file,false);
 st:=W.ActiveDocument.Range.Text;

 crypt:=crypton_zamena(st,key,1);
  results:=crypton_mendeleev(crypt);


AssignFile(f,'1.txt');
Rewrite(f);
Write(f,results);
closeFile(f);


W.Quit;
W:=UnAssigned;
end;


Здесь текст из word документа сохраняется в текстовый файл 1.txt. Но проблема в том что я не знаю как сделать обратное преобразование(то есть текст из txt файла перенести в doc) и к тому же таким способом я не смогу кодировать exl файлы (((

Кто что может посоветовать, на тему как можно правильно прочитать все содержимое word или exl документа, сделать над ним нужные действия и сохранить в файл(doc в doc exl соотвествено в exl файл). 

PS Думал может попробовать преобразовать doc или xls в html а патом уже шифровать как обычный текст файл. Но так и не смог сделать такого преобразования.

Это сообщение отредактировал(а) MrDmitry - 28.2.2012, 15:34
PM MAIL   Вверх
Чучмек
Дата 28.2.2012, 16:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЭТ БИЛЭТ
**


Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41
Цитата(MrDmitry @  28.2.2012,  15:32 Найти цитируемый пост)
шифровать по байтово

Код

prosedure crypt(data:pointer;datal:cardinal;key:pointer;keyl:cardinal);
var i,j:cardinal;
begin
j:=0;
for i:=0 to datal-1 do
 begin
 pbyte(cardinal(data)+i)^:=pbyte(cardinal(data)+i)^+pbyte(cardinal(key)+j)^;
 inc(j);
 if j>=keyl then j:=0;
 end;
end;


var buf:pointer;
bufl,rb:integer;

bufl:=keyl*N;


getmem(buf,bufl);

 h1:=fileopen(fn,0);
 h2:=filecreate(fn2);

repeat 
rb:=fileread(h1,buf^,bufl);
crypt(buf,bufl,key,keyl);
 filewrite(h2,buf^,bufl);
until rb<>bufl;

fileclose(h1);
fileclose(h2);







Это сообщение отредактировал(а) Чучмек - 28.2.2012, 16:19


--------------------
умную мысль держи при себе, а дурной - поделись с другими 
PM MAIL   Вверх
MrDmitry
Дата 28.2.2012, 21:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Дело в том что у меня свой алгоритм шифрования. И он шифрует построчно а не по байтово (В общем понимаю что сам себе противоречу., но вопрос заключается в том, как дернуть все текстовые данные из документа word и/или из ecxel и зашифровать их. Но чтоб при этом при декодировании осталось форматирования от оригинального документа. 

Например как кодировать-разкодировать word или excel документ методом замены?

Для тех кто не знает что за метод код паскаля:

Код

program subs3;

     type
       str80=string[80];

     var
       inf, outf: str80;
       alphabet, sub, sub2: str80;
       ch: char;

     {данная функция возвращает индекс в алфавите подстановки }

     function find(alphabet: str80; ch: char): integer;
     var
       t: integer;

     begin
       find:= -1;  { код ошибки }
       for t:= 1 to 27 do if ch=alphabet[t] then find:= t;
     end;  {find}

     {This function returns TRUE if ch is a letter
      of the alphabet.}
     function isalpha(ch: char): boolean;
     begin
       isalpha:= (upcase(ch)>='A') and (upcase(ch)<='Z');
     end;  {is alpha}

     procedure code(inf, outf: str80);
     var
       infile, outfile: file of char;
       ch: char;
       change: boolean;

     begin
       assign(infile, inf);
       reset(infile);
       assign(outfile, outf);
       rewrite(outfile);

     change  := TRUE;
     while not eof(infile) do
     begin
       Read(infile,ch);
       ch := upcase(ch);

       { переключение алфавитов при каждом пробеле }

       if ch=' ' then change  := not change;
       if isalpha(ch) then
       begin
         if change then
          ch:=sub[find(alphabet,ch)]
         else
          ch:=sub2[find(alphabet,ch)];
       end;
       Write(outfile, ch);
     end;
       WriteLn('файл закодирован ');
       close(infile); close(outfile);
     end;  {code}

     procedure decode(inf, outf: str80);
     var
       infile, outfile: file of char;
       ch: char;
       change: boolean;

     begin
       assign(infile, inf);
       reset(infile);
       assign(outfile, outf);
       rewrite(outfile);

       change  := TRUE;
       while not eof(infile) do
       begin
         Read(infile, ch);
         ch  := upcase(ch);
         if ch=' ' then change  := not change;
         if isalpha(ch) then
         begin
           if change then
             ch:=alphabet[find(sub, ch)] {find substitution}
           else
             ch:=alphabet[find(sub2, ch)]; {second sub}
         end;
         Write(outfile, ch);
       end;
       WriteLn('файл декодирован ');
       close(infile); close(outfile);
     end;

     begin
       alphabet:='ABCDEFGHIJKLMNOPQRSTUVWXYZ ';
       sub     :='QAZWSXEDCRFVTGBYHNUJM IKOLP'; {алфавит #1}
       sub2    :='POI UYTREWQASDFGHJKLMNBVCXZ'; {алфавит #2}

       Write('введите имя входного файла : ');
       ReadLn(inf);
       Write('введите имя выходного файла : ');
       ReadLn(outf);
       Write('кодировать или декодировать (C or D): ');
       ReadLn(ch);
       if upcase(ch)='C' then code(inf, outf)
       else if upcase(ch)='D' then decode(inf, outf);
     end.
PM MAIL   Вверх
Чучмек
Дата 28.2.2012, 21:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЭТ БИЛЭТ
**


Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41
Это не правильный подход.
Если так не хочется менять алгоритм шифрования -  перекодируй предварительно в base64


--------------------
умную мысль держи при себе, а дурной - поделись с другими 
PM MAIL   Вверх
MrDmitry
Дата 29.2.2012, 01:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Что значит не правильный подход? Почему?
PM MAIL   Вверх
MrDmitry
Дата 29.2.2012, 06:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Придумал как можно "выкрутиться"  из своей ситуации но не знаю как это реализовать.

Как через delphi стандартными средствами word можно сохранить документ как xml??

После такого сохранения я бы мог пройтись по получившемуся xml файлу своим шифрованием )
PM MAIL   Вверх
MrDmitry
Дата 29.2.2012, 07:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
В общем делаю так


Код

function Convertwort(FileName: string) : string;
var
  oWord: OleVariant;
  oDoc: OleVariant;
begin
  try
    oWord := GetActiveOleObject('Word.Application');
  except
    oWord := CreateOleObject('Word.Application');
  end;
  oWord.Documents.Open(FileName);
  oDoc  := oWord.ActiveDocument;
  FileName := ChangeFileExt(FileName, '.xml');

  oWord.ActiveDocument.SaveAs(fileName, $00000013,EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);

  oWord.ActiveDocument.Close(EmptyParam, EmptyParam);
  oWord.Quit(EmptyParam, EmptyParam, EmptyParam);
  oDoc := VarNull;
  oWord := VarNull;

  Result:=fileName;
end;


Документ преобразуется в xml но почему то вылетает ошибка (

project crypt.exe raised exception class EOleSysError with message 'Операция не доступна'
project crypt.exe raised exception class EOleException with message 'Таблица в документе повреждена'

как я уже писал, документ преобразуется в xml но код который следует ниже после вызова функции не выполняется ((
PM MAIL   Вверх
Чучмек
Дата 29.2.2012, 21:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЭТ БИЛЭТ
**


Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41
А рисунки из вордовского документа как хранить будешь?
Да и вообще, вордовский документ, кроме всего, архив. 


--------------------
умную мысль держи при себе, а дурной - поделись с другими 
PM MAIL   Вверх
MrDmitry
Дата 29.2.2012, 21:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Чесно говоря не думал. Но сейчас бы с этой ошибкой разобраться )
PM MAIL   Вверх
Чучмек
Дата 1.3.2012, 04:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЭТ БИЛЭТ
**


Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41
На вот, дарю
Код

{
Base64encode - кодирует в base64
data - Указатель на буфер с исходными данными
предварительно исходные данные необходимо выравнять нулями(#0) до кратности трем (!!!обязательно)
datal- размер данных для кодирования (с выравнивающими нулями)
размер буфера >=datal+1 (!!!обязательно)

resultbuf - указатель на буфер приемник
размер буфера >=4*datal/3 +1 (!!!обязательно)

После завершения Base64encode необходимо,по количеству выравнивающих нулей,
   заменить последние 1,2 или 0 символа  на ('=')
}
procedure Base64encode(data:pointer;datal:cardinal;resultbuf:pansichar);stdcall;
const
  codetable:array[0..63]of ansichar=(
  'A','B','C','D','E','F','G','H',
  'I','J','K','L','M','N','O','P',
  'Q','R','S','T','U','V','W','X',
  'Y','Z','a','b','c','d','e','f',
  'g','h','i','j','k','l','m','n',
  'o','p','q','r','s','t','u','v',
  'w','x','y','z','0','1','2','3',
  '4','5','6','7','8','9','+','/');
asm
pushad
xor edx,edx
mov eax,datal
mov ebx,3
div ebx
push eax
mov esi,data
mov edi,resultbuf
add edi,3
@b:
mov ebx,[esi]
bswap ebx
shr ebx,8
mov ecx,4
@a:
mov edx,$3f
and edx,ebx
mov [edi],dl
dec edi
shr ebx,6
loop @a
add esi,3
add edi,8
dec eax
jnz @b
pop ecx
shl ecx,2
mov esi,resultbuf
xor eax,eax
lea edi,codetable
@c:
mov al,[esi]
mov al,[edi+eax]
mov [esi],al
inc esi
loop @c
mov [esi],ah
popad
end;

{
Base64decode декодирует Base64 код.
datal кратна 4
размер выходного буфера >=3*datal/4 +1 (!!!обязательно)
выравнивающие "=" в исходном коде заменить на 'A' (!!!обязательно)
Размер раскодированных данных 3*datal/4 - n (n - количество символов "=" в конце исходного Base64 кода)

}

procedure Base64decode(data:pansichar;datal:cardinal;resultbuf:pointer);stdcall;
const
  codetable:array[0..255]of byte=(
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$3E,$FF,$FF,$FF,$3F,
  $34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,
  $0F,$10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$FF,$FF,$FF,$FF,$FF,
  $FF,$1A,$1B,$1C,$1D,$1E,$1F,$20,$21,$22,$23,$24,$25,$26,$27,$28,
  $29,$2A,$2B,$2C,$2D,$2E,$2F,$30,$31,$32,$33,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
  $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
asm
pushad
mov ecx,datal
lea edi,codetable
mov esi,data
xor eax,eax
@a:
mov al,[esi]
mov al,[edi+eax]
mov [esi],al
inc esi
loop @a
mov ecx,datal
shr ecx,2
mov esi,data
mov edi,resultbuf
@c:
xor eax,eax
mov ebx,4
@b:
or al,[esi]
shl eax,6
inc esi
dec ebx
jnz @b
shl eax, 2
bswap eax
mov [edi],eax
add edi,3
loop @c
popad
end;


Читай из файла по 96,192,384 байт (кратно 3)
кодируй в base64 строку
дальше кодируй своими функциями, сохраняй в текстовый файл.
Конечный файл неплохо еще упаковать.



--------------------
умную мысль держи при себе, а дурной - поделись с другими 
PM MAIL   Вверх
MrDmitry
Дата 1.3.2012, 15:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Ого огромное спасибо!
А как работать с этими процедурами? ((

procedure Base64encode(data:pointer;datal:cardinal;resultbuf:pansichar);stdcall;

data-сам файл?
datal - размер файла?
resultbuf - что за символ ему подсовывать? o0

Это сообщение отредактировал(а) MrDmitry - 1.3.2012, 15:50
PM MAIL   Вверх
MrDmitry
Дата 1.3.2012, 17:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Блин. Вот я глупый оказывается (((((((((((((

Не могу эту процедуру заиспользовать ( не понимаю что её нужно подсовывать если учитывать что ей нужно как то подсунуть файл.

Как я понял 


data-c:/1.doc
datal - размер файла
resultbuf - а что сюда надо я не понял. Или процедуру надо как то в цикле вызывать чтоб подсовывать сюда символ?
PM MAIL   Вверх
Чучмек
Дата 1.3.2012, 18:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


НЭТ БИЛЭТ
**


Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 14
Всего: 41
Код

var 
 m1:array[0..192] of byte;
 m2:array[0..256]of ansichar;
 rb:integer;


 repeat
 rb:=fileread(h1,m1,192);
 Base64encode(@m1,192,@m2);
 ....
 ....
 ....
 until rb<>192;



После выполнения Base64encode m2 ,будет содержать строку Base64 кода.
если rb<192 - необходимо выравнивание нулями.
Подробнее, если не разберешься, напишу позже.

Это сообщение отредактировал(а) Чучмек - 1.3.2012, 18:32


--------------------
умную мысль держи при себе, а дурной - поделись с другими 
PM MAIL   Вверх
MrDmitry
Дата 1.3.2012, 22:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
спасибо. Было бы хорошо если ты напишешь более подробно, чтоб патом небыло трудностей )

И сразу вопрос.


Код

rb:=fileread(h1,m1,192);
 Base64encode(@m1,192,@m2);


Получается кодироватся в base64 будет в тодже самый файл который будет указан в переменной h1?

Это сообщение отредактировал(а) MrDmitry - 1.3.2012, 22:43
PM MAIL   Вверх
MrDmitry
Дата 2.3.2012, 14:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 556
Регистрация: 10.11.2006

Репутация: нет
Всего: нет
Баааалиииин. Я серьезно не понимаю как тем способом который ты мне скинул можно зашифровать файл, учитывая что сам файл я ни где не указываю (
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0905 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.